diff --git a/contract-tests/src/Main.hs b/contract-tests/src/Main.hs index f183eec..d350b67 100644 --- a/contract-tests/src/Main.hs +++ b/contract-tests/src/Main.hs @@ -52,6 +52,8 @@ getAppStatus = , "anonymous-redaction" , "omit-anonymous-contexts" , "client-prereq-events" + , "event-gzip" + , "optional-event-gzip" ] } diff --git a/contract-tests/src/Types.hs b/contract-tests/src/Types.hs index 32f726b..8027850 100644 --- a/contract-tests/src/Types.hs +++ b/contract-tests/src/Types.hs @@ -45,6 +45,7 @@ data EventParams = EventParams , capacity :: !(Maybe Natural) , enableDiagnostics :: !(Maybe Bool) , allAttributesPrivate :: !(Maybe Bool) + , enableGzip :: !(Maybe Bool) , globalPrivateAttributes :: !(Maybe (Set Text)) , flushIntervalMs :: !(Maybe Natural) , omitAnonymousContexts :: !(Maybe Bool) diff --git a/contract-tests/src/Utils.hs b/contract-tests/src/Utils.hs index d2f99e8..866793b 100644 --- a/contract-tests/src/Utils.hs +++ b/contract-tests/src/Utils.hs @@ -66,7 +66,8 @@ eventConfig Nothing c = updateConfig LD.configSetSendEvents (Just False) c eventConfig (Just p) c = updateConfig LD.configSetEventsURI (getField @"baseUri" p) $ updateConfig LD.configSetEventsCapacity (getField @"capacity" p) $ - updateConfig LD.configSetAllAttributesPrivate (getField @"allAttributesPrivate" p) $ - updateConfig LD.configSetPrivateAttributeNames ((S.map R.makeReference) <$> getField @"globalPrivateAttributes" p) $ - updateConfig LD.configSetOmitAnonymousContexts (getField @"omitAnonymousContexts" p) $ - updateConfig LD.configSetFlushIntervalSeconds (getField @"flushIntervalMs" p) c + updateConfig LD.configSetCompressEvents (getField @"enableGzip" p) $ + updateConfig LD.configSetAllAttributesPrivate (getField @"allAttributesPrivate" p) $ + updateConfig LD.configSetPrivateAttributeNames ((S.map R.makeReference) <$> getField @"globalPrivateAttributes" p) $ + updateConfig LD.configSetOmitAnonymousContexts (getField @"omitAnonymousContexts" p) $ + updateConfig LD.configSetFlushIntervalSeconds (getField @"flushIntervalMs" p) c diff --git a/launchdarkly-server-sdk.cabal b/launchdarkly-server-sdk.cabal index 9baf220..3aa5c4f 100644 --- a/launchdarkly-server-sdk.cabal +++ b/launchdarkly-server-sdk.cabal @@ -5,7 +5,7 @@ cabal-version: 1.12 -- 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 category: Web @@ -126,6 +126,7 @@ library , unordered-containers >=0.2.10.0 && <0.3 , uuid >=1.3.13 && <1.4 , yaml >=0.11.5.0 && <0.12 + , zlib >=0.6.2.2 && <0.7 default-language: Haskell2010 test-suite haskell-server-sdk-test @@ -237,4 +238,5 @@ test-suite haskell-server-sdk-test , unordered-containers >=0.2.10.0 && <0.3 , uuid >=1.3.13 && <1.4 , yaml >=0.11.5.0 && <0.12 + , zlib >=0.6.2.2 && <0.7 default-language: Haskell2010 diff --git a/package.yaml b/package.yaml index 8f49f5f..0fcb5bc 100644 --- a/package.yaml +++ b/package.yaml @@ -48,6 +48,7 @@ dependencies: - unordered-containers >=0.2.10.0 && <0.3 - uuid >=1.3.13 && <1.4 - yaml >=0.11.5.0 && <0.12 + - zlib >= 0.6.2.2 && <0.7 default-extensions: - AllowAmbiguousTypes - DataKinds diff --git a/src/LaunchDarkly/Server/Config.hs b/src/LaunchDarkly/Server/Config.hs index e510daf..d9b2400 100644 --- a/src/LaunchDarkly/Server/Config.hs +++ b/src/LaunchDarkly/Server/Config.hs @@ -17,6 +17,7 @@ module LaunchDarkly.Server.Config , configSetContextKeyLRUCapacity , configSetUserKeyLRUCapacity , configSetEventsCapacity + , configSetCompressEvents , configSetLogger , configSetManager , configSetSendEvents @@ -53,6 +54,7 @@ makeConfig key = , baseURI = "https://sdk.launchdarkly.com" , streamURI = "https://stream.launchdarkly.com" , eventsURI = "https://events.launchdarkly.com" + , compressEvents = False , storeBackend = Nothing , storeTTLSeconds = 10 , streaming = True @@ -169,6 +171,16 @@ configSetUserKeyLRUCapacity = configSetContextKeyLRUCapacity configSetEventsCapacity :: Natural -> Config -> Config configSetEventsCapacity = setField @"eventsCapacity" +-- | +-- Should the event payload sent to LaunchDarkly use gzip compression. By +-- default this is false to prevent backward breaking compatibility issues with +-- older versions of the relay proxy. +-- +-- Customers not using the relay proxy are strongly encouraged to enable this +-- feature to reduce egress bandwidth cost. +configSetCompressEvents :: Bool -> Config -> Config +configSetCompressEvents = setField @"compressEvents" + -- | Set the logger to be used by the client. configSetLogger :: (LoggingT IO () -> IO ()) -> Config -> Config configSetLogger = setField @"logger" diff --git a/src/LaunchDarkly/Server/Config/Internal.hs b/src/LaunchDarkly/Server/Config/Internal.hs index 1481700..501bd7c 100644 --- a/src/LaunchDarkly/Server/Config/Internal.hs +++ b/src/LaunchDarkly/Server/Config/Internal.hs @@ -41,6 +41,7 @@ data Config = Config , pollIntervalSeconds :: !Natural , contextKeyLRUCapacity :: !Natural , eventsCapacity :: !Natural + , compressEvents :: !Bool , logger :: !(LoggingT IO () -> IO ()) , sendEvents :: !Bool , offline :: !Bool diff --git a/src/LaunchDarkly/Server/Network/Eventing.hs b/src/LaunchDarkly/Server/Network/Eventing.hs index 90e5d4d..4492c5a 100644 --- a/src/LaunchDarkly/Server/Network/Eventing.hs +++ b/src/LaunchDarkly/Server/Network/Eventing.hs @@ -1,5 +1,6 @@ module LaunchDarkly.Server.Network.Eventing (eventThread) where +import qualified Codec.Compression.GZip as GZip import Control.Concurrent (killThread, myThreadId) import Control.Concurrent.MVar (modifyMVar_, readMVar, swapMVar, takeMVar) import Control.Monad (forever, unless, void, when) @@ -59,7 +60,11 @@ updateLastKnownServerTime state serverTime = modifyMVar_ (getField @"lastKnownSe eventThread :: (MonadIO m, MonadLogger m, MonadMask m) => Manager -> Client -> ClientContext -> m () eventThread manager client clientContext = do - let state = getField @"events" client; config = getField @"config" client; httpConfig = httpConfiguration clientContext + let + state = getField @"events" client + config = getField @"config" client + compressEvents = getField @"compressEvents" config + httpConfig = httpConfiguration clientContext rngRef <- liftIO $ newStdGen >>= newIORef req <- (liftIO $ prepareRequest httpConfig $ (T.unpack $ getField @"eventsURI" config) ++ "/bulk") >>= pure . setEventHeaders void $ tryAuthorized client $ forever $ do @@ -69,12 +74,15 @@ eventThread manager client clientContext = do payloadId <- liftIO $ atomicModifyIORef' rngRef (swap . random) let encoded = encode events' + payload = if compressEvents then GZip.compress encoded else encoded thisReq = req - { requestBody = RequestBodyLBS encoded + { requestBody = RequestBodyLBS payload , requestHeaders = (requestHeaders req) - & \l -> addToAL l "X-LaunchDarkly-Payload-ID" (UUID.toASCIIBytes payloadId) + & \l -> + addToAL l "X-LaunchDarkly-Payload-ID" (UUID.toASCIIBytes payloadId) + & \l -> if compressEvents then addToAL l "Content-Encoding" "gzip" else l } (success, serverTime) <- processSend manager thisReq $(logDebug) $ T.append "sending events: " $ decodeUtf8 $ L.toStrict encoded