-- |
-- 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
--                 \<&\> variationForAllUsers 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"
--          \<&\> variationForUser "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
    , variationForAllUsers
    , valueForAllUsers
    , variationForUser
    , variations
    , ifMatch
    , ifNotMatch
    , VariationIndex

    -- * FlagRuleBuilder
    , 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 -> DataSourceFactory
dataSourceFactory (TestData MVar TestData'
ref) ClientContext
_clientContext DataSourceUpdates
dataSourceUpdates = do
    MVar Int
listenerIdRef <- IO (MVar Int)
forall a. IO (MVar a)
newEmptyMVar
    let upsert :: Flag -> IO ()
upsert 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
$ \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 (TestData'
td', 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
$ \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 {IO Bool
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 (Flag -> IO ())
dataSourceListeners      :: IntMap TestDataListener
    }

-- | Creates a new instance of the test data source.
newTestData :: IO TestData -- ^ a new configurable test data source
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 Int
0 IntMap (Flag -> IO ())
forall a. Monoid a => a
mempty)

addDataSourceListener :: TestData' -> TestDataListener -> (TestData', Int)
addDataSourceListener :: TestData' -> (Flag -> IO ()) -> (TestData', Int)
addDataSourceListener TestData'
td 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
+ Int
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 TestData'
td 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
     -> Text  -- ^ the flag key
     -> IO FlagBuilder -- ^ a flag configuration builder
flag :: TestData -> Text -> IO FlagBuilder
flag (TestData MVar TestData'
ref) 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
       -> FlagBuilder -- ^ a flag configuration builder
       -> IO ()
update :: TestData -> FlagBuilder -> IO ()
update (TestData MVar TestData'
ref) 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
$ \TestData'
td -> do
        let key :: Text
key = FlagBuilder -> Text
fbKey FlagBuilder
fb
            mOldFlag :: Maybe Flag
mOldFlag = Text -> KeyMap Flag -> Maybe Flag
forall v. Text -> KeyMap 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 Natural
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
+ Natural
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 -> KeyMap v -> KeyMap 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 TestData'
td 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)