launchdarkly-server-sdk 3.0.4 → 3.1.0

raw patch · 12 files changed

+167/−39 lines, 12 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +4/−0
• launchdarkly-server-sdk.cabal +2/−1
• src/LaunchDarkly/AesonCompat.hs +8/−2
• src/LaunchDarkly/Server.hs +4/−0
• src/LaunchDarkly/Server/Client.hs +15/−6
• src/LaunchDarkly/Server/Client/Internal.hs +1/−1
• src/LaunchDarkly/Server/Config.hs +19/−5
• src/LaunchDarkly/Server/Config/Internal.hs +49/−0
• src/LaunchDarkly/Server/Network/Common.hs +4/−18
• src/LaunchDarkly/Server/Network/Eventing.hs +8/−6
• test/Spec.hs +2/−0
• test/Spec/Config.hs +51/−0

@@ -2,6 +2,10 @@  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). +## [3.1.0] - 2023-01-27+### Added:+- New `ApplicationInfo` type, for configuration of application metadata that may be used in LaunchDarkly analytics or other product features. This does not affect feature flag evaluations.+ ## [3.0.4] - 2023-01-09 ### Changed: - Expanded upper version to allow `aeson-2.1`.  (Thanks, [vrom911](https://github.com/launchdarkly/haskell-server-sdk/pull/49))

@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           launchdarkly-server-sdk-version:        3.0.4+version:        3.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@@ -131,6 +131,7 @@   main-is: Spec.hs   other-modules:       Spec.Bucket+      Spec.Config       Spec.DataSource       Spec.Evaluate       Spec.Features

@@ -15,6 +15,9 @@ #if MIN_VERSION_aeson(2,0,0) type KeyMap = KeyMap.KeyMap +null :: KeyMap v -> Bool+null = KeyMap.null+ emptyObject :: KeyMap v emptyObject = KeyMap.empty @@ -64,10 +67,13 @@ mapMaybeValues = KeyMap.mapMaybe  keyMapUnion :: KeyMap.KeyMap v -> KeyMap.KeyMap v -> KeyMap.KeyMap v-keyMapUnion = KeyMap.union +keyMapUnion = KeyMap.union #else type KeyMap = HM.HashMap T.Text +null :: KeyMap v -> Bool+null = HM.null+ emptyObject :: KeyMap v emptyObject = HM.empty @@ -117,5 +123,5 @@ mapMaybeValues = HM.mapMaybe  keyMapUnion :: HM.HashMap T.Text v -> HM.HashMap T.Text v -> HM.HashMap T.Text v-keyMapUnion = HM.union +keyMapUnion = HM.union #endif

@@ -24,6 +24,10 @@     , configSetStoreTTL     , configSetUseLdd     , configSetDataSourceFactory+    , configSetApplicationInfo+    , ApplicationInfo+    , makeApplicationInfo+    , withApplicationValue     , User     , makeUser     , userSetKey

