{-# LANGUAGE RankNTypes #-}
-- | Lensified version of "Log.Backend.ElasticSearch".
module Log.Backend.ElasticSearch.Lens
  ( I.ElasticSearchConfig
  , esServer
  , esIndex
  , esShardCount
  , esReplicaCount
  , esMapping
  , esLogin
  , esLoginInsecure
  , I.defaultElasticSearchConfig
  , I.withElasticSearchLogger
  ) where

import qualified Data.Text as T
import qualified Log.Backend.ElasticSearch as I

type Lens' s a = forall f. Functor f => (a -> f a) -> s -> f s

-- | Elasticsearch server address.
esServer :: Lens' I.ElasticSearchConfig T.Text
esServer :: Lens' ElasticSearchConfig Text
esServer Text -> f Text
f ElasticSearchConfig
esc = (\Text
x -> ElasticSearchConfig
esc { esServer :: Text
I.esServer = Text
x }) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> f Text
f (ElasticSearchConfig -> Text
I.esServer ElasticSearchConfig
esc)
{-# INLINE esServer #-}

-- | Elasticsearch index name.
esIndex :: Lens' I.ElasticSearchConfig T.Text
esIndex :: Lens' ElasticSearchConfig Text
esIndex Text -> f Text
f ElasticSearchConfig
esc = (\Text
x -> ElasticSearchConfig
esc { esIndex :: Text
I.esIndex = Text
x }) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> f Text
f (ElasticSearchConfig -> Text
I.esIndex ElasticSearchConfig
esc)
{-# INLINE esIndex #-}

-- | Elasticsearch shard count for the named index.
--
-- @since 0.10.0.0
esShardCount :: Lens' I.ElasticSearchConfig Int
esShardCount :: Lens' ElasticSearchConfig Int
esShardCount Int -> f Int
f ElasticSearchConfig
esc = (\Int
x -> ElasticSearchConfig
esc { esShardCount :: Int
I.esShardCount = Int
x }) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> f Int
f (ElasticSearchConfig -> Int
I.esShardCount ElasticSearchConfig
esc)
{-# INLINE esShardCount #-}

-- | Elasticsearch replica count for the named index.
--
-- @since 0.10.0.0
esReplicaCount :: Lens' I.ElasticSearchConfig Int
esReplicaCount :: Lens' ElasticSearchConfig Int
esReplicaCount Int -> f Int
f ElasticSearchConfig
esc = (\Int
x -> ElasticSearchConfig
esc { esReplicaCount :: Int
I.esReplicaCount = Int
x }) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> f Int
f (ElasticSearchConfig -> Int
I.esReplicaCount ElasticSearchConfig
esc)
{-# INLINE esReplicaCount #-}

-- | Elasticsearch mapping name.
esMapping :: Lens' I.ElasticSearchConfig T.Text
esMapping :: Lens' ElasticSearchConfig Text
esMapping Text -> f Text
f ElasticSearchConfig
esc = (\Text
x -> ElasticSearchConfig
esc { esMapping :: Text
I.esMapping = Text
x }) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> f Text
f (ElasticSearchConfig -> Text
I.esMapping ElasticSearchConfig
esc)
{-# INLINE esMapping #-}

-- |  Elasticsearch basic authentication username and password.
esLogin :: Lens' I.ElasticSearchConfig (Maybe (T.Text, T.Text))
esLogin :: Lens' ElasticSearchConfig (Maybe (Text, Text))
esLogin Maybe (Text, Text) -> f (Maybe (Text, Text))
f ElasticSearchConfig
esc = (\Maybe (Text, Text)
x -> ElasticSearchConfig
esc { esLogin :: Maybe (Text, Text)
I.esLogin = Maybe (Text, Text)
x }) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Text, Text) -> f (Maybe (Text, Text))
f (ElasticSearchConfig -> Maybe (Text, Text)
I.esLogin ElasticSearchConfig
esc)
{-# INLINE esLogin #-}

-- | Allow basic authentication over non-TLS connections.
esLoginInsecure :: Lens' I.ElasticSearchConfig Bool
esLoginInsecure :: Lens' ElasticSearchConfig Bool
esLoginInsecure Bool -> f Bool
f ElasticSearchConfig
esc = (\Bool
x -> ElasticSearchConfig
esc { esLoginInsecure :: Bool
I.esLoginInsecure = Bool
x }) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> f Bool
f (ElasticSearchConfig -> Bool
I.esLoginInsecure ElasticSearchConfig
esc)
{-# INLINE esLoginInsecure #-}