{- |
Module      : Unleash.Internal.HttpClient
Copyright   : Copyright © FINN.no AS, Inc. All rights reserved.
License     : MIT
Stability   : experimental
-}
module Unleash.Internal.HttpClient (
    getAllClientFeatures,
    register,
    sendMetrics,
) where

import Control.Monad.IO.Class (MonadIO, liftIO)
import Data.Aeson (ToJSON, encode)
import qualified Data.List.NonEmpty as NE
import Data.Map.Strict (Map, fromListWith)
import Data.Proxy (Proxy (..))
import Data.Text (Text)
import qualified Data.Text as T
import Data.Version (showVersion)
import qualified Network.HTTP.Media as M
import Paths_unleash_client_haskell (version)
import Servant.API (Accept (contentTypes), Get, Header, JSON, MimeRender (mimeRender), NoContent, PostNoContent, ReqBody, type (:<|>) (..), type (:>))
import Servant.Client (ClientEnv, ClientError, client, runClientM)
import Unleash (Features, StrategyEvaluator)
import Unleash.Internal.DomainTypes (fromJsonFeatures)
import Unleash.Internal.JsonTypes (FullMetricsBucket (..), FullMetricsPayload (..), FullRegisterPayload (..), MetricsPayload, RegisterPayload, YesAndNoes (..))
import qualified Unleash.Internal.JsonTypes as UJT

type Register = "api" :> "client" :> "register" :> Header "Authorization" Text :> Header "Content-Type" Text :> ReqBody '[CustomJSON] FullRegisterPayload :> PostNoContent
type GetAllClientFeatures = "api" :> "client" :> "features" :> Header "Authorization" Text :> Get '[JSON] UJT.Features
type SendMetrics = "api" :> "client" :> "metrics" :> Header "Authorization" Text :> ReqBody '[CustomJSON] FullMetricsPayload :> PostNoContent
type Api = GetAllClientFeatures :<|> SendMetrics :<|> Register

Maybe Text -> ClientM Features
getAllClientFeatures' :<|> Maybe Text -> FullMetricsPayload -> ClientM NoContent
sendMetrics' :<|> Maybe Text
-> Maybe Text -> FullRegisterPayload -> ClientM NoContent
register' = Proxy Api -> Client ClientM Api
forall api.
HasClient ClientM api =>
Proxy api -> Client ClientM api
client Proxy Api
api

api :: Proxy Api
api :: Proxy Api
api = Proxy Api
forall {k} (t :: k). Proxy t
Proxy

type ApiKey = Text

data CustomJSON = CustomJSON

-- Remove charset=utf-8 because older versions of Unleash (e.g. 3.17.4) does not recognize it
instance Accept CustomJSON where
    contentTypes :: Proxy CustomJSON -> NonEmpty MediaType
contentTypes Proxy CustomJSON
_ =
        ByteString
"application" ByteString -> ByteString -> MediaType
M.// ByteString
"json"
            MediaType -> [MediaType] -> NonEmpty MediaType
forall a. a -> [a] -> NonEmpty a
NE.:| [ByteString
"application" ByteString -> ByteString -> MediaType
M.// ByteString
"json"]

instance {-# OVERLAPPABLE #-} (ToJSON a) => MimeRender CustomJSON a where
    mimeRender :: Proxy CustomJSON -> a -> ByteString
mimeRender Proxy CustomJSON
_ = a -> ByteString
forall a. ToJSON a => a -> ByteString
encode

register :: (MonadIO m) => ClientEnv -> Maybe ApiKey -> RegisterPayload -> m (Either ClientError NoContent)
register :: forall (m :: * -> *).
MonadIO m =>
ClientEnv
-> Maybe Text
-> RegisterPayload
-> m (Either ClientError NoContent)
register ClientEnv
clientEnv Maybe Text
apiKey RegisterPayload
registerPayload = do
    let fullRegisterPayload :: FullRegisterPayload
fullRegisterPayload =
            FullRegisterPayload
                { $sel:appName:FullRegisterPayload :: Text
appName = RegisterPayload
registerPayload.appName,
                  $sel:instanceId:FullRegisterPayload :: Text
instanceId = RegisterPayload
registerPayload.instanceId,
                  $sel:sdkVersion:FullRegisterPayload :: Text
sdkVersion = Text
"unleash-client-haskell:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (String -> Text
T.pack (String -> Text) -> (Version -> String) -> Version -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version -> String
showVersion) Version
version,
                  $sel:strategies:FullRegisterPayload :: SupportedStrategies
strategies = RegisterPayload
registerPayload.strategies,
                  $sel:started:FullRegisterPayload :: UTCTime
started = RegisterPayload
registerPayload.started,
                  $sel:interval:FullRegisterPayload :: Int
interval = RegisterPayload
registerPayload.intervalSeconds Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1000
                }
    IO (Either ClientError NoContent)
-> m (Either ClientError NoContent)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either ClientError NoContent)
 -> m (Either ClientError NoContent))
-> IO (Either ClientError NoContent)
-> m (Either ClientError NoContent)
forall a b. (a -> b) -> a -> b
$ ClientM NoContent -> ClientEnv -> IO (Either ClientError NoContent)
forall a. ClientM a -> ClientEnv -> IO (Either ClientError a)
runClientM (Maybe Text
-> Maybe Text -> FullRegisterPayload -> ClientM NoContent
register' Maybe Text
apiKey (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"application/json") FullRegisterPayload
fullRegisterPayload) ClientEnv
clientEnv

