{- |
Module      : Unleash.Client
Copyright   : Copyright © FINN.no AS, Inc. All rights reserved.
License     : MIT
Stability   : experimental

Functions and types that constitute an Unleash client SDK.

This module re-exports select constructors from [unleash-client-haskell-core](https://github.com/finn-no/unleash-client-haskell-core).
-}
module Unleash.Client (
    makeUnleashConfig,
    UnleashConfig (..),
    HasUnleash (..),
    registerClient,
    pollToggles,
    pushMetrics,
    isEnabled,
    tryIsEnabled,
    getVariant,
    tryGetVariant,
    -- Re-exports
    Context (..),
    emptyContext,
    VariantResponse (..),
) where

import Control.Concurrent.MVar
import Control.Monad (unless, void)
import Control.Monad.IO.Class (MonadIO (liftIO))
import Control.Monad.Reader (MonadReader, asks)
import Data.Text (Text)
import Data.Time (UTCTime, getCurrentTime)
import Network.HTTP.Client.TLS (newTlsManager)
import Servant.Client (BaseUrl, ClientEnv, ClientError, mkClientEnv)
import Unleash (Context (..), Features, MetricsPayload (..), RegisterPayload (..), VariantResponse (..), emptyContext, emptyVariantResponse, featureGetVariant, featureIsEnabled)
import Unleash.Internal.HttpClient (getAllClientFeatures, register, sendMetrics)

-- | Smart constructor for Unleash client configuration. Initializes the mutable variables properly.
makeUnleashConfig ::
    MonadIO m =>
    -- | Application name.
    Text ->
    -- | Instance identifier.
    Text ->
    -- | Unleash server base URL.
    BaseUrl ->
    -- | API key for authorization.
    Maybe Text ->
    -- | Configuration instance.
    m UnleashConfig
makeUnleashConfig :: forall (m :: * -> *).
MonadIO m =>
Text -> Text -> BaseUrl -> Maybe Text -> m UnleashConfig
makeUnleashConfig Text
applicationName Text
instanceId BaseUrl
serverUrl Maybe Text
apiKey = do
    MVar Features
state <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a. IO (MVar a)
newEmptyMVar
    MVar [(Text, Bool)]
metrics <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. a -> IO (MVar a)
newMVar forall a. Monoid a => a
mempty
    MVar UTCTime
metricsBucketStart <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ IO UTCTime
getCurrentTime forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. a -> IO (MVar a)
newMVar
    Manager
manager <- forall (m :: * -> *). MonadIO m => m Manager
newTlsManager
    let clientEnv :: ClientEnv
clientEnv = Manager -> BaseUrl -> ClientEnv
mkClientEnv Manager
manager BaseUrl
serverUrl
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
        UnleashConfig
            { $sel:applicationName:UnleashConfig :: Text
applicationName = Text
applicationName,
              $sel:instanceId:UnleashConfig :: Text
instanceId = Text
instanceId,
              $sel:state:UnleashConfig :: MVar Features
state = MVar Features
state,
              $sel:statePollIntervalInSeconds:UnleashConfig :: Int
statePollIntervalInSeconds = Int
4,
              $sel:metrics:UnleashConfig :: MVar [(Text, Bool)]
metrics = MVar [(Text, Bool)]
metrics,
              $sel:metricsBucketStart:UnleashConfig :: MVar UTCTime
metricsBucketStart = MVar UTCTime
metricsBucketStart,
              $sel:metricsPushIntervalInSeconds:UnleashConfig :: Int
metricsPushIntervalInSeconds = Int
8,
              $sel:apiKey:UnleashConfig :: Maybe Text
apiKey = Maybe Text
apiKey,
              $sel:httpClientEnvironment:UnleashConfig :: ClientEnv
httpClientEnvironment = ClientEnv
clientEnv
            }

-- | Unleash client configuration. Use the smart constructor or make sure the mutable metrics variables are not empty.
data UnleashConfig = UnleashConfig
    { -- | Application name.
      UnleashConfig -> Text
applicationName :: Text,
      -- | Instance identifier.
      UnleashConfig -> Text
instanceId :: Text,
      -- | Full client feature set state.
      UnleashConfig -> MVar Features
state :: MVar Features,
      -- | Feature set state update interval.
      UnleashConfig -> Int
statePollIntervalInSeconds :: Int,
      -- | Collected metrics state.
      UnleashConfig -> MVar [(Text, Bool)]
metrics :: MVar [(Text, Bool)],
      -- | Current metrics bucket start time.
      UnleashConfig -> MVar UTCTime
metricsBucketStart :: MVar UTCTime,
      -- | Metrics sending interval.
      UnleashConfig -> Int
metricsPushIntervalInSeconds :: Int,
      -- | API key for authorization.
      UnleashConfig -> Maybe Text
apiKey :: Maybe Text,
      -- | HTTP client environment.
      UnleashConfig -> ClientEnv
httpClientEnvironment :: ClientEnv
    }

-- | Reader monad convenience class. Use this to get an Unleash configuration from inside of an application configuration (for example).
class HasUnleash r where
    getUnleashConfig :: r -> UnleashConfig

-- | Register client for the Unleash server. Call this on application startup before calling the state poller and metrics pusher functions.
registerClient :: (HasUnleash r, MonadReader r m, MonadIO m) => m (Either ClientError ())
registerClient :: forall r (m :: * -> *).
(HasUnleash r, MonadReader r m, MonadIO m) =>
m (Either ClientError ())
registerClient = do
    UnleashConfig
config <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks forall r. HasUnleash r => r -> UnleashConfig
getUnleashConfig
    UTCTime
now <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
    let registrationPayload :: RegisterPayload
        registrationPayload :: RegisterPayload
registrationPayload =
            RegisterPayload
                { $sel:appName:RegisterPayload :: Text
appName = UnleashConfig
config.applicationName,
                  $sel:instanceId:RegisterPayload :: Text
instanceId = UnleashConfig
config.instanceId,
                  $sel:started:RegisterPayload :: UTCTime
started = UTCTime
now,
                  $sel:intervalSeconds:RegisterPayload :: Int
intervalSeconds = UnleashConfig
config.metricsPushIntervalInSeconds
                }
    forall (f :: * -> *) a. Functor f => f a -> f ()
void forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
MonadIO m =>
ClientEnv
-> Maybe Text
-> RegisterPayload
-> m (Either ClientError NoContent)
register UnleashConfig
config.httpClientEnvironment UnleashConfig
config.apiKey RegisterPayload
registrationPayload

-- | Fetch the most recent feature toggle set from the Unleash server. Meant to be run every statePollIntervalInSeconds. Non-blocking.
pollToggles :: (HasUnleash r, MonadReader r m, MonadIO m) => m (Either ClientError ())
pollToggles :: forall r (m :: * -> *).
(HasUnleash r, MonadReader r m, MonadIO m) =>
m (Either ClientError ())
pollToggles = do
    UnleashConfig
config <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks forall r. HasUnleash r => r -> UnleashConfig
getUnleashConfig
    Either ClientError Features
eitherFeatures <- forall (m :: * -> *).
MonadIO m =>
ClientEnv -> Maybe Text -> m (Either ClientError Features)
getAllClientFeatures UnleashConfig
config.httpClientEnvironment UnleashConfig
config.apiKey
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) (forall {m :: * -> *} {a}. MonadIO m => MVar a -> a -> m ()
updateState UnleashConfig
config.state) Either ClientError Features
eitherFeatures
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ Either ClientError Features
eitherFeatures
    where
        updateState :: MVar a -> a -> m ()