@@ -54,7 +54,7 @@ import           LaunchDarkly.Server.Client.Status            (Status(..)) import           LaunchDarkly.Server.Config.ClientContext     (ClientContext(..)) import           LaunchDarkly.Server.Config.HttpConfiguration (HttpConfiguration(..))-import           LaunchDarkly.Server.Config.Internal          (ConfigI, Config(..), shouldSendEvents)+import           LaunchDarkly.Server.Config.Internal          (ConfigI, Config(..), shouldSendEvents, getApplicationInfoHeader, ApplicationInfo) import           LaunchDarkly.Server.DataSource.Internal      (DataSource(..), DataSourceFactory, DataSourceUpdates(..), defaultDataSourceUpdates, nullDataSourceFactory) import           LaunchDarkly.Server.Details                  (EvaluationDetail(..), EvaluationReason(..), EvalErrorKind(..)) import           LaunchDarkly.Server.Evaluate                 (evaluateTyped, evaluateDetail)@@ -66,8 +66,10 @@ import           LaunchDarkly.Server.Store.Internal           (makeStoreIO, getAllFlagsC) import           LaunchDarkly.Server.User.Internal            (User(..), userSerializeRedacted) import           LaunchDarkly.AesonCompat                     (KeyMap, insertKey, emptyObject, mapValues, filterObject)-  +import Data.ByteString (ByteString)+import Network.HTTP.Types (HeaderName) + networkDataSourceFactory :: (ClientContext -> DataSourceUpdates -> LoggingT IO ()) -> DataSourceFactory networkDataSourceFactory threadF clientContext dataSourceUpdates = do     initialized <- liftIO $ newIORef False@@ -91,11 +93,18 @@ makeHttpConfiguration :: ConfigI -> IO HttpConfiguration makeHttpConfiguration config = do     tlsManager <- newManager tlsManagerSettings-    let defaultRequestHeaders = [ ("Authorization", encodeUtf8 $ getField @"key" config)-                                , ("User-Agent" , "HaskellServerClient/" <> encodeUtf8 clientVersion)-                                ]+    let headers = [ ("Authorization", encodeUtf8 $ getField @"key" config)+                  , ("User-Agent" , "HaskellServerClient/" <> encodeUtf8 clientVersion)+                  ]+        defaultRequestHeaders = addTagsHeader headers (getField @"applicationInfo" config)         defaultRequestTimeout = Http.responseTimeoutMicro $ fromIntegral $ getField @"requestTimeoutSeconds" config * 1000000     pure $ HttpConfiguration{..}+    where+        addTagsHeader :: [(HeaderName, ByteString)] -> Maybe ApplicationInfo -> [(HeaderName, ByteString)]+        addTagsHeader headers Nothing = headers+        addTagsHeader headers (Just info) = case getApplicationInfoHeader info of+            Nothing -> headers+            Just header -> ("X-LaunchDarkly-Tags", encodeUtf8 header) : headers  makeClientContext :: ConfigI -> IO ClientContext makeClientContext config = do@@ -119,7 +128,7 @@     dataSource <- dataSourceFactory config clientContext dataSourceUpdates     eventThreadPair    <- if not (shouldSendEvents config) then pure Nothing else do         sync   <- newEmptyMVar-        thread <- forkFinally (runLogger clientContext $ eventThread manager client) (\_ -> putMVar sync ())+        thread <- forkFinally (runLogger clientContext $ eventThread manager client clientContext) (\_ -> putMVar sync ())         pure $ pure (thread, sync)      dataSourceStart dataSource

@@ -27,7 +27,7 @@  -- | The version string for this library. clientVersion :: Text-clientVersion = "3.0.4"+clientVersion = "3.1.0"  setStatus :: ClientI -> Status -> IO () setStatus client status' =

@@ -24,23 +24,26 @@     , configSetStoreTTL     , configSetUseLdd     , configSetDataSourceFactory+    , configSetApplicationInfo+    , ApplicationInfo+    , makeApplicationInfo+    , withApplicationValue     ) where  import Control.Monad.Logger                (LoggingT, runStdoutLoggingT) import Data.Generics.Product               (setField) import Data.Set                            (Set) import Data.Text                           (Text, dropWhileEnd)-import Data.Monoid                         (mempty) import GHC.Natural                         (Natural) import Network.HTTP.Client                 (Manager) -import LaunchDarkly.Server.Config.Internal (Config(..), mapConfig, ConfigI(..))+import LaunchDarkly.Server.Config.Internal (Config(..), mapConfig, ConfigI(..), ApplicationInfo, makeApplicationInfo, withApplicationValue) import LaunchDarkly.Server.Store           (StoreInterface) import LaunchDarkly.Server.DataSource.Internal (DataSourceFactory)  -- | Create a default configuration from a given SDK key. makeConfig :: Text -> Config-makeConfig key = +makeConfig key =     Config $ ConfigI     { key                   = key     , baseURI               = "https://app.launchdarkly.com"@@ -61,8 +64,9 @@     , offline               = False     , requestTimeoutSeconds = 30     , useLdd                = False-    , dataSourceFactory     = Nothing +    , dataSourceFactory     = Nothing     , manager               = Nothing+    , applicationInfo       = Nothing     }  -- | Set the SDK key used to authenticate with LaunchDarkly.@@ -161,7 +165,7 @@ configSetUseLdd :: Bool -> Config -> Config configSetUseLdd = mapConfig . setField @"useLdd" --- | Sets a data source to use instead of the default network based data source +-- | Sets a data source to use instead of the default network based data source -- see "LaunchDarkly.Server.Integrations.FileData" configSetDataSourceFactory :: Maybe DataSourceFactory -> Config -> Config configSetDataSourceFactory = mapConfig . setField @"dataSourceFactory"@@ -170,3 +174,13 @@ -- 'Manager' will be created when creating the client. configSetManager :: Manager -> Config -> Config configSetManager = mapConfig . setField @"manager" . Just++-- | An object that allows configuration of application metadata.+--+-- Application metadata may be used in LaunchDarkly analytics or other product+-- features, but does not affect feature flag evaluations.+--+-- If you want to set non-default values for any of these fields, provide the+-- appropriately configured dict to the 'Config' object.+configSetApplicationInfo :: ApplicationInfo -> Config -> Config+configSetApplicationInfo = mapConfig . setField @"applicationInfo" . Just

