module LaunchDarkly.Server.Client.Internal
    ( Client(..)
    , ClientI(..)
    , Status(..)
    , clientVersion
    , setStatus
    , getStatusI
    ) where

import Data.Text                           (Text)
import Data.IORef                          (IORef, readIORef, atomicModifyIORef')
import GHC.Generics                        (Generic)
import Control.Concurrent                  (ThreadId)
import Control.Concurrent.MVar             (MVar)
import Data.Generics.Product               (getField)

import LaunchDarkly.Server.Client.Status       (Status(..), transitionStatus)
import LaunchDarkly.Server.Config.Internal     (ConfigI)
import LaunchDarkly.Server.Store.Internal      (StoreHandle, getInitializedC)
import LaunchDarkly.Server.Events              (EventState)
import LaunchDarkly.Server.DataSource.Internal (DataSource)

-- | Client is the LaunchDarkly client. Client instances are thread-safe.
-- Applications should instantiate a single instance for the lifetime of their
-- application.
newtype Client = Client ClientI

-- | The version string for this library.
clientVersion :: Text
clientVersion :: Text
clientVersion = Text
"3.1.0"

setStatus :: ClientI -> Status -> IO ()
setStatus :: ClientI -> Status -> IO ()
setStatus ClientI
client Status
status' =
    forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' (forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"status" ClientI
client) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (,()) (Status -> Status -> Status
transitionStatus Status
status'))

getStatusI :: ClientI -> IO Status
getStatusI :: ClientI -> IO Status
getStatusI ClientI
client = forall a. IORef a -> IO a
readIORef (forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"status" ClientI
client) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Status
Unauthorized -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Status
Unauthorized
    Status
ShuttingDown -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Status
ShuttingDown
    Status
_            -> forall store (m :: * -> *).
LaunchDarklyStoreRead store m =>
store -> StoreResultM m Bool
getInitializedC (forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"store" ClientI
client) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Right Bool
True -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Status
Initialized
        Either Text Bool
_          -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Status
Uninitialized

data ClientI = ClientI
    { ClientI -> ConfigI
config             :: !(ConfigI)
    , ClientI -> StoreHandle IO
store              :: !(StoreHandle IO)
    , ClientI -> IORef Status
status             :: !(IORef Status)
    , ClientI -> EventState
events             :: !EventState
    , ClientI -> Maybe (ThreadId, MVar ())
eventThreadPair    :: !(Maybe (ThreadId, MVar ()))
    , ClientI -> DataSource
dataSource         :: !DataSource
    } deriving (forall x. Rep ClientI x -> ClientI
forall x. ClientI -> Rep ClientI x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ClientI x -> ClientI
$cfrom :: forall x. ClientI -> Rep ClientI x
Generic)