launchdarkly-server-sdk 1.0.2 → 1.0.3
raw patch · 4 files changed
+38/−12 lines, 4 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- CHANGELOG.md +4/−0
- launchdarkly-server-sdk.cabal +2/−2
- src/LaunchDarkly/Server/Client/Internal.hs +1/−1
- src/LaunchDarkly/Server/Network/Streaming.hs +31/−9
CHANGELOG.md view
@@ -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). +## [1.0.3] - 2020-03-31+### Fixed:+- Standardize streaming retry behavior. Changed handling of status codes. Exponential back-off is now reset after 60 seconds of successful streaming.+ ## [1.0.2] - 2020-03-16 ### Fixed: - Added a timeout on SSE reads to 5 minutes.
launchdarkly-server-sdk.cabal view
@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 3d20deec805adbfa07184ad9027c2fbf90433f00cb1a39de56f50cf6601c419f+-- hash: 8f2c3f44424f5b9c9ba95a323f330e29386d03ef7f21f726dc3d733235bb828e name: launchdarkly-server-sdk-version: 1.0.2+version: 1.0.3 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
@@ -25,7 +25,7 @@ -- | The version string for this library. clientVersion :: Text-clientVersion = "1.0.2"+clientVersion = "1.0.3" -- | The status of the client initialization. data Status
src/LaunchDarkly/Server/Network/Streaming.hs view
@@ -3,7 +3,8 @@ import Data.Text (Text) import qualified Data.Text as T import Data.Attoparsec.Text as P hiding (Result, try)-import Control.Monad (void, mzero, forever)+import Data.Function (fix)+import Control.Monad (void, mzero) import Control.Monad.Catch (Exception, MonadCatch, try) import Control.Exception (throwIO) import Data.ByteString (ByteString)@@ -11,8 +12,8 @@ import Control.Applicative (many) import Data.Text.Encoding (decodeUtf8, encodeUtf8) import Data.HashMap.Strict (HashMap)-import Network.HTTP.Client (Manager, Response(..), Request, parseRequest, brRead, throwErrorStatusCodes)-import Control.Monad.Logger (MonadLogger, logInfo, logWarn, logError)+import Network.HTTP.Client (Manager, Response(..), Request, HttpException(..), HttpExceptionContent(..), parseRequest, brRead, throwErrorStatusCodes)+import Control.Monad.Logger (MonadLogger, logInfo, logWarn, logError, logDebug) import Control.Monad.IO.Class (MonadIO, liftIO) import Data.Generics.Product (getField) import Data.Aeson (FromJSON, parseJSON, withObject, eitherDecode, (.:), fromJSON, Result(..))@@ -21,8 +22,9 @@ import GHC.Generics (Generic) import Control.Monad.Catch (MonadMask) import Control.Retry (RetryPolicyM, RetryStatus, fullJitterBackoff, capDelay, retrying)-import Network.HTTP.Types.Status (ok200)+import Network.HTTP.Types.Status (ok200, Status(statusCode)) import System.Timeout (timeout)+import System.Clock (getTime, Clock(Monotonic), TimeSpec(TimeSpec)) import LaunchDarkly.Server.Client.Internal (ClientI) import LaunchDarkly.Server.Store.Internal (StoreHandle, StoreResult, initializeStore, insertFlag, deleteFlag, deleteSegment, insertSegment)@@ -163,19 +165,39 @@ -- https://aws.amazon.com/blogs/architecture/exponential-backoff-and-jitter/ retryPolicy :: MonadIO m => RetryPolicyM m-retryPolicy = capDelay (3600 * 1000000) $ fullJitterBackoff (1 * 1000000)+retryPolicy = capDelay (30 * 1000000) $ fullJitterBackoff (1 * 1000000) -handleStream :: (MonadIO m, MonadLogger m, MonadMask m) => Manager -> Request -> StoreHandle IO -> RetryStatus -> m Bool+data Failure = FailurePermanent | FailureTemporary | FailureReset deriving (Eq)++handleStream :: (MonadIO m, MonadLogger m, MonadMask m) => Manager -> Request -> StoreHandle IO -> RetryStatus -> m Failure handleStream manager request store _ = do+ $(logDebug) "starting new streaming connection"+ startTime <- liftIO $ getTime Monotonic status <- tryHTTP $ withResponseGeneric request manager $ \response -> checkAuthorization response >> if responseStatus response /= ok200 then throwErrorStatusCodes request response else readStream (responseBody response) store case status of- (Left err) -> $(logError) (T.intercalate " " ["HTTP Exception", T.pack $ show err]) >> pure True- (Right _) -> pure False+ (Right ()) -> liftIO (getTime Monotonic) >>= \now -> if now >= startTime + (TimeSpec 60 0)+ then do+ $(logError) "streaming connection closed after 60 seconds, retrying instantly"+ pure FailureReset+ else do+ $(logError) "streaming connection closed before 60 seconds, retrying after backoff"+ pure FailureTemporary+ (Left err) -> do+ $(logError) (T.intercalate " " ["HTTP Exception", T.pack $ show err])+ pure $ case err of+ (InvalidUrlException _ _) -> FailurePermanent+ (HttpExceptionRequest _ (StatusCodeException response _)) ->+ let code = statusCode (responseStatus response) in if code >= 400 && code < 500+ then if elem code [400, 408, 429] then FailureTemporary else FailurePermanent+ else FailureTemporary+ _ -> FailureTemporary streamingThread :: (MonadIO m, MonadLogger m, MonadMask m) => Manager -> ClientI -> m () streamingThread manager client = do let config = getField @"config" client; store = getField @"store" client; req <- prepareRequest config <$> liftIO (parseRequest $ T.unpack (getField @"streamURI" config) ++ "/all")- tryAuthorized client $ forever $ retrying retryPolicy (\_ status -> pure status) $ handleStream manager req store+ tryAuthorized client $ fix $ \loop ->+ retrying retryPolicy (\_ status -> pure $ status == FailureTemporary) (handleStream manager req store) >>=+ \case FailureReset -> loop; _ -> pure ()