diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,5 @@ +# Change log + +All notable changes to the LaunchDarkly SDK for Haskell - Redis Integration will be documented in this file. This project adheres to [Semantic Versioning](https://semver.org). + + diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,13 @@ +Copyright 2023 Catamorphic, Co. + +Licensed under the Apache License, Version 2.0 (the "License"); +you may not use this file except in compliance with the License. +You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + +Unless required by applicable law or agreed to in writing, software +distributed under the License is distributed on an "AS IS" BASIS, +WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +See the License for the specific language governing permissions and +limitations under the License. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,45 @@ +# LaunchDarkly Server SDK for Haskell - Redis Integration + +[![Hackage](https://img.shields.io/hackage/v/launchdarkly-server-sdk-redis-hedis)](https://hackage.haskell.org/package/launchdarkly-server-sdk-redis-hedis) +[![CircleCI](https://circleci.com/gh/launchdarkly/haskell-server-sdk-redis-hedis.svg?style=shield)](https://circleci.com/gh/launchdarkly/haskell-server-sdk-redis-hedis) +[![Documentation](https://img.shields.io/static/v1?label=GitHub+Pages&message=API+reference&color=00add8)](https://launchdarkly.github.io/haskell-server-sdk-redis-hedis) + +## LaunchDarkly overview + +[LaunchDarkly](https://www.launchdarkly.com) is a feature management platform that serves over 100 billion feature flags daily to help teams build better software, faster. [Get started](https://docs.launchdarkly.com/home/getting-started) using LaunchDarkly today! + +[![Twitter Follow](https://img.shields.io/twitter/follow/launchdarkly.svg?style=social&label=Follow&maxAge=2592000)](https://twitter.com/intent/follow?screen_name=launchdarkly) + +## Supported Haskell versions + +This version of the LaunchDarkly SDK has been tested with Haskell v4. + +## Getting started + +Download a release archive from the [GitHub Releases](https://github.com/launchdarkly/haskell-server-sdk-redis-hedis/releases) for use in your project. Refer to the [SDK Redis documentation](https://docs.launchdarkly.com/sdk/features/storing-data/redis#haskell) for complete instructions on getting started with using the SDK with Redis. + +## Learn more + +Check out our [documentation](https://docs.launchdarkly.com) for in-depth instructions on configuring and using LaunchDarkly. You can also head straight to the [complete reference guide for this SDK](https://docs.launchdarkly.com/sdk/server-side/haskell) or our [code-generated API documentation](https://launchdarkly.github.io/haskell-server-sdk/). + +## Testing + +We run integration tests for all our SDKs using a centralized test harness. This approach gives us the ability to test for consistency across SDKs, as well as test networking behavior in a long-running application. These tests cover each method in the SDK, and verify that event sending, flag evaluation, stream reconnection, and other aspects of the SDK all behave correctly. + +## Contributing + +We encourage pull requests and other contributions from the community. Check out our [contributing guidelines](CONTRIBUTING.md) for instructions on how to contribute to this SDK. + +## About LaunchDarkly + +* LaunchDarkly is a continuous delivery platform that provides feature flags as a service and allows developers to iterate quickly and safely. We allow you to easily flag your features and manage them from the LaunchDarkly dashboard. With LaunchDarkly, you can: + * Roll out a new feature to a subset of your users (like a group of users who opt-in to a beta tester group), gathering feedback and bug reports from real-world use cases. + * Gradually roll out a feature to an increasing percentage of users, and track the effect that the feature has on key metrics (for instance, how likely is a user to complete a purchase if they have feature A versus feature B?). + * Turn off a feature that you realize is causing performance problems in production, without needing to re-deploy, or even restart the application with a changed configuration file. + * Grant access to certain features based on user attributes, like payment plan (eg: users on the ‘gold’ plan get access to more features than users in the ‘silver’ plan). Disable parts of your application to facilitate maintenance, without taking everything offline. +* LaunchDarkly provides feature flag SDKs for a wide variety of languages and technologies. Check out [our documentation](https://docs.launchdarkly.com/docs) for a complete list. +* Explore LaunchDarkly + * [launchdarkly.com](https://www.launchdarkly.com/ "LaunchDarkly Main Website") for more information + * [docs.launchdarkly.com](https://docs.launchdarkly.com/ "LaunchDarkly Documentation") for our documentation and SDK reference guides + * [apidocs.launchdarkly.com](https://apidocs.launchdarkly.com/ "LaunchDarkly API Documentation") for our API documentation + * [launchdarkly.com/blog](https://launchdarkly.com/blog/ "LaunchDarkly Blog Documentation") for the latest product updates diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/launchdarkly-server-sdk-redis-hedis.cabal b/launchdarkly-server-sdk-redis-hedis.cabal new file mode 100644 --- /dev/null +++ b/launchdarkly-server-sdk-redis-hedis.cabal @@ -0,0 +1,88 @@ +cabal-version: 1.12 + +-- This file has been generated from package.yaml by hpack version 0.35.1. +-- +-- see: https://github.com/sol/hpack + +name: launchdarkly-server-sdk-redis-hedis +version: 1.0.0 +synopsis: LaunchDarkly Server-Side SDK - Redis Integration +description: Redis integration for the LaunchDarkly SDK using hedis +category: Web +homepage: https://github.com/launchdarkly/haskell-server-sdk-redis-hedis#readme +bug-reports: https://github.com/launchdarkly/haskell-server-sdk-redis-hedis/issues +author: LaunchDarkly +maintainer: dev@launchdarkly.com +copyright: 2023 Catamorphic, Co +license: Apache-2.0 +license-file: LICENSE +build-type: Simple +extra-source-files: + README.md + CHANGELOG.md + LICENSE + +source-repository head + type: git + location: https://github.com/launchdarkly/haskell-server-sdk-redis-hedis + +library + exposed-modules: + LaunchDarkly.Server.Store.Redis + other-modules: + LaunchDarkly.Server.Store.Redis.Internal + Paths_launchdarkly_server_sdk_redis_hedis + hs-source-dirs: + src + default-extensions: + DataKinds + DeriveAnyClass + LambdaCase + OverloadedStrings + ScopedTypeVariables + TypeApplications + ghc-options: -fwarn-unused-imports -Wall -Wno-name-shadowing + build-depends: + aeson >=1.4.7.1 && <1.6 || >=2.0.1.0 && <2.2 + , base >=4.13.0.0 && <5 + , bytestring >=0.10.10.1 && <0.12 + , exceptions >=0.10.4 && <0.11 + , generic-lens >=2.0.0.0 && <2.3 + , hedis >=0.12.15 && <0.16 + , launchdarkly-server-sdk >=4.0 && <5 + , text >=1.2.4.0 && <2.1 + default-language: Haskell2010 + +test-suite haskell-server-sdk-redis-hedis-test + type: exitcode-stdio-1.0 + main-is: Spec.hs + other-modules: + Spec.Get + Spec.Initialization + Spec.Upsert + Util + LaunchDarkly.Server.Store.Redis + LaunchDarkly.Server.Store.Redis.Internal + Paths_launchdarkly_server_sdk_redis_hedis + hs-source-dirs: + test + src + default-extensions: + DataKinds + DeriveAnyClass + LambdaCase + OverloadedStrings + ScopedTypeVariables + TypeApplications + ghc-options: -rtsopts -threaded -with-rtsopts=-N -Wno-name-shadowing -fwarn-unused-imports -Wall + build-depends: + HUnit + , aeson >=1.4.7.1 && <1.6 || >=2.0.1.0 && <2.2 + , base >=4.13.0.0 && <5 + , bytestring >=0.10.10.1 && <0.12 + , exceptions >=0.10.4 && <0.11 + , generic-lens >=2.0.0.0 && <2.3 + , hedis >=0.12.15 && <0.16 + , launchdarkly-server-sdk + , text >=1.2.4.0 && <2.1 + default-language: Haskell2010 diff --git a/src/LaunchDarkly/Server/Store/Redis.hs b/src/LaunchDarkly/Server/Store/Redis.hs new file mode 100644 --- /dev/null +++ b/src/LaunchDarkly/Server/Store/Redis.hs @@ -0,0 +1,9 @@ +-- | The public interface for the LaunchDarkly Haskell Redis integration +module LaunchDarkly.Server.Store.Redis + ( RedisStoreConfig + , makeRedisStoreConfig + , redisConfigSetNamespace + , makeRedisStore + ) where + +import LaunchDarkly.Server.Store.Redis.Internal diff --git a/src/LaunchDarkly/Server/Store/Redis/Internal.hs b/src/LaunchDarkly/Server/Store/Redis/Internal.hs new file mode 100644 --- /dev/null +++ b/src/LaunchDarkly/Server/Store/Redis/Internal.hs @@ -0,0 +1,143 @@ +module LaunchDarkly.Server.Store.Redis.Internal + ( RedisStoreConfig + , makeRedisStoreConfig + , redisConfigSetNamespace + , makeRedisStore + ) where + +import Control.Exception (throwIO) +import Control.Monad (forM_, void) +import Control.Monad.Catch (Exception, Handler (..), catches) +import Control.Monad.IO.Class (MonadIO, liftIO) +import Data.Bifunctor (first) +import Data.ByteString (ByteString) +import Data.Functor ((<&>)) +import Data.Generics.Product (getField) +import Data.Maybe (isJust) +import Data.Text (Text) +import qualified Data.Text as T +import Data.Text.Encoding (decodeUtf8, encodeUtf8) +import Data.Typeable (Typeable) +import Database.Redis + ( Connection + , ConnectionLostException + , Redis + , Reply + , TxResult (..) + , del + , get + , hget + , hgetall + , hset + , multiExec + , runRedis + , set + , watch + ) + +import LaunchDarkly.AesonCompat (KeyMap, fromList, mapValues, objectKeys, toList) +import LaunchDarkly.Server.Store (PersistentDataStore (..), SerializedItemDescriptor (..), StoreResult, byteStringToVersionedData, serializeWithPlaceholder) + +-- | Opaque type used to configure the Redis store integration. +data RedisStoreConfig = RedisStoreConfig + { namespace :: Text + , connection :: Connection + } + +-- | Create a default config from a given connection pool. +makeRedisStoreConfig :: Connection -> RedisStoreConfig +makeRedisStoreConfig con = + RedisStoreConfig + { namespace = "launchdarkly" + , connection = con + } + +-- | +-- Configure the Redis key prefix. All keys are prefixed by default before +-- being inserted into Redis. The default prefix is "launchdarkly". +redisConfigSetNamespace :: Text -> RedisStoreConfig -> RedisStoreConfig +redisConfigSetNamespace namespace' config = config {namespace = namespace'} + +-- | +-- Construct a `PersistentDataStore` that can then be used during SDK +-- configuration. +makeRedisStore :: RedisStoreConfig -> IO PersistentDataStore +makeRedisStore config = + pure + PersistentDataStore + { persistentDataStoreUpsertFeature = redisUpsert config + , persistentDataStoreGetFeature = redisGetFeature config + , persistentDataStoreInitialize = redisInitialize config + , persistentDataStoreIsInitialized = redisIsInitialized config + , persistentDataStoreAllFeatures = redisGetAll config + } + +newtype RedisError = RedisError Text deriving (Typeable, Show, Exception) + +makeKey :: RedisStoreConfig -> Text -> ByteString +makeKey config key = encodeUtf8 $ T.concat [namespace config, ":", key] + +exceptOnReply :: (MonadIO m) => Either Reply a -> m a +exceptOnReply = \case + Left err -> liftIO $ throwIO $ RedisError $ T.pack $ show err + Right x -> pure x + +run :: RedisStoreConfig -> Redis a -> StoreResult a +run config action = + catches + (runRedis (connection config) action <&> pure) + [ Handler $ \(e :: ConnectionLostException) -> pure $ Left $ T.pack $ show e + , Handler $ \(RedisError err) -> pure $ Left err + ] + +createSerializedItemDescriptor :: ByteString -> SerializedItemDescriptor +createSerializedItemDescriptor byteString = SerializedItemDescriptor (Just byteString) 0 False + +redisInitialize :: RedisStoreConfig -> KeyMap (KeyMap SerializedItemDescriptor) -> StoreResult () +redisInitialize config values = run config $ do + del (map (makeKey config) $ objectKeys values) >>= void . exceptOnReply + forM_ (toList values) $ \(kind, features) -> forM_ (toList features) $ \(key, feature) -> + hset (makeKey config kind) (encodeUtf8 key) (serializeWithPlaceholder feature) >>= void . exceptOnReply + set (makeKey config "$inited") "" >>= void . exceptOnReply + +redisUpsert :: RedisStoreConfig -> Text -> Text -> SerializedItemDescriptor -> StoreResult Bool +redisUpsert = redisUpsertInternal (pure ()) + +redisUpsertInternal :: IO () -> RedisStoreConfig -> Text -> Text -> SerializedItemDescriptor -> StoreResult Bool +redisUpsertInternal hook config kind key opaque = run config tryUpsert + where + tryUpsert = + watch [space] + >>= void . exceptOnReply + >> hget space (encodeUtf8 key) + >>= exceptOnReply + >>= \x -> + liftIO hook >> case x of + Nothing -> doInsert + (Just byteString) -> case byteStringToVersionedData byteString of + Nothing -> pure True + Just decodedVersion -> + if getField @"version" decodedVersion >= getField @"version" opaque + then pure False + else doInsert + space = makeKey config kind + doInsert = + multiExec (hset space (encodeUtf8 key) (serializeWithPlaceholder opaque)) >>= \case + TxSuccess _ -> pure True + TxError err -> liftIO $ throwIO $ RedisError $ T.pack $ show err + TxAborted -> tryUpsert + +redisGetFeature :: RedisStoreConfig -> Text -> Text -> StoreResult (Maybe SerializedItemDescriptor) +redisGetFeature config kind key = + run config $ + hget (makeKey config kind) (encodeUtf8 key) + >>= exceptOnReply + >>= \result -> pure $ createSerializedItemDescriptor <$> result + +redisIsInitialized :: RedisStoreConfig -> StoreResult Bool +redisIsInitialized config = + run config $ (get (makeKey config "$inited") >>= exceptOnReply) <&> isJust + +redisGetAll :: RedisStoreConfig -> Text -> StoreResult (KeyMap SerializedItemDescriptor) +redisGetAll config kind = + run config $ (hgetall (makeKey config kind) >>= exceptOnReply) <&> (mapValues createSerializedItemDescriptor . fromList . map (first decodeUtf8)) diff --git a/test/Spec.hs b/test/Spec.hs new file mode 100644 --- /dev/null +++ b/test/Spec.hs @@ -0,0 +1,23 @@ +{-# LANGUAGE RecordWildCards #-} + +module Main where + +import Control.Monad (when) +import Test.HUnit (Counts (..), Test (TestLabel, TestList), runTestTT) + +import qualified Spec.Get +import qualified Spec.Initialization +import qualified Spec.Upsert + +import System.Exit (ExitCode (ExitFailure), exitWith) + +main :: IO () +main = do + Counts {..} <- + runTestTT $ + TestList + [ TestLabel "Get" Spec.Get.allTests + , TestLabel "Initialization" Spec.Initialization.allTests + , TestLabel "Upsert" Spec.Upsert.allTests + ] + when (errors + failures > 0) $ exitWith (ExitFailure 1) diff --git a/test/Spec/Get.hs b/test/Spec/Get.hs new file mode 100644 --- /dev/null +++ b/test/Spec/Get.hs @@ -0,0 +1,43 @@ +module Spec.Get (allTests) where + +import Data.Maybe (fromJust) +import LaunchDarkly.AesonCompat (lookupKey, mapValues) +import LaunchDarkly.Server.Store (PersistentDataStore (..), SerializedItemDescriptor (..)) +import Test.HUnit +import Util (defaultPrefix, initialData, initialFlag, makeDefaultRedisBackend) + +testCanExistingItem :: Test +testCanExistingItem = TestCase $ do + backend <- makeDefaultRedisBackend defaultPrefix + _ <- persistentDataStoreInitialize backend initialData + flag <- persistentDataStoreGetFeature backend "features" "first-flag" + + assertEqual "" (Right $ Just expectedFlag) flag + where + expectedFlag = initialFlag {version = 0, deleted = False} + +testHandlesNonExistentData :: Test +testHandlesNonExistentData = TestCase $ do + backend <- makeDefaultRedisBackend defaultPrefix + _ <- persistentDataStoreInitialize backend initialData + flag <- persistentDataStoreGetFeature backend "features" "does-not-exist" + + assertEqual "" (Right Nothing) flag + +testAllFlagsReturnsEveryFlag :: Test +testAllFlagsReturnsEveryFlag = TestCase $ do + backend <- makeDefaultRedisBackend defaultPrefix + _ <- persistentDataStoreInitialize backend initialData + flags <- persistentDataStoreAllFeatures backend "features" + + assertEqual "" (Right expectedFlags) flags + where + expectedFlags = mapValues (\flag -> flag {version = 0, deleted = False}) $ fromJust $ lookupKey "features" initialData + +allTests :: Test +allTests = + TestList + [ testCanExistingItem + , testHandlesNonExistentData + , testAllFlagsReturnsEveryFlag + ] diff --git a/test/Spec/Initialization.hs b/test/Spec/Initialization.hs new file mode 100644 --- /dev/null +++ b/test/Spec/Initialization.hs @@ -0,0 +1,71 @@ +module Spec.Initialization (allTests) where + +import LaunchDarkly.Server.Store (PersistentDataStore (..)) +import Test.HUnit +import Util (defaultPrefix, emptyData, initialData, makeDefaultRedisBackend) + +testClientIsNotInitializedByDefault :: Test +testClientIsNotInitializedByDefault = TestCase $ do + backend <- makeDefaultRedisBackend defaultPrefix + isInitialized <- persistentDataStoreIsInitialized backend + + assertEqual "" (Right False) isInitialized + +testClientCanBeMarkedAsInitialized :: Test +testClientCanBeMarkedAsInitialized = TestCase $ do + backend <- makeDefaultRedisBackend defaultPrefix + initResult <- persistentDataStoreInitialize backend initialData + isInitialized <- persistentDataStoreIsInitialized backend + + assertEqual "" (Right ()) initResult + assertEqual "" (Right True) isInitialized + +testClientCanSeeInitializiationFromAnotherClient :: Test +testClientCanSeeInitializiationFromAnotherClient = TestCase $ do + activeBackend <- makeDefaultRedisBackend defaultPrefix + passiveBackend <- makeDefaultRedisBackend defaultPrefix + _ <- persistentDataStoreInitialize activeBackend initialData + isActiveBackendInitialized <- persistentDataStoreIsInitialized activeBackend + isPassiveBackendInitialized <- persistentDataStoreIsInitialized passiveBackend + + assertEqual "" (Right True) isActiveBackendInitialized + assertEqual "" (Right True) isPassiveBackendInitialized + +testDifferentPrefixesAreIndependent :: Test +testDifferentPrefixesAreIndependent = TestCase $ do + initializedBackend <- makeDefaultRedisBackend "initialized" + uninitializedBackend <- makeDefaultRedisBackend "uninitialized" + _ <- persistentDataStoreInitialize initializedBackend initialData + isInitializedBackendInitialized <- persistentDataStoreIsInitialized initializedBackend + isUninitializedBackendInitialized <- persistentDataStoreIsInitialized uninitializedBackend + + assertEqual "" (Right True) isInitializedBackendInitialized + assertEqual "" (Right False) isUninitializedBackendInitialized + +testInitializationReplacesAllPreviousData :: Test +testInitializationReplacesAllPreviousData = TestCase $ do + backend <- makeDefaultRedisBackend defaultPrefix + _ <- persistentDataStoreInitialize backend initialData + _ <- persistentDataStoreIsInitialized backend + flagResult <- persistentDataStoreGetFeature backend "features" "first-flag" + segmentResult <- persistentDataStoreGetFeature backend "segments" "first-segment" + + case flagResult of Right (Just _) -> pure (); _ -> assertFailure "first-flag was not present" + case segmentResult of Right (Just _) -> pure (); _ -> assertFailure "first-segment was not present" + + _ <- persistentDataStoreInitialize backend emptyData + flagResult' <- persistentDataStoreGetFeature backend "features" "first-flag" + segmentResult' <- persistentDataStoreGetFeature backend "segments" "first-segment" + + case flagResult' of Right Nothing -> pure (); _ -> assertFailure "first-flag was not present" + case segmentResult' of Right Nothing -> pure (); _ -> assertFailure "first-segment was not present" + +allTests :: Test +allTests = + TestList + [ testClientIsNotInitializedByDefault + , testClientCanBeMarkedAsInitialized + , testClientCanSeeInitializiationFromAnotherClient + , testDifferentPrefixesAreIndependent + , testInitializationReplacesAllPreviousData + ] diff --git a/test/Spec/Upsert.hs b/test/Spec/Upsert.hs new file mode 100644 --- /dev/null +++ b/test/Spec/Upsert.hs @@ -0,0 +1,75 @@ +module Spec.Upsert (allTests) where + +import Data.ByteString (isInfixOf) +import Data.ByteString.Char8 (pack) +import Data.Char (toLower) +import GHC.Natural (Natural) +import qualified LaunchDarkly.Server.Store as Store +import Test.HUnit +import Text.Printf +import Util (defaultPrefix, emptyData, makeDefaultRedisBackend) + +createTestFlag :: Natural -> Bool -> Store.SerializedItemDescriptor +createTestFlag version deleted = + Store.SerializedItemDescriptor + { Store.item = Just $ pack $ printf "{\"deleted\":%s,\"version\":%d}" (map toLower $ show deleted) version + , Store.version = version + , Store.deleted = deleted + } + +testHandlesVersionsAppropriately :: Natural -> Natural -> Natural -> Test +testHandlesVersionsAppropriately initialVersion secondVersion expectedVersion = TestCase $ do + backend <- makeDefaultRedisBackend defaultPrefix + _ <- Store.persistentDataStoreInitialize backend emptyData + _ <- Store.persistentDataStoreUpsertFeature backend "features" "first-flag" $ createTestFlag initialVersion False + _ <- Store.persistentDataStoreUpsertFeature backend "features" "first-flag" $ createTestFlag secondVersion False + flag <- Store.persistentDataStoreGetFeature backend "features" "first-flag" + + assertEqual "" (Right $ Just expectedFlag) flag + where + expectedFlag = (createTestFlag expectedVersion False) {Store.version = 0, Store.deleted = False} + +testUpsertionAfterDeletionHandlesVersionsAppropriately :: Natural -> Natural -> Natural -> Bool -> Test +testUpsertionAfterDeletionHandlesVersionsAppropriately initialVersion secondVersion expectedVersion expectedDeletionStatus = TestCase $ do + backend <- makeDefaultRedisBackend defaultPrefix + _ <- Store.persistentDataStoreInitialize backend emptyData + _ <- Store.persistentDataStoreUpsertFeature backend "features" "first-flag" $ createTestFlag initialVersion True + _ <- Store.persistentDataStoreUpsertFeature backend "features" "first-flag" $ createTestFlag secondVersion False + flag <- Store.persistentDataStoreGetFeature backend "features" "first-flag" + + case flag of + Right (Just Store.SerializedItemDescriptor {Store.item = Just item, Store.version = 0, Store.deleted = False}) -> do + assertBool "" (expectedVersionString `isInfixOf` item) + assertBool "" (expectedDeletionString `isInfixOf` item) + _ -> assertFailure "failed to restore deleted file" + where + expectedVersionString = pack $ printf "\"version\":%d" expectedVersion + expectedDeletionString = pack $ printf "\"deleted\":%s" (map toLower $ show expectedDeletionStatus) + +testUpsertionToADeletionHandlesVersionsAppropriately :: Natural -> Natural -> Natural -> Bool -> Test +testUpsertionToADeletionHandlesVersionsAppropriately initialVersion secondVersion expectedVersion expectedDeletionStatus = TestCase $ do + backend <- makeDefaultRedisBackend defaultPrefix + _ <- Store.persistentDataStoreInitialize backend emptyData + _ <- Store.persistentDataStoreUpsertFeature backend "features" "first-flag" $ createTestFlag initialVersion False + _ <- Store.persistentDataStoreUpsertFeature backend "features" "first-flag" $ createTestFlag secondVersion True + flag <- Store.persistentDataStoreGetFeature backend "features" "first-flag" + + case flag of + Right (Just Store.SerializedItemDescriptor {Store.item = Just item, Store.version = 0, Store.deleted = False}) -> do + assertBool "" (expectedVersionString `isInfixOf` item) + assertBool "" (expectedDeletionString `isInfixOf` item) + _ -> assertFailure "failed to restore deleted file" + where + expectedVersionString = pack $ printf "\"version\":%d" expectedVersion + expectedDeletionString = pack $ printf "\"deleted\":%s" (map toLower $ show expectedDeletionStatus) + +allTests :: Test +allTests = + TestList + [ TestLabel "Newer versions replace older" $ testHandlesVersionsAppropriately 1 2 2 + , TestLabel "Older versions do not replace newer" $ testHandlesVersionsAppropriately 2 1 2 + , TestLabel "Newer versions replace older" $ testUpsertionAfterDeletionHandlesVersionsAppropriately 1 2 2 False + , TestLabel "Older versions do not replace newer" $ testUpsertionAfterDeletionHandlesVersionsAppropriately 2 1 2 True + , TestLabel "Newer versions replace older" $ testUpsertionToADeletionHandlesVersionsAppropriately 1 2 2 True + , TestLabel "Older versions do not replace newer" $ testUpsertionToADeletionHandlesVersionsAppropriately 2 1 2 False + ] diff --git a/test/Util.hs b/test/Util.hs new file mode 100644 --- /dev/null +++ b/test/Util.hs @@ -0,0 +1,37 @@ +module Util where + +import Control.Monad (void) +import Data.Function ((&)) +import qualified Data.Text as T +import qualified Data.Text.Encoding as T +import qualified Database.Redis as R +import LaunchDarkly.AesonCompat (KeyMap, emptyObject, insertKey, singleton) +import LaunchDarkly.Server.Store (PersistentDataStore (..), SerializedItemDescriptor (..)) +import LaunchDarkly.Server.Store.Redis (makeRedisStore, makeRedisStoreConfig, redisConfigSetNamespace) + +defaultPrefix :: T.Text +defaultPrefix = "launchdarkly-test-prefix" + +emptyData :: KeyMap (KeyMap SerializedItemDescriptor) +emptyData = + emptyObject + & insertKey "features" emptyObject + & insertKey "segments" emptyObject + +initialFlag :: SerializedItemDescriptor +initialFlag = SerializedItemDescriptor {version = 1, deleted = False, item = Just $ T.encodeUtf8 "flag"} + +initialSegment :: SerializedItemDescriptor +initialSegment = SerializedItemDescriptor {version = 1, deleted = False, item = Just $ T.encodeUtf8 "segment"} + +initialData :: KeyMap (KeyMap SerializedItemDescriptor) +initialData = + emptyObject + & insertKey "features" (singleton "first-flag" initialFlag) + & insertKey "segments" (singleton "first-segment" initialSegment) + +makeDefaultRedisBackend :: T.Text -> IO PersistentDataStore +makeDefaultRedisBackend prefix = do + con <- R.checkedConnect R.defaultConnectInfo + void $ R.runRedis con R.flushall + makeRedisStore $ redisConfigSetNamespace prefix $ makeRedisStoreConfig con