{- |
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.Internal.DomainTypes (Features, fromJsonFeatures, supportedStrategies)
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' = forall api.
HasClient ClientM api =>
Proxy api -> Client ClientM api
client Proxy Api
api

api :: Proxy Api
api :: Proxy Api
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"
            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
_ = 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:" forall a. Semigroup a => a -> a -> a
<> (String -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version -> String
showVersion) Version
version,
                  $sel:strategies:FullRegisterPayload :: [Text]
strategies = [Text]
supportedStrategies,
                  $sel:started:FullRegisterPayload :: UTCTime
started = RegisterPayload
registerPayload.started,
                  $sel:interval:FullRegisterPayload :: Int
interval = RegisterPayload
registerPayload.intervalSeconds forall a. Num a => a -> a -> a
* Int
1000
                }
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. ClientM a -> ClientEnv -> IO (Either ClientError a)
runClientM (Maybe Text
-> Maybe Text -> FullRegisterPayload -> ClientM NoContent
register' Maybe Text
apiKey (forall a. a -> Maybe a
Just Text
"application/json") FullRegisterPayload
fullRegisterPayload) ClientEnv
clientEnv

getAllClientFeatures :: MonadIO m => ClientEnv -> Maybe ApiKey -> m (Either ClientError Features)
getAllClientFeatures :: forall (m :: * -> *).
MonadIO m =>
ClientEnv -> Maybe Text -> m (Either ClientError Features)
getAllClientFeatures ClientEnv
clientEnv Maybe Text
apiKey = do
    Either ClientError Features
eitherFeatures <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. ClientM a -> ClientEnv -> IO (Either ClientError a)
runClientM (Maybe Text -> ClientM Features
getAllClientFeatures' Maybe Text
apiKey) ClientEnv
clientEnv
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Features -> Features
fromJsonFeatures 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
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ 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])) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Text, Bool)]
tuples
            let Map Text [Bool]
asMap :: (Map Text [Bool]) = forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
fromListWith forall a. [a] -> [a] -> [a]
(++) [(Text, [Bool])]
withSingletonLists
            [Bool] -> YesAndNoes
boolsToYesAndNoes 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 = forall (t :: * -> *) a. Foldable t => t a -> Int
length forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter forall a. a -> a
id [Bool]
bools
            let no :: Int
no = forall (t :: * -> *) a. Foldable t => t a -> Int
length [Bool]
bools forall a. Num a => a -> a -> a
- Int
yes
            Int -> Int -> YesAndNoes
YesAndNoes Int
yes Int
no