@@ -3,11 +3,16 @@     , mapConfig     , ConfigI(..)     , shouldSendEvents+    , ApplicationInfo+    , makeApplicationInfo+    , withApplicationValue+    , getApplicationInfoHeader     ) where  import Control.Monad.Logger               (LoggingT) import Data.Generics.Product              (getField) import Data.Text                          (Text)+import qualified Data.Text as T import Data.Set                           (Set) import GHC.Natural                        (Natural) import GHC.Generics                       (Generic)@@ -15,6 +20,11 @@  import LaunchDarkly.Server.Store               (StoreInterface) import LaunchDarkly.Server.DataSource.Internal (DataSourceFactory)+import LaunchDarkly.AesonCompat (KeyMap, insertKey, emptyObject, toList)+import qualified LaunchDarkly.AesonCompat as AesonCompat+import Data.List (sortBy)+import Control.Lens ((&))+import Data.Ord (comparing)  mapConfig :: (ConfigI -> ConfigI) -> Config -> Config mapConfig f (Config c) = Config $ f c@@ -47,4 +57,43 @@     , useLdd                :: !Bool     , dataSourceFactory     :: !(Maybe DataSourceFactory)     , manager               :: !(Maybe Manager)+    , applicationInfo       :: !(Maybe ApplicationInfo)     } deriving (Generic)++-- | An object that allows configuration of application metadata.+--+-- Application metadata may be used in LaunchDarkly analytics or other product+-- features, but does not affect feature flag evaluations.+--+-- To use these properties, provide an instance of ApplicationInfo to the 'Config' with 'configSetApplicationInfo'.+newtype ApplicationInfo = ApplicationInfo (KeyMap Text) deriving (Show, Eq)++-- | Create a default instance+makeApplicationInfo :: ApplicationInfo+makeApplicationInfo = ApplicationInfo emptyObject++-- | Set a new name / value pair into the application info instance.+--+-- Values have the following restrictions:+-- - Cannot be empty+-- - Cannot exceed 64 characters in length+-- - Can only contain a-z, A-Z, 0-9, period (.), dash (-), and underscore (_).+--+-- Invalid values or unsupported keys will be ignored.+withApplicationValue :: Text -> Text -> ApplicationInfo -> ApplicationInfo+withApplicationValue _ "" info = info+withApplicationValue name value info@(ApplicationInfo map)+    | (name `elem` ["id", "version"]) == False = info+    | T.length(value) > 64 = info+    | (all (`elem` ['a'..'z'] ++ ['A' .. 'Z'] ++ ['0' .. '9'] ++ ['.', '-', '_']) (T.unpack value)) == False = info+    | otherwise = ApplicationInfo $ insertKey name value map++getApplicationInfoHeader :: ApplicationInfo -> Maybe Text+getApplicationInfoHeader (ApplicationInfo values)+    | AesonCompat.null values = Nothing+    | otherwise = toList values+        & sortBy (comparing fst)+        & map makeTag+        & T.unwords+        & Just+    where makeTag (key, value) = "application-" <> key <> "/" <> value

