feat: Add option to enable compression of event payloads

contract-tests/src/Main.hs

@@ -52,6 +52,8 @@ getAppStatus =
                 , "anonymous-redaction"
                 , "omit-anonymous-contexts"
                 , "client-prereq-events"
+                , "event-gzip"
+                , "optional-event-gzip"
                 ]
             }
 

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)

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

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 <https://github.com/launchdarkly/haskell-server-sdk#readme>
 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

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

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"

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

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