launchdarkly-server-sdk 3.1.0 → 3.1.1

raw patch · 5 files changed

+56/−18 lines, 5 files

Files

• CHANGELOG.md +5/−0
• launchdarkly-server-sdk.cabal +1/−1
• src/LaunchDarkly/Server/Client/Internal.hs +1/−1
• src/LaunchDarkly/Server/Network/Common.hs +7/−0
• src/LaunchDarkly/Server/Network/Polling.hs +42/−16

@@ -2,6 +2,11 @@  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.1] - 2023-02-17+### Fixed:+- The polling thread will be shutdown if the LaunchDarkly polling API returns an unrecoverable response code.+- Updated dependency versions in the Redis store package to mirror the SDK requirements.+ ## [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.

@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           launchdarkly-server-sdk-version:        3.1.0+version:        3.1.1 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

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

@@ -6,6 +6,7 @@     , tryHTTP     , addToAL     , handleUnauthorized+    , isHttpUnrecoverable     ) where  import Data.ByteString.Internal            (unpackChars)@@ -56,3 +57,9 @@     where headers = responseHeaders response           date = fromMaybe "" $ lookup hDate headers           parsedTime = parseTimeM True defaultTimeLocale rfc822DateFormat (unpackChars date)++isHttpUnrecoverable :: Int -> Bool+isHttpUnrecoverable status+    | status < 400 || status >= 500 = False+    | status `elem` [400, 408, 429] = False+    | otherwise = True

@@ -5,15 +5,14 @@ import qualified Data.Text as                            T import           Network.HTTP.Client                     (Manager, Request(..), Response(..), httpLbs) import           Data.Generics.Product                   (getField)-import           Control.Monad                           (forever) import           Control.Concurrent                      (threadDelay) import           Data.Aeson                              (eitherDecode, FromJSON(..)) import           Control.Monad.Logger                    (MonadLogger, logInfo, logError) import           Control.Monad.IO.Class                  (MonadIO, liftIO) import           Control.Monad.Catch                     (MonadMask, MonadThrow)-import           Network.HTTP.Types.Status               (ok200)+import           Network.HTTP.Types.Status               (ok200, Status (statusCode)) -import           LaunchDarkly.Server.Network.Common      (checkAuthorization, tryHTTP, handleUnauthorized)+import           LaunchDarkly.Server.Network.Common      (checkAuthorization, tryHTTP, handleUnauthorized, isHttpUnrecoverable) import           LaunchDarkly.Server.Features            (Flag, Segment) import           LaunchDarkly.AesonCompat                (KeyMap) @@ -23,33 +22,60 @@ import LaunchDarkly.Server.Config.ClientContext import LaunchDarkly.Server.Client.Internal (Status(..)) import LaunchDarkly.Server.Config.HttpConfiguration (HttpConfiguration(..), prepareRequest)+import Data.ByteString.Lazy (ByteString)  data PollingResponse = PollingResponse     { flags    :: !(KeyMap Flag)     , segments :: !(KeyMap Segment)     } deriving (Generic, FromJSON, Show) -processPoll :: (MonadIO m, MonadLogger m, MonadMask m, MonadThrow m) => Manager -> DataSourceUpdates -> Request -> m ()+processPoll :: (MonadIO m, MonadLogger m, MonadMask m, MonadThrow m) => Manager -> DataSourceUpdates -> Request -> m Bool processPoll manager dataSourceUpdates request = liftIO (tryHTTP $ httpLbs request manager) >>= \case-    (Left err)       -> $(logError) (T.pack $ show err)-    (Right response) -> checkAuthorization response >> if responseStatus response /= ok200-        then $(logError) "unexpected polling status code"-        else case (eitherDecode (responseBody response) :: Either String PollingResponse) of-            (Left err)   -> $(logError) (T.pack $ show err)+    (Left err)       -> do+        $(logError) (T.pack $ show err)+        pure True+    (Right response) -> checkAuthorization response >> processResponse response++    where++    processResponse :: (MonadIO m, MonadLogger m, MonadMask m, MonadThrow m) => Response ByteString -> m Bool+    processResponse response+        | isHttpUnrecoverable $ statusCode $ responseStatus response = do+            $(logError) "polling stopping after receiving unrecoverable error"+            pure False+        | responseStatus response /= ok200 = do+            $(logError) "unexpected polling status code"+            pure True+        | otherwise = case (eitherDecode (responseBody response) :: Either String PollingResponse) of+            (Left err)   -> do+                $(logError) (T.pack $ show err)+                pure $ True             (Right body) -> do                 status <- liftIO $ dataSourceUpdatesInit dataSourceUpdates (getField @"flags" body) (getField @"segments" body)                 case status of-                  Right () -> liftIO $ dataSourceUpdatesSetStatus dataSourceUpdates Initialized-                  Left err ->+                  Right () -> do+                    liftIO $ dataSourceUpdatesSetStatus dataSourceUpdates Initialized+                    pure $ True+                  Left err -> do                     $(logError) $ T.append "store failed put: " err+                    pure $ True  ++ pollingThread :: (MonadIO m, MonadLogger m, MonadMask m) => Text -> Natural -> ClientContext -> DataSourceUpdates -> m () pollingThread baseURI pollingIntervalSeconds clientContext dataSourceUpdates = do     let pollingMicroseconds = fromIntegral pollingIntervalSeconds * 1000000-    req <- liftIO $ prepareRequest (httpConfiguration clientContext) (T.unpack baseURI ++ "/sdk/latest-all") -    handleUnauthorized dataSourceUpdates $ forever $ do+    req <- liftIO $ prepareRequest (httpConfiguration clientContext) (T.unpack baseURI ++ "/sdk/latest-all")+    handleUnauthorized dataSourceUpdates $ (poll req pollingMicroseconds)++    where++    poll :: (MonadIO m, MonadLogger m, MonadMask m) => Request -> Int -> m ()+    poll req pollingMicroseconds = do         $(logInfo) "starting poll"-        processPoll (tlsManager $ httpConfiguration clientContext) dataSourceUpdates req-        $(logInfo) "finished poll"-        liftIO $ threadDelay pollingMicroseconds+        processPoll (tlsManager $ httpConfiguration clientContext) dataSourceUpdates req >>= \case+            True -> do+                liftIO $ threadDelay pollingMicroseconds+                poll req pollingMicroseconds+            False -> pure ()