-- |
-- 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 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
    }

-- | 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 (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)
        }

-- |
--  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 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)

-- |
--  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 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)