@@ -1,32 +1,26 @@ module LaunchDarkly.Server.Network.Common-    ( prepareRequest-    , withResponseGeneric+    ( withResponseGeneric     , tryAuthorized     , checkAuthorization     , getServerTime     , tryHTTP     , addToAL-    , handleUnauthorized +    , handleUnauthorized     ) where -import Data.ByteString                     (append) import Data.ByteString.Internal            (unpackChars)-import Network.HTTP.Client                 (HttpException, Manager, Request(..), Response(..), BodyReader, setRequestIgnoreStatus, responseOpen, responseTimeout, responseTimeoutMicro, responseClose)+import Network.HTTP.Client                 (HttpException, Manager, Request(..), Response(..), BodyReader, responseOpen, responseClose) import Network.HTTP.Types.Header           (hDate) import Network.HTTP.Types.Status           (unauthorized401, forbidden403)-import Data.Generics.Product               (getField)-import Data.Text.Encoding                  (encodeUtf8) import Data.Time.Format                    (parseTimeM, defaultTimeLocale, rfc822DateFormat) import Data.Time.Clock.POSIX               (utcTimeToPOSIXSeconds)-import Data.Function                       ((&)) import Data.Maybe                          (fromMaybe) import Control.Monad                       (when) import Control.Monad.Catch                 (Exception, MonadCatch, MonadMask, MonadThrow, try, bracket, throwM, handle) import Control.Monad.Logger                (MonadLogger, logError) import Control.Monad.IO.Class              (MonadIO, liftIO) -import LaunchDarkly.Server.Client.Internal     (ClientI, Status(Unauthorized), clientVersion, setStatus)-import LaunchDarkly.Server.Config.Internal     (ConfigI)+import LaunchDarkly.Server.Client.Internal     (ClientI, Status(Unauthorized), setStatus) import LaunchDarkly.Server.DataSource.Internal (DataSourceUpdates(..))  tryHTTP :: MonadCatch m => m a -> m (Either HttpException a)@@ -34,14 +28,6 @@  addToAL :: Eq k => [(k, v)] -> k -> v -> [(k, v)] addToAL l k v = (k, v) : filter ((/=) k . fst) l--prepareRequest :: ConfigI -> Request -> Request-prepareRequest config request = request-    { requestHeaders       = (requestHeaders request)-        & \l -> addToAL l "Authorization" (encodeUtf8 $ getField @"key" config)-        & \l -> addToAL l "User-Agent" (append "HaskellServerClient/" $ encodeUtf8 clientVersion)-    , responseTimeout      = responseTimeoutMicro $ (fromIntegral $ getField @"requestTimeoutSeconds" config) * 1000000-    } & setRequestIgnoreStatus  withResponseGeneric :: (MonadIO m, MonadMask m) => Request -> Manager -> (Response BodyReader -> m a) -> m a withResponseGeneric req man f = bracket (liftIO $ responseOpen req man) (liftIO . responseClose) f

@@ -7,7 +7,7 @@ import qualified Data.UUID as                        UUID import           Control.Monad.Logger                (MonadLogger, logDebug, logWarn, logError) import           Control.Monad.IO.Class              (MonadIO, liftIO)-import           Network.HTTP.Client                 (Manager, Request(..), RequestBody(..), httpLbs, parseRequest, responseStatus)+import           Network.HTTP.Client                 (Manager, Request(..), RequestBody(..), httpLbs, responseStatus) import           Data.Generics.Product               (getField) import qualified Data.Text as                        T import           Control.Concurrent                  (killThread, myThreadId)@@ -21,8 +21,10 @@ import           Network.HTTP.Types.Status           (status400, status408, status429, status500)  import           LaunchDarkly.Server.Client.Internal (ClientI, Status(ShuttingDown))-import           LaunchDarkly.Server.Network.Common  (tryAuthorized, checkAuthorization, getServerTime, prepareRequest, tryHTTP, addToAL)+import           LaunchDarkly.Server.Network.Common  (tryAuthorized, checkAuthorization, getServerTime, tryHTTP, addToAL) import           LaunchDarkly.Server.Events          (processSummary, EventState)+import LaunchDarkly.Server.Config.ClientContext+import LaunchDarkly.Server.Config.HttpConfiguration (prepareRequest)  -- A true result indicates a retry does not need to be attempted processSend :: (MonadIO m, MonadLogger m, MonadMask m, MonadThrow m) => Manager -> Request -> m (Bool, Integer)@@ -50,11 +52,11 @@ updateLastKnownServerTime :: EventState -> Integer -> IO () updateLastKnownServerTime state serverTime = modifyMVar_ (getField @"lastKnownServerTime" state) (\lastKnown -> pure $ max serverTime lastKnown) -eventThread :: (MonadIO m, MonadLogger m, MonadMask m) => Manager -> ClientI -> m ()-eventThread manager client = do-    let state = getField @"events" client; config = getField @"config" client;+eventThread :: (MonadIO m, MonadLogger m, MonadMask m) => Manager -> ClientI -> ClientContext -> m ()+eventThread manager client clientContext = do+    let state = getField @"events" client; config = getField @"config" client; httpConfig = httpConfiguration clientContext     rngRef <- liftIO $ newStdGen >>= newIORef-    req <- (liftIO $ parseRequest $ (T.unpack $ getField @"eventsURI" config) ++ "/bulk") >>= pure . setEventHeaders . prepareRequest config+    req <- (liftIO $ prepareRequest httpConfig $ (T.unpack $ getField @"eventsURI" config) ++ "/bulk") >>= pure . setEventHeaders     void $ tryAuthorized client $ forever $ do         liftIO $ processSummary config state         events' <- liftIO $ swapMVar (getField @"events" state) []

@@ -4,6 +4,7 @@ import           Test.HUnit    (runTestTT, Test(TestList, TestLabel))  import qualified Spec.Bucket+import qualified Spec.Config import qualified Spec.Evaluate import qualified Spec.Features import qualified Spec.Operators@@ -21,6 +22,7 @@ main :: IO () main = void $ runTestTT $ TestList     [ Spec.Bucket.allTests+    , Spec.Config.allTests     , Spec.Evaluate.allTests     , Spec.Features.allTests     , Spec.Operators.allTests

@@ -0,0 +1,51 @@+module Spec.Config (allTests) where+import Test.HUnit+import LaunchDarkly.Server (makeApplicationInfo)+import LaunchDarkly.Server.Config.Internal (makeApplicationInfo, withApplicationValue, getApplicationInfoHeader)+import Control.Lens ((&))++testEmptyApplicationInfoGeneratesNoHeader :: Test+testEmptyApplicationInfoGeneratesNoHeader = TestCase $ do+    assertEqual "" Nothing $ getApplicationInfoHeader $ makeApplicationInfo++testEmptyApplicationInfoIgnoresInvalidKeys :: Test+testEmptyApplicationInfoIgnoresInvalidKeys = TestCase $ do+    assertEqual "" emptyInfo modified++    where++    emptyInfo = makeApplicationInfo+    modified = withApplicationValue "invalid-key" "value" emptyInfo+        & withApplicationValue "another-invalid-key" "value"++testEmptyApplicationInfoIgnoresInvalidValues :: Test+testEmptyApplicationInfoIgnoresInvalidValues = TestCase $ do+    assertEqual "" emptyInfo modified++    where++    emptyInfo = makeApplicationInfo+    modified = withApplicationValue "id" " " emptyInfo+        & withApplicationValue "id" "&"+        & withApplicationValue "id" "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789._-a"++testCorrectlyGeneratesHeaderText :: Test+testCorrectlyGeneratesHeaderText = TestCase $ do+    assertEqual "" (Just "application-id/my-id application-version/my-version") value+    assertEqual "" (Just "application-id/my-id application-version/my-version") ignoreError++    where++    info = makeApplicationInfo+        & withApplicationValue "id" "my-id"+        & withApplicationValue "version" "my-version"+    value = getApplicationInfoHeader info+    ignoreError = withApplicationValue "version" "should-ignore-@me" info & getApplicationInfoHeader++allTests :: Test+allTests = TestList+    [ testEmptyApplicationInfoGeneratesNoHeader+    , testEmptyApplicationInfoIgnoresInvalidKeys+    , testEmptyApplicationInfoIgnoresInvalidValues+    , testCorrectlyGeneratesHeaderText+    ]