launchdarkly-server-sdk 4.0.4 → 4.1.0
raw patch · 6 files changed
+149/−42 lines, 6 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- CHANGELOG.md +8/−0
- launchdarkly-server-sdk.cabal +1/−1
- src/LaunchDarkly/Server/Client/Internal.hs +1/−1
- src/LaunchDarkly/Server/Context/Internal.hs +25/−11
- src/LaunchDarkly/Server/Events.hs +24/−28
- test/Spec/Context.hs +90/−1
CHANGELOG.md view
@@ -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)
launchdarkly-server-sdk.cabal view
@@ -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 <https://github.com/launchdarkly/haskell-server-sdk#readme> category: Web
src/LaunchDarkly/Server/Client/Internal.hs view
@@ -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.
src/LaunchDarkly/Server/Context/Internal.hs view
@@ -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.
src/LaunchDarkly/Server/Events.hs view
@@ -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
test/Spec/Context.hs view
@@ -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 ]