diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,6 +2,14 @@ All notable changes to the LaunchDarkly Haskell Server-side SDK will be documented in this file. This project adheres to [Semantic Versioning](http://semver.org). +## [4.1.0](https://github.com/launchdarkly/haskell-server-sdk/compare/4.0.4...4.1.0) (2024-03-18) + + +### Features + +* Inline contexts for all evaluation events ([#67](https://github.com/launchdarkly/haskell-server-sdk/issues/67)) ([654df01](https://github.com/launchdarkly/haskell-server-sdk/commit/654df01c2136c0ce75f58600836b76c0e87337dd)) +* Redact anonymous attributes within feature events ([#68](https://github.com/launchdarkly/haskell-server-sdk/issues/68)) ([65a3f3d](https://github.com/launchdarkly/haskell-server-sdk/commit/65a3f3d342a51941358fe0b92c3d842cb9eb8007)) + ## [4.0.4](https://github.com/launchdarkly/haskell-server-sdk/compare/4.0.3...4.0.4) (2024-03-05) diff --git a/launchdarkly-server-sdk.cabal b/launchdarkly-server-sdk.cabal --- a/launchdarkly-server-sdk.cabal +++ b/launchdarkly-server-sdk.cabal @@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack name: launchdarkly-server-sdk -version: 4.0.4 +version: 4.1.0 synopsis: Server-side SDK for integrating with LaunchDarkly description: Please see the README on GitHub at category: Web diff --git a/src/LaunchDarkly/Server/Client/Internal.hs b/src/LaunchDarkly/Server/Client/Internal.hs --- a/src/LaunchDarkly/Server/Client/Internal.hs +++ b/src/LaunchDarkly/Server/Client/Internal.hs @@ -21,7 +21,7 @@ -- | The version string for this library. clientVersion :: Text -clientVersion = "4.0.4" -- x-release-please-version +clientVersion = "4.1.0" -- x-release-please-version -- | -- Client is the LaunchDarkly client. Client instances are thread-safe. diff --git a/src/LaunchDarkly/Server/Context/Internal.hs b/src/LaunchDarkly/Server/Context/Internal.hs --- a/src/LaunchDarkly/Server/Context/Internal.hs +++ b/src/LaunchDarkly/Server/Context/Internal.hs @@ -32,6 +32,7 @@ , getCanonicalKey , getKinds , redactContext + , redactContextRedactAnonymous ) where @@ -400,14 +401,24 @@ -- 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 @@ -- 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. diff --git a/src/LaunchDarkly/Server/Events.hs b/src/LaunchDarkly/Server/Events.hs --- a/src/LaunchDarkly/Server/Events.hs +++ b/src/LaunchDarkly/Server/Events.hs @@ -6,7 +6,7 @@ import Data.Aeson (ToJSON, Value (..), object, toJSON, (.=)) import Data.Cache.LRU (LRU, newLRU) import qualified Data.Cache.LRU as LRU -import Data.Generics.Product (HasField', field, getField, setField) +import Data.Generics.Product (field, getField) import qualified Data.HashSet as HS import Data.Maybe (fromMaybe) import Data.Text (Text) @@ -19,7 +19,7 @@ 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, getKeys, getKinds, redactContext) +import LaunchDarkly.Server.Context.Internal (getCanonicalKey, getKinds, redactContext, redactContextRedactAnonymous) import LaunchDarkly.Server.Details (EvaluationReason (..)) import LaunchDarkly.Server.Features (Flag) @@ -152,8 +152,7 @@ data FeatureEvent = FeatureEvent { key :: !Text - , context :: !(Maybe Value) - , contextKeys :: !(Maybe (KeyMap Text)) + , context :: !Value , value :: !Value , defaultValue :: !(Maybe Value) , version :: !(Maybe Natural) @@ -170,7 +169,6 @@ ((/=) Null . snd) [ ("key", toJSON $ getField @"key" event) , ("context", toJSON $ getField @"context" event) - , ("contextKeys", toJSON $ getField @"contextKeys" event) , ("value", toJSON $ getField @"value" event) , ("default", toJSON $ getField @"defaultValue" event) , ("version", toJSON $ getField @"version" event) @@ -190,31 +188,30 @@ instance ToJSON DebugEvent where toJSON (DebugEvent x) = toJSON x -addContextToEvent :: (HasField' "context" r (Maybe Value)) => Config -> Context -> r -> r -addContextToEvent config context event = setField @"context" (Just $ redactContext config context) event - -contextOrContextKeys :: Bool -> Config -> Context -> FeatureEvent -> FeatureEvent -contextOrContextKeys True config context event = addContextToEvent config context event & setField @"contextKeys" Nothing -contextOrContextKeys False _ context event = event {contextKeys = Just $ getKeys context, context = Nothing} +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 = - contextOrContextKeys False config context $ - FeatureEvent - { key = getField @"key" event - , context = Nothing - , contextKeys = Nothing - , value = getField @"value" event - , defaultValue = getField @"defaultValue" event - , version = getField @"version" event - , prereqOf = getField @"prereqOf" event - , variation = getField @"variation" event - , reason = - if includeReason || getField @"forceIncludeReason" event - then pure $ getField @"reason" event - else Nothing - } + makeFeatureEventWithContextPayload (redactContextRedactAnonymous config context) includeReason event +makeFeatureEventWithContextPayload :: Value -> Bool -> EvalEvent -> FeatureEvent +makeFeatureEventWithContextPayload context includeReason event = + FeatureEvent + { key = getField @"key" event + , context = context + , value = getField @"value" event + , defaultValue = getField @"defaultValue" event + , version = getField @"version" event + , prereqOf = getField @"prereqOf" event + , variation = getField @"variation" event + , reason = + if includeReason || getField @"forceIncludeReason" event + then pure $ getField @"reason" event + else Nothing + } + data CustomEvent = CustomEvent { key :: !Text , contextKeys :: !(KeyMap Text) @@ -368,8 +365,7 @@ queueEvent config state $ EventTypeDebug $ BaseEvent now $ - DebugEvent $ - contextOrContextKeys True config context featureEvent + makeDebugEvent config context includeReason event runSummary now state event unknown maybeIndexContext now config context state diff --git a/test/Spec/Context.hs b/test/Spec/Context.hs --- a/test/Spec/Context.hs +++ b/test/Spec/Context.hs @@ -12,7 +12,7 @@ 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 @@ 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 @@ 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 @@ , canParseMultiKindFormat , canRedactAttributesCorrectly , canRedactAllAttributesCorrectly + , canRedactSingleKindAnonymousContextAttributesCorrectly + , canRedactMultiKindAnonymousContextAttributesCorrectly ]