updateState MVar a
state a
value = do
            Bool
isUpdated <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. MVar a -> a -> IO Bool
tryPutMVar MVar a
state a
value
            forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
isUpdated forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall a. MVar a -> a -> IO a
swapMVar MVar a
state a
value

-- | Push metrics to the Unleash server. Meant to be run every metricsPushIntervalInSeconds. Blocks if the mutable metrics variables are empty.
pushMetrics :: (HasUnleash r, MonadReader r m, MonadIO m) => m (Either ClientError ())
pushMetrics :: forall r (m :: * -> *).
(HasUnleash r, MonadReader r m, MonadIO m) =>
m (Either ClientError ())
pushMetrics = do
    UnleashConfig
config <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks forall r. HasUnleash r => r -> UnleashConfig
getUnleashConfig
    UTCTime
now <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
    UTCTime
lastBucketStart <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. MVar a -> a -> IO a
swapMVar UnleashConfig
config.metricsBucketStart UTCTime
now
    [(Text, Bool)]
bucket <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. MVar a -> a -> IO a
swapMVar UnleashConfig
config.metrics forall a. Monoid a => a
mempty
    let metricsPayload :: MetricsPayload
metricsPayload =
            MetricsPayload
                { $sel:appName:MetricsPayload :: Text
appName = UnleashConfig
config.applicationName,
                  $sel:instanceId:MetricsPayload :: Text
instanceId = UnleashConfig
config.instanceId,
                  $sel:start:MetricsPayload :: UTCTime
start = UTCTime
lastBucketStart,
                  $sel:stop:MetricsPayload :: UTCTime
stop = UTCTime
now,
                  $sel:toggles:MetricsPayload :: [(Text, Bool)]
toggles = [(Text, Bool)]
bucket
                }
    forall (f :: * -> *) a. Functor f => f a -> f ()
void forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
MonadIO m =>
ClientEnv
-> Maybe Text -> MetricsPayload -> m (Either ClientError NoContent)
sendMetrics UnleashConfig
config.httpClientEnvironment UnleashConfig
config.apiKey MetricsPayload
metricsPayload

-- | Check if a feature is enabled or not. Blocks until first feature toggle set is received. Blocks if the mutable metrics variables are empty.
isEnabled ::
    (HasUnleash r, MonadReader r m, MonadIO m) =>
    -- | Feature toggle name.
    Text ->
    -- | Client context.
    Context ->
    -- | Whether or not the feature toggle is enabled.
    m Bool
isEnabled :: forall r (m :: * -> *).
(HasUnleash r, MonadReader r m, MonadIO m) =>
Text -> Context -> m Bool
isEnabled Text
feature Context
context = do
    UnleashConfig
config <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks forall r. HasUnleash r => r -> UnleashConfig
getUnleashConfig
    Features
state <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. MVar a -> IO a
readMVar forall a b. (a -> b) -> a -> b
$ UnleashConfig
config.state
    Bool
enabled <- forall (m :: * -> *).
MonadIO m =>
Features -> Text -> Context -> m Bool
featureIsEnabled Features
state Text
feature Context
context
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ UnleashConfig
config.metrics (\[(Text, Bool)]
info -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ (Text
feature, Bool
enabled) forall a. a -> [a] -> [a]
: [(Text, Bool)]
info)
    forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
enabled

-- | Check if a feature is enabled or not. Returns false for all toggles until first toggle set is received. Blocks if the mutable metrics variables are empty.
tryIsEnabled ::
    (HasUnleash r, MonadReader r m, MonadIO m) =>
    -- | Feature toggle name.
    Text ->
    -- | Client context.
    Context ->
    -- | Whether or not the feature toggle is enabled.
    m Bool
tryIsEnabled :: forall r (m :: * -> *).
(HasUnleash r, MonadReader r m, MonadIO m) =>
Text -> Context -> m Bool
tryIsEnabled Text
feature Context
context = do
    UnleashConfig
config <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks forall r. HasUnleash r => r -> UnleashConfig
getUnleashConfig
    Maybe Features
maybeState <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. MVar a -> IO (Maybe a)
tryReadMVar forall a b. (a -> b) -> a -> b
$ UnleashConfig
config.state
    case Maybe Features
maybeState of
        Just Features
state -> do
            Bool
enabled <- forall (m :: * -> *).
MonadIO m =>
Features -> Text -> Context -> m Bool
featureIsEnabled Features
state Text
feature Context
context
            forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ UnleashConfig
config.metrics (\[(Text, Bool)]
info -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ (Text
feature, Bool
enabled) forall a. a -> [a] -> [a]
: [(Text, Bool)]
info)
            forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
enabled
        Maybe Features
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False

-- | Get a variant. Blocks until first feature toggle set is received.
getVariant ::
    (HasUnleash r, MonadReader r m, MonadIO m) =>
    -- | Feature toggle name.
    Text ->
    -- | Client context.
    Context ->
    -- | Variant.
    m VariantResponse
getVariant :: forall r (m :: * -> *).
(HasUnleash r, MonadReader r m, MonadIO m) =>
Text -> Context -> m VariantResponse
getVariant Text
feature Context
context = do
    UnleashConfig
config <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks forall r. HasUnleash r => r -> UnleashConfig
getUnleashConfig
    Features
state <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. MVar a -> IO a
readMVar forall a b. (a -> b) -> a -> b
$ UnleashConfig
config.state
    forall (m :: * -> *).
MonadIO m =>
Features -> Text -> Context -> m VariantResponse
featureGetVariant Features
state Text
feature Context
context

-- | Get a variant. Returns an empty variant until first toggle set is received.
tryGetVariant ::
    (HasUnleash r, MonadReader r m, MonadIO m) =>
    -- | Feature toggle name.
    Text ->
    -- | Client context.
    Context ->
    -- | Variant.
    m VariantResponse
tryGetVariant :: forall r (m :: * -> *).
(HasUnleash r, MonadReader r m, MonadIO m) =>
Text -> Context -> m VariantResponse
tryGetVariant Text
feature Context
context = do
    UnleashConfig
config <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks forall r. HasUnleash r => r -> UnleashConfig
getUnleashConfig
    Maybe Features
maybeState <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. MVar a -> IO (Maybe a)
tryReadMVar forall a b. (a -> b) -> a -> b
$ UnleashConfig
config.state
    case Maybe Features
maybeState of
        Just Features
state -> do
            forall (m :: * -> *).
MonadIO m =>
Features -> Text -> Context -> m VariantResponse
featureGetVariant Features
state Text
feature Context
context
        Maybe Features
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure VariantResponse
emptyVariantResponse