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 MVar TestData'
ref) ClientContext
_clientContext DataSourceUpdates
dataSourceUpdates = do
MVar Int
listenerIdRef <- forall a. IO (MVar a)
newEmptyMVar
let upsert :: TestDataListener
upsert Flag
flag = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ DataSourceUpdates -> Flag -> IO (Either Text ())
dataSourceUpdatesInsertFlag DataSourceUpdates
dataSourceUpdates Flag
flag
dataSourceStart :: IO ()
dataSourceStart = do
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ MVar TestData'
ref forall a b. (a -> b) -> a -> b
$ \TestData'
td -> do
forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ DataSourceUpdates
-> KeyMap Flag -> KeyMap Segment -> IO (Either Text ())
dataSourceUpdatesInit DataSourceUpdates
dataSourceUpdates (TestData' -> KeyMap Flag
currentFlags TestData'
td) forall a. Monoid a => a
mempty
let (TestData'
td', Int
listenerId) = TestData' -> TestDataListener -> (TestData', Int)
addDataSourceListener TestData'
td TestDataListener
upsert
forall a. MVar a -> a -> IO ()
putMVar MVar Int
listenerIdRef Int
listenerId
forall (f :: * -> *) a. Applicative f => a -> f a
pure TestData'
td'
dataSourceIsInitialized :: f Bool
dataSourceIsInitialized =
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
dataSourceStop :: IO ()
dataSourceStop =
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ MVar TestData'
ref forall a b. (a -> b) -> a -> b
$ \TestData'
td ->
TestData' -> Int -> TestData'
removeDataSourceListener TestData'
td forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. MVar a -> IO a
readMVar MVar Int
listenerIdRef
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ DataSource {IO ()
forall {f :: * -> *}. Applicative f => f Bool
$sel:dataSourceStop:DataSource :: IO ()
$sel:dataSourceStart:DataSource :: IO ()
$sel:dataSourceIsInitialized:DataSource :: IO Bool
dataSourceStop :: IO ()
dataSourceIsInitialized :: forall {f :: * -> *}. Applicative f => f Bool
dataSourceStart :: IO ()
..}
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 TestDataListener
dataSourceListeners :: IntMap TestDataListener
}
newTestData ::
IO TestData
newTestData :: IO TestData
newTestData =
MVar TestData' -> TestData
TestData forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. a -> IO (MVar a)
newMVar (Map Text FlagBuilder
-> KeyMap Flag -> Int -> IntMap TestDataListener -> TestData'
TestData' forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty Int
0 forall a. Monoid a => a
mempty)
addDataSourceListener :: TestData' -> TestDataListener -> (TestData', Int)
addDataSourceListener :: TestData' -> TestDataListener -> (TestData', Int)
addDataSourceListener TestData'
td TestDataListener
listener =
( TestData'
td
{ $sel:nextDataSourceListenerId:TestData' :: Int
nextDataSourceListenerId = TestData' -> Int
nextDataSourceListenerId TestData'
td forall a. Num a => a -> a -> a
+ Int
1
, $sel:dataSourceListeners:TestData' :: IntMap TestDataListener
dataSourceListeners = forall a. Int -> a -> IntMap a -> IntMap a
IntMap.insert (TestData' -> Int
nextDataSourceListenerId TestData'
td) TestDataListener
listener (TestData' -> IntMap TestDataListener
dataSourceListeners TestData'
td)
}
, TestData' -> Int
nextDataSourceListenerId TestData'
td
)
removeDataSourceListener :: TestData' -> Int -> TestData'
removeDataSourceListener :: TestData' -> Int -> TestData'
removeDataSourceListener TestData'
td Int
listenerId =
TestData'
td
{ $sel:dataSourceListeners:TestData' :: IntMap TestDataListener
dataSourceListeners =
forall a. Int -> IntMap a -> IntMap a
IntMap.delete Int
listenerId (TestData' -> IntMap TestDataListener
dataSourceListeners TestData'
td)
}
flag ::
TestData ->
Text ->
IO FlagBuilder
flag :: TestData -> Text -> IO FlagBuilder
flag (TestData MVar TestData'
ref) Text
key = do
TestData'
td <- forall a. MVar a -> IO a
readMVar MVar TestData'
ref
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
forall a. a -> Maybe a -> a
Maybe.fromMaybe (FlagBuilder -> FlagBuilder
booleanFlag forall a b. (a -> b) -> a -> b
$ Text -> FlagBuilder
newFlagBuilder Text
key) forall a b. (a -> b) -> a -> b
$
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 MVar TestData'
ref) FlagBuilder
fb =
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ MVar TestData'
ref forall a b. (a -> b) -> a -> b
$ \TestData'
td -> do
let key :: Text
key = FlagBuilder -> Text
fbKey FlagBuilder
fb
mOldFlag :: Maybe Flag
mOldFlag = forall v. Text -> KeyMap v -> Maybe v
lookupKey Text
key (TestData' -> KeyMap Flag
currentFlags TestData'
td)
oldFlagVersion :: Natural
oldFlagVersion = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Natural
0 (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 forall a. Num a => a -> a -> a
+ Natural
1) FlagBuilder
fb
td' :: TestData'
td' =
TestData'
td
{ $sel:flagBuilders:TestData' :: Map Text FlagBuilder
flagBuilders = 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 = forall v. Text -> v -> KeyMap v -> KeyMap v
insertKey Text
key Flag
newFlag (TestData' -> KeyMap Flag
currentFlags TestData'
td)
}
TestData' -> TestDataListener
notifyListeners TestData'
td Flag
newFlag
forall (f :: * -> *) a. Applicative f => a -> f a
pure TestData'
td'
where
notifyListeners :: TestData' -> TestDataListener
notifyListeners TestData'
td Flag
newFlag =
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (forall a b. (a -> b) -> a -> b
$ Flag
newFlag) (TestData' -> IntMap TestDataListener
dataSourceListeners TestData'
td)