module LaunchDarkly.Server.Integrations.TestData
( TestData
, newTestData
, flag
, update
, dataSourceFactory
, FlagBuilder
, booleanFlag
, on
, fallthroughVariation
, offVariation
, variationForAllUsers
, valueForAllUsers
, variationForUser
, variations
, ifMatch
, ifNotMatch
, VariationIndex
, FlagRuleBuilder
, andMatch
, andNotMatch
, thenReturn
)
where
import Control.Concurrent.MVar (MVar, modifyMVar_, newMVar, newEmptyMVar, readMVar, putMVar)
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.Server.DataSource.Internal
import qualified LaunchDarkly.Server.Features as Features
import LaunchDarkly.Server.Integrations.TestData.FlagBuilder
import LaunchDarkly.AesonCompat (KeyMap, insertKey, insertKey, lookupKey)
dataSourceFactory :: TestData -> DataSourceFactory
dataSourceFactory (TestData ref) _clientContext dataSourceUpdates = do
listenerIdRef <- newEmptyMVar
let upsert flag = void $ dataSourceUpdatesInsertFlag dataSourceUpdates flag
dataSourceStart = do
modifyMVar_ ref $ \td -> do
void $ dataSourceUpdatesInit dataSourceUpdates (currentFlags td) mempty
let (td', listenerId) = addDataSourceListener td upsert
putMVar listenerIdRef listenerId
pure td'
dataSourceIsInitialized =
pure True
dataSourceStop =
modifyMVar_ ref $ \td ->
removeDataSourceListener td <$> readMVar listenerIdRef
pure $ DataSource {..}
newtype TestData = TestData (MVar TestData')
type TestDataListener = Features.Flag -> IO ()
data TestData' = TestData'
{ flagBuilders :: Map Text FlagBuilder
, currentFlags :: KeyMap Features.Flag
, nextDataSourceListenerId :: Int
, dataSourceListeners :: IntMap TestDataListener
}
newTestData :: IO TestData
newTestData =
TestData <$> newMVar (TestData' mempty mempty 0 mempty)
addDataSourceListener :: TestData' -> TestDataListener -> (TestData', Int)
addDataSourceListener td listener =
( td{ nextDataSourceListenerId = nextDataSourceListenerId td + 1
, dataSourceListeners = IntMap.insert (nextDataSourceListenerId td) listener (dataSourceListeners td)
}
, nextDataSourceListenerId td
)
removeDataSourceListener :: TestData' -> Int -> TestData'
removeDataSourceListener td listenerId =
td{ dataSourceListeners =
IntMap.delete listenerId (dataSourceListeners td)
}
flag :: TestData
-> Text
-> IO FlagBuilder
flag (TestData ref) key = do
td <- readMVar ref
pure $ Maybe.fromMaybe (booleanFlag $ newFlagBuilder key)
$ Map.lookup key (flagBuilders td)
update :: TestData
-> FlagBuilder
-> IO ()
update (TestData ref) fb =
modifyMVar_ ref $ \td -> do
let key = fbKey fb
mOldFlag = lookupKey key (currentFlags td)
oldFlagVersion = maybe 0 (getField @"version") mOldFlag
newFlag = buildFlag (oldFlagVersion + 1) fb
td' = td{ flagBuilders = Map.insert key fb (flagBuilders td)
, currentFlags = insertKey key newFlag (currentFlags td)
}
notifyListeners td newFlag
pure td'
where
notifyListeners td newFlag =
traverse_ ($ newFlag) (dataSourceListeners td)