module LaunchDarkly.Server.Integrations.TestData
( TestData
, newTestData
, flag
, update
, dataSourceFactory
, FlagBuilder
, booleanFlag
, on
, fallthroughVariation
, offVariation
, variationForAll
, variationForAllUsers
, valueForAll
, valueForAllUsers
, variationForKey
, variationForUser
, variations
, ifMatch
, ifMatchContext
, ifNotMatch
, ifNotMatchContext
, VariationIndex
, FlagRuleBuilder
, andMatch
, andMatchContext
, andNotMatch
, andNotMatchContext
, thenReturn
)
where
import Control.Concurrent.MVar (MVar, modifyMVar_, newEmptyMVar, newMVar, putMVar, readMVar)
import Control.Monad (void)
import Data.Foldable (traverse_)
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IntMap
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import qualified Data.Maybe as Maybe
import Data.Text (Text)
import Data.Generics.Product (getField)
import LaunchDarkly.AesonCompat (KeyMap, insertKey, lookupKey)
import LaunchDarkly.Server.DataSource.Internal
import qualified LaunchDarkly.Server.Features as Features
import LaunchDarkly.Server.Integrations.TestData.FlagBuilder
dataSourceFactory :: TestData -> DataSourceFactory
dataSourceFactory :: TestData -> DataSourceFactory
dataSourceFactory (TestData ref :: MVar TestData'
ref) _clientContext :: ClientContext
_clientContext dataSourceUpdates :: DataSourceUpdates
dataSourceUpdates = do
MVar Int
listenerIdRef <- IO (MVar Int)
forall a. IO (MVar a)
newEmptyMVar
let upsert :: Flag -> IO ()
upsert flag :: Flag
flag = IO (Either Text ()) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (Either Text ()) -> IO ()) -> IO (Either Text ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ DataSourceUpdates -> Flag -> IO (Either Text ())
dataSourceUpdatesInsertFlag DataSourceUpdates
dataSourceUpdates Flag
flag
dataSourceStart :: IO ()
dataSourceStart = do
MVar TestData' -> (TestData' -> IO TestData') -> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ MVar TestData'
ref ((TestData' -> IO TestData') -> IO ())
-> (TestData' -> IO TestData') -> IO ()
forall a b. (a -> b) -> a -> b
$ \td :: TestData'
td -> do
IO (Either Text ()) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (Either Text ()) -> IO ()) -> IO (Either Text ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ DataSourceUpdates
-> KeyMap Flag -> KeyMap Segment -> IO (Either Text ())
dataSourceUpdatesInit DataSourceUpdates
dataSourceUpdates (TestData' -> KeyMap Flag
currentFlags TestData'
td) KeyMap Segment
forall a. Monoid a => a
mempty
let (td' :: TestData'
td', listenerId :: Int
listenerId) = TestData' -> (Flag -> IO ()) -> (TestData', Int)
addDataSourceListener TestData'
td Flag -> IO ()
upsert
MVar Int -> Int -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar Int
listenerIdRef Int
listenerId
TestData' -> IO TestData'
forall (f :: * -> *) a. Applicative f => a -> f a
pure TestData'
td'
dataSourceIsInitialized :: f Bool
dataSourceIsInitialized =
Bool -> f Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
dataSourceStop :: IO ()
dataSourceStop =
MVar TestData' -> (TestData' -> IO TestData') -> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ MVar TestData'
ref ((TestData' -> IO TestData') -> IO ())
-> (TestData' -> IO TestData') -> IO ()
forall a b. (a -> b) -> a -> b
$ \td :: TestData'
td ->
TestData' -> Int -> TestData'
removeDataSourceListener TestData'
td (Int -> TestData') -> IO Int -> IO TestData'
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MVar Int -> IO Int
forall a. MVar a -> IO a
readMVar MVar Int
listenerIdRef
DataSource -> IO DataSource
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DataSource -> IO DataSource) -> DataSource -> IO DataSource
forall a b. (a -> b) -> a -> b
$ DataSource :: IO Bool -> IO () -> IO () -> DataSource
DataSource {..}
newtype TestData = TestData (MVar TestData')
type TestDataListener = Features.Flag -> IO ()
data TestData' = TestData'
{ TestData' -> Map Text FlagBuilder
flagBuilders :: Map Text FlagBuilder
, TestData' -> KeyMap Flag
currentFlags :: KeyMap Features.Flag
, TestData' -> Int
nextDataSourceListenerId :: Int
, TestData' -> IntMap (Flag -> IO ())
dataSourceListeners :: IntMap TestDataListener
}
newTestData ::
IO TestData
newTestData :: IO TestData
newTestData =
MVar TestData' -> TestData
TestData (MVar TestData' -> TestData) -> IO (MVar TestData') -> IO TestData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TestData' -> IO (MVar TestData')
forall a. a -> IO (MVar a)
newMVar (Map Text FlagBuilder
-> KeyMap Flag -> Int -> IntMap (Flag -> IO ()) -> TestData'
TestData' Map Text FlagBuilder
forall a. Monoid a => a
mempty KeyMap Flag
forall a. Monoid a => a
mempty 0 IntMap (Flag -> IO ())
forall a. Monoid a => a
mempty)
addDataSourceListener :: TestData' -> TestDataListener -> (TestData', Int)
addDataSourceListener :: TestData' -> (Flag -> IO ()) -> (TestData', Int)
addDataSourceListener td :: TestData'
td listener :: Flag -> IO ()
listener =
( TestData'
td
{ $sel:nextDataSourceListenerId:TestData' :: Int
nextDataSourceListenerId = TestData' -> Int
nextDataSourceListenerId TestData'
td Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1
, $sel:dataSourceListeners:TestData' :: IntMap (Flag -> IO ())
dataSourceListeners = Int
-> (Flag -> IO ())
-> IntMap (Flag -> IO ())
-> IntMap (Flag -> IO ())
forall a. Int -> a -> IntMap a -> IntMap a
IntMap.insert (TestData' -> Int
nextDataSourceListenerId TestData'
td) Flag -> IO ()
listener (TestData' -> IntMap (Flag -> IO ())
dataSourceListeners TestData'
td)
}
, TestData' -> Int
nextDataSourceListenerId TestData'
td
)
removeDataSourceListener :: TestData' -> Int -> TestData'
removeDataSourceListener :: TestData' -> Int -> TestData'
removeDataSourceListener td :: TestData'
td listenerId :: Int
listenerId =
TestData'
td
{ $sel:dataSourceListeners:TestData' :: IntMap (Flag -> IO ())
dataSourceListeners =
Int -> IntMap (Flag -> IO ()) -> IntMap (Flag -> IO ())
forall a. Int -> IntMap a -> IntMap a
IntMap.delete Int
listenerId (TestData' -> IntMap (Flag -> IO ())
dataSourceListeners TestData'
td)
}
flag ::
TestData ->
Text ->
IO FlagBuilder
flag :: TestData -> Text -> IO FlagBuilder
flag (TestData ref :: MVar TestData'
ref) key :: Text
key = do
TestData'
td <- MVar TestData' -> IO TestData'
forall a. MVar a -> IO a
readMVar MVar TestData'
ref
FlagBuilder -> IO FlagBuilder
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FlagBuilder -> IO FlagBuilder) -> FlagBuilder -> IO FlagBuilder
forall a b. (a -> b) -> a -> b
$
FlagBuilder -> Maybe FlagBuilder -> FlagBuilder
forall a. a -> Maybe a -> a
Maybe.fromMaybe (FlagBuilder -> FlagBuilder
booleanFlag (FlagBuilder -> FlagBuilder) -> FlagBuilder -> FlagBuilder
forall a b. (a -> b) -> a -> b
$ Text -> FlagBuilder
newFlagBuilder Text
key) (Maybe FlagBuilder -> FlagBuilder)
-> Maybe FlagBuilder -> FlagBuilder
forall a b. (a -> b) -> a -> b
$
Text -> Map Text FlagBuilder -> Maybe FlagBuilder
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
key (TestData' -> Map Text FlagBuilder
flagBuilders TestData'
td)
update ::
TestData ->
FlagBuilder ->
IO ()
update :: TestData -> FlagBuilder -> IO ()
update (TestData ref :: MVar TestData'
ref) fb :: FlagBuilder
fb =
MVar TestData' -> (TestData' -> IO TestData') -> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ MVar TestData'
ref ((TestData' -> IO TestData') -> IO ())
-> (TestData' -> IO TestData') -> IO ()
forall a b. (a -> b) -> a -> b
$ \td :: TestData'
td -> do
let key :: Text
key = FlagBuilder -> Text
fbKey FlagBuilder
fb
mOldFlag :: Maybe Flag
mOldFlag = Text -> KeyMap Flag -> Maybe Flag
forall v. Text -> HashMap Text v -> Maybe v
lookupKey Text
key (TestData' -> KeyMap Flag
currentFlags TestData'
td)
oldFlagVersion :: Natural
oldFlagVersion = Natural -> (Flag -> Natural) -> Maybe Flag -> Natural
forall b a. b -> (a -> b) -> Maybe a -> b
maybe 0 (forall a s. HasField' "version" s a => s -> a
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"version") Maybe Flag
mOldFlag
newFlag :: Flag
newFlag = Natural -> FlagBuilder -> Flag
buildFlag (Natural
oldFlagVersion Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
+ 1) FlagBuilder
fb
td' :: TestData'
td' =
TestData'
td
{ $sel:flagBuilders:TestData' :: Map Text FlagBuilder
flagBuilders = Text -> FlagBuilder -> Map Text FlagBuilder -> Map Text FlagBuilder
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Text
key FlagBuilder
fb (TestData' -> Map Text FlagBuilder
flagBuilders TestData'
td)
, $sel:currentFlags:TestData' :: KeyMap Flag
currentFlags = Text -> Flag -> KeyMap Flag -> KeyMap Flag
forall v. Text -> v -> HashMap Text v -> HashMap Text v
insertKey Text
key Flag
newFlag (TestData' -> KeyMap Flag
currentFlags TestData'
td)
}
TestData' -> Flag -> IO ()
notifyListeners TestData'
td Flag
newFlag
TestData' -> IO TestData'
forall (f :: * -> *) a. Applicative f => a -> f a
pure TestData'
td'
where
notifyListeners :: TestData' -> Flag -> IO ()
notifyListeners td :: TestData'
td newFlag :: Flag
newFlag =
((Flag -> IO ()) -> IO ()) -> IntMap (Flag -> IO ()) -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ ((Flag -> IO ()) -> Flag -> IO ()
forall a b. (a -> b) -> a -> b
$ Flag
newFlag) (TestData' -> IntMap (Flag -> IO ())
dataSourceListeners TestData'
td)