-- |
-- A mechanism for providing dynamically updatable feature flag state in a
-- simplified form to an SDK client in test scenarios.
--
-- Unlike "LaunchDarkly.Server.Integrations.FileData", this mechanism does not
-- use any external resources. It provides only the data that the application
-- has put into it using the 'update' function.
--
-- @
-- td <- TestData.newTestData
-- update td =<< (flag td "flag-key-1"
--                 \<&\> booleanFlag
--                 \<&\> variationForAll True)
--
-- let config = makeConfig "sdkKey"
--                 & configSetDataSourceFactory (dataSourceFactory td)
-- client <- makeClient config
--
-- -- flags can be updated at any time:
-- update td =<<
--    (flag td "flag-key-2"
--          \<&\> variationForKey "user" "some-user-key" True
--          \<&\> fallthroughVariation False)
-- @
--
-- The above example uses a simple boolean flag, but more complex
-- configurations are possible using the methods of the 'FlagBuilder' that is
-- returned by 'flag'. 'FlagBuilder' supports many of the ways a flag can be
-- configured on the LaunchDarkly dashboard, but does not currently support:
--
--      1. Rule operators other than "in" and "not in"
--      2. Percentage rollouts.
--
-- If the same 'TestData' instance is used to configure multiple
-- 'LaunchDarkly.Server.Client.Client' instances, any changes made to the data
-- will propagate to all of the @Client@s.
--
-- see "LaunchDarkly.Server.Integrations.FileData"
--
-- @since 2.2.1
module LaunchDarkly.Server.Integrations.TestData
    ( TestData
    , newTestData
    , flag
    , update
    , dataSourceFactory

      -- * FlagBuilder
    , FlagBuilder
    , booleanFlag
    , on
    , fallthroughVariation
    , offVariation
    , variationForAll
    , variationForAllUsers
    , valueForAll
    , valueForAllUsers
    , variationForKey
    , variationForUser
    , variations
    , ifMatch
    , ifMatchContext
    , ifNotMatch
    , ifNotMatchContext
    , VariationIndex

      -- * FlagRuleBuilder
    , 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
    }

-- | Creates a new instance of the test data source.
newTestData ::
    -- | a new configurable test data source
    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)
        }

-- |
--  Creates or copies a 'FlagBuilder' for building a test flag configuration.
--
--  If this flag key has already been defined in this 'TestData' instance, then
--  the builder starts with the same configuration that was last provided for
--  this flag.
--
--  Otherwise, it starts with a new default configuration in which the flag has
--  @True@ and @False@ variations, is @True@ for all users when targeting is
--  turned on and @False@ otherwise, and currently has targeting turned on. You
--  can change any of those properties, and provide more complex behavior,
--  using the 'FlagBuilder' methods.
--
--  Once you have set the desired configuration, pass the builder to 'update'.
--
--  see 'update'
flag ::
    TestData ->
    -- | the flag key
    Text ->
    -- | a flag configuration builder
    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)

-- |
--  Updates the test data with the specified flag configuration.
--
--  This has the same effect as if a flag were added or modified on the
--  LaunchDarkly dashboard. It immediately propagates the flag change to any
--  'LaunchDarkly.Server.Client.Client' instance(s) that you have already
--  configured to use this 'TestData'. If no @Client@ has been started yet, it
--  simply adds this flag to the test data which will be provided to any
--  @Client@ that you subsequently configure.
--
--  Any subsequent changes to this 'FlagBuilder' instance do not affect the
--  test data, unless you call 'update'
--
--  see 'flag'
update ::
    TestData ->
    -- | a flag configuration builder
    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)