feat: Redact anonymous attributes within feature events (#68)

contract-tests/src/Main.hs

@@ -47,6 +47,7 @@ getAppStatus = json AppStatus
         , "secure-mode-hash"
         , "tags"
         , "inline-context"
+        , "anonymous-redaction"
         ]
     }
 

src/LaunchDarkly/Server/Context/Internal.hs

@@ -32,6 +32,7 @@ module LaunchDarkly.Server.Context.Internal
     , getCanonicalKey
     , getKinds
     , redactContext
+    , redactContextRedactAnonymous
     )
 where
 
@@ -400,14 +401,24 @@ parseMultiContext = withObject "MultiContext" $ \o -> do
 
 -- Internally used function which performs context attribute redaction.
 redactContext :: Config -> Context -> Value
-redactContext _ (Invalid _) = Null
-redactContext config (Multi MultiContext {contexts}) =
-    mapValues (\context -> redactSingleContext False context (getAllPrivateAttributes config context)) contexts
+redactContext config context = internalRedactContext config context False
+
+-- Internally used function which performs context attribute redaction.
+--
+-- If a provided context is anonymous, all attributes for that context will be
+-- redacted.
+redactContextRedactAnonymous :: Config -> Context -> Value
+redactContextRedactAnonymous config context = internalRedactContext config context True
+
+internalRedactContext :: Config -> Context -> Bool -> Value
+internalRedactContext _ (Invalid _) _ = Null
+internalRedactContext config (Multi MultiContext {contexts}) redactAnonymous =
+    mapValues (\context -> redactSingleContext False context (getAllPrivateAttributes config context redactAnonymous)) contexts
         & insertKey "kind" "multi"
         & Object
         & toJSON
-redactContext config (Single context) =
-    toJSON $ redactSingleContext True context (getAllPrivateAttributes config context)
+internalRedactContext config (Single context) redactAnonymous =
+    toJSON $ redactSingleContext True context (getAllPrivateAttributes config context redactAnonymous)
 
 -- Apply redaction requirements to a SingleContext type.
 redactSingleContext :: Bool -> SingleContext -> Set Reference -> Value
@@ -443,12 +454,15 @@ getAllTopLevelRedactableNames SingleContext {name = Just _, attributes = Just at
 -- Internally used convenience function to return a set of references which
 -- would apply all redaction rules.
 --
--- If allAttributesPrivate is True in the config, this will return a set which
--- covers the entire context.
-getAllPrivateAttributes :: Config -> SingleContext -> Set Reference
-getAllPrivateAttributes (getField @"allAttributesPrivate" -> True) context = getAllTopLevelRedactableNames context
-getAllPrivateAttributes config SingleContext {privateAttributes = Nothing} = getField @"privateAttributeNames" config
-getAllPrivateAttributes config SingleContext {privateAttributes = Just attrs} = S.union (getField @"privateAttributeNames" config) attrs
+-- This will return a set which covers the entire context if:
+--
+-- 1. The allAttributesPrivate config value is set to True, or
+-- 2. Anonymous attribute redaction is requested and the context is anonymous.
+getAllPrivateAttributes :: Config -> SingleContext -> Bool -> Set Reference
+getAllPrivateAttributes (getField @"allAttributesPrivate" -> True) context _ = getAllTopLevelRedactableNames context
+getAllPrivateAttributes _ context@(SingleContext {anonymous = True}) True = getAllTopLevelRedactableNames context
+getAllPrivateAttributes config SingleContext {privateAttributes = Nothing} _ = getField @"privateAttributeNames" config
+getAllPrivateAttributes config SingleContext {privateAttributes = Just attrs} _ = S.union (getField @"privateAttributeNames" config) attrs
 
 -- Internally used storage type for returning both the resulting redacted
 -- context and the list of any attributes which were redacted.

src/LaunchDarkly/Server/Events.hs

@@ -19,7 +19,7 @@ import GHC.Natural (Natural, naturalFromInteger)
 import LaunchDarkly.AesonCompat (KeyMap, insertKey, keyMapUnion, lookupKey, objectValues)
 import LaunchDarkly.Server.Config.Internal (Config, shouldSendEvents)
 import LaunchDarkly.Server.Context (Context)
-import LaunchDarkly.Server.Context.Internal (getCanonicalKey, getKinds, redactContext)
+import LaunchDarkly.Server.Context.Internal (getCanonicalKey, getKinds, redactContext, redactContextRedactAnonymous)
 import LaunchDarkly.Server.Details (EvaluationReason (..))
 import LaunchDarkly.Server.Features (Flag)
 
@@ -188,11 +188,19 @@ instance EventKind DebugEvent where
 instance ToJSON DebugEvent where
     toJSON (DebugEvent x) = toJSON x
 
+makeDebugEvent :: Config -> Context -> Bool -> EvalEvent -> DebugEvent
+makeDebugEvent config context includeReason event =
+    DebugEvent $ makeFeatureEventWithContextPayload (redactContext config context) includeReason event
+
 makeFeatureEvent :: Config -> Context -> Bool -> EvalEvent -> FeatureEvent
 makeFeatureEvent config context includeReason event =
+    makeFeatureEventWithContextPayload (redactContextRedactAnonymous config context) includeReason event
+
+makeFeatureEventWithContextPayload :: Value -> Bool -> EvalEvent -> FeatureEvent
+makeFeatureEventWithContextPayload context includeReason event =
     FeatureEvent
         { key = getField @"key" event
-        , context = redactContext config context
+        , context = context
         , value = getField @"value" event
         , defaultValue = getField @"defaultValue" event
         , version = getField @"version" event
@@ -357,7 +365,7 @@ processEvalEvent now config state context includeReason unknown event = do
         queueEvent config state $
             EventTypeDebug $
                 BaseEvent now $
-                    DebugEvent featureEvent
+                    makeDebugEvent config context includeReason event
     runSummary now state event unknown
     maybeIndexContext now config context state
 

test/Spec/Context.hs

@@ -12,7 +12,7 @@ import GHC.Exts (fromList)
 import LaunchDarkly.AesonCompat (lookupKey)
 import LaunchDarkly.Server.Config (configSetAllAttributesPrivate, makeConfig)
 import LaunchDarkly.Server.Context
-import LaunchDarkly.Server.Context.Internal (redactContext)
+import LaunchDarkly.Server.Context.Internal (redactContext, redactContextRedactAnonymous)
 import qualified LaunchDarkly.Server.Reference as R
 
 confirmInvalidContext :: Context -> Text -> Assertion
@@ -286,6 +286,7 @@ canRedactAllAttributesCorrectly = TestCase $ do
     assertEqual "" expectedRedacted (fromJust $ lookupKey "redactedAttributes" meta)
     assertEqual "" "user" (fromJust $ lookupKey "kind" decodedIntoMap)
     assertEqual "" "user-key" (fromJust $ lookupKey "key" decodedIntoMap)
+    assertEqual "" Nothing (lookupKey "name" decodedIntoMap)
     assertEqual "" Nothing (lookupKey "firstName" decodedIntoMap)
     assertEqual "" Nothing (lookupKey "lastName" decodedIntoMap)
     assertEqual "" Nothing (lookupKey "hobbies" decodedIntoMap)
@@ -310,6 +311,92 @@ canRedactAllAttributesCorrectly = TestCase $ do
     expectedRedacted = Array $ fromList ["address", "firstName", "hobbies", "lastName", "name"]
     expectedAddress = Object $ fromList [("state", "IL")]
 
+canRedactSingleKindAnonymousContextAttributesCorrectly :: Test
+canRedactSingleKindAnonymousContextAttributesCorrectly = TestCase $ do
+    assertEqual "" expectedRedacted (fromJust $ lookupKey "redactedAttributes" meta)
+    assertEqual "" "user" (fromJust $ lookupKey "kind" decodedIntoMap)
+    assertEqual "" "user-key" (fromJust $ lookupKey "key" decodedIntoMap)
+    assertEqual "" (Bool True) (fromJust $ lookupKey "anonymous" decodedIntoMap)
+    assertEqual "" Nothing (lookupKey "name" decodedIntoMap)
+    assertEqual "" Nothing (lookupKey "firstName" decodedIntoMap)
+    assertEqual "" Nothing (lookupKey "lastName" decodedIntoMap)
+    assertEqual "" Nothing (lookupKey "hobbies" decodedIntoMap)
+    assertEqual "" Nothing (lookupKey "address" decodedIntoMap)
+  where
+    config = makeConfig "sdk-key"
+
+    address = Object $ fromList [("city", "Chicago"), ("state", "IL")]
+
+    context =
+        makeContext "user-key" "user"
+            & withAnonymous True
+            & withAttribute "name" "Sandy"
+            & withAttribute "firstName" "Sandy"
+            & withAttribute "lastName" "Beaches"
+            & withAttribute "address" address
+            & withAttribute "hobbies" (Array $ fromList ["coding", "reading"])
+
+    jsonByteString = encode $ redactContextRedactAnonymous config context
+    decodedAsValue = fromJust $ decode jsonByteString :: Value
+    decodedIntoMap = case decodedAsValue of (Object o) -> o; _ -> error "expected object"
+    meta = case lookupKey "_meta" decodedIntoMap of (Just (Object o)) -> o; _ -> error "expected object"
+    expectedRedacted = Array $ fromList ["address", "firstName", "hobbies", "lastName", "name"]
+
+canRedactMultiKindAnonymousContextAttributesCorrectly :: Test
+canRedactMultiKindAnonymousContextAttributesCorrectly = TestCase $ do
+    assertEqual "" expectedRedacted (fromJust $ lookupKey "redactedAttributes" userMeta)
+
+    assertEqual "" "user-key" (fromJust $ lookupKey "key" userObj)
+    assertEqual "" (Bool True) (fromJust $ lookupKey "anonymous" userObj)
+    assertEqual "" Nothing (lookupKey "name" userObj)
+    assertEqual "" Nothing (lookupKey "firstName" userObj)
+    assertEqual "" Nothing (lookupKey "lastName" userObj)
+    assertEqual "" Nothing (lookupKey "hobbies" userObj)
+    assertEqual "" Nothing (lookupKey "address" userObj)
+
+    assertEqual "" "org-key" (fromJust $ lookupKey "key" orgObj)
+    assertEqual "" Nothing (lookupKey "anonymous" orgObj)
+    assertEqual "" "LaunchDarkly" (fromJust $ lookupKey "name" orgObj)
+    assertEqual "" "Launch" (fromJust $ lookupKey "firstName" orgObj)
+    assertEqual "" "Darkly" (fromJust $ lookupKey "lastName" orgObj)
+    assertEqual "" hobbies (fromJust $ lookupKey "hobbies" orgObj)
+    assertEqual "" address (fromJust $ lookupKey "address" orgObj)
+  where
+    config = makeConfig "sdk-key"
+
+    address = Object $ fromList [("city", "Chicago"), ("state", "IL")]
+    hobbies = Array $ fromList ["coding", "reading"]
+
+    userContext =
+        makeContext "user-key" "user"
+            & withAnonymous True
+            & withAttribute "name" "Sandy"
+            & withAttribute "firstName" "Sandy"
+            & withAttribute "lastName" "Beaches"
+            & withAttribute "address" address
+            & withAttribute "hobbies" hobbies
+
+    orgContext =
+        makeContext "org-key" "org"
+            & withAnonymous False
+            & withAttribute "name" "LaunchDarkly"
+            & withAttribute "firstName" "Launch"
+            & withAttribute "lastName" "Darkly"
+            & withAttribute "address" address
+            & withAttribute "hobbies" hobbies
+
+    multiContext = makeMultiContext [userContext, orgContext]
+
+    jsonByteString = encode $ redactContextRedactAnonymous config multiContext
+    decodedAsValue = fromJust $ decode jsonByteString :: Value
+    decodedIntoMap = case decodedAsValue of (Object o) -> o; _decodeFailure -> error "expected object"
+
+    userObj = case lookupKey "user" decodedIntoMap of (Just (Object o)) -> o; _decodeFailure -> error "expected object"
+    userMeta = case lookupKey "_meta" userObj of (Just (Object o)) -> o; _ -> error "expected object"
+    expectedRedacted = Array $ fromList ["address", "firstName", "hobbies", "lastName", "name"]
+
+    orgObj = case lookupKey "org" decodedIntoMap of (Just (Object o)) -> o; _decodeFailure -> error "expected object"
+
 allTests :: Test
 allTests =
     TestList
@@ -330,4 +417,6 @@ allTests =
         , canParseMultiKindFormat
         , canRedactAttributesCorrectly
         , canRedactAllAttributesCorrectly
+        , canRedactSingleKindAnonymousContextAttributesCorrectly
+        , canRedactMultiKindAnonymousContextAttributesCorrectly
         ]