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

import Control.Concurrent (ThreadId)
import Control.Concurrent.MVar (MVar)
import Data.ByteString (ByteString)
import Data.Generics.Product (getField)
import Data.IORef (IORef, atomicModifyIORef', readIORef)
import Data.Text (Text)
import Data.Text.Encoding (encodeUtf8)
import qualified Data.UUID as UUID
import qualified Data.UUID.V4 as UUIDv4
import GHC.Generics (Generic)
import Network.HTTP.Client (newManager)
import qualified Network.HTTP.Client as Http
import Network.HTTP.Client.TLS (tlsManagerSettings)
import Network.HTTP.Types (HeaderName)

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

-- | The version string for this library.
clientVersion :: Text
clientVersion :: Text
clientVersion = "4.6.0" -- x-release-please-version

-- |
-- Client is the LaunchDarkly client. Client instances are thread-safe.
-- Applications should instantiate a single instance for the lifetime of their
-- application.
data Client = Client
    { Client -> Config
config :: !(Config)
    , Client -> StoreHandle IO
store :: !(StoreHandle IO)
    , Client -> IORef Status
status :: !(IORef Status)
    , Client -> EventState
events :: !EventState
    , Client -> Maybe (ThreadId, MVar ())
eventThreadPair :: !(Maybe (ThreadId, MVar ()))
    , Client -> DataSource
dataSource :: !DataSource
    }
    deriving ((forall x. Client -> Rep Client x)
-> (forall x. Rep Client x -> Client) -> Generic Client
forall x. Rep Client x -> Client
forall x. Client -> Rep Client x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Client x -> Client
$cfrom :: forall x. Client -> Rep Client x
Generic)

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

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

-- |
-- Build an 'HttpConfiguration' for the given 'Config'. A fresh TLS manager is created and a new
-- per-instance GUID v4 is generated for the 'X-LaunchDarkly-Instance-Id' header. Because the
-- returned 'defaultRequestHeaders' is shared by the polling, streaming, and event clients, every
-- outbound request carries the same stable per-instance identifier without per-channel plumbing.
--
-- The SDK key, version banner, and (optional) application tags header are also attached here.
makeHttpConfiguration :: Config -> IO HttpConfiguration
makeHttpConfiguration :: Config -> IO HttpConfiguration
makeHttpConfiguration config :: Config
config = do
    Manager
tlsManager <- ManagerSettings -> IO Manager
newManager ManagerSettings
tlsManagerSettings
    UUID
instanceId <- IO UUID
UUIDv4.nextRandom
    let baseHeaders :: [(HeaderName, ByteString)]
baseHeaders =
            [ ("Authorization", Text -> ByteString
encodeUtf8 (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ Config -> Text
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"key" Config
config)
            , ("User-Agent", "HaskellServerClient/" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Text -> ByteString
encodeUtf8 Text
clientVersion)
            , ("X-LaunchDarkly-Instance-Id", Text -> ByteString
encodeUtf8 (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ UUID -> Text
UUID.toText UUID
instanceId)
            ]
        defaultRequestHeaders :: [(HeaderName, ByteString)]
defaultRequestHeaders = [(HeaderName, ByteString)]
-> Maybe ApplicationInfo -> [(HeaderName, ByteString)]
addTagsHeader [(HeaderName, ByteString)]
baseHeaders (Config -> Maybe ApplicationInfo
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"applicationInfo" Config
config)
        defaultRequestTimeout :: ResponseTimeout
defaultRequestTimeout = Int -> ResponseTimeout
Http.responseTimeoutMicro (Int -> ResponseTimeout) -> Int -> ResponseTimeout
forall a b. (a -> b) -> a -> b
$ Natural -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Natural -> Int) -> Natural -> Int
forall a b. (a -> b) -> a -> b
$ Config -> Natural
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"requestTimeoutSeconds" Config
config Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
* 1000000
    HttpConfiguration -> IO HttpConfiguration
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HttpConfiguration -> IO HttpConfiguration)
-> HttpConfiguration -> IO HttpConfiguration
forall a b. (a -> b) -> a -> b
$ $WHttpConfiguration :: [(HeaderName, ByteString)]
-> ResponseTimeout -> Manager -> HttpConfiguration
HttpConfiguration {..}
  where
    addTagsHeader :: [(HeaderName, ByteString)] -> Maybe ApplicationInfo -> [(HeaderName, ByteString)]
    addTagsHeader :: [(HeaderName, ByteString)]
-> Maybe ApplicationInfo -> [(HeaderName, ByteString)]
addTagsHeader headers :: [(HeaderName, ByteString)]
headers Nothing = [(HeaderName, ByteString)]
headers
    addTagsHeader headers :: [(HeaderName, ByteString)]
headers (Just info :: ApplicationInfo
info) = case ApplicationInfo -> Maybe Text
getApplicationInfoHeader ApplicationInfo
info of
        Nothing -> [(HeaderName, ByteString)]
headers
        Just header :: Text
header -> ("X-LaunchDarkly-Tags", Text -> ByteString
encodeUtf8 Text
header) (HeaderName, ByteString)
-> [(HeaderName, ByteString)] -> [(HeaderName, ByteString)]
forall a. a -> [a] -> [a]
: [(HeaderName, ByteString)]
headers