getAllClientFeatures :: (MonadIO m) => ClientEnv -> StrategyEvaluator -> Maybe ApiKey -> m (Either ClientError Features)
getAllClientFeatures :: forall (m :: * -> *).
MonadIO m =>
ClientEnv
-> StrategyEvaluator
-> Maybe Text
-> m (Either ClientError Features)
getAllClientFeatures ClientEnv
clientEnv StrategyEvaluator
strategyEvaluator Maybe Text
apiKey = do
    Either ClientError Features
eitherFeatures <- IO (Either ClientError Features) -> m (Either ClientError Features)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either ClientError Features)
 -> m (Either ClientError Features))
-> IO (Either ClientError Features)
-> m (Either ClientError Features)
forall a b. (a -> b) -> a -> b
$ ClientM Features -> ClientEnv -> IO (Either ClientError Features)
forall a. ClientM a -> ClientEnv -> IO (Either ClientError a)
runClientM (Maybe Text -> ClientM Features
getAllClientFeatures' Maybe Text
apiKey) ClientEnv
clientEnv
    Either ClientError Features -> m (Either ClientError Features)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ClientError Features -> m (Either ClientError Features))
-> Either ClientError Features -> m (Either ClientError Features)
forall a b. (a -> b) -> a -> b
$ StrategyEvaluator -> Features -> Features
fromJsonFeatures Strategy -> Text -> Context -> m Bool
StrategyEvaluator
strategyEvaluator (Features -> Features)
-> Either ClientError Features -> Either ClientError Features
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either ClientError Features
eitherFeatures

sendMetrics :: (MonadIO m) => ClientEnv -> Maybe ApiKey -> MetricsPayload -> m (Either ClientError NoContent)
sendMetrics :: forall (m :: * -> *).
MonadIO m =>
ClientEnv
-> Maybe Text -> MetricsPayload -> m (Either ClientError NoContent)
sendMetrics ClientEnv
clientEnv Maybe Text
apiKey MetricsPayload
metricsPayload = do
    IO (Either ClientError NoContent)
-> m (Either ClientError NoContent)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either ClientError NoContent)
 -> m (Either ClientError NoContent))
-> IO (Either ClientError NoContent)
-> m (Either ClientError NoContent)
forall a b. (a -> b) -> a -> b
$ ClientM NoContent -> ClientEnv -> IO (Either ClientError NoContent)
forall a. ClientM a -> ClientEnv -> IO (Either ClientError a)
runClientM (Maybe Text -> FullMetricsPayload -> ClientM NoContent
sendMetrics' Maybe Text
apiKey FullMetricsPayload
fullMetricsPayload) ClientEnv
clientEnv
    where
        fullMetricsPayload :: FullMetricsPayload
        fullMetricsPayload :: FullMetricsPayload
fullMetricsPayload =
            FullMetricsPayload
                { $sel:appName:FullMetricsPayload :: Text
appName = MetricsPayload
metricsPayload.appName,
                  $sel:instanceId:FullMetricsPayload :: Text
instanceId = MetricsPayload
metricsPayload.instanceId,
                  $sel:bucket:FullMetricsPayload :: FullMetricsBucket
bucket =
                    FullMetricsBucket
                        { $sel:start:FullMetricsBucket :: UTCTime
start = MetricsPayload
metricsPayload.start,
                          $sel:stop:FullMetricsBucket :: UTCTime
stop = MetricsPayload
metricsPayload.stop,
                          $sel:toggles:FullMetricsBucket :: Map Text YesAndNoes
toggles = [(Text, Bool)] -> Map Text YesAndNoes
makeMapOfYesAndNoes MetricsPayload
metricsPayload.toggles
                        }
                }
        makeMapOfYesAndNoes :: [(Text, Bool)] -> Map Text YesAndNoes
        makeMapOfYesAndNoes :: [(Text, Bool)] -> Map Text YesAndNoes
makeMapOfYesAndNoes [(Text, Bool)]
tuples = do
            let [(Text, [Bool])]
withSingletonLists :: [(Text, [Bool])] = (\(Text
k, Bool
v) -> (Text
k, [Bool
v])) ((Text, Bool) -> (Text, [Bool]))
-> [(Text, Bool)] -> [(Text, [Bool])]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Text, Bool)]
tuples
            let Map Text [Bool]
asMap :: (Map Text [Bool]) = ([Bool] -> [Bool] -> [Bool]) -> [(Text, [Bool])] -> Map Text [Bool]
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
fromListWith [Bool] -> [Bool] -> [Bool]
forall a. [a] -> [a] -> [a]
(++) [(Text, [Bool])]
withSingletonLists
            [Bool] -> YesAndNoes
boolsToYesAndNoes ([Bool] -> YesAndNoes) -> Map Text [Bool] -> Map Text YesAndNoes
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Text [Bool]
asMap
        boolsToYesAndNoes :: [Bool] -> YesAndNoes
        boolsToYesAndNoes :: [Bool] -> YesAndNoes
boolsToYesAndNoes [Bool]
bools = do
            let yes :: Int
yes = [Bool] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Bool] -> Int) -> [Bool] -> Int
forall a b. (a -> b) -> a -> b
$ (Bool -> Bool) -> [Bool] -> [Bool]
forall a. (a -> Bool) -> [a] -> [a]
filter Bool -> Bool
forall a. a -> a
id [Bool]
bools
            let no :: Int
no = [Bool] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Bool]
bools Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
yes
            Int -> Int -> YesAndNoes
YesAndNoes Int
yes Int
no