packages feed

launchdarkly-server-sdk 4.2.0 → 4.3.0

raw patch · 7 files changed

+86/−34 lines, 7 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

CHANGELOG.md view
@@ -2,6 +2,13 @@  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.3.0](https://github.com/launchdarkly/haskell-server-sdk/compare/4.2.0...4.3.0) (2024-10-24)+++### Features++* Add support for client-side prerequisite events ([#89](https://github.com/launchdarkly/haskell-server-sdk/issues/89)) ([a3bf10a](https://github.com/launchdarkly/haskell-server-sdk/commit/a3bf10acc4bebedadea9fdfcbded560cbda89d04))+ ## [4.2.0](https://github.com/launchdarkly/haskell-server-sdk/compare/4.1.0...4.2.0) (2024-08-23)  
launchdarkly-server-sdk.cabal view
@@ -1,11 +1,11 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.35.1.+-- This file has been generated from package.yaml by hpack version 0.37.0. -- -- see: https://github.com/sol/hpack  name:           launchdarkly-server-sdk-version:        4.2.0+version:        4.3.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@@ -66,6 +66,7 @@       LaunchDarkly.Server.Network.Streaming       LaunchDarkly.Server.Operators       LaunchDarkly.Server.Store.Internal+      LaunchDarkly.Server.Util       Paths_launchdarkly_server_sdk   hs-source-dirs:       src@@ -174,6 +175,7 @@       LaunchDarkly.Server.Reference       LaunchDarkly.Server.Store       LaunchDarkly.Server.Store.Internal+      LaunchDarkly.Server.Util       Paths_launchdarkly_server_sdk   hs-source-dirs:       test
src/LaunchDarkly/Server/Client.hs view
@@ -194,6 +194,7 @@     , trackEvents :: !Bool     , trackReason :: !Bool     , debugEventsUntilDate :: !(Maybe Natural)+    , prerequisites :: !(Maybe [Text])     }     deriving (Show, Generic) @@ -208,6 +209,7 @@                 , "trackReason" .= if getField @"trackReason" state then Just True else Nothing                 , "reason" .= getField @"reason" state                 , "debugEventsUntilDate" .= getField @"debugEventsUntilDate" state+                , "prerequisites" .= getField @"prerequisites" state                 ]  -- |@@ -236,13 +238,13 @@         Left _ -> pure AllFlagsState {evaluations = emptyObject, state = emptyObject, valid = False}         Right flags -> do             filtered <- pure $ (filterObject (\flag -> (not client_side_only) || isClientSideOnlyFlag flag) flags)-            details <- mapM (\flag -> (\detail -> (flag, fst detail)) <$> (evaluateDetail flag context HS.empty $ getField @"store" client)) filtered-            evaluations <- pure $ mapValues (getField @"value" . snd) details+            details <- mapM (\flag -> (\(detail, _, prereqs) -> (flag, (detail, prereqs))) <$> (evaluateDetail flag context HS.empty $ getField @"store" client)) filtered+            evaluations <- pure $ mapValues (getField @"value" . fst . snd) details             now <- unixMilliseconds             state <-                 pure $                     mapValues-                        ( \(flag, detail) -> do+                        ( \(flag, (detail, prereqs)) -> do                             let reason' = getField @"reason" detail                                 inExperiment = isInExperiment flag reason'                                 isDebugging = now < fromMaybe 0 (getField @"debugEventsUntilDate" flag)@@ -256,6 +258,7 @@                                 , trackEvents = trackEvents' || inExperiment                                 , trackReason = trackReason'                                 , debugEventsUntilDate = getField @"debugEventsUntilDate" flag+                                , prerequisites = prereqs                                 }                         )                         details
src/LaunchDarkly/Server/Client/Internal.hs view
@@ -21,7 +21,7 @@  -- | The version string for this library. clientVersion :: Text-clientVersion = "4.2.0" -- x-release-please-version+clientVersion = "4.3.0" -- x-release-please-version  -- | -- Client is the LaunchDarkly client. Client instances are thread-safe.
src/LaunchDarkly/Server/Evaluate.hs view
@@ -17,7 +17,7 @@ import Data.HashSet (HashSet) import qualified Data.HashSet as HS import Data.List (genericIndex)-import Data.Maybe (fromJust, fromMaybe, isJust)+import Data.Maybe (fromJust, fromMaybe, isJust, mapMaybe) import Data.Scientific (Scientific, floatingOrInteger) import Data.Text (Text) import qualified Data.Text as T@@ -37,6 +37,7 @@ import LaunchDarkly.Server.Operators (Op (OpSegmentMatch), getOperation) import LaunchDarkly.Server.Reference (getComponents, getError, isValid, makeLiteral, makeReference) import LaunchDarkly.Server.Store.Internal (LaunchDarklyStoreRead, getFlagC, getSegmentC)+import LaunchDarkly.Server.Util (fst3, snd3, trd)  setFallback :: EvaluationDetail Value -> Value -> EvaluationDetail Value setFallback detail fallback = case getField @"variationIndex" detail of@@ -55,26 +56,26 @@         if status /= Initialized             then pure $ EvaluationDetail fallback Nothing $ EvaluationReasonError EvalErrorClientNotReady             else-                evaluateInternalClient client key context (wrap fallback) includeReason >>= \detail ->+                evaluateInternalClient client key context (wrap fallback) includeReason >>= \(detail, _) ->                     pure $                         maybe                             (EvaluationDetail fallback Nothing $ if isError (getField @"reason" detail) then (getField @"reason" detail) else EvaluationReasonError EvalErrorWrongType)                             (setValue detail)                             (convert $ getField @"value" detail) -evaluateInternalClient :: Client -> Text -> Context -> Value -> Bool -> IO (EvaluationDetail Value)-evaluateInternalClient _ _ (Invalid _) fallback _ = pure $ errorDefault EvalErrorInvalidContext fallback+evaluateInternalClient :: Client -> Text -> Context -> Value -> Bool -> IO (EvaluationDetail Value, Maybe [Text])+evaluateInternalClient _ _ (Invalid _) fallback _ = pure $ (errorDefault EvalErrorInvalidContext fallback, Nothing) evaluateInternalClient client key context fallback includeReason = do-    (detail, unknown, events) <-+    (detail, unknown, events, prereqs) <-         getFlagC (getField @"store" client) key >>= \case             Left err -> do                 let event = newUnknownFlagEvent key fallback (EvaluationReasonError $ EvalErrorExternalStore err) context-                pure (errorDetail $ EvalErrorExternalStore err, True, pure event)+                pure (errorDetail $ EvalErrorExternalStore err, True, pure event, Nothing)             Right Nothing -> do                 let event = newUnknownFlagEvent key fallback (EvaluationReasonError EvalErrorFlagNotFound) context-                pure (errorDefault EvalErrorFlagNotFound fallback, True, pure event)+                pure (errorDefault EvalErrorFlagNotFound fallback, True, pure event, Nothing)             Right (Just flag) -> do-                (detail, events) <- evaluateDetail flag context HS.empty $ getField @"store" client+                (detail, events, prereqs) <- evaluateDetail flag context HS.empty $ getField @"store" client                 let detail' = setFallback detail fallback                 pure                     ( detail'@@ -88,9 +89,10 @@                             (getField @"reason" detail')                             Nothing                             context+                    , prereqs                     )     processEvalEvents (getField @"config" client) (getField @"events" client) context includeReason events unknown-    pure detail+    pure (detail, prereqs)  getOffValue :: Flag -> EvaluationReason -> EvaluationDetail Value getOffValue flag reason = case getField @"offVariation" flag of@@ -106,14 +108,14 @@     idx = fromIntegral index     variations = getField @"variations" flag -evaluateDetail :: (Monad m, LaunchDarklyStoreRead store m) => Flag -> Context -> HS.HashSet Text -> store -> m (EvaluationDetail Value, [EvalEvent])-evaluateDetail flag@(getField @"on" -> False) _ _ _ = pure (getOffValue flag EvaluationReasonOff, [])+evaluateDetail :: (Monad m, LaunchDarklyStoreRead store m) => Flag -> Context -> HS.HashSet Text -> store -> m (EvaluationDetail Value, [EvalEvent], Maybe [Text])+evaluateDetail flag@(getField @"on" -> False) _ _ _ = pure (getOffValue flag EvaluationReasonOff, [], Nothing) evaluateDetail flag context seenFlags store-    | HS.member (getField @"key" flag) seenFlags = pure (getOffValue flag $ EvaluationReasonError EvalErrorKindMalformedFlag, [])+    | HS.member (getField @"key" flag) seenFlags = pure (getOffValue flag $ EvaluationReasonError EvalErrorKindMalformedFlag, [], Nothing)     | otherwise =         checkPrerequisites flag context (HS.insert (getField @"key" flag) seenFlags) store >>= \case-            (Nothing, events) -> evaluateInternal flag context store >>= (\x -> pure (x, events))-            (Just detail, events) -> pure (detail, events)+            (Nothing, events, prereqs) -> evaluateInternal flag context store >>= (\x -> pure (x, events, prereqs))+            (Just detail, events, prereqs) -> pure (detail, events, prereqs)  status :: Prerequisite -> EvaluationDetail a -> Flag -> Bool status prereq result prereqFlag =@@ -129,32 +131,41 @@             then return [a]             else sequenceUntil p ms >>= \as -> return (a : as) -checkPrerequisites :: (Monad m, LaunchDarklyStoreRead store m) => Flag -> Context -> HS.HashSet Text -> store -> m (Maybe (EvaluationDetail Value), [EvalEvent])+checkPrerequisites :: (Monad m, LaunchDarklyStoreRead store m) => Flag -> Context -> HS.HashSet Text -> store -> m (Maybe (EvaluationDetail Value), [EvalEvent], Maybe [Text]) checkPrerequisites flag context seenFlags store =     let p = getField @"prerequisites" flag      in if null p-            then pure (Nothing, [])+            then pure (Nothing, [], Nothing)             else do-                evals <- sequenceUntil (isJust . fst) $ map (checkPrerequisite store context flag seenFlags) p-                pure (msum $ map fst evals, concatMap snd evals)+                evals <- sequenceUntil (isJust . fst3) $ map (checkPrerequisite store context flag seenFlags) p+                prereqs <- pure $ foldr (collectPrereqs . trd) Nothing evals+                pure (msum $ map fst3 evals, concatMap snd3 evals, prereqs)+  where+    collectPrereqs :: Maybe a -> Maybe [a] -> Maybe [a]+    collectPrereqs Nothing Nothing = Nothing+    collectPrereqs Nothing (Just x) = Just x+    collectPrereqs (Just x) Nothing = Just [x]+    collectPrereqs (Just x) (Just xs) = Just (x : xs) -checkPrerequisite :: (Monad m, LaunchDarklyStoreRead store m) => store -> Context -> Flag -> HS.HashSet Text -> Prerequisite -> m (Maybe (EvaluationDetail Value), [EvalEvent])+checkPrerequisite :: (Monad m, LaunchDarklyStoreRead store m) => store -> Context -> Flag -> HS.HashSet Text -> Prerequisite -> m (Maybe (EvaluationDetail Value), [EvalEvent], Maybe Text) checkPrerequisite store context flag seenFlags prereq =-    if HS.member (getField @"key" prereq) seenFlags-        then pure (Just $ errorDetail EvalErrorKindMalformedFlag, [])+    if HS.member prereqKey seenFlags+        then pure (Just $ errorDetail EvalErrorKindMalformedFlag, [], Nothing)         else-            getFlagC store (getField @"key" prereq) >>= \case-                Left err -> pure (pure $ getOffValue flag $ EvaluationReasonError $ EvalErrorExternalStore err, [])-                Right Nothing -> pure (pure $ getOffValue flag $ EvaluationReasonPrerequisiteFailed (getField @"key" prereq), [])+            getFlagC store prereqKey >>= \case+                Left err -> pure (pure $ getOffValue flag $ EvaluationReasonError $ EvalErrorExternalStore err, [], Nothing)+                Right Nothing -> pure (pure $ getOffValue flag $ EvaluationReasonPrerequisiteFailed prereqKey, [], Just prereqKey)                 Right (Just prereqFlag) -> evaluateDetail prereqFlag context seenFlags store >>= (process prereqFlag)   where-    process prereqFlag (detail, events)-        | isError (getField @"reason" detail) = pure (Just $ errorDetail EvalErrorKindMalformedFlag, mempty)+    prereqKey = getField @"key" prereq+    process prereqFlag (detail, events, _prereqs)+        | isError (getField @"reason" detail) = pure (Just $ errorDetail EvalErrorKindMalformedFlag, mempty, Just prereqKey)         | otherwise =             let event = newSuccessfulEvalEvent prereqFlag (getField @"variationIndex" detail) (getField @"value" detail) Nothing (getField @"reason" detail) (Just $ getField @"key" flag) context+                prereqKey = getField @"key" prereqFlag              in if status prereq detail prereqFlag-                    then pure (Nothing, event : events)-                    else pure (pure $ getOffValue flag $ EvaluationReasonPrerequisiteFailed (getField @"key" prereq), event : events)+                    then pure (Nothing, event : events, Just prereqKey)+                    else pure (pure $ getOffValue flag $ EvaluationReasonPrerequisiteFailed (getField @"key" prereq), event : events, Just prereqKey)  evaluateInternal :: (Monad m, LaunchDarklyStoreRead store m) => Flag -> Context -> store -> m (EvaluationDetail Value) evaluateInternal flag context store = result
+ src/LaunchDarkly/Server/Util.hs view
@@ -0,0 +1,21 @@+module LaunchDarkly.Server.Util+    ( fst3+    , snd3+    , trd+    )+where++-- |+-- Returns the first element of a 3-tuple.+fst3 :: (a, b, c) -> a+fst3 (x, _, _) = x++-- |+-- Returns the second element of a 3-tuple.+snd3 :: (a, b, c) -> b+snd3 (_, x, _) = x++-- |+-- Returns the third element of a 3-tuple.+trd :: (a, b, c) -> c+trd (_, _, x) = x
test/Spec/Evaluate.hs view
@@ -36,6 +36,7 @@             , reason = EvaluationReasonOff             }         , []+        , Nothing         )      context = makeContext "x" "user"@@ -80,6 +81,7 @@                     }             }         , []+        , Nothing         )      context = makeContext "x" "user"@@ -546,6 +548,7 @@                     }             }         , []+        , Nothing         )      expectedFailure =@@ -555,6 +558,7 @@             , reason = EvaluationReasonFallthrough {inExperiment = False}             }         , []+        , Nothing         )      orgContext = makeContext "x" "org"@@ -624,6 +628,7 @@                     }             }         , []+        , Nothing         )      expectedFailure =@@ -633,6 +638,7 @@             , reason = EvaluationReasonFallthrough {inExperiment = False}             }         , []+        , Nothing         )      userContext = makeContext "x" "user" & withAttribute "legs" (Number 4)@@ -702,6 +708,7 @@                     }             }         , []+        , Nothing         )      expectedFailure =@@ -711,6 +718,7 @@             , reason = EvaluationReasonFallthrough {inExperiment = False}             }         , []+        , Nothing         )      userContext = makeContext "x" "user" & withAttribute "attr~1a" (String "right")