{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}

module Database.Bloodhound.Internal.Versions.Common.Types.Indices
  ( AliasRouting (..),
    AllocationPolicy (..),
    CompoundFormat (..),
    Compression (..),
    FSType (..),
    FieldDefinition (..),
    FieldType (..),
    ForceMergeIndexSettings (..),
    IndexAlias (..),
    IndexAliasAction (..),
    IndexAliasCreate (..),
    IndexAliasRouting (..),
    IndexAliasSummary (..),
    IndexAliasesSummary (..),
    IndexDocumentSettings (..),
    IndexMappingsLimits (..),
    IndexPattern (..),
    IndexSelection (..),
    IndexSettings (..),
    IndexSettingsSummary (..),
    IndexTemplate (..),
    JoinRelation (..),
    Mapping (..),
    MappingField (..),
    NominalDiffTimeJSON (..),
    OpenCloseIndex (..),
    ReplicaBounds (..),
    RoutingValue (..),
    SearchAliasRouting (..),
    Status (..),
    TemplateName (..),
    UpdatableIndexSetting (..),
    defaultForceMergeIndexSettings,
    defaultIndexDocumentSettings,
    defaultIndexMappingsLimits,
    defaultIndexSettings,

    -- * Optics
    nameLens,
    clusterNameLens,
    clusterUuidLens,
    versionLens,
    taglineLens,
    indexShardsLens,
    indexReplicasLens,
    indexMappingsLimitsLens,
    indexMappingsLimitDepthLens,
    indexMappingsLimitNestedFieldsLens,
    indexMappingsLimitNestedObjectsLens,
    indexMappingsLimitFieldNameLengthLens,
    maxNumSegmentsLens,
    onlyExpungeDeletesLens,
    flushAfterOptimizeLens,
    sSummaryIndexNameLens,
    sSummaryFixedSettingsLens,
    sSummaryUpdateableLens,
    fieldTypeLens,
    templatePatternsLens,
    templateSettingsLens,
    templateMappingsLens,
    mappingFieldNameLens,
    fieldDefinitionLens,
    mappingFieldsLens,
    srcIndexLens,
    indexAliasLens,
    aliasCreateRoutingLens,
    aliasCreateFilterLens,
    routingValueLens,
    indexAliasesSummaryLens,
    indexAliasSummaryAliasLens,
    indexAliasSummaryCreateLens,
    idsVersionControlLens,
    idsJoinRelationLens,
  )
where

import Control.Monad.Except
import qualified Data.Aeson.KeyMap as X
import qualified Data.HashMap.Strict as HM
import Data.Maybe (mapMaybe)
import qualified Data.Text as T
import qualified Data.Traversable as DT
import Database.Bloodhound.Internal.Client.Doc
import Database.Bloodhound.Internal.Utils.Imports
import Database.Bloodhound.Internal.Utils.StringlyTyped
import Database.Bloodhound.Internal.Versions.Common.Types.Analysis
import Database.Bloodhound.Internal.Versions.Common.Types.Newtypes
import Database.Bloodhound.Internal.Versions.Common.Types.Nodes
import Database.Bloodhound.Internal.Versions.Common.Types.Query
import Database.Bloodhound.Internal.Versions.Common.Types.Units
import GHC.Generics

-- | 'Status' is a data type for describing the JSON body returned by
--   Elasticsearch when you query its status. This was deprecated in 1.2.0.
--
--  <http://www.elastic.co/guide/en/elasticsearch/reference/current/indices-status.html#indices-status>
data Status = Status
  { Status -> Text
name :: Text,
    Status -> Text
cluster_name :: Text,
    Status -> Text
cluster_uuid :: Text,
    Status -> Version
version :: Version,
    Status -> Text
tagline :: Text
  }
  deriving stock (Status -> Status -> Bool
(Status -> Status -> Bool)
-> (Status -> Status -> Bool) -> Eq Status
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Status -> Status -> Bool
== :: Status -> Status -> Bool
$c/= :: Status -> Status -> Bool
/= :: Status -> Status -> Bool
Eq, Int -> Status -> ShowS
[Status] -> ShowS
Status -> String
(Int -> Status -> ShowS)
-> (Status -> String) -> ([Status] -> ShowS) -> Show Status
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Status -> ShowS
showsPrec :: Int -> Status -> ShowS
$cshow :: Status -> String
show :: Status -> String
$cshowList :: [Status] -> ShowS
showList :: [Status] -> ShowS
Show)

instance FromJSON Status where
  parseJSON :: Value -> Parser Status
parseJSON (Object Object
v) =
    Text -> Text -> Text -> Version -> Text -> Status
Status
      (Text -> Text -> Text -> Version -> Text -> Status)
-> Parser Text
-> Parser (Text -> Text -> Version -> Text -> Status)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v
        Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
      Parser (Text -> Text -> Version -> Text -> Status)
-> Parser Text -> Parser (Text -> Version -> Text -> Status)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v
        Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"cluster_name"
      Parser (Text -> Version -> Text -> Status)
-> Parser Text -> Parser (Version -> Text -> Status)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v
        Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"cluster_uuid"
      Parser (Version -> Text -> Status)
-> Parser Version -> Parser (Text -> Status)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v
        Object -> Key -> Parser Version
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"version"
      Parser (Text -> Status) -> Parser Text -> Parser Status
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v
        Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"tagline"
  parseJSON Value
_ = Parser Status
forall a. Parser a
forall (f :: * -> *) a. Alternative f => f a
empty

nameLens :: Lens' Status Text
nameLens :: Lens' Status Text
nameLens = (Status -> Text) -> (Status -> Text -> Status) -> Lens' Status Text
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Status -> Text
name (\Status
x Text
y -> Status
x {name = y})

clusterNameLens :: Lens' Status Text
clusterNameLens :: Lens' Status Text
clusterNameLens = (Status -> Text) -> (Status -> Text -> Status) -> Lens' Status Text
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Status -> Text
cluster_name (\Status
x Text
y -> Status
x {cluster_name = y})

clusterUuidLens :: Lens' Status Text
clusterUuidLens :: Lens' Status Text
clusterUuidLens = (Status -> Text) -> (Status -> Text -> Status) -> Lens' Status Text
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Status -> Text
cluster_uuid (\Status
x Text
y -> Status
x {cluster_uuid = y})

versionLens :: Lens' Status Version
versionLens :: Lens' Status Version
versionLens = (Status -> Version)
-> (Status -> Version -> Status) -> Lens' Status Version
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Status -> Version
version (\Status
x Version
y -> Status
x {version = y})

taglineLens :: Lens' Status Text
taglineLens :: Lens' Status Text
taglineLens = (Status -> Text) -> (Status -> Text -> Status) -> Lens' Status Text
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Status -> Text
tagline (\Status
x Text
y -> Status
x {tagline = y})

-- | 'IndexSettings' is used to configure the shards and replicas when
--   you create an Elasticsearch Index.
--
--  <http://www.elastic.co/guide/en/elasticsearch/reference/current/indices-create-index.html>
data IndexSettings = IndexSettings
  { IndexSettings -> ShardCount
indexShards :: ShardCount,
    IndexSettings -> ReplicaCount
indexReplicas :: ReplicaCount,
    IndexSettings -> IndexMappingsLimits
indexMappingsLimits :: IndexMappingsLimits
  }
  deriving stock (IndexSettings -> IndexSettings -> Bool
(IndexSettings -> IndexSettings -> Bool)
-> (IndexSettings -> IndexSettings -> Bool) -> Eq IndexSettings
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: IndexSettings -> IndexSettings -> Bool
== :: IndexSettings -> IndexSettings -> Bool
$c/= :: IndexSettings -> IndexSettings -> Bool
/= :: IndexSettings -> IndexSettings -> Bool
Eq, Int -> IndexSettings -> ShowS
[IndexSettings] -> ShowS
IndexSettings -> String
(Int -> IndexSettings -> ShowS)
-> (IndexSettings -> String)
-> ([IndexSettings] -> ShowS)
-> Show IndexSettings
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> IndexSettings -> ShowS
showsPrec :: Int -> IndexSettings -> ShowS
$cshow :: IndexSettings -> String
show :: IndexSettings -> String
$cshowList :: [IndexSettings] -> ShowS
showList :: [IndexSettings] -> ShowS
Show, (forall x. IndexSettings -> Rep IndexSettings x)
-> (forall x. Rep IndexSettings x -> IndexSettings)
-> Generic IndexSettings
forall x. Rep IndexSettings x -> IndexSettings
forall x. IndexSettings -> Rep IndexSettings x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. IndexSettings -> Rep IndexSettings x
from :: forall x. IndexSettings -> Rep IndexSettings x
$cto :: forall x. Rep IndexSettings x -> IndexSettings
to :: forall x. Rep IndexSettings x -> IndexSettings
Generic)

instance ToJSON IndexSettings where
  toJSON :: IndexSettings -> Value
toJSON (IndexSettings ShardCount
s ReplicaCount
r IndexMappingsLimits
l) =
    [Pair] -> Value
object
      [ Key
"settings"
          Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [Pair] -> Value
object
            [ Key
"index"
                Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [Pair] -> Value
object [Key
"number_of_shards" Key -> ShardCount -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ShardCount
s, Key
"number_of_replicas" Key -> ReplicaCount -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ReplicaCount
r, Key
"mapping" Key -> IndexMappingsLimits -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= IndexMappingsLimits
l]
            ]
      ]

instance FromJSON IndexSettings where
  parseJSON :: Value -> Parser IndexSettings
parseJSON = String
-> (Object -> Parser IndexSettings)
-> Value
-> Parser IndexSettings
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"IndexSettings" Object -> Parser IndexSettings
parse
    where
      parse :: Object -> Parser IndexSettings
parse Object
o = do
        Object
s <- Object
o Object -> Key -> Parser Object
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"settings"
        Object
i <- Object
s Object -> Key -> Parser Object
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"index"
        ShardCount -> ReplicaCount -> IndexMappingsLimits -> IndexSettings
IndexSettings
          (ShardCount
 -> ReplicaCount -> IndexMappingsLimits -> IndexSettings)
-> Parser ShardCount
-> Parser (ReplicaCount -> IndexMappingsLimits -> IndexSettings)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
i
            Object -> Key -> Parser ShardCount
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"number_of_shards"
          Parser (ReplicaCount -> IndexMappingsLimits -> IndexSettings)
-> Parser ReplicaCount
-> Parser (IndexMappingsLimits -> IndexSettings)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
i
            Object -> Key -> Parser ReplicaCount
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"number_of_replicas"
          Parser (IndexMappingsLimits -> IndexSettings)
-> Parser IndexMappingsLimits -> Parser IndexSettings
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
i
            Object -> Key -> Parser (Maybe IndexMappingsLimits)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"mapping"
            Parser (Maybe IndexMappingsLimits)
-> IndexMappingsLimits -> Parser IndexMappingsLimits
forall a. Parser (Maybe a) -> a -> Parser a
.!= IndexMappingsLimits
defaultIndexMappingsLimits

indexShardsLens :: Lens' IndexSettings ShardCount
indexShardsLens :: Lens' IndexSettings ShardCount
indexShardsLens = (IndexSettings -> ShardCount)
-> (IndexSettings -> ShardCount -> IndexSettings)
-> Lens' IndexSettings ShardCount
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens IndexSettings -> ShardCount
indexShards (\IndexSettings
x ShardCount
y -> IndexSettings
x {indexShards = y})

indexReplicasLens :: Lens' IndexSettings ReplicaCount
indexReplicasLens :: Lens' IndexSettings ReplicaCount
indexReplicasLens = (IndexSettings -> ReplicaCount)
-> (IndexSettings -> ReplicaCount -> IndexSettings)
-> Lens' IndexSettings ReplicaCount
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens IndexSettings -> ReplicaCount
indexReplicas (\IndexSettings
x ReplicaCount
y -> IndexSettings
x {indexReplicas = y})

indexMappingsLimitsLens :: Lens' IndexSettings IndexMappingsLimits
indexMappingsLimitsLens :: Lens' IndexSettings IndexMappingsLimits
indexMappingsLimitsLens = (IndexSettings -> IndexMappingsLimits)
-> (IndexSettings -> IndexMappingsLimits -> IndexSettings)
-> Lens' IndexSettings IndexMappingsLimits
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens IndexSettings -> IndexMappingsLimits
indexMappingsLimits (\IndexSettings
x IndexMappingsLimits
y -> IndexSettings
x {indexMappingsLimits = y})

-- | 'defaultIndexSettings' is an 'IndexSettings' with 3 shards and
--   2 replicas.
defaultIndexSettings :: IndexSettings
defaultIndexSettings :: IndexSettings
defaultIndexSettings = ShardCount -> ReplicaCount -> IndexMappingsLimits -> IndexSettings
IndexSettings (Int -> ShardCount
ShardCount Int
3) (Int -> ReplicaCount
ReplicaCount Int
2) IndexMappingsLimits
defaultIndexMappingsLimits

-- defaultIndexSettings is exported by Database.Bloodhound as well
-- no trailing slashes in servers, library handles building the path.

-- | 'IndexMappingsLimits is used to configure index's limits.
--  <https://www.elastic.co/guide/en/elasticsearch/reference/master/mapping-settings-limit.html>
data IndexMappingsLimits = IndexMappingsLimits
  { IndexMappingsLimits -> Maybe Int
indexMappingsLimitDepth :: Maybe Int,
    IndexMappingsLimits -> Maybe Int
indexMappingsLimitNestedFields :: Maybe Int,
    IndexMappingsLimits -> Maybe Int
indexMappingsLimitNestedObjects :: Maybe Int,
    IndexMappingsLimits -> Maybe Int
indexMappingsLimitFieldNameLength :: Maybe Int
  }
  deriving stock (IndexMappingsLimits -> IndexMappingsLimits -> Bool
(IndexMappingsLimits -> IndexMappingsLimits -> Bool)
-> (IndexMappingsLimits -> IndexMappingsLimits -> Bool)
-> Eq IndexMappingsLimits
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: IndexMappingsLimits -> IndexMappingsLimits -> Bool
== :: IndexMappingsLimits -> IndexMappingsLimits -> Bool
$c/= :: IndexMappingsLimits -> IndexMappingsLimits -> Bool
/= :: IndexMappingsLimits -> IndexMappingsLimits -> Bool
Eq, Int -> IndexMappingsLimits -> ShowS
[IndexMappingsLimits] -> ShowS
IndexMappingsLimits -> String
(Int -> IndexMappingsLimits -> ShowS)
-> (IndexMappingsLimits -> String)
-> ([IndexMappingsLimits] -> ShowS)
-> Show IndexMappingsLimits
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> IndexMappingsLimits -> ShowS
showsPrec :: Int -> IndexMappingsLimits -> ShowS
$cshow :: IndexMappingsLimits -> String
show :: IndexMappingsLimits -> String
$cshowList :: [IndexMappingsLimits] -> ShowS
showList :: [IndexMappingsLimits] -> ShowS
Show, (forall x. IndexMappingsLimits -> Rep IndexMappingsLimits x)
-> (forall x. Rep IndexMappingsLimits x -> IndexMappingsLimits)
-> Generic IndexMappingsLimits
forall x. Rep IndexMappingsLimits x -> IndexMappingsLimits
forall x. IndexMappingsLimits -> Rep IndexMappingsLimits x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. IndexMappingsLimits -> Rep IndexMappingsLimits x
from :: forall x. IndexMappingsLimits -> Rep IndexMappingsLimits x
$cto :: forall x. Rep IndexMappingsLimits x -> IndexMappingsLimits
to :: forall x. Rep IndexMappingsLimits x -> IndexMappingsLimits
Generic)

instance ToJSON IndexMappingsLimits where
  toJSON :: IndexMappingsLimits -> Value
toJSON (IndexMappingsLimits Maybe Int
d Maybe Int
f Maybe Int
o Maybe Int
n) =
    [Pair] -> Value
object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$
      ((Key, Maybe Int) -> Maybe Pair) -> [(Key, Maybe Int)] -> [Pair]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe
        (Key, Maybe Int) -> Maybe Pair
forall {f :: * -> *} {e} {b} {a}.
(Functor f, KeyValue e b, ToJSON a) =>
(Key, f a) -> f b
go
        [ (Key
"depth.limit", Maybe Int
d),
          (Key
"nested_fields.limit", Maybe Int
f),
          (Key
"nested_objects.limit", Maybe Int
o),
          (Key
"field_name_length.limit", Maybe Int
n)
        ]
    where
      go :: (Key, f a) -> f b
go (Key
name, f a
value) = (Key
name Key -> a -> b
forall v. ToJSON v => Key -> v -> b
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.=) (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f a
value

instance FromJSON IndexMappingsLimits where
  parseJSON :: Value -> Parser IndexMappingsLimits
parseJSON = String
-> (Object -> Parser IndexMappingsLimits)
-> Value
-> Parser IndexMappingsLimits
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"IndexMappingsLimits" ((Object -> Parser IndexMappingsLimits)
 -> Value -> Parser IndexMappingsLimits)
-> (Object -> Parser IndexMappingsLimits)
-> Value
-> Parser IndexMappingsLimits
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Int
-> Maybe Int -> Maybe Int -> Maybe Int -> IndexMappingsLimits
IndexMappingsLimits
      (Maybe Int
 -> Maybe Int -> Maybe Int -> Maybe Int -> IndexMappingsLimits)
-> Parser (Maybe Int)
-> Parser
     (Maybe Int -> Maybe Int -> Maybe Int -> IndexMappingsLimits)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:?? Key
"depth"
      Parser (Maybe Int -> Maybe Int -> Maybe Int -> IndexMappingsLimits)
-> Parser (Maybe Int)
-> Parser (Maybe Int -> Maybe Int -> IndexMappingsLimits)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:?? Key
"nested_fields"
      Parser (Maybe Int -> Maybe Int -> IndexMappingsLimits)
-> Parser (Maybe Int) -> Parser (Maybe Int -> IndexMappingsLimits)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:?? Key
"nested_objects"
      Parser (Maybe Int -> IndexMappingsLimits)
-> Parser (Maybe Int) -> Parser IndexMappingsLimits
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:?? Key
"field_name_length"
    where
      Object
o .:?? :: Object -> Key -> Parser (Maybe a)
.:?? Key
name = Parser a -> Parser (Maybe a)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser a -> Parser (Maybe a)) -> Parser a -> Parser (Maybe a)
forall a b. (a -> b) -> a -> b
$ do
        Object
f <- Object
o Object -> Key -> Parser Object
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
name
        Object
f Object -> Key -> Parser a
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"limit"

indexMappingsLimitDepthLens :: Lens' IndexMappingsLimits (Maybe Int)
indexMappingsLimitDepthLens :: Lens' IndexMappingsLimits (Maybe Int)
indexMappingsLimitDepthLens = (IndexMappingsLimits -> Maybe Int)
-> (IndexMappingsLimits -> Maybe Int -> IndexMappingsLimits)
-> Lens' IndexMappingsLimits (Maybe Int)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens IndexMappingsLimits -> Maybe Int
indexMappingsLimitDepth (\IndexMappingsLimits
x Maybe Int
y -> IndexMappingsLimits
x {indexMappingsLimitDepth = y})

indexMappingsLimitNestedFieldsLens :: Lens' IndexMappingsLimits (Maybe Int)
indexMappingsLimitNestedFieldsLens :: Lens' IndexMappingsLimits (Maybe Int)
indexMappingsLimitNestedFieldsLens = (IndexMappingsLimits -> Maybe Int)
-> (IndexMappingsLimits -> Maybe Int -> IndexMappingsLimits)
-> Lens' IndexMappingsLimits (Maybe Int)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens IndexMappingsLimits -> Maybe Int
indexMappingsLimitNestedFields (\IndexMappingsLimits
x Maybe Int
y -> IndexMappingsLimits
x {indexMappingsLimitNestedFields = y})

indexMappingsLimitNestedObjectsLens :: Lens' IndexMappingsLimits (Maybe Int)
indexMappingsLimitNestedObjectsLens :: Lens' IndexMappingsLimits (Maybe Int)
indexMappingsLimitNestedObjectsLens = (IndexMappingsLimits -> Maybe Int)
-> (IndexMappingsLimits -> Maybe Int -> IndexMappingsLimits)
-> Lens' IndexMappingsLimits (Maybe Int)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens IndexMappingsLimits -> Maybe Int
indexMappingsLimitNestedObjects (\IndexMappingsLimits
x Maybe Int
y -> IndexMappingsLimits
x {indexMappingsLimitNestedObjects = y})

indexMappingsLimitFieldNameLengthLens :: Lens' IndexMappingsLimits (Maybe Int)
indexMappingsLimitFieldNameLengthLens :: Lens' IndexMappingsLimits (Maybe Int)
indexMappingsLimitFieldNameLengthLens = (IndexMappingsLimits -> Maybe Int)
-> (IndexMappingsLimits -> Maybe Int -> IndexMappingsLimits)
-> Lens' IndexMappingsLimits (Maybe Int)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens IndexMappingsLimits -> Maybe Int
indexMappingsLimitFieldNameLength (\IndexMappingsLimits
x Maybe Int
y -> IndexMappingsLimits
x {indexMappingsLimitFieldNameLength = y})

defaultIndexMappingsLimits :: IndexMappingsLimits
defaultIndexMappingsLimits :: IndexMappingsLimits
defaultIndexMappingsLimits = Maybe Int
-> Maybe Int -> Maybe Int -> Maybe Int -> IndexMappingsLimits
IndexMappingsLimits Maybe Int
forall a. Maybe a
Nothing Maybe Int
forall a. Maybe a
Nothing Maybe Int
forall a. Maybe a
Nothing Maybe Int
forall a. Maybe a
Nothing

-- | 'ForceMergeIndexSettings' is used to configure index optimization. See
--   <https://www.elastic.co/guide/en/elasticsearch/reference/current/indices-forcemerge.html>
--   for more info.
data ForceMergeIndexSettings = ForceMergeIndexSettings
  { -- | Number of segments to optimize to. 1 will fully optimize the index. If omitted, the default behavior is to only optimize if the server deems it necessary.
    ForceMergeIndexSettings -> Maybe Int
maxNumSegments :: Maybe Int,
    -- | Should the optimize process only expunge segments with deletes in them? If the purpose of the optimization is to free disk space, this should be set to True.
    ForceMergeIndexSettings -> Bool
onlyExpungeDeletes :: Bool,
    -- | Should a flush be performed after the optimize.
    ForceMergeIndexSettings -> Bool
flushAfterOptimize :: Bool
  }
  deriving stock (ForceMergeIndexSettings -> ForceMergeIndexSettings -> Bool
(ForceMergeIndexSettings -> ForceMergeIndexSettings -> Bool)
-> (ForceMergeIndexSettings -> ForceMergeIndexSettings -> Bool)
-> Eq ForceMergeIndexSettings
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ForceMergeIndexSettings -> ForceMergeIndexSettings -> Bool
== :: ForceMergeIndexSettings -> ForceMergeIndexSettings -> Bool
$c/= :: ForceMergeIndexSettings -> ForceMergeIndexSettings -> Bool
/= :: ForceMergeIndexSettings -> ForceMergeIndexSettings -> Bool
Eq, Int -> ForceMergeIndexSettings -> ShowS
[ForceMergeIndexSettings] -> ShowS
ForceMergeIndexSettings -> String
(Int -> ForceMergeIndexSettings -> ShowS)
-> (ForceMergeIndexSettings -> String)
-> ([ForceMergeIndexSettings] -> ShowS)
-> Show ForceMergeIndexSettings
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ForceMergeIndexSettings -> ShowS
showsPrec :: Int -> ForceMergeIndexSettings -> ShowS
$cshow :: ForceMergeIndexSettings -> String
show :: ForceMergeIndexSettings -> String
$cshowList :: [ForceMergeIndexSettings] -> ShowS
showList :: [ForceMergeIndexSettings] -> ShowS
Show)

maxNumSegmentsLens :: Lens' ForceMergeIndexSettings (Maybe Int)
maxNumSegmentsLens :: Lens' ForceMergeIndexSettings (Maybe Int)
maxNumSegmentsLens = (ForceMergeIndexSettings -> Maybe Int)
-> (ForceMergeIndexSettings
    -> Maybe Int -> ForceMergeIndexSettings)
-> Lens' ForceMergeIndexSettings (Maybe Int)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens ForceMergeIndexSettings -> Maybe Int
maxNumSegments (\ForceMergeIndexSettings
x Maybe Int
y -> ForceMergeIndexSettings
x {maxNumSegments = y})

onlyExpungeDeletesLens :: Lens' ForceMergeIndexSettings Bool
onlyExpungeDeletesLens :: Lens' ForceMergeIndexSettings Bool
onlyExpungeDeletesLens = (ForceMergeIndexSettings -> Bool)
-> (ForceMergeIndexSettings -> Bool -> ForceMergeIndexSettings)
-> Lens' ForceMergeIndexSettings Bool
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens ForceMergeIndexSettings -> Bool
onlyExpungeDeletes (\ForceMergeIndexSettings
x Bool
y -> ForceMergeIndexSettings
x {onlyExpungeDeletes = y})

flushAfterOptimizeLens :: Lens' ForceMergeIndexSettings Bool
flushAfterOptimizeLens :: Lens' ForceMergeIndexSettings Bool
flushAfterOptimizeLens = (ForceMergeIndexSettings -> Bool)
-> (ForceMergeIndexSettings -> Bool -> ForceMergeIndexSettings)
-> Lens' ForceMergeIndexSettings Bool
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens ForceMergeIndexSettings -> Bool
flushAfterOptimize (\ForceMergeIndexSettings
x Bool
y -> ForceMergeIndexSettings
x {flushAfterOptimize = y})

-- | 'defaultForceMergeIndexSettings' implements the default settings that
--   Elasticsearch uses for index optimization. 'maxNumSegments' is Nothing,
--   'onlyExpungeDeletes' is False, and flushAfterOptimize is True.
defaultForceMergeIndexSettings :: ForceMergeIndexSettings
defaultForceMergeIndexSettings :: ForceMergeIndexSettings
defaultForceMergeIndexSettings = Maybe Int -> Bool -> Bool -> ForceMergeIndexSettings
ForceMergeIndexSettings Maybe Int
forall a. Maybe a
Nothing Bool
False Bool
True

-- | 'UpdatableIndexSetting' are settings which may be updated after an index is created.
--
--  <https://www.elastic.co/guide/en/elasticsearch/reference/current/indices-update-settings.html>
data UpdatableIndexSetting
  = -- | The number of replicas each shard has.
    NumberOfReplicas ReplicaCount
  | AutoExpandReplicas ReplicaBounds
  | -- | Set to True to have the index read only. False to allow writes and metadata changes.
    BlocksReadOnly Bool
  | -- | Set to True to disable read operations against the index.
    BlocksRead Bool
  | -- | Set to True to disable write operations against the index.
    BlocksWrite Bool
  | -- | Set to True to disable metadata operations against the index.
    BlocksMetaData Bool
  | -- | The async refresh interval of a shard
    RefreshInterval NominalDiffTime
  | IndexConcurrency Int
  | FailOnMergeFailure Bool
  | -- | When to flush on operations.
    TranslogFlushThresholdOps Int
  | -- | When to flush based on translog (bytes) size.
    TranslogFlushThresholdSize Bytes
  | -- | When to flush based on a period of not flushing.
    TranslogFlushThresholdPeriod NominalDiffTime
  | -- | Disables flushing. Note, should be set for a short interval and then enabled.
    TranslogDisableFlush Bool
  | -- | The maximum size of filter cache (per segment in shard).
    CacheFilterMaxSize (Maybe Bytes)
  | -- | The expire after access time for filter cache.
    CacheFilterExpire (Maybe NominalDiffTime)
  | -- | The gateway snapshot interval (only applies to shared gateways).
    GatewaySnapshotInterval NominalDiffTime
  | -- | A node matching any rule will be allowed to host shards from the index.
    RoutingAllocationInclude (NonEmpty NodeAttrFilter)
  | -- | A node matching any rule will NOT be allowed to host shards from the index.
    RoutingAllocationExclude (NonEmpty NodeAttrFilter)
  | -- | Only nodes matching all rules will be allowed to host shards from the index.
    RoutingAllocationRequire (NonEmpty NodeAttrFilter)
  | -- | Enables shard allocation for a specific index.
    RoutingAllocationEnable AllocationPolicy
  | -- | Controls the total number of shards (replicas and primaries) allowed to be allocated on a single node.
    RoutingAllocationShardsPerNode ShardCount
  | -- | When using local gateway a particular shard is recovered only if there can be allocated quorum shards in the cluster.
    RecoveryInitialShards InitialShardCount
  | GCDeletes NominalDiffTime
  | -- | Disables temporarily the purge of expired docs.
    TTLDisablePurge Bool
  | TranslogFSType FSType
  | CompressionSetting Compression
  | IndexCompoundFormat CompoundFormat
  | IndexCompoundOnFlush Bool
  | WarmerEnabled Bool
  | MappingTotalFieldsLimit Int
  | -- | Analysis is not a dynamic setting and can only be performed on a closed index.
    AnalysisSetting Analysis
  | -- | Sets a delay to the allocation of replica shards which become unassigned because a node has left, giving them chance to return. See <https://www.elastic.co/guide/en/elasticsearch/reference/5.6/delayed-allocation.html>
    UnassignedNodeLeftDelayedTimeout NominalDiffTime
  deriving stock (UpdatableIndexSetting -> UpdatableIndexSetting -> Bool
(UpdatableIndexSetting -> UpdatableIndexSetting -> Bool)
-> (UpdatableIndexSetting -> UpdatableIndexSetting -> Bool)
-> Eq UpdatableIndexSetting
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UpdatableIndexSetting -> UpdatableIndexSetting -> Bool
== :: UpdatableIndexSetting -> UpdatableIndexSetting -> Bool
$c/= :: UpdatableIndexSetting -> UpdatableIndexSetting -> Bool
/= :: UpdatableIndexSetting -> UpdatableIndexSetting -> Bool
Eq, Int -> UpdatableIndexSetting -> ShowS
[UpdatableIndexSetting] -> ShowS
UpdatableIndexSetting -> String
(Int -> UpdatableIndexSetting -> ShowS)
-> (UpdatableIndexSetting -> String)
-> ([UpdatableIndexSetting] -> ShowS)
-> Show UpdatableIndexSetting
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UpdatableIndexSetting -> ShowS
showsPrec :: Int -> UpdatableIndexSetting -> ShowS
$cshow :: UpdatableIndexSetting -> String
show :: UpdatableIndexSetting -> String
$cshowList :: [UpdatableIndexSetting] -> ShowS
showList :: [UpdatableIndexSetting] -> ShowS
Show, (forall x. UpdatableIndexSetting -> Rep UpdatableIndexSetting x)
-> (forall x. Rep UpdatableIndexSetting x -> UpdatableIndexSetting)
-> Generic UpdatableIndexSetting
forall x. Rep UpdatableIndexSetting x -> UpdatableIndexSetting
forall x. UpdatableIndexSetting -> Rep UpdatableIndexSetting x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. UpdatableIndexSetting -> Rep UpdatableIndexSetting x
from :: forall x. UpdatableIndexSetting -> Rep UpdatableIndexSetting x
$cto :: forall x. Rep UpdatableIndexSetting x -> UpdatableIndexSetting
to :: forall x. Rep UpdatableIndexSetting x -> UpdatableIndexSetting
Generic)

attrFilterJSON :: NonEmpty NodeAttrFilter -> Value
attrFilterJSON :: NonEmpty NodeAttrFilter -> Value
attrFilterJSON NonEmpty NodeAttrFilter
fs =
  [Pair] -> Value
object
    [ Text -> Key
fromText Text
n Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> [Text] -> Text
T.intercalate Text
"," (NonEmpty Text -> [Text]
forall a. NonEmpty a -> [a]
toList NonEmpty Text
vs)
      | NodeAttrFilter (NodeAttrName Text
n) NonEmpty Text
vs <- NonEmpty NodeAttrFilter -> [NodeAttrFilter]
forall a. NonEmpty a -> [a]
toList NonEmpty NodeAttrFilter
fs
    ]

parseAttrFilter :: Value -> Parser (NonEmpty NodeAttrFilter)
parseAttrFilter :: Value -> Parser (NonEmpty NodeAttrFilter)
parseAttrFilter = String
-> (Object -> Parser (NonEmpty NodeAttrFilter))
-> Value
-> Parser (NonEmpty NodeAttrFilter)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"NonEmpty NodeAttrFilter" Object -> Parser (NonEmpty NodeAttrFilter)
parse
  where
    parse :: Object -> Parser (NonEmpty NodeAttrFilter)
parse Object
o = case Object -> [Pair]
forall v. KeyMap v -> [(Key, v)]
X.toList Object
o of
      [] -> String -> Parser (NonEmpty NodeAttrFilter)
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Expected non-empty list of NodeAttrFilters"
      Pair
x : [Pair]
xs -> (Pair -> Parser NodeAttrFilter)
-> NonEmpty Pair -> Parser (NonEmpty NodeAttrFilter)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> NonEmpty a -> m (NonEmpty b)
DT.mapM ((Key -> Value -> Parser NodeAttrFilter)
-> Pair -> Parser NodeAttrFilter
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Key -> Value -> Parser NodeAttrFilter
parse') (Pair
x Pair -> [Pair] -> NonEmpty Pair
forall a. a -> [a] -> NonEmpty a
:| [Pair]
xs)
    parse' :: Key -> Value -> Parser NodeAttrFilter
parse' Key
n = String
-> (Text -> Parser NodeAttrFilter)
-> Value
-> Parser NodeAttrFilter
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"Text" ((Text -> Parser NodeAttrFilter) -> Value -> Parser NodeAttrFilter)
-> (Text -> Parser NodeAttrFilter)
-> Value
-> Parser NodeAttrFilter
forall a b. (a -> b) -> a -> b
$ \Text
t ->
      case HasCallStack => Text -> Text -> [Text]
Text -> Text -> [Text]
T.splitOn Text
"," Text
t of
        Text
fv : [Text]
fvs -> NodeAttrFilter -> Parser NodeAttrFilter
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (NodeAttrName -> NonEmpty Text -> NodeAttrFilter
NodeAttrFilter (Text -> NodeAttrName
NodeAttrName (Text -> NodeAttrName) -> Text -> NodeAttrName
forall a b. (a -> b) -> a -> b
$ Key -> Text
toText Key
n) (Text
fv Text -> [Text] -> NonEmpty Text
forall a. a -> [a] -> NonEmpty a
:| [Text]
fvs))
        [] -> String -> Parser NodeAttrFilter
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Expected non-empty list of filter values"

instance ToJSON UpdatableIndexSetting where
  toJSON :: UpdatableIndexSetting -> Value
toJSON (NumberOfReplicas ReplicaCount
x) = NonEmpty Key -> ReplicaCount -> Value
forall a. ToJSON a => NonEmpty Key -> a -> Value
oPath (Key
"index" Key -> [Key] -> NonEmpty Key
forall a. a -> [a] -> NonEmpty a
:| [Key
"number_of_replicas"]) ReplicaCount
x
  toJSON (AutoExpandReplicas ReplicaBounds
x) = NonEmpty Key -> ReplicaBounds -> Value
forall a. ToJSON a => NonEmpty Key -> a -> Value
oPath (Key
"index" Key -> [Key] -> NonEmpty Key
forall a. a -> [a] -> NonEmpty a
:| [Key
"auto_expand_replicas"]) ReplicaBounds
x
  toJSON (RefreshInterval NominalDiffTime
x) = NonEmpty Key -> NominalDiffTimeJSON -> Value
forall a. ToJSON a => NonEmpty Key -> a -> Value
oPath (Key
"index" Key -> [Key] -> NonEmpty Key
forall a. a -> [a] -> NonEmpty a
:| [Key
"refresh_interval"]) (NominalDiffTime -> NominalDiffTimeJSON
NominalDiffTimeJSON NominalDiffTime
x)
  toJSON (IndexConcurrency Int
x) = NonEmpty Key -> Int -> Value
forall a. ToJSON a => NonEmpty Key -> a -> Value
oPath (Key
"index" Key -> [Key] -> NonEmpty Key
forall a. a -> [a] -> NonEmpty a
:| [Key
"concurrency"]) Int
x
  toJSON (FailOnMergeFailure Bool
x) = NonEmpty Key -> Bool -> Value
forall a. ToJSON a => NonEmpty Key -> a -> Value
oPath (Key
"index" Key -> [Key] -> NonEmpty Key
forall a. a -> [a] -> NonEmpty a
:| [Key
"fail_on_merge_failure"]) Bool
x
  toJSON (TranslogFlushThresholdOps Int
x) = NonEmpty Key -> Int -> Value
forall a. ToJSON a => NonEmpty Key -> a -> Value
oPath (Key
"index" Key -> [Key] -> NonEmpty Key
forall a. a -> [a] -> NonEmpty a
:| [Key
"translog", Key
"flush_threshold_ops"]) Int
x
  toJSON (TranslogFlushThresholdSize Bytes
x) = NonEmpty Key -> Bytes -> Value
forall a. ToJSON a => NonEmpty Key -> a -> Value
oPath (Key
"index" Key -> [Key] -> NonEmpty Key
forall a. a -> [a] -> NonEmpty a
:| [Key
"translog", Key
"flush_threshold_size"]) Bytes
x
  toJSON (TranslogFlushThresholdPeriod NominalDiffTime
x) = NonEmpty Key -> NominalDiffTimeJSON -> Value
forall a. ToJSON a => NonEmpty Key -> a -> Value
oPath (Key
"index" Key -> [Key] -> NonEmpty Key
forall a. a -> [a] -> NonEmpty a
:| [Key
"translog", Key
"flush_threshold_period"]) (NominalDiffTime -> NominalDiffTimeJSON
NominalDiffTimeJSON NominalDiffTime
x)
  toJSON (TranslogDisableFlush Bool
x) = NonEmpty Key -> Bool -> Value
forall a. ToJSON a => NonEmpty Key -> a -> Value
oPath (Key
"index" Key -> [Key] -> NonEmpty Key
forall a. a -> [a] -> NonEmpty a
:| [Key
"translog", Key
"disable_flush"]) Bool
x
  toJSON (CacheFilterMaxSize Maybe Bytes
x) = NonEmpty Key -> Maybe Bytes -> Value
forall a. ToJSON a => NonEmpty Key -> a -> Value
oPath (Key
"index" Key -> [Key] -> NonEmpty Key
forall a. a -> [a] -> NonEmpty a
:| [Key
"cache", Key
"filter", Key
"max_size"]) Maybe Bytes
x
  toJSON (CacheFilterExpire Maybe NominalDiffTime
x) = NonEmpty Key -> Maybe NominalDiffTimeJSON -> Value
forall a. ToJSON a => NonEmpty Key -> a -> Value
oPath (Key
"index" Key -> [Key] -> NonEmpty Key
forall a. a -> [a] -> NonEmpty a
:| [Key
"cache", Key
"filter", Key
"expire"]) (NominalDiffTime -> NominalDiffTimeJSON
NominalDiffTimeJSON (NominalDiffTime -> NominalDiffTimeJSON)
-> Maybe NominalDiffTime -> Maybe NominalDiffTimeJSON
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe NominalDiffTime
x)
  toJSON (GatewaySnapshotInterval NominalDiffTime
x) = NonEmpty Key -> NominalDiffTimeJSON -> Value
forall a. ToJSON a => NonEmpty Key -> a -> Value
oPath (Key
"index" Key -> [Key] -> NonEmpty Key
forall a. a -> [a] -> NonEmpty a
:| [Key
"gateway", Key
"snapshot_interval"]) (NominalDiffTime -> NominalDiffTimeJSON
NominalDiffTimeJSON NominalDiffTime
x)
  toJSON (RoutingAllocationInclude NonEmpty NodeAttrFilter
fs) = NonEmpty Key -> Value -> Value
forall a. ToJSON a => NonEmpty Key -> a -> Value
oPath (Key
"index" Key -> [Key] -> NonEmpty Key
forall a. a -> [a] -> NonEmpty a
:| [Key
"routing", Key
"allocation", Key
"include"]) (NonEmpty NodeAttrFilter -> Value
attrFilterJSON NonEmpty NodeAttrFilter
fs)
  toJSON (RoutingAllocationExclude NonEmpty NodeAttrFilter
fs) = NonEmpty Key -> Value -> Value
forall a. ToJSON a => NonEmpty Key -> a -> Value
oPath (Key
"index" Key -> [Key] -> NonEmpty Key
forall a. a -> [a] -> NonEmpty a
:| [Key
"routing", Key
"allocation", Key
"exclude"]) (NonEmpty NodeAttrFilter -> Value
attrFilterJSON NonEmpty NodeAttrFilter
fs)
  toJSON (RoutingAllocationRequire NonEmpty NodeAttrFilter
fs) = NonEmpty Key -> Value -> Value
forall a. ToJSON a => NonEmpty Key -> a -> Value
oPath (Key
"index" Key -> [Key] -> NonEmpty Key
forall a. a -> [a] -> NonEmpty a
:| [Key
"routing", Key
"allocation", Key
"require"]) (NonEmpty NodeAttrFilter -> Value
attrFilterJSON NonEmpty NodeAttrFilter
fs)
  toJSON (RoutingAllocationEnable AllocationPolicy
x) = NonEmpty Key -> AllocationPolicy -> Value
forall a. ToJSON a => NonEmpty Key -> a -> Value
oPath (Key
"index" Key -> [Key] -> NonEmpty Key
forall a. a -> [a] -> NonEmpty a
:| [Key
"routing", Key
"allocation", Key
"enable"]) AllocationPolicy
x
  toJSON (RoutingAllocationShardsPerNode ShardCount
x) = NonEmpty Key -> ShardCount -> Value
forall a. ToJSON a => NonEmpty Key -> a -> Value
oPath (Key
"index" Key -> [Key] -> NonEmpty Key
forall a. a -> [a] -> NonEmpty a
:| [Key
"routing", Key
"allocation", Key
"total_shards_per_node"]) ShardCount
x
  toJSON (RecoveryInitialShards InitialShardCount
x) = NonEmpty Key -> InitialShardCount -> Value
forall a. ToJSON a => NonEmpty Key -> a -> Value
oPath (Key
"index" Key -> [Key] -> NonEmpty Key
forall a. a -> [a] -> NonEmpty a
:| [Key
"recovery", Key
"initial_shards"]) InitialShardCount
x
  toJSON (GCDeletes NominalDiffTime
x) = NonEmpty Key -> NominalDiffTimeJSON -> Value
forall a. ToJSON a => NonEmpty Key -> a -> Value
oPath (Key
"index" Key -> [Key] -> NonEmpty Key
forall a. a -> [a] -> NonEmpty a
:| [Key
"gc_deletes"]) (NominalDiffTime -> NominalDiffTimeJSON
NominalDiffTimeJSON NominalDiffTime
x)
  toJSON (TTLDisablePurge Bool
x) = NonEmpty Key -> Bool -> Value
forall a. ToJSON a => NonEmpty Key -> a -> Value
oPath (Key
"index" Key -> [Key] -> NonEmpty Key
forall a. a -> [a] -> NonEmpty a
:| [Key
"ttl", Key
"disable_purge"]) Bool
x
  toJSON (TranslogFSType FSType
x) = NonEmpty Key -> FSType -> Value
forall a. ToJSON a => NonEmpty Key -> a -> Value
oPath (Key
"index" Key -> [Key] -> NonEmpty Key
forall a. a -> [a] -> NonEmpty a
:| [Key
"translog", Key
"fs", Key
"type"]) FSType
x
  toJSON (CompressionSetting Compression
x) = NonEmpty Key -> Compression -> Value
forall a. ToJSON a => NonEmpty Key -> a -> Value
oPath (Key
"index" Key -> [Key] -> NonEmpty Key
forall a. a -> [a] -> NonEmpty a
:| [Key
"codec"]) Compression
x
  toJSON (IndexCompoundFormat CompoundFormat
x) = NonEmpty Key -> CompoundFormat -> Value
forall a. ToJSON a => NonEmpty Key -> a -> Value
oPath (Key
"index" Key -> [Key] -> NonEmpty Key
forall a. a -> [a] -> NonEmpty a
:| [Key
"compound_format"]) CompoundFormat
x
  toJSON (IndexCompoundOnFlush Bool
x) = NonEmpty Key -> Bool -> Value
forall a. ToJSON a => NonEmpty Key -> a -> Value
oPath (Key
"index" Key -> [Key] -> NonEmpty Key
forall a. a -> [a] -> NonEmpty a
:| [Key
"compound_on_flush"]) Bool
x
  toJSON (WarmerEnabled Bool
x) = NonEmpty Key -> Bool -> Value
forall a. ToJSON a => NonEmpty Key -> a -> Value
oPath (Key
"index" Key -> [Key] -> NonEmpty Key
forall a. a -> [a] -> NonEmpty a
:| [Key
"warmer", Key
"enabled"]) Bool
x
  toJSON (BlocksReadOnly Bool
x) = NonEmpty Key -> Bool -> Value
forall a. ToJSON a => NonEmpty Key -> a -> Value
oPath (Key
"blocks" Key -> [Key] -> NonEmpty Key
forall a. a -> [a] -> NonEmpty a
:| [Key
"read_only"]) Bool
x
  toJSON (BlocksRead Bool
x) = NonEmpty Key -> Bool -> Value
forall a. ToJSON a => NonEmpty Key -> a -> Value
oPath (Key
"blocks" Key -> [Key] -> NonEmpty Key
forall a. a -> [a] -> NonEmpty a
:| [Key
"read"]) Bool
x
  toJSON (BlocksWrite Bool
x) = NonEmpty Key -> Bool -> Value
forall a. ToJSON a => NonEmpty Key -> a -> Value
oPath (Key
"blocks" Key -> [Key] -> NonEmpty Key
forall a. a -> [a] -> NonEmpty a
:| [Key
"write"]) Bool
x
  toJSON (BlocksMetaData Bool
x) = NonEmpty Key -> Bool -> Value
forall a. ToJSON a => NonEmpty Key -> a -> Value
oPath (Key
"blocks" Key -> [Key] -> NonEmpty Key
forall a. a -> [a] -> NonEmpty a
:| [Key
"metadata"]) Bool
x
  toJSON (MappingTotalFieldsLimit Int
x) = NonEmpty Key -> Int -> Value
forall a. ToJSON a => NonEmpty Key -> a -> Value
oPath (Key
"index" Key -> [Key] -> NonEmpty Key
forall a. a -> [a] -> NonEmpty a
:| [Key
"mapping", Key
"total_fields", Key
"limit"]) Int
x
  toJSON (AnalysisSetting Analysis
x) = NonEmpty Key -> Analysis -> Value
forall a. ToJSON a => NonEmpty Key -> a -> Value
oPath (Key
"index" Key -> [Key] -> NonEmpty Key
forall a. a -> [a] -> NonEmpty a
:| [Key
"analysis"]) Analysis
x
  toJSON (UnassignedNodeLeftDelayedTimeout NominalDiffTime
x) = NonEmpty Key -> NominalDiffTimeJSON -> Value
forall a. ToJSON a => NonEmpty Key -> a -> Value
oPath (Key
"index" Key -> [Key] -> NonEmpty Key
forall a. a -> [a] -> NonEmpty a
:| [Key
"unassigned", Key
"node_left", Key
"delayed_timeout"]) (NominalDiffTime -> NominalDiffTimeJSON
NominalDiffTimeJSON NominalDiffTime
x)

instance FromJSON UpdatableIndexSetting where
  parseJSON :: Value -> Parser UpdatableIndexSetting
parseJSON = String
-> (Object -> Parser UpdatableIndexSetting)
-> Value
-> Parser UpdatableIndexSetting
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"UpdatableIndexSetting" Object -> Parser UpdatableIndexSetting
parse
    where
      parse :: Object -> Parser UpdatableIndexSetting
parse Object
o =
        ReplicaCount -> Parser UpdatableIndexSetting
numberOfReplicas
          (ReplicaCount -> Parser UpdatableIndexSetting)
-> [Key] -> Parser UpdatableIndexSetting
forall a b. FromJSON a => (a -> Parser b) -> [Key] -> Parser b
`taggedAt` [Key
"index", Key
"number_of_replicas"]
          Parser UpdatableIndexSetting
-> Parser UpdatableIndexSetting -> Parser UpdatableIndexSetting
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ReplicaBounds -> Parser UpdatableIndexSetting
autoExpandReplicas
            (ReplicaBounds -> Parser UpdatableIndexSetting)
-> [Key] -> Parser UpdatableIndexSetting
forall a b. FromJSON a => (a -> Parser b) -> [Key] -> Parser b
`taggedAt` [Key
"index", Key
"auto_expand_replicas"]
          Parser UpdatableIndexSetting
-> Parser UpdatableIndexSetting -> Parser UpdatableIndexSetting
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> NominalDiffTimeJSON -> Parser UpdatableIndexSetting
refreshInterval
            (NominalDiffTimeJSON -> Parser UpdatableIndexSetting)
-> [Key] -> Parser UpdatableIndexSetting
forall a b. FromJSON a => (a -> Parser b) -> [Key] -> Parser b
`taggedAt` [Key
"index", Key
"refresh_interval"]
          Parser UpdatableIndexSetting
-> Parser UpdatableIndexSetting -> Parser UpdatableIndexSetting
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Int -> Parser UpdatableIndexSetting
indexConcurrency
            (Int -> Parser UpdatableIndexSetting)
-> [Key] -> Parser UpdatableIndexSetting
forall a b. FromJSON a => (a -> Parser b) -> [Key] -> Parser b
`taggedAt` [Key
"index", Key
"concurrency"]
          Parser UpdatableIndexSetting
-> Parser UpdatableIndexSetting -> Parser UpdatableIndexSetting
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool -> Parser UpdatableIndexSetting
failOnMergeFailure
            (Bool -> Parser UpdatableIndexSetting)
-> [Key] -> Parser UpdatableIndexSetting
forall a b. FromJSON a => (a -> Parser b) -> [Key] -> Parser b
`taggedAt` [Key
"index", Key
"fail_on_merge_failure"]
          Parser UpdatableIndexSetting
-> Parser UpdatableIndexSetting -> Parser UpdatableIndexSetting
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Int -> Parser UpdatableIndexSetting
translogFlushThresholdOps
            (Int -> Parser UpdatableIndexSetting)
-> [Key] -> Parser UpdatableIndexSetting
forall a b. FromJSON a => (a -> Parser b) -> [Key] -> Parser b
`taggedAt` [Key
"index", Key
"translog", Key
"flush_threshold_ops"]
          Parser UpdatableIndexSetting
-> Parser UpdatableIndexSetting -> Parser UpdatableIndexSetting
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bytes -> Parser UpdatableIndexSetting
translogFlushThresholdSize
            (Bytes -> Parser UpdatableIndexSetting)
-> [Key] -> Parser UpdatableIndexSetting
forall a b. FromJSON a => (a -> Parser b) -> [Key] -> Parser b
`taggedAt` [Key
"index", Key
"translog", Key
"flush_threshold_size"]
          Parser UpdatableIndexSetting
-> Parser UpdatableIndexSetting -> Parser UpdatableIndexSetting
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> NominalDiffTimeJSON -> Parser UpdatableIndexSetting
translogFlushThresholdPeriod
            (NominalDiffTimeJSON -> Parser UpdatableIndexSetting)
-> [Key] -> Parser UpdatableIndexSetting
forall a b. FromJSON a => (a -> Parser b) -> [Key] -> Parser b
`taggedAt` [Key
"index", Key
"translog", Key
"flush_threshold_period"]
          Parser UpdatableIndexSetting
-> Parser UpdatableIndexSetting -> Parser UpdatableIndexSetting
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool -> Parser UpdatableIndexSetting
translogDisableFlush
            (Bool -> Parser UpdatableIndexSetting)
-> [Key] -> Parser UpdatableIndexSetting
forall a b. FromJSON a => (a -> Parser b) -> [Key] -> Parser b
`taggedAt` [Key
"index", Key
"translog", Key
"disable_flush"]
          Parser UpdatableIndexSetting
-> Parser UpdatableIndexSetting -> Parser UpdatableIndexSetting
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Bytes -> Parser UpdatableIndexSetting
cacheFilterMaxSize
            (Maybe Bytes -> Parser UpdatableIndexSetting)
-> [Key] -> Parser UpdatableIndexSetting
forall a b. FromJSON a => (a -> Parser b) -> [Key] -> Parser b
`taggedAt` [Key
"index", Key
"cache", Key
"filter", Key
"max_size"]
          Parser UpdatableIndexSetting
-> Parser UpdatableIndexSetting -> Parser UpdatableIndexSetting
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe NominalDiffTimeJSON -> Parser UpdatableIndexSetting
cacheFilterExpire
            (Maybe NominalDiffTimeJSON -> Parser UpdatableIndexSetting)
-> [Key] -> Parser UpdatableIndexSetting
forall a b. FromJSON a => (a -> Parser b) -> [Key] -> Parser b
`taggedAt` [Key
"index", Key
"cache", Key
"filter", Key
"expire"]
          Parser UpdatableIndexSetting
-> Parser UpdatableIndexSetting -> Parser UpdatableIndexSetting
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> NominalDiffTimeJSON -> Parser UpdatableIndexSetting
gatewaySnapshotInterval
            (NominalDiffTimeJSON -> Parser UpdatableIndexSetting)
-> [Key] -> Parser UpdatableIndexSetting
forall a b. FromJSON a => (a -> Parser b) -> [Key] -> Parser b
`taggedAt` [Key
"index", Key
"gateway", Key
"snapshot_interval"]
          Parser UpdatableIndexSetting
-> Parser UpdatableIndexSetting -> Parser UpdatableIndexSetting
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Value -> Parser UpdatableIndexSetting
routingAllocationInclude
            (Value -> Parser UpdatableIndexSetting)
-> [Key] -> Parser UpdatableIndexSetting
forall a b. FromJSON a => (a -> Parser b) -> [Key] -> Parser b
`taggedAt` [Key
"index", Key
"routing", Key
"allocation", Key
"include"]
          Parser UpdatableIndexSetting
-> Parser UpdatableIndexSetting -> Parser UpdatableIndexSetting
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Value -> Parser UpdatableIndexSetting
routingAllocationExclude
            (Value -> Parser UpdatableIndexSetting)
-> [Key] -> Parser UpdatableIndexSetting
forall a b. FromJSON a => (a -> Parser b) -> [Key] -> Parser b
`taggedAt` [Key
"index", Key
"routing", Key
"allocation", Key
"exclude"]
          Parser UpdatableIndexSetting
-> Parser UpdatableIndexSetting -> Parser UpdatableIndexSetting
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Value -> Parser UpdatableIndexSetting
routingAllocationRequire
            (Value -> Parser UpdatableIndexSetting)
-> [Key] -> Parser UpdatableIndexSetting
forall a b. FromJSON a => (a -> Parser b) -> [Key] -> Parser b
`taggedAt` [Key
"index", Key
"routing", Key
"allocation", Key
"require"]
          Parser UpdatableIndexSetting
-> Parser UpdatableIndexSetting -> Parser UpdatableIndexSetting
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> AllocationPolicy -> Parser UpdatableIndexSetting
routingAllocationEnable
            (AllocationPolicy -> Parser UpdatableIndexSetting)
-> [Key] -> Parser UpdatableIndexSetting
forall a b. FromJSON a => (a -> Parser b) -> [Key] -> Parser b
`taggedAt` [Key
"index", Key
"routing", Key
"allocation", Key
"enable"]
          Parser UpdatableIndexSetting
-> Parser UpdatableIndexSetting -> Parser UpdatableIndexSetting
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ShardCount -> Parser UpdatableIndexSetting
routingAllocationShardsPerNode
            (ShardCount -> Parser UpdatableIndexSetting)
-> [Key] -> Parser UpdatableIndexSetting
forall a b. FromJSON a => (a -> Parser b) -> [Key] -> Parser b
`taggedAt` [Key
"index", Key
"routing", Key
"allocation", Key
"total_shards_per_node"]
          Parser UpdatableIndexSetting
-> Parser UpdatableIndexSetting -> Parser UpdatableIndexSetting
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> InitialShardCount -> Parser UpdatableIndexSetting
recoveryInitialShards
            (InitialShardCount -> Parser UpdatableIndexSetting)
-> [Key] -> Parser UpdatableIndexSetting
forall a b. FromJSON a => (a -> Parser b) -> [Key] -> Parser b
`taggedAt` [Key
"index", Key
"recovery", Key
"initial_shards"]
          Parser UpdatableIndexSetting
-> Parser UpdatableIndexSetting -> Parser UpdatableIndexSetting
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> NominalDiffTimeJSON -> Parser UpdatableIndexSetting
gcDeletes
            (NominalDiffTimeJSON -> Parser UpdatableIndexSetting)
-> [Key] -> Parser UpdatableIndexSetting
forall a b. FromJSON a => (a -> Parser b) -> [Key] -> Parser b
`taggedAt` [Key
"index", Key
"gc_deletes"]
          Parser UpdatableIndexSetting
-> Parser UpdatableIndexSetting -> Parser UpdatableIndexSetting
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool -> Parser UpdatableIndexSetting
ttlDisablePurge
            (Bool -> Parser UpdatableIndexSetting)
-> [Key] -> Parser UpdatableIndexSetting
forall a b. FromJSON a => (a -> Parser b) -> [Key] -> Parser b
`taggedAt` [Key
"index", Key
"ttl", Key
"disable_purge"]
          Parser UpdatableIndexSetting
-> Parser UpdatableIndexSetting -> Parser UpdatableIndexSetting
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> FSType -> Parser UpdatableIndexSetting
translogFSType
            (FSType -> Parser UpdatableIndexSetting)
-> [Key] -> Parser UpdatableIndexSetting
forall a b. FromJSON a => (a -> Parser b) -> [Key] -> Parser b
`taggedAt` [Key
"index", Key
"translog", Key
"fs", Key
"type"]
          Parser UpdatableIndexSetting
-> Parser UpdatableIndexSetting -> Parser UpdatableIndexSetting
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Compression -> Parser UpdatableIndexSetting
compressionSetting
            (Compression -> Parser UpdatableIndexSetting)
-> [Key] -> Parser UpdatableIndexSetting
forall a b. FromJSON a => (a -> Parser b) -> [Key] -> Parser b
`taggedAt` [Key
"index", Key
"codec"]
          Parser UpdatableIndexSetting
-> Parser UpdatableIndexSetting -> Parser UpdatableIndexSetting
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> CompoundFormat -> Parser UpdatableIndexSetting
compoundFormat
            (CompoundFormat -> Parser UpdatableIndexSetting)
-> [Key] -> Parser UpdatableIndexSetting
forall a b. FromJSON a => (a -> Parser b) -> [Key] -> Parser b
`taggedAt` [Key
"index", Key
"compound_format"]
          Parser UpdatableIndexSetting
-> Parser UpdatableIndexSetting -> Parser UpdatableIndexSetting
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool -> Parser UpdatableIndexSetting
compoundOnFlush
            (Bool -> Parser UpdatableIndexSetting)
-> [Key] -> Parser UpdatableIndexSetting
forall a b. FromJSON a => (a -> Parser b) -> [Key] -> Parser b
`taggedAt` [Key
"index", Key
"compound_on_flush"]
          Parser UpdatableIndexSetting
-> Parser UpdatableIndexSetting -> Parser UpdatableIndexSetting
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool -> Parser UpdatableIndexSetting
warmerEnabled
            (Bool -> Parser UpdatableIndexSetting)
-> [Key] -> Parser UpdatableIndexSetting
forall a b. FromJSON a => (a -> Parser b) -> [Key] -> Parser b
`taggedAt` [Key
"index", Key
"warmer", Key
"enabled"]
          Parser UpdatableIndexSetting
-> Parser UpdatableIndexSetting -> Parser UpdatableIndexSetting
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool -> Parser UpdatableIndexSetting
blocksReadOnly
            (Bool -> Parser UpdatableIndexSetting)
-> [Key] -> Parser UpdatableIndexSetting
forall a b. FromJSON a => (a -> Parser b) -> [Key] -> Parser b
`taggedAt` [Key
"blocks", Key
"read_only"]
          Parser UpdatableIndexSetting
-> Parser UpdatableIndexSetting -> Parser UpdatableIndexSetting
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool -> Parser UpdatableIndexSetting
blocksRead
            (Bool -> Parser UpdatableIndexSetting)
-> [Key] -> Parser UpdatableIndexSetting
forall a b. FromJSON a => (a -> Parser b) -> [Key] -> Parser b
`taggedAt` [Key
"blocks", Key
"read"]
          Parser UpdatableIndexSetting
-> Parser UpdatableIndexSetting -> Parser UpdatableIndexSetting
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool -> Parser UpdatableIndexSetting
blocksWrite
            (Bool -> Parser UpdatableIndexSetting)
-> [Key] -> Parser UpdatableIndexSetting
forall a b. FromJSON a => (a -> Parser b) -> [Key] -> Parser b
`taggedAt` [Key
"blocks", Key
"write"]
          Parser UpdatableIndexSetting
-> Parser UpdatableIndexSetting -> Parser UpdatableIndexSetting
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool -> Parser UpdatableIndexSetting
blocksMetaData
            (Bool -> Parser UpdatableIndexSetting)
-> [Key] -> Parser UpdatableIndexSetting
forall a b. FromJSON a => (a -> Parser b) -> [Key] -> Parser b
`taggedAt` [Key
"blocks", Key
"metadata"]
          Parser UpdatableIndexSetting
-> Parser UpdatableIndexSetting -> Parser UpdatableIndexSetting
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Int -> Parser UpdatableIndexSetting
mappingTotalFieldsLimit
            (Int -> Parser UpdatableIndexSetting)
-> [Key] -> Parser UpdatableIndexSetting
forall a b. FromJSON a => (a -> Parser b) -> [Key] -> Parser b
`taggedAt` [Key
"index", Key
"mapping", Key
"total_fields", Key
"limit"]
          Parser UpdatableIndexSetting
-> Parser UpdatableIndexSetting -> Parser UpdatableIndexSetting
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Analysis -> Parser UpdatableIndexSetting
analysisSetting
            (Analysis -> Parser UpdatableIndexSetting)
-> [Key] -> Parser UpdatableIndexSetting
forall a b. FromJSON a => (a -> Parser b) -> [Key] -> Parser b
`taggedAt` [Key
"index", Key
"analysis"]
          Parser UpdatableIndexSetting
-> Parser UpdatableIndexSetting -> Parser UpdatableIndexSetting
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> NominalDiffTimeJSON -> Parser UpdatableIndexSetting
unassignedNodeLeftDelayedTimeout
            (NominalDiffTimeJSON -> Parser UpdatableIndexSetting)
-> [Key] -> Parser UpdatableIndexSetting
forall a b. FromJSON a => (a -> Parser b) -> [Key] -> Parser b
`taggedAt` [Key
"index", Key
"unassigned", Key
"node_left", Key
"delayed_timeout"]
        where
          taggedAt :: (FromJSON a) => (a -> Parser b) -> [Key] -> Parser b
          taggedAt :: forall a b. FromJSON a => (a -> Parser b) -> [Key] -> Parser b
taggedAt a -> Parser b
f [Key]
ks = (a -> Parser b) -> Value -> [Key] -> Parser b
forall {a} {b}.
FromJSON a =>
(a -> Parser b) -> Value -> [Key] -> Parser b
taggedAt' a -> Parser b
f (Object -> Value
Object Object
o) [Key]
ks
      taggedAt' :: (a -> Parser b) -> Value -> [Key] -> Parser b
taggedAt' a -> Parser b
f Value
v [] =
        a -> Parser b
f (a -> Parser b) -> Parser a -> Parser b
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Value -> Parser a
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v Parser a -> Parser a -> Parser a
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Value -> Parser a
forall a. FromJSON a => Value -> Parser a
parseJSON (Value -> Value
unStringlyTypeJSON Value
v))
      taggedAt' a -> Parser b
f Value
v (Key
k : [Key]
ks) =
        String -> (Object -> Parser b) -> Value -> Parser b
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject
          String
"Object"
          ( \Object
o -> do
              Value
v' <- Object
o Object -> Key -> Parser Value
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
k
              (a -> Parser b) -> Value -> [Key] -> Parser b
taggedAt' a -> Parser b
f Value
v' [Key]
ks
          )
          Value
v
      numberOfReplicas :: ReplicaCount -> Parser UpdatableIndexSetting
numberOfReplicas = UpdatableIndexSetting -> Parser UpdatableIndexSetting
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UpdatableIndexSetting -> Parser UpdatableIndexSetting)
-> (ReplicaCount -> UpdatableIndexSetting)
-> ReplicaCount
-> Parser UpdatableIndexSetting
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReplicaCount -> UpdatableIndexSetting
NumberOfReplicas
      autoExpandReplicas :: ReplicaBounds -> Parser UpdatableIndexSetting
autoExpandReplicas = UpdatableIndexSetting -> Parser UpdatableIndexSetting
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UpdatableIndexSetting -> Parser UpdatableIndexSetting)
-> (ReplicaBounds -> UpdatableIndexSetting)
-> ReplicaBounds
-> Parser UpdatableIndexSetting
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReplicaBounds -> UpdatableIndexSetting
AutoExpandReplicas
      refreshInterval :: NominalDiffTimeJSON -> Parser UpdatableIndexSetting
refreshInterval = UpdatableIndexSetting -> Parser UpdatableIndexSetting
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UpdatableIndexSetting -> Parser UpdatableIndexSetting)
-> (NominalDiffTimeJSON -> UpdatableIndexSetting)
-> NominalDiffTimeJSON
-> Parser UpdatableIndexSetting
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NominalDiffTime -> UpdatableIndexSetting
RefreshInterval (NominalDiffTime -> UpdatableIndexSetting)
-> (NominalDiffTimeJSON -> NominalDiffTime)
-> NominalDiffTimeJSON
-> UpdatableIndexSetting
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NominalDiffTimeJSON -> NominalDiffTime
ndtJSON
      indexConcurrency :: Int -> Parser UpdatableIndexSetting
indexConcurrency = UpdatableIndexSetting -> Parser UpdatableIndexSetting
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UpdatableIndexSetting -> Parser UpdatableIndexSetting)
-> (Int -> UpdatableIndexSetting)
-> Int
-> Parser UpdatableIndexSetting
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> UpdatableIndexSetting
IndexConcurrency
      failOnMergeFailure :: Bool -> Parser UpdatableIndexSetting
failOnMergeFailure = UpdatableIndexSetting -> Parser UpdatableIndexSetting
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UpdatableIndexSetting -> Parser UpdatableIndexSetting)
-> (Bool -> UpdatableIndexSetting)
-> Bool
-> Parser UpdatableIndexSetting
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> UpdatableIndexSetting
FailOnMergeFailure
      translogFlushThresholdOps :: Int -> Parser UpdatableIndexSetting
translogFlushThresholdOps = UpdatableIndexSetting -> Parser UpdatableIndexSetting
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UpdatableIndexSetting -> Parser UpdatableIndexSetting)
-> (Int -> UpdatableIndexSetting)
-> Int
-> Parser UpdatableIndexSetting
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> UpdatableIndexSetting
TranslogFlushThresholdOps
      translogFlushThresholdSize :: Bytes -> Parser UpdatableIndexSetting
translogFlushThresholdSize = UpdatableIndexSetting -> Parser UpdatableIndexSetting
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UpdatableIndexSetting -> Parser UpdatableIndexSetting)
-> (Bytes -> UpdatableIndexSetting)
-> Bytes
-> Parser UpdatableIndexSetting
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bytes -> UpdatableIndexSetting
TranslogFlushThresholdSize
      translogFlushThresholdPeriod :: NominalDiffTimeJSON -> Parser UpdatableIndexSetting
translogFlushThresholdPeriod = UpdatableIndexSetting -> Parser UpdatableIndexSetting
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UpdatableIndexSetting -> Parser UpdatableIndexSetting)
-> (NominalDiffTimeJSON -> UpdatableIndexSetting)
-> NominalDiffTimeJSON
-> Parser UpdatableIndexSetting
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NominalDiffTime -> UpdatableIndexSetting
TranslogFlushThresholdPeriod (NominalDiffTime -> UpdatableIndexSetting)
-> (NominalDiffTimeJSON -> NominalDiffTime)
-> NominalDiffTimeJSON
-> UpdatableIndexSetting
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NominalDiffTimeJSON -> NominalDiffTime
ndtJSON
      translogDisableFlush :: Bool -> Parser UpdatableIndexSetting
translogDisableFlush = UpdatableIndexSetting -> Parser UpdatableIndexSetting
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UpdatableIndexSetting -> Parser UpdatableIndexSetting)
-> (Bool -> UpdatableIndexSetting)
-> Bool
-> Parser UpdatableIndexSetting
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> UpdatableIndexSetting
TranslogDisableFlush
      cacheFilterMaxSize :: Maybe Bytes -> Parser UpdatableIndexSetting
cacheFilterMaxSize = UpdatableIndexSetting -> Parser UpdatableIndexSetting
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UpdatableIndexSetting -> Parser UpdatableIndexSetting)
-> (Maybe Bytes -> UpdatableIndexSetting)
-> Maybe Bytes
-> Parser UpdatableIndexSetting
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Bytes -> UpdatableIndexSetting
CacheFilterMaxSize
      cacheFilterExpire :: Maybe NominalDiffTimeJSON -> Parser UpdatableIndexSetting
cacheFilterExpire = UpdatableIndexSetting -> Parser UpdatableIndexSetting
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UpdatableIndexSetting -> Parser UpdatableIndexSetting)
-> (Maybe NominalDiffTimeJSON -> UpdatableIndexSetting)
-> Maybe NominalDiffTimeJSON
-> Parser UpdatableIndexSetting
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe NominalDiffTime -> UpdatableIndexSetting
CacheFilterExpire (Maybe NominalDiffTime -> UpdatableIndexSetting)
-> (Maybe NominalDiffTimeJSON -> Maybe NominalDiffTime)
-> Maybe NominalDiffTimeJSON
-> UpdatableIndexSetting
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NominalDiffTimeJSON -> NominalDiffTime)
-> Maybe NominalDiffTimeJSON -> Maybe NominalDiffTime
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NominalDiffTimeJSON -> NominalDiffTime
ndtJSON
      gatewaySnapshotInterval :: NominalDiffTimeJSON -> Parser UpdatableIndexSetting
gatewaySnapshotInterval = UpdatableIndexSetting -> Parser UpdatableIndexSetting
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UpdatableIndexSetting -> Parser UpdatableIndexSetting)
-> (NominalDiffTimeJSON -> UpdatableIndexSetting)
-> NominalDiffTimeJSON
-> Parser UpdatableIndexSetting
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NominalDiffTime -> UpdatableIndexSetting
GatewaySnapshotInterval (NominalDiffTime -> UpdatableIndexSetting)
-> (NominalDiffTimeJSON -> NominalDiffTime)
-> NominalDiffTimeJSON
-> UpdatableIndexSetting
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NominalDiffTimeJSON -> NominalDiffTime
ndtJSON
      routingAllocationInclude :: Value -> Parser UpdatableIndexSetting
routingAllocationInclude = (NonEmpty NodeAttrFilter -> UpdatableIndexSetting)
-> Parser (NonEmpty NodeAttrFilter) -> Parser UpdatableIndexSetting
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NonEmpty NodeAttrFilter -> UpdatableIndexSetting
RoutingAllocationInclude (Parser (NonEmpty NodeAttrFilter) -> Parser UpdatableIndexSetting)
-> (Value -> Parser (NonEmpty NodeAttrFilter))
-> Value
-> Parser UpdatableIndexSetting
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser (NonEmpty NodeAttrFilter)
parseAttrFilter
      routingAllocationExclude :: Value -> Parser UpdatableIndexSetting
routingAllocationExclude = (NonEmpty NodeAttrFilter -> UpdatableIndexSetting)
-> Parser (NonEmpty NodeAttrFilter) -> Parser UpdatableIndexSetting
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NonEmpty NodeAttrFilter -> UpdatableIndexSetting
RoutingAllocationExclude (Parser (NonEmpty NodeAttrFilter) -> Parser UpdatableIndexSetting)
-> (Value -> Parser (NonEmpty NodeAttrFilter))
-> Value
-> Parser UpdatableIndexSetting
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser (NonEmpty NodeAttrFilter)
parseAttrFilter
      routingAllocationRequire :: Value -> Parser UpdatableIndexSetting
routingAllocationRequire = (NonEmpty NodeAttrFilter -> UpdatableIndexSetting)
-> Parser (NonEmpty NodeAttrFilter) -> Parser UpdatableIndexSetting
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NonEmpty NodeAttrFilter -> UpdatableIndexSetting
RoutingAllocationRequire (Parser (NonEmpty NodeAttrFilter) -> Parser UpdatableIndexSetting)
-> (Value -> Parser (NonEmpty NodeAttrFilter))
-> Value
-> Parser UpdatableIndexSetting
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser (NonEmpty NodeAttrFilter)
parseAttrFilter
      routingAllocationEnable :: AllocationPolicy -> Parser UpdatableIndexSetting
routingAllocationEnable = UpdatableIndexSetting -> Parser UpdatableIndexSetting
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UpdatableIndexSetting -> Parser UpdatableIndexSetting)
-> (AllocationPolicy -> UpdatableIndexSetting)
-> AllocationPolicy
-> Parser UpdatableIndexSetting
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AllocationPolicy -> UpdatableIndexSetting
RoutingAllocationEnable
      routingAllocationShardsPerNode :: ShardCount -> Parser UpdatableIndexSetting
routingAllocationShardsPerNode = UpdatableIndexSetting -> Parser UpdatableIndexSetting
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UpdatableIndexSetting -> Parser UpdatableIndexSetting)
-> (ShardCount -> UpdatableIndexSetting)
-> ShardCount
-> Parser UpdatableIndexSetting
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShardCount -> UpdatableIndexSetting
RoutingAllocationShardsPerNode
      recoveryInitialShards :: InitialShardCount -> Parser UpdatableIndexSetting
recoveryInitialShards = UpdatableIndexSetting -> Parser UpdatableIndexSetting
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UpdatableIndexSetting -> Parser UpdatableIndexSetting)
-> (InitialShardCount -> UpdatableIndexSetting)
-> InitialShardCount
-> Parser UpdatableIndexSetting
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InitialShardCount -> UpdatableIndexSetting
RecoveryInitialShards
      gcDeletes :: NominalDiffTimeJSON -> Parser UpdatableIndexSetting
gcDeletes = UpdatableIndexSetting -> Parser UpdatableIndexSetting
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UpdatableIndexSetting -> Parser UpdatableIndexSetting)
-> (NominalDiffTimeJSON -> UpdatableIndexSetting)
-> NominalDiffTimeJSON
-> Parser UpdatableIndexSetting
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NominalDiffTime -> UpdatableIndexSetting
GCDeletes (NominalDiffTime -> UpdatableIndexSetting)
-> (NominalDiffTimeJSON -> NominalDiffTime)
-> NominalDiffTimeJSON
-> UpdatableIndexSetting
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NominalDiffTimeJSON -> NominalDiffTime
ndtJSON
      ttlDisablePurge :: Bool -> Parser UpdatableIndexSetting
ttlDisablePurge = UpdatableIndexSetting -> Parser UpdatableIndexSetting
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UpdatableIndexSetting -> Parser UpdatableIndexSetting)
-> (Bool -> UpdatableIndexSetting)
-> Bool
-> Parser UpdatableIndexSetting
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> UpdatableIndexSetting
TTLDisablePurge
      translogFSType :: FSType -> Parser UpdatableIndexSetting
translogFSType = UpdatableIndexSetting -> Parser UpdatableIndexSetting
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UpdatableIndexSetting -> Parser UpdatableIndexSetting)
-> (FSType -> UpdatableIndexSetting)
-> FSType
-> Parser UpdatableIndexSetting
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FSType -> UpdatableIndexSetting
TranslogFSType
      compressionSetting :: Compression -> Parser UpdatableIndexSetting
compressionSetting = UpdatableIndexSetting -> Parser UpdatableIndexSetting
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UpdatableIndexSetting -> Parser UpdatableIndexSetting)
-> (Compression -> UpdatableIndexSetting)
-> Compression
-> Parser UpdatableIndexSetting
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Compression -> UpdatableIndexSetting
CompressionSetting
      compoundFormat :: CompoundFormat -> Parser UpdatableIndexSetting
compoundFormat = UpdatableIndexSetting -> Parser UpdatableIndexSetting
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UpdatableIndexSetting -> Parser UpdatableIndexSetting)
-> (CompoundFormat -> UpdatableIndexSetting)
-> CompoundFormat
-> Parser UpdatableIndexSetting
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CompoundFormat -> UpdatableIndexSetting
IndexCompoundFormat
      compoundOnFlush :: Bool -> Parser UpdatableIndexSetting
compoundOnFlush = UpdatableIndexSetting -> Parser UpdatableIndexSetting
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UpdatableIndexSetting -> Parser UpdatableIndexSetting)
-> (Bool -> UpdatableIndexSetting)
-> Bool
-> Parser UpdatableIndexSetting
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> UpdatableIndexSetting
IndexCompoundOnFlush
      warmerEnabled :: Bool -> Parser UpdatableIndexSetting
warmerEnabled = UpdatableIndexSetting -> Parser UpdatableIndexSetting
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UpdatableIndexSetting -> Parser UpdatableIndexSetting)
-> (Bool -> UpdatableIndexSetting)
-> Bool
-> Parser UpdatableIndexSetting
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> UpdatableIndexSetting
WarmerEnabled
      blocksReadOnly :: Bool -> Parser UpdatableIndexSetting
blocksReadOnly = UpdatableIndexSetting -> Parser UpdatableIndexSetting
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UpdatableIndexSetting -> Parser UpdatableIndexSetting)
-> (Bool -> UpdatableIndexSetting)
-> Bool
-> Parser UpdatableIndexSetting
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> UpdatableIndexSetting
BlocksReadOnly
      blocksRead :: Bool -> Parser UpdatableIndexSetting
blocksRead = UpdatableIndexSetting -> Parser UpdatableIndexSetting
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UpdatableIndexSetting -> Parser UpdatableIndexSetting)
-> (Bool -> UpdatableIndexSetting)
-> Bool
-> Parser UpdatableIndexSetting
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> UpdatableIndexSetting
BlocksRead
      blocksWrite :: Bool -> Parser UpdatableIndexSetting
blocksWrite = UpdatableIndexSetting -> Parser UpdatableIndexSetting
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UpdatableIndexSetting -> Parser UpdatableIndexSetting)
-> (Bool -> UpdatableIndexSetting)
-> Bool
-> Parser UpdatableIndexSetting
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> UpdatableIndexSetting
BlocksWrite
      blocksMetaData :: Bool -> Parser UpdatableIndexSetting
blocksMetaData = UpdatableIndexSetting -> Parser UpdatableIndexSetting
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UpdatableIndexSetting -> Parser UpdatableIndexSetting)
-> (Bool -> UpdatableIndexSetting)
-> Bool
-> Parser UpdatableIndexSetting
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> UpdatableIndexSetting
BlocksMetaData
      mappingTotalFieldsLimit :: Int -> Parser UpdatableIndexSetting
mappingTotalFieldsLimit = UpdatableIndexSetting -> Parser UpdatableIndexSetting
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UpdatableIndexSetting -> Parser UpdatableIndexSetting)
-> (Int -> UpdatableIndexSetting)
-> Int
-> Parser UpdatableIndexSetting
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> UpdatableIndexSetting
MappingTotalFieldsLimit
      analysisSetting :: Analysis -> Parser UpdatableIndexSetting
analysisSetting = UpdatableIndexSetting -> Parser UpdatableIndexSetting
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UpdatableIndexSetting -> Parser UpdatableIndexSetting)
-> (Analysis -> UpdatableIndexSetting)
-> Analysis
-> Parser UpdatableIndexSetting
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Analysis -> UpdatableIndexSetting
AnalysisSetting
      unassignedNodeLeftDelayedTimeout :: NominalDiffTimeJSON -> Parser UpdatableIndexSetting
unassignedNodeLeftDelayedTimeout = UpdatableIndexSetting -> Parser UpdatableIndexSetting
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UpdatableIndexSetting -> Parser UpdatableIndexSetting)
-> (NominalDiffTimeJSON -> UpdatableIndexSetting)
-> NominalDiffTimeJSON
-> Parser UpdatableIndexSetting
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NominalDiffTime -> UpdatableIndexSetting
UnassignedNodeLeftDelayedTimeout (NominalDiffTime -> UpdatableIndexSetting)
-> (NominalDiffTimeJSON -> NominalDiffTime)
-> NominalDiffTimeJSON
-> UpdatableIndexSetting
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NominalDiffTimeJSON -> NominalDiffTime
ndtJSON

data ReplicaBounds
  = ReplicasBounded Int Int
  | ReplicasLowerBounded Int
  | ReplicasUnbounded
  deriving stock (ReplicaBounds -> ReplicaBounds -> Bool
(ReplicaBounds -> ReplicaBounds -> Bool)
-> (ReplicaBounds -> ReplicaBounds -> Bool) -> Eq ReplicaBounds
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ReplicaBounds -> ReplicaBounds -> Bool
== :: ReplicaBounds -> ReplicaBounds -> Bool
$c/= :: ReplicaBounds -> ReplicaBounds -> Bool
/= :: ReplicaBounds -> ReplicaBounds -> Bool
Eq, Int -> ReplicaBounds -> ShowS
[ReplicaBounds] -> ShowS
ReplicaBounds -> String
(Int -> ReplicaBounds -> ShowS)
-> (ReplicaBounds -> String)
-> ([ReplicaBounds] -> ShowS)
-> Show ReplicaBounds
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ReplicaBounds -> ShowS
showsPrec :: Int -> ReplicaBounds -> ShowS
$cshow :: ReplicaBounds -> String
show :: ReplicaBounds -> String
$cshowList :: [ReplicaBounds] -> ShowS
showList :: [ReplicaBounds] -> ShowS
Show)

instance ToJSON ReplicaBounds where
  toJSON :: ReplicaBounds -> Value
toJSON (ReplicasBounded Int
a Int
b) = Text -> Value
String (Int -> Text
forall a. Show a => a -> Text
showText Int
a Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
showText Int
b)
  toJSON (ReplicasLowerBounded Int
a) = Text -> Value
String (Int -> Text
forall a. Show a => a -> Text
showText Int
a Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"-all")
  toJSON ReplicaBounds
ReplicasUnbounded = Bool -> Value
Bool Bool
False

instance FromJSON ReplicaBounds where
  parseJSON :: Value -> Parser ReplicaBounds
parseJSON Value
v =
    String
-> (Text -> Parser ReplicaBounds) -> Value -> Parser ReplicaBounds
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"ReplicaBounds" Text -> Parser ReplicaBounds
parseText Value
v
      Parser ReplicaBounds
-> Parser ReplicaBounds -> Parser ReplicaBounds
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String
-> (Bool -> Parser ReplicaBounds) -> Value -> Parser ReplicaBounds
forall a. String -> (Bool -> Parser a) -> Value -> Parser a
withBool String
"ReplicaBounds" Bool -> Parser ReplicaBounds
forall {f :: * -> *}. MonadFail f => Bool -> f ReplicaBounds
parseBool Value
v
    where
      parseText :: Text -> Parser ReplicaBounds
parseText Text
t = case HasCallStack => Text -> Text -> [Text]
Text -> Text -> [Text]
T.splitOn Text
"-" Text
t of
        [Text
a, Text
"all"] -> Int -> ReplicaBounds
ReplicasLowerBounded (Int -> ReplicaBounds) -> Parser Int -> Parser ReplicaBounds
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Parser Int
forall a. Read a => Text -> Parser a
parseReadText Text
a
        [Text
a, Text
b] ->
          Int -> Int -> ReplicaBounds
ReplicasBounded
            (Int -> Int -> ReplicaBounds)
-> Parser Int -> Parser (Int -> ReplicaBounds)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Parser Int
forall a. Read a => Text -> Parser a
parseReadText Text
a
            Parser (Int -> ReplicaBounds) -> Parser Int -> Parser ReplicaBounds
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> Parser Int
forall a. Read a => Text -> Parser a
parseReadText Text
b
        [Text]
_ -> String -> Parser ReplicaBounds
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Could not parse ReplicaBounds: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall a. Show a => a -> String
show Text
t)
      parseBool :: Bool -> f ReplicaBounds
parseBool Bool
False = ReplicaBounds -> f ReplicaBounds
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ReplicaBounds
ReplicasUnbounded
      parseBool Bool
_ = String -> f ReplicaBounds
forall a. String -> f a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"ReplicasUnbounded cannot be represented with True"

data Compression
  = -- | Compress with LZ4
    CompressionDefault
  | -- | Compress with DEFLATE. Elastic
    --   <https://www.elastic.co/blog/elasticsearch-storage-the-true-story-2.0 blogs>
    --   that this can reduce disk use by 15%-25%.
    CompressionBest
  deriving stock (Compression -> Compression -> Bool
(Compression -> Compression -> Bool)
-> (Compression -> Compression -> Bool) -> Eq Compression
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Compression -> Compression -> Bool
== :: Compression -> Compression -> Bool
$c/= :: Compression -> Compression -> Bool
/= :: Compression -> Compression -> Bool
Eq, Int -> Compression -> ShowS
[Compression] -> ShowS
Compression -> String
(Int -> Compression -> ShowS)
-> (Compression -> String)
-> ([Compression] -> ShowS)
-> Show Compression
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Compression -> ShowS
showsPrec :: Int -> Compression -> ShowS
$cshow :: Compression -> String
show :: Compression -> String
$cshowList :: [Compression] -> ShowS
showList :: [Compression] -> ShowS
Show, (forall x. Compression -> Rep Compression x)
-> (forall x. Rep Compression x -> Compression)
-> Generic Compression
forall x. Rep Compression x -> Compression
forall x. Compression -> Rep Compression x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Compression -> Rep Compression x
from :: forall x. Compression -> Rep Compression x
$cto :: forall x. Rep Compression x -> Compression
to :: forall x. Rep Compression x -> Compression
Generic)

instance ToJSON Compression where
  toJSON :: Compression -> Value
toJSON Compression
x = case Compression
x of
    Compression
CompressionDefault -> Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text
"default" :: Text)
    Compression
CompressionBest -> Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text
"best_compression" :: Text)

instance FromJSON Compression where
  parseJSON :: Value -> Parser Compression
parseJSON = String
-> (Text -> Parser Compression) -> Value -> Parser Compression
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"Compression" ((Text -> Parser Compression) -> Value -> Parser Compression)
-> (Text -> Parser Compression) -> Value -> Parser Compression
forall a b. (a -> b) -> a -> b
$ \Text
t -> case Text
t of
    Text
"default" -> Compression -> Parser Compression
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return Compression
CompressionDefault
    Text
"best_compression" -> Compression -> Parser Compression
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return Compression
CompressionBest
    Text
_ -> String -> Parser Compression
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"invalid compression codec"

data FSType
  = FSSimple
  | FSBuffered
  deriving stock (FSType -> FSType -> Bool
(FSType -> FSType -> Bool)
-> (FSType -> FSType -> Bool) -> Eq FSType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FSType -> FSType -> Bool
== :: FSType -> FSType -> Bool
$c/= :: FSType -> FSType -> Bool
/= :: FSType -> FSType -> Bool
Eq, Int -> FSType -> ShowS
[FSType] -> ShowS
FSType -> String
(Int -> FSType -> ShowS)
-> (FSType -> String) -> ([FSType] -> ShowS) -> Show FSType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FSType -> ShowS
showsPrec :: Int -> FSType -> ShowS
$cshow :: FSType -> String
show :: FSType -> String
$cshowList :: [FSType] -> ShowS
showList :: [FSType] -> ShowS
Show, (forall x. FSType -> Rep FSType x)
-> (forall x. Rep FSType x -> FSType) -> Generic FSType
forall x. Rep FSType x -> FSType
forall x. FSType -> Rep FSType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. FSType -> Rep FSType x
from :: forall x. FSType -> Rep FSType x
$cto :: forall x. Rep FSType x -> FSType
to :: forall x. Rep FSType x -> FSType
Generic)

instance ToJSON FSType where
  toJSON :: FSType -> Value
toJSON FSType
FSSimple = Value
"simple"
  toJSON FSType
FSBuffered = Value
"buffered"

instance FromJSON FSType where
  parseJSON :: Value -> Parser FSType
parseJSON = String -> (Text -> Parser FSType) -> Value -> Parser FSType
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"FSType" Text -> Parser FSType
forall {a} {f :: * -> *}.
(Eq a, IsString a, MonadFail f, Show a) =>
a -> f FSType
parse
    where
      parse :: a -> f FSType
parse a
"simple" = FSType -> f FSType
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FSType
FSSimple
      parse a
"buffered" = FSType -> f FSType
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FSType
FSBuffered
      parse a
t = String -> f FSType
forall a. String -> f a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Invalid FSType: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> a -> String
forall a. Show a => a -> String
show a
t)

data CompoundFormat
  = CompoundFileFormat Bool
  | -- | percentage between 0 and 1 where 0 is false, 1 is true
    MergeSegmentVsTotalIndex Double
  deriving stock (CompoundFormat -> CompoundFormat -> Bool
(CompoundFormat -> CompoundFormat -> Bool)
-> (CompoundFormat -> CompoundFormat -> Bool) -> Eq CompoundFormat
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CompoundFormat -> CompoundFormat -> Bool
== :: CompoundFormat -> CompoundFormat -> Bool
$c/= :: CompoundFormat -> CompoundFormat -> Bool
/= :: CompoundFormat -> CompoundFormat -> Bool
Eq, Int -> CompoundFormat -> ShowS
[CompoundFormat] -> ShowS
CompoundFormat -> String
(Int -> CompoundFormat -> ShowS)
-> (CompoundFormat -> String)
-> ([CompoundFormat] -> ShowS)
-> Show CompoundFormat
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CompoundFormat -> ShowS
showsPrec :: Int -> CompoundFormat -> ShowS
$cshow :: CompoundFormat -> String
show :: CompoundFormat -> String
$cshowList :: [CompoundFormat] -> ShowS
showList :: [CompoundFormat] -> ShowS
Show, (forall x. CompoundFormat -> Rep CompoundFormat x)
-> (forall x. Rep CompoundFormat x -> CompoundFormat)
-> Generic CompoundFormat
forall x. Rep CompoundFormat x -> CompoundFormat
forall x. CompoundFormat -> Rep CompoundFormat x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CompoundFormat -> Rep CompoundFormat x
from :: forall x. CompoundFormat -> Rep CompoundFormat x
$cto :: forall x. Rep CompoundFormat x -> CompoundFormat
to :: forall x. Rep CompoundFormat x -> CompoundFormat
Generic)

instance ToJSON CompoundFormat where
  toJSON :: CompoundFormat -> Value
toJSON (CompoundFileFormat Bool
x) = Bool -> Value
Bool Bool
x
  toJSON (MergeSegmentVsTotalIndex Double
x) = Double -> Value
forall a. ToJSON a => a -> Value
toJSON Double
x

instance FromJSON CompoundFormat where
  parseJSON :: Value -> Parser CompoundFormat
parseJSON Value
v =
    Bool -> CompoundFormat
CompoundFileFormat (Bool -> CompoundFormat) -> Parser Bool -> Parser CompoundFormat
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser Bool
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
      Parser CompoundFormat
-> Parser CompoundFormat -> Parser CompoundFormat
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Double -> CompoundFormat
MergeSegmentVsTotalIndex (Double -> CompoundFormat)
-> Parser Double -> Parser CompoundFormat
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser Double
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v

newtype NominalDiffTimeJSON = NominalDiffTimeJSON {NominalDiffTimeJSON -> NominalDiffTime
ndtJSON :: NominalDiffTime}

instance ToJSON NominalDiffTimeJSON where
  toJSON :: NominalDiffTimeJSON -> Value
toJSON (NominalDiffTimeJSON NominalDiffTime
t) = Text -> Value
String (Integer -> Text
forall a. Show a => a -> Text
showText (NominalDiffTime -> Integer
forall b. Integral b => NominalDiffTime -> b
forall a b. (RealFrac a, Integral b) => a -> b
round NominalDiffTime
t :: Integer) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"s")

instance FromJSON NominalDiffTimeJSON where
  parseJSON :: Value -> Parser NominalDiffTimeJSON
parseJSON = String
-> (Text -> Parser NominalDiffTimeJSON)
-> Value
-> Parser NominalDiffTimeJSON
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"NominalDiffTime" Text -> Parser NominalDiffTimeJSON
parse
    where
      parse :: Text -> Parser NominalDiffTimeJSON
parse Text
t = case Int -> Text -> Text
T.takeEnd Int
1 Text
t of
        Text
"s" -> NominalDiffTime -> NominalDiffTimeJSON
NominalDiffTimeJSON (NominalDiffTime -> NominalDiffTimeJSON)
-> (Integer -> NominalDiffTime) -> Integer -> NominalDiffTimeJSON
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> NominalDiffTime
forall a. Num a => Integer -> a
fromInteger (Integer -> NominalDiffTimeJSON)
-> Parser Integer -> Parser NominalDiffTimeJSON
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Parser Integer
forall a. Read a => Text -> Parser a
parseReadText (Int -> Text -> Text
T.dropEnd Int
1 Text
t)
        Text
_ -> String -> Parser NominalDiffTimeJSON
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Invalid or missing NominalDiffTime unit (expected s)"

data IndexSettingsSummary = IndexSettingsSummary
  { IndexSettingsSummary -> IndexName
sSummaryIndexName :: IndexName,
    IndexSettingsSummary -> IndexSettings
sSummaryFixedSettings :: IndexSettings,
    IndexSettingsSummary -> [UpdatableIndexSetting]
sSummaryUpdateable :: [UpdatableIndexSetting]
  }
  deriving stock (IndexSettingsSummary -> IndexSettingsSummary -> Bool
(IndexSettingsSummary -> IndexSettingsSummary -> Bool)
-> (IndexSettingsSummary -> IndexSettingsSummary -> Bool)
-> Eq IndexSettingsSummary
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: IndexSettingsSummary -> IndexSettingsSummary -> Bool
== :: IndexSettingsSummary -> IndexSettingsSummary -> Bool
$c/= :: IndexSettingsSummary -> IndexSettingsSummary -> Bool
/= :: IndexSettingsSummary -> IndexSettingsSummary -> Bool
Eq, Int -> IndexSettingsSummary -> ShowS
[IndexSettingsSummary] -> ShowS
IndexSettingsSummary -> String
(Int -> IndexSettingsSummary -> ShowS)
-> (IndexSettingsSummary -> String)
-> ([IndexSettingsSummary] -> ShowS)
-> Show IndexSettingsSummary
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> IndexSettingsSummary -> ShowS
showsPrec :: Int -> IndexSettingsSummary -> ShowS
$cshow :: IndexSettingsSummary -> String
show :: IndexSettingsSummary -> String
$cshowList :: [IndexSettingsSummary] -> ShowS
showList :: [IndexSettingsSummary] -> ShowS
Show)

sSummaryIndexNameLens :: Lens' IndexSettingsSummary IndexName
sSummaryIndexNameLens :: Lens' IndexSettingsSummary IndexName
sSummaryIndexNameLens = (IndexSettingsSummary -> IndexName)
-> (IndexSettingsSummary -> IndexName -> IndexSettingsSummary)
-> Lens' IndexSettingsSummary IndexName
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens IndexSettingsSummary -> IndexName
sSummaryIndexName (\IndexSettingsSummary
x IndexName
y -> IndexSettingsSummary
x {sSummaryIndexName = y})

sSummaryFixedSettingsLens :: Lens' IndexSettingsSummary IndexSettings
sSummaryFixedSettingsLens :: Lens' IndexSettingsSummary IndexSettings
sSummaryFixedSettingsLens = (IndexSettingsSummary -> IndexSettings)
-> (IndexSettingsSummary -> IndexSettings -> IndexSettingsSummary)
-> Lens' IndexSettingsSummary IndexSettings
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens IndexSettingsSummary -> IndexSettings
sSummaryFixedSettings (\IndexSettingsSummary
x IndexSettings
y -> IndexSettingsSummary
x {sSummaryFixedSettings = y})

sSummaryUpdateableLens :: Lens' IndexSettingsSummary [UpdatableIndexSetting]
sSummaryUpdateableLens :: Lens' IndexSettingsSummary [UpdatableIndexSetting]
sSummaryUpdateableLens = (IndexSettingsSummary -> [UpdatableIndexSetting])
-> (IndexSettingsSummary
    -> [UpdatableIndexSetting] -> IndexSettingsSummary)
-> Lens' IndexSettingsSummary [UpdatableIndexSetting]
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens IndexSettingsSummary -> [UpdatableIndexSetting]
sSummaryUpdateable (\IndexSettingsSummary
x [UpdatableIndexSetting]
y -> IndexSettingsSummary
x {sSummaryUpdateable = y})

parseSettings :: Object -> Parser [UpdatableIndexSetting]
parseSettings :: Object -> Parser [UpdatableIndexSetting]
parseSettings Object
o = do
  HashMap Key Value
o' <- Object
o Object -> Key -> Parser (HashMap Key Value)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"index"
  -- slice the index object into singleton hashmaps and try to parse each
  [Maybe UpdatableIndexSetting]
parses <- [Pair]
-> (Pair -> Parser (Maybe UpdatableIndexSetting))
-> Parser [Maybe UpdatableIndexSetting]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (HashMap Key Value -> [Pair]
forall k v. HashMap k v -> [(k, v)]
HM.toList HashMap Key Value
o') ((Pair -> Parser (Maybe UpdatableIndexSetting))
 -> Parser [Maybe UpdatableIndexSetting])
-> (Pair -> Parser (Maybe UpdatableIndexSetting))
-> Parser [Maybe UpdatableIndexSetting]
forall a b. (a -> b) -> a -> b
$ \(Key
k, Value
v) -> do
    -- blocks are now nested into the "index" key, which is not how they're serialized
    let atRoot :: Value
atRoot = Object -> Value
Object (Key -> Value -> Object
forall v. Key -> v -> KeyMap v
X.singleton Key
k Value
v)
    let atIndex :: Value
atIndex = Object -> Value
Object (Key -> Value -> Object
forall v. Key -> v -> KeyMap v
X.singleton Key
"index" Value
atRoot)
    Parser UpdatableIndexSetting
-> Parser (Maybe UpdatableIndexSetting)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Value -> Parser UpdatableIndexSetting
forall a. FromJSON a => Value -> Parser a
parseJSON Value
atRoot Parser UpdatableIndexSetting
-> Parser UpdatableIndexSetting -> Parser UpdatableIndexSetting
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Value -> Parser UpdatableIndexSetting
forall a. FromJSON a => Value -> Parser a
parseJSON Value
atIndex)
  [UpdatableIndexSetting] -> Parser [UpdatableIndexSetting]
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Maybe UpdatableIndexSetting] -> [UpdatableIndexSetting]
forall a. [Maybe a] -> [a]
catMaybes [Maybe UpdatableIndexSetting]
parses)

instance FromJSON IndexSettingsSummary where
  parseJSON :: Value -> Parser IndexSettingsSummary
parseJSON = String
-> (Object -> Parser IndexSettingsSummary)
-> Value
-> Parser IndexSettingsSummary
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"IndexSettingsSummary" Object -> Parser IndexSettingsSummary
parse
    where
      parse :: Object -> Parser IndexSettingsSummary
parse Object
o = case Object -> [Pair]
forall v. KeyMap v -> [(Key, v)]
X.toList Object
o of
        [(Key
ixn, v :: Value
v@(Object Object
o'))] ->
          IndexName
-> IndexSettings -> [UpdatableIndexSetting] -> IndexSettingsSummary
IndexSettingsSummary
            (IndexName
 -> IndexSettings
 -> [UpdatableIndexSetting]
 -> IndexSettingsSummary)
-> Parser IndexName
-> Parser
     (IndexSettings -> [UpdatableIndexSetting] -> IndexSettingsSummary)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser IndexName
forall a. FromJSON a => Value -> Parser a
parseJSON (Key -> Value
forall a. ToJSON a => a -> Value
toJSON Key
ixn)
            Parser
  (IndexSettings -> [UpdatableIndexSetting] -> IndexSettingsSummary)
-> Parser IndexSettings
-> Parser ([UpdatableIndexSetting] -> IndexSettingsSummary)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Value -> Parser IndexSettings
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
            Parser ([UpdatableIndexSetting] -> IndexSettingsSummary)
-> Parser [UpdatableIndexSetting] -> Parser IndexSettingsSummary
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (([UpdatableIndexSetting] -> [UpdatableIndexSetting])
-> Parser [UpdatableIndexSetting] -> Parser [UpdatableIndexSetting]
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((UpdatableIndexSetting -> Bool)
-> [UpdatableIndexSetting] -> [UpdatableIndexSetting]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> (UpdatableIndexSetting -> Bool) -> UpdatableIndexSetting -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UpdatableIndexSetting -> Bool
redundant)) (Parser [UpdatableIndexSetting] -> Parser [UpdatableIndexSetting])
-> (Object -> Parser [UpdatableIndexSetting])
-> Object
-> Parser [UpdatableIndexSetting]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Object -> Parser [UpdatableIndexSetting]
parseSettings (Object -> Parser [UpdatableIndexSetting])
-> Parser Object -> Parser [UpdatableIndexSetting]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Object
o' Object -> Key -> Parser Object
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"settings")
        [Pair]
_ -> String -> Parser IndexSettingsSummary
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Expected single-key object with index name"
      redundant :: UpdatableIndexSetting -> Bool
redundant (NumberOfReplicas ReplicaCount
_) = Bool
True
      redundant UpdatableIndexSetting
_ = Bool
False

-- | 'OpenCloseIndex' is a sum type for opening and closing indices.
--
--  <http://www.elastic.co/guide/en/elasticsearch/reference/current/indices-open-close.html>
data OpenCloseIndex = OpenIndex | CloseIndex deriving stock (OpenCloseIndex -> OpenCloseIndex -> Bool
(OpenCloseIndex -> OpenCloseIndex -> Bool)
-> (OpenCloseIndex -> OpenCloseIndex -> Bool) -> Eq OpenCloseIndex
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OpenCloseIndex -> OpenCloseIndex -> Bool
== :: OpenCloseIndex -> OpenCloseIndex -> Bool
$c/= :: OpenCloseIndex -> OpenCloseIndex -> Bool
/= :: OpenCloseIndex -> OpenCloseIndex -> Bool
Eq, Int -> OpenCloseIndex -> ShowS
[OpenCloseIndex] -> ShowS
OpenCloseIndex -> String
(Int -> OpenCloseIndex -> ShowS)
-> (OpenCloseIndex -> String)
-> ([OpenCloseIndex] -> ShowS)
-> Show OpenCloseIndex
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OpenCloseIndex -> ShowS
showsPrec :: Int -> OpenCloseIndex -> ShowS
$cshow :: OpenCloseIndex -> String
show :: OpenCloseIndex -> String
$cshowList :: [OpenCloseIndex] -> ShowS
showList :: [OpenCloseIndex] -> ShowS
Show)

data FieldType
  = GeoPointType
  | GeoShapeType
  | FloatType
  | IntegerType
  | LongType
  | ShortType
  | ByteType
  deriving stock (FieldType -> FieldType -> Bool
(FieldType -> FieldType -> Bool)
-> (FieldType -> FieldType -> Bool) -> Eq FieldType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FieldType -> FieldType -> Bool
== :: FieldType -> FieldType -> Bool
$c/= :: FieldType -> FieldType -> Bool
/= :: FieldType -> FieldType -> Bool
Eq, Int -> FieldType -> ShowS
[FieldType] -> ShowS
FieldType -> String
(Int -> FieldType -> ShowS)
-> (FieldType -> String)
-> ([FieldType] -> ShowS)
-> Show FieldType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FieldType -> ShowS
showsPrec :: Int -> FieldType -> ShowS
$cshow :: FieldType -> String
show :: FieldType -> String
$cshowList :: [FieldType] -> ShowS
showList :: [FieldType] -> ShowS
Show)

newtype FieldDefinition = FieldDefinition
  { FieldDefinition -> FieldType
fieldType :: FieldType
  }
  deriving stock (FieldDefinition -> FieldDefinition -> Bool
(FieldDefinition -> FieldDefinition -> Bool)
-> (FieldDefinition -> FieldDefinition -> Bool)
-> Eq FieldDefinition
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FieldDefinition -> FieldDefinition -> Bool
== :: FieldDefinition -> FieldDefinition -> Bool
$c/= :: FieldDefinition -> FieldDefinition -> Bool
/= :: FieldDefinition -> FieldDefinition -> Bool
Eq, Int -> FieldDefinition -> ShowS
[FieldDefinition] -> ShowS
FieldDefinition -> String
(Int -> FieldDefinition -> ShowS)
-> (FieldDefinition -> String)
-> ([FieldDefinition] -> ShowS)
-> Show FieldDefinition
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FieldDefinition -> ShowS
showsPrec :: Int -> FieldDefinition -> ShowS
$cshow :: FieldDefinition -> String
show :: FieldDefinition -> String
$cshowList :: [FieldDefinition] -> ShowS
showList :: [FieldDefinition] -> ShowS
Show)

fieldTypeLens :: Lens' FieldDefinition FieldType
fieldTypeLens :: Lens' FieldDefinition FieldType
fieldTypeLens = (FieldDefinition -> FieldType)
-> (FieldDefinition -> FieldType -> FieldDefinition)
-> Lens' FieldDefinition FieldType
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens FieldDefinition -> FieldType
fieldType (\FieldDefinition
x FieldType
y -> FieldDefinition
x {fieldType = y})

-- | An 'IndexTemplate' defines a template that will automatically be
--   applied to new indices created. The templates include both
--   'IndexSettings' and mappings, and a simple 'IndexPattern' that
--   controls if the template will be applied to the index created.
--   Specify mappings as follows: @[toJSON TweetMapping, ...]@
--
--   https://www.elastic.co/guide/en/elasticsearch/reference/1.7/indices-templates.html
data IndexTemplate = IndexTemplate
  { IndexTemplate -> [IndexPattern]
templatePatterns :: [IndexPattern],
    IndexTemplate -> Maybe IndexSettings
templateSettings :: Maybe IndexSettings,
    IndexTemplate -> Value
templateMappings :: Value
  }

instance ToJSON IndexTemplate where
  toJSON :: IndexTemplate -> Value
toJSON (IndexTemplate [IndexPattern]
p Maybe IndexSettings
s Value
m) =
    Value -> Value -> Value
merge
      ( [Pair] -> Value
object
          [ Key
"index_patterns" Key -> [IndexPattern] -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [IndexPattern]
p,
            Key
"mappings" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Value
m
          ]
      )
      (Maybe IndexSettings -> Value
forall a. ToJSON a => a -> Value
toJSON Maybe IndexSettings
s)
    where
      merge :: Value -> Value -> Value
merge (Object Object
o1) (Object Object
o2) = Object -> Value
forall a. ToJSON a => a -> Value
toJSON (Object -> Value) -> Object -> Value
forall a b. (a -> b) -> a -> b
$ Object -> Object -> Object
forall v. KeyMap v -> KeyMap v -> KeyMap v
X.union Object
o1 Object
o2
      merge Value
o Value
Null = Value
o
      merge Value
_ Value
_ = Value
forall a. HasCallStack => a
undefined

templatePatternsLens :: Lens' IndexTemplate [IndexPattern]
templatePatternsLens :: Lens' IndexTemplate [IndexPattern]
templatePatternsLens = (IndexTemplate -> [IndexPattern])
-> (IndexTemplate -> [IndexPattern] -> IndexTemplate)
-> Lens' IndexTemplate [IndexPattern]
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens IndexTemplate -> [IndexPattern]
templatePatterns (\IndexTemplate
x [IndexPattern]
y -> IndexTemplate
x {templatePatterns = y})

templateSettingsLens :: Lens' IndexTemplate (Maybe IndexSettings)
templateSettingsLens :: Lens' IndexTemplate (Maybe IndexSettings)
templateSettingsLens = (IndexTemplate -> Maybe IndexSettings)
-> (IndexTemplate -> Maybe IndexSettings -> IndexTemplate)
-> Lens' IndexTemplate (Maybe IndexSettings)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens IndexTemplate -> Maybe IndexSettings
templateSettings (\IndexTemplate
x Maybe IndexSettings
y -> IndexTemplate
x {templateSettings = y})

templateMappingsLens :: Lens' IndexTemplate Value
templateMappingsLens :: Lens' IndexTemplate Value
templateMappingsLens = (IndexTemplate -> Value)
-> (IndexTemplate -> Value -> IndexTemplate)
-> Lens' IndexTemplate Value
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens IndexTemplate -> Value
templateMappings (\IndexTemplate
x Value
y -> IndexTemplate
x {templateMappings = y})

data MappingField = MappingField
  { MappingField -> FieldName
mappingFieldName :: FieldName,
    MappingField -> FieldDefinition
fieldDefinition :: FieldDefinition
  }
  deriving stock (MappingField -> MappingField -> Bool
(MappingField -> MappingField -> Bool)
-> (MappingField -> MappingField -> Bool) -> Eq MappingField
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MappingField -> MappingField -> Bool
== :: MappingField -> MappingField -> Bool
$c/= :: MappingField -> MappingField -> Bool
/= :: MappingField -> MappingField -> Bool
Eq, Int -> MappingField -> ShowS
[MappingField] -> ShowS
MappingField -> String
(Int -> MappingField -> ShowS)
-> (MappingField -> String)
-> ([MappingField] -> ShowS)
-> Show MappingField
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MappingField -> ShowS
showsPrec :: Int -> MappingField -> ShowS
$cshow :: MappingField -> String
show :: MappingField -> String
$cshowList :: [MappingField] -> ShowS
showList :: [MappingField] -> ShowS
Show)

mappingFieldNameLens :: Lens' MappingField FieldName
mappingFieldNameLens :: Lens' MappingField FieldName
mappingFieldNameLens = (MappingField -> FieldName)
-> (MappingField -> FieldName -> MappingField)
-> Lens' MappingField FieldName
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens MappingField -> FieldName
mappingFieldName (\MappingField
x FieldName
y -> MappingField
x {mappingFieldName = y})

fieldDefinitionLens :: Lens' MappingField FieldDefinition
fieldDefinitionLens :: Lens' MappingField FieldDefinition
fieldDefinitionLens = (MappingField -> FieldDefinition)
-> (MappingField -> FieldDefinition -> MappingField)
-> Lens' MappingField FieldDefinition
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens MappingField -> FieldDefinition
fieldDefinition (\MappingField
x FieldDefinition
y -> MappingField
x {fieldDefinition = y})

-- | Support for type reification of 'Mapping's is currently incomplete, for
--   now the mapping API verbiage expects a 'ToJSON'able blob.
--
--   Indexes have mappings, mappings are schemas for the documents contained
--   in the index. I'd recommend having only one mapping per index, always
--   having a mapping, and keeping different kinds of documents separated
--   if possible.
newtype Mapping = Mapping {Mapping -> [MappingField]
mappingFields :: [MappingField]}
  deriving stock (Mapping -> Mapping -> Bool
(Mapping -> Mapping -> Bool)
-> (Mapping -> Mapping -> Bool) -> Eq Mapping
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Mapping -> Mapping -> Bool
== :: Mapping -> Mapping -> Bool
$c/= :: Mapping -> Mapping -> Bool
/= :: Mapping -> Mapping -> Bool
Eq, Int -> Mapping -> ShowS
[Mapping] -> ShowS
Mapping -> String
(Int -> Mapping -> ShowS)
-> (Mapping -> String) -> ([Mapping] -> ShowS) -> Show Mapping
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Mapping -> ShowS
showsPrec :: Int -> Mapping -> ShowS
$cshow :: Mapping -> String
show :: Mapping -> String
$cshowList :: [Mapping] -> ShowS
showList :: [Mapping] -> ShowS
Show)

mappingFieldsLens :: Lens' Mapping [MappingField]
mappingFieldsLens :: Lens' Mapping [MappingField]
mappingFieldsLens = (Mapping -> [MappingField])
-> (Mapping -> [MappingField] -> Mapping)
-> Lens' Mapping [MappingField]
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Mapping -> [MappingField]
mappingFields (\Mapping
x [MappingField]
y -> Mapping
x {mappingFields = y})

data AllocationPolicy
  = -- | Allows shard allocation for all shards.
    AllocAll
  | -- | Allows shard allocation only for primary shards.
    AllocPrimaries
  | -- | Allows shard allocation only for primary shards for new indices.
    AllocNewPrimaries
  | -- | No shard allocation is allowed
    AllocNone
  deriving stock (AllocationPolicy -> AllocationPolicy -> Bool
(AllocationPolicy -> AllocationPolicy -> Bool)
-> (AllocationPolicy -> AllocationPolicy -> Bool)
-> Eq AllocationPolicy
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AllocationPolicy -> AllocationPolicy -> Bool
== :: AllocationPolicy -> AllocationPolicy -> Bool
$c/= :: AllocationPolicy -> AllocationPolicy -> Bool
/= :: AllocationPolicy -> AllocationPolicy -> Bool
Eq, Int -> AllocationPolicy -> ShowS
[AllocationPolicy] -> ShowS
AllocationPolicy -> String
(Int -> AllocationPolicy -> ShowS)
-> (AllocationPolicy -> String)
-> ([AllocationPolicy] -> ShowS)
-> Show AllocationPolicy
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AllocationPolicy -> ShowS
showsPrec :: Int -> AllocationPolicy -> ShowS
$cshow :: AllocationPolicy -> String
show :: AllocationPolicy -> String
$cshowList :: [AllocationPolicy] -> ShowS
showList :: [AllocationPolicy] -> ShowS
Show, (forall x. AllocationPolicy -> Rep AllocationPolicy x)
-> (forall x. Rep AllocationPolicy x -> AllocationPolicy)
-> Generic AllocationPolicy
forall x. Rep AllocationPolicy x -> AllocationPolicy
forall x. AllocationPolicy -> Rep AllocationPolicy x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. AllocationPolicy -> Rep AllocationPolicy x
from :: forall x. AllocationPolicy -> Rep AllocationPolicy x
$cto :: forall x. Rep AllocationPolicy x -> AllocationPolicy
to :: forall x. Rep AllocationPolicy x -> AllocationPolicy
Generic)

instance ToJSON AllocationPolicy where
  toJSON :: AllocationPolicy -> Value
toJSON AllocationPolicy
AllocAll = Text -> Value
String Text
"all"
  toJSON AllocationPolicy
AllocPrimaries = Text -> Value
String Text
"primaries"
  toJSON AllocationPolicy
AllocNewPrimaries = Text -> Value
String Text
"new_primaries"
  toJSON AllocationPolicy
AllocNone = Text -> Value
String Text
"none"

instance FromJSON AllocationPolicy where
  parseJSON :: Value -> Parser AllocationPolicy
parseJSON = String
-> (Text -> Parser AllocationPolicy)
-> Value
-> Parser AllocationPolicy
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"AllocationPolicy" Text -> Parser AllocationPolicy
forall {a} {f :: * -> *}.
(Eq a, IsString a, MonadFail f, Show a) =>
a -> f AllocationPolicy
parse
    where
      parse :: a -> f AllocationPolicy
parse a
"all" = AllocationPolicy -> f AllocationPolicy
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure AllocationPolicy
AllocAll
      parse a
"primaries" = AllocationPolicy -> f AllocationPolicy
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure AllocationPolicy
AllocPrimaries
      parse a
"new_primaries" = AllocationPolicy -> f AllocationPolicy
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure AllocationPolicy
AllocNewPrimaries
      parse a
"none" = AllocationPolicy -> f AllocationPolicy
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure AllocationPolicy
AllocNone
      parse a
t = String -> f AllocationPolicy
forall a. String -> f a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Invlaid AllocationPolicy: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> a -> String
forall a. Show a => a -> String
show a
t)

data IndexAlias = IndexAlias
  { IndexAlias -> IndexName
srcIndex :: IndexName,
    IndexAlias -> IndexAliasName
indexAlias :: IndexAliasName
  }
  deriving stock (IndexAlias -> IndexAlias -> Bool
(IndexAlias -> IndexAlias -> Bool)
-> (IndexAlias -> IndexAlias -> Bool) -> Eq IndexAlias
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: IndexAlias -> IndexAlias -> Bool
== :: IndexAlias -> IndexAlias -> Bool
$c/= :: IndexAlias -> IndexAlias -> Bool
/= :: IndexAlias -> IndexAlias -> Bool
Eq, Int -> IndexAlias -> ShowS
[IndexAlias] -> ShowS
IndexAlias -> String
(Int -> IndexAlias -> ShowS)
-> (IndexAlias -> String)
-> ([IndexAlias] -> ShowS)
-> Show IndexAlias
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> IndexAlias -> ShowS
showsPrec :: Int -> IndexAlias -> ShowS
$cshow :: IndexAlias -> String
show :: IndexAlias -> String
$cshowList :: [IndexAlias] -> ShowS
showList :: [IndexAlias] -> ShowS
Show)

srcIndexLens :: Lens' IndexAlias IndexName
srcIndexLens :: Lens' IndexAlias IndexName
srcIndexLens = (IndexAlias -> IndexName)
-> (IndexAlias -> IndexName -> IndexAlias)
-> Lens' IndexAlias IndexName
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens IndexAlias -> IndexName
srcIndex (\IndexAlias
x IndexName
y -> IndexAlias
x {srcIndex = y})

indexAliasLens :: Lens' IndexAlias IndexAliasName
indexAliasLens :: Lens' IndexAlias IndexAliasName
indexAliasLens = (IndexAlias -> IndexAliasName)
-> (IndexAlias -> IndexAliasName -> IndexAlias)
-> Lens' IndexAlias IndexAliasName
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens IndexAlias -> IndexAliasName
indexAlias (\IndexAlias
x IndexAliasName
y -> IndexAlias
x {indexAlias = y})

data IndexAliasAction
  = AddAlias IndexAlias IndexAliasCreate
  | RemoveAlias IndexAlias
  deriving stock (IndexAliasAction -> IndexAliasAction -> Bool
(IndexAliasAction -> IndexAliasAction -> Bool)
-> (IndexAliasAction -> IndexAliasAction -> Bool)
-> Eq IndexAliasAction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: IndexAliasAction -> IndexAliasAction -> Bool
== :: IndexAliasAction -> IndexAliasAction -> Bool
$c/= :: IndexAliasAction -> IndexAliasAction -> Bool
/= :: IndexAliasAction -> IndexAliasAction -> Bool
Eq, Int -> IndexAliasAction -> ShowS
[IndexAliasAction] -> ShowS
IndexAliasAction -> String
(Int -> IndexAliasAction -> ShowS)
-> (IndexAliasAction -> String)
-> ([IndexAliasAction] -> ShowS)
-> Show IndexAliasAction
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> IndexAliasAction -> ShowS
showsPrec :: Int -> IndexAliasAction -> ShowS
$cshow :: IndexAliasAction -> String
show :: IndexAliasAction -> String
$cshowList :: [IndexAliasAction] -> ShowS
showList :: [IndexAliasAction] -> ShowS
Show)

data IndexAliasCreate = IndexAliasCreate
  { IndexAliasCreate -> Maybe AliasRouting
aliasCreateRouting :: Maybe AliasRouting,
    IndexAliasCreate -> Maybe Filter
aliasCreateFilter :: Maybe Filter
  }
  deriving stock (IndexAliasCreate -> IndexAliasCreate -> Bool
(IndexAliasCreate -> IndexAliasCreate -> Bool)
-> (IndexAliasCreate -> IndexAliasCreate -> Bool)
-> Eq IndexAliasCreate
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: IndexAliasCreate -> IndexAliasCreate -> Bool
== :: IndexAliasCreate -> IndexAliasCreate -> Bool
$c/= :: IndexAliasCreate -> IndexAliasCreate -> Bool
/= :: IndexAliasCreate -> IndexAliasCreate -> Bool
Eq, Int -> IndexAliasCreate -> ShowS
[IndexAliasCreate] -> ShowS
IndexAliasCreate -> String
(Int -> IndexAliasCreate -> ShowS)
-> (IndexAliasCreate -> String)
-> ([IndexAliasCreate] -> ShowS)
-> Show IndexAliasCreate
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> IndexAliasCreate -> ShowS
showsPrec :: Int -> IndexAliasCreate -> ShowS
$cshow :: IndexAliasCreate -> String
show :: IndexAliasCreate -> String
$cshowList :: [IndexAliasCreate] -> ShowS
showList :: [IndexAliasCreate] -> ShowS
Show)

aliasCreateRoutingLens :: Lens' IndexAliasCreate (Maybe AliasRouting)
aliasCreateRoutingLens :: Lens' IndexAliasCreate (Maybe AliasRouting)
aliasCreateRoutingLens = (IndexAliasCreate -> Maybe AliasRouting)
-> (IndexAliasCreate -> Maybe AliasRouting -> IndexAliasCreate)
-> Lens' IndexAliasCreate (Maybe AliasRouting)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens IndexAliasCreate -> Maybe AliasRouting
aliasCreateRouting (\IndexAliasCreate
x Maybe AliasRouting
y -> IndexAliasCreate
x {aliasCreateRouting = y})

aliasCreateFilterLens :: Lens' IndexAliasCreate (Maybe Filter)
aliasCreateFilterLens :: Lens' IndexAliasCreate (Maybe Filter)
aliasCreateFilterLens = (IndexAliasCreate -> Maybe Filter)
-> (IndexAliasCreate -> Maybe Filter -> IndexAliasCreate)
-> Lens' IndexAliasCreate (Maybe Filter)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens IndexAliasCreate -> Maybe Filter
aliasCreateFilter (\IndexAliasCreate
x Maybe Filter
y -> IndexAliasCreate
x {aliasCreateFilter = y})

data AliasRouting
  = AllAliasRouting RoutingValue
  | GranularAliasRouting (Maybe SearchAliasRouting) (Maybe IndexAliasRouting)
  deriving stock (AliasRouting -> AliasRouting -> Bool
(AliasRouting -> AliasRouting -> Bool)
-> (AliasRouting -> AliasRouting -> Bool) -> Eq AliasRouting
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AliasRouting -> AliasRouting -> Bool
== :: AliasRouting -> AliasRouting -> Bool
$c/= :: AliasRouting -> AliasRouting -> Bool
/= :: AliasRouting -> AliasRouting -> Bool
Eq, Int -> AliasRouting -> ShowS
[AliasRouting] -> ShowS
AliasRouting -> String
(Int -> AliasRouting -> ShowS)
-> (AliasRouting -> String)
-> ([AliasRouting] -> ShowS)
-> Show AliasRouting
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AliasRouting -> ShowS
showsPrec :: Int -> AliasRouting -> ShowS
$cshow :: AliasRouting -> String
show :: AliasRouting -> String
$cshowList :: [AliasRouting] -> ShowS
showList :: [AliasRouting] -> ShowS
Show)

newtype SearchAliasRouting
  = SearchAliasRouting (NonEmpty RoutingValue)
  deriving stock (SearchAliasRouting -> SearchAliasRouting -> Bool
(SearchAliasRouting -> SearchAliasRouting -> Bool)
-> (SearchAliasRouting -> SearchAliasRouting -> Bool)
-> Eq SearchAliasRouting
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SearchAliasRouting -> SearchAliasRouting -> Bool
== :: SearchAliasRouting -> SearchAliasRouting -> Bool
$c/= :: SearchAliasRouting -> SearchAliasRouting -> Bool
/= :: SearchAliasRouting -> SearchAliasRouting -> Bool
Eq, Int -> SearchAliasRouting -> ShowS
[SearchAliasRouting] -> ShowS
SearchAliasRouting -> String
(Int -> SearchAliasRouting -> ShowS)
-> (SearchAliasRouting -> String)
-> ([SearchAliasRouting] -> ShowS)
-> Show SearchAliasRouting
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SearchAliasRouting -> ShowS
showsPrec :: Int -> SearchAliasRouting -> ShowS
$cshow :: SearchAliasRouting -> String
show :: SearchAliasRouting -> String
$cshowList :: [SearchAliasRouting] -> ShowS
showList :: [SearchAliasRouting] -> ShowS
Show, (forall x. SearchAliasRouting -> Rep SearchAliasRouting x)
-> (forall x. Rep SearchAliasRouting x -> SearchAliasRouting)
-> Generic SearchAliasRouting
forall x. Rep SearchAliasRouting x -> SearchAliasRouting
forall x. SearchAliasRouting -> Rep SearchAliasRouting x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SearchAliasRouting -> Rep SearchAliasRouting x
from :: forall x. SearchAliasRouting -> Rep SearchAliasRouting x
$cto :: forall x. Rep SearchAliasRouting x -> SearchAliasRouting
to :: forall x. Rep SearchAliasRouting x -> SearchAliasRouting
Generic)

instance ToJSON SearchAliasRouting where
  toJSON :: SearchAliasRouting -> Value
toJSON (SearchAliasRouting NonEmpty RoutingValue
rvs) = Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> [Text] -> Text
T.intercalate Text
"," (RoutingValue -> Text
routingValue (RoutingValue -> Text) -> [RoutingValue] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty RoutingValue -> [RoutingValue]
forall a. NonEmpty a -> [a]
toList NonEmpty RoutingValue
rvs))

instance FromJSON SearchAliasRouting where
  parseJSON :: Value -> Parser SearchAliasRouting
parseJSON = String
-> (Text -> Parser SearchAliasRouting)
-> Value
-> Parser SearchAliasRouting
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"SearchAliasRouting" Text -> Parser SearchAliasRouting
parse
    where
      parse :: Text -> Parser SearchAliasRouting
parse Text
t = NonEmpty RoutingValue -> SearchAliasRouting
SearchAliasRouting (NonEmpty RoutingValue -> SearchAliasRouting)
-> Parser (NonEmpty RoutingValue) -> Parser SearchAliasRouting
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Value] -> Parser (NonEmpty RoutingValue)
forall a. FromJSON a => [Value] -> Parser (NonEmpty a)
parseNEJSON (Text -> Value
String (Text -> Value) -> [Text] -> [Value]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HasCallStack => Text -> Text -> [Text]
Text -> Text -> [Text]
T.splitOn Text
"," Text
t)

newtype IndexAliasRouting
  = IndexAliasRouting RoutingValue
  deriving newtype (IndexAliasRouting -> IndexAliasRouting -> Bool
(IndexAliasRouting -> IndexAliasRouting -> Bool)
-> (IndexAliasRouting -> IndexAliasRouting -> Bool)
-> Eq IndexAliasRouting
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: IndexAliasRouting -> IndexAliasRouting -> Bool
== :: IndexAliasRouting -> IndexAliasRouting -> Bool
$c/= :: IndexAliasRouting -> IndexAliasRouting -> Bool
/= :: IndexAliasRouting -> IndexAliasRouting -> Bool
Eq, Int -> IndexAliasRouting -> ShowS
[IndexAliasRouting] -> ShowS
IndexAliasRouting -> String
(Int -> IndexAliasRouting -> ShowS)
-> (IndexAliasRouting -> String)
-> ([IndexAliasRouting] -> ShowS)
-> Show IndexAliasRouting
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> IndexAliasRouting -> ShowS
showsPrec :: Int -> IndexAliasRouting -> ShowS
$cshow :: IndexAliasRouting -> String
show :: IndexAliasRouting -> String
$cshowList :: [IndexAliasRouting] -> ShowS
showList :: [IndexAliasRouting] -> ShowS
Show, [IndexAliasRouting] -> Value
[IndexAliasRouting] -> Encoding
IndexAliasRouting -> Bool
IndexAliasRouting -> Value
IndexAliasRouting -> Encoding
(IndexAliasRouting -> Value)
-> (IndexAliasRouting -> Encoding)
-> ([IndexAliasRouting] -> Value)
-> ([IndexAliasRouting] -> Encoding)
-> (IndexAliasRouting -> Bool)
-> ToJSON IndexAliasRouting
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: IndexAliasRouting -> Value
toJSON :: IndexAliasRouting -> Value
$ctoEncoding :: IndexAliasRouting -> Encoding
toEncoding :: IndexAliasRouting -> Encoding
$ctoJSONList :: [IndexAliasRouting] -> Value
toJSONList :: [IndexAliasRouting] -> Value
$ctoEncodingList :: [IndexAliasRouting] -> Encoding
toEncodingList :: [IndexAliasRouting] -> Encoding
$comitField :: IndexAliasRouting -> Bool
omitField :: IndexAliasRouting -> Bool
ToJSON, Maybe IndexAliasRouting
Value -> Parser [IndexAliasRouting]
Value -> Parser IndexAliasRouting
(Value -> Parser IndexAliasRouting)
-> (Value -> Parser [IndexAliasRouting])
-> Maybe IndexAliasRouting
-> FromJSON IndexAliasRouting
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser IndexAliasRouting
parseJSON :: Value -> Parser IndexAliasRouting
$cparseJSONList :: Value -> Parser [IndexAliasRouting]
parseJSONList :: Value -> Parser [IndexAliasRouting]
$comittedField :: Maybe IndexAliasRouting
omittedField :: Maybe IndexAliasRouting
FromJSON)

newtype RoutingValue = RoutingValue {RoutingValue -> Text
routingValue :: Text}
  deriving newtype (RoutingValue -> RoutingValue -> Bool
(RoutingValue -> RoutingValue -> Bool)
-> (RoutingValue -> RoutingValue -> Bool) -> Eq RoutingValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RoutingValue -> RoutingValue -> Bool
== :: RoutingValue -> RoutingValue -> Bool
$c/= :: RoutingValue -> RoutingValue -> Bool
/= :: RoutingValue -> RoutingValue -> Bool
Eq, Int -> RoutingValue -> ShowS
[RoutingValue] -> ShowS
RoutingValue -> String
(Int -> RoutingValue -> ShowS)
-> (RoutingValue -> String)
-> ([RoutingValue] -> ShowS)
-> Show RoutingValue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RoutingValue -> ShowS
showsPrec :: Int -> RoutingValue -> ShowS
$cshow :: RoutingValue -> String
show :: RoutingValue -> String
$cshowList :: [RoutingValue] -> ShowS
showList :: [RoutingValue] -> ShowS
Show, [RoutingValue] -> Value
[RoutingValue] -> Encoding
RoutingValue -> Bool
RoutingValue -> Value
RoutingValue -> Encoding
(RoutingValue -> Value)
-> (RoutingValue -> Encoding)
-> ([RoutingValue] -> Value)
-> ([RoutingValue] -> Encoding)
-> (RoutingValue -> Bool)
-> ToJSON RoutingValue
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: RoutingValue -> Value
toJSON :: RoutingValue -> Value
$ctoEncoding :: RoutingValue -> Encoding
toEncoding :: RoutingValue -> Encoding
$ctoJSONList :: [RoutingValue] -> Value
toJSONList :: [RoutingValue] -> Value
$ctoEncodingList :: [RoutingValue] -> Encoding
toEncodingList :: [RoutingValue] -> Encoding
$comitField :: RoutingValue -> Bool
omitField :: RoutingValue -> Bool
ToJSON, Maybe RoutingValue
Value -> Parser [RoutingValue]
Value -> Parser RoutingValue
(Value -> Parser RoutingValue)
-> (Value -> Parser [RoutingValue])
-> Maybe RoutingValue
-> FromJSON RoutingValue
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser RoutingValue
parseJSON :: Value -> Parser RoutingValue
$cparseJSONList :: Value -> Parser [RoutingValue]
parseJSONList :: Value -> Parser [RoutingValue]
$comittedField :: Maybe RoutingValue
omittedField :: Maybe RoutingValue
FromJSON)

routingValueLens :: Lens' RoutingValue Text
routingValueLens :: Lens' RoutingValue Text
routingValueLens = (RoutingValue -> Text)
-> (RoutingValue -> Text -> RoutingValue)
-> Lens' RoutingValue Text
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens RoutingValue -> Text
routingValue (\RoutingValue
x Text
y -> RoutingValue
x {routingValue = y})

newtype IndexAliasesSummary = IndexAliasesSummary {IndexAliasesSummary -> [IndexAliasSummary]
indexAliasesSummary :: [IndexAliasSummary]}
  deriving stock (IndexAliasesSummary -> IndexAliasesSummary -> Bool
(IndexAliasesSummary -> IndexAliasesSummary -> Bool)
-> (IndexAliasesSummary -> IndexAliasesSummary -> Bool)
-> Eq IndexAliasesSummary
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: IndexAliasesSummary -> IndexAliasesSummary -> Bool
== :: IndexAliasesSummary -> IndexAliasesSummary -> Bool
$c/= :: IndexAliasesSummary -> IndexAliasesSummary -> Bool
/= :: IndexAliasesSummary -> IndexAliasesSummary -> Bool
Eq, Int -> IndexAliasesSummary -> ShowS
[IndexAliasesSummary] -> ShowS
IndexAliasesSummary -> String
(Int -> IndexAliasesSummary -> ShowS)
-> (IndexAliasesSummary -> String)
-> ([IndexAliasesSummary] -> ShowS)
-> Show IndexAliasesSummary
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> IndexAliasesSummary -> ShowS
showsPrec :: Int -> IndexAliasesSummary -> ShowS
$cshow :: IndexAliasesSummary -> String
show :: IndexAliasesSummary -> String
$cshowList :: [IndexAliasesSummary] -> ShowS
showList :: [IndexAliasesSummary] -> ShowS
Show)

instance FromJSON IndexAliasesSummary where
  parseJSON :: Value -> Parser IndexAliasesSummary
parseJSON = String
-> (Object -> Parser IndexAliasesSummary)
-> Value
-> Parser IndexAliasesSummary
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"IndexAliasesSummary" Object -> Parser IndexAliasesSummary
parse
    where
      parse :: Object -> Parser IndexAliasesSummary
parse Object
o = [IndexAliasSummary] -> IndexAliasesSummary
IndexAliasesSummary ([IndexAliasSummary] -> IndexAliasesSummary)
-> ([[IndexAliasSummary]] -> [IndexAliasSummary])
-> [[IndexAliasSummary]]
-> IndexAliasesSummary
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[IndexAliasSummary]] -> [IndexAliasSummary]
forall a. Monoid a => [a] -> a
mconcat ([[IndexAliasSummary]] -> IndexAliasesSummary)
-> Parser [[IndexAliasSummary]] -> Parser IndexAliasesSummary
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Pair -> Parser [IndexAliasSummary])
-> [Pair] -> Parser [[IndexAliasSummary]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((Key -> Value -> Parser [IndexAliasSummary])
-> Pair -> Parser [IndexAliasSummary]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Key -> Value -> Parser [IndexAliasSummary]
forall {a}. ToJSON a => a -> Value -> Parser [IndexAliasSummary]
go) (Object -> [Pair]
forall v. KeyMap v -> [(Key, v)]
X.toList Object
o)
      go :: a -> Value -> Parser [IndexAliasSummary]
go a
ixn = String
-> (Object -> Parser [IndexAliasSummary])
-> Value
-> Parser [IndexAliasSummary]
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"index aliases" ((Object -> Parser [IndexAliasSummary])
 -> Value -> Parser [IndexAliasSummary])
-> (Object -> Parser [IndexAliasSummary])
-> Value
-> Parser [IndexAliasSummary]
forall a b. (a -> b) -> a -> b
$ \Object
ia -> do
        IndexName
indexName <- Value -> Parser IndexName
forall a. FromJSON a => Value -> Parser a
parseJSON (Value -> Parser IndexName) -> Value -> Parser IndexName
forall a b. (a -> b) -> a -> b
$ a -> Value
forall a. ToJSON a => a -> Value
toJSON a
ixn
        HashMap IndexName Value
aliases <- Object
ia Object -> Key -> Parser (Maybe (HashMap IndexName Value))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"aliases" Parser (Maybe (HashMap IndexName Value))
-> HashMap IndexName Value -> Parser (HashMap IndexName Value)
forall a. Parser (Maybe a) -> a -> Parser a
.!= HashMap IndexName Value
forall a. Monoid a => a
mempty
        [(IndexName, Value)]
-> ((IndexName, Value) -> Parser IndexAliasSummary)
-> Parser [IndexAliasSummary]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (HashMap IndexName Value -> [(IndexName, Value)]
forall k v. HashMap k v -> [(k, v)]
HM.toList HashMap IndexName Value
aliases) (((IndexName, Value) -> Parser IndexAliasSummary)
 -> Parser [IndexAliasSummary])
-> ((IndexName, Value) -> Parser IndexAliasSummary)
-> Parser [IndexAliasSummary]
forall a b. (a -> b) -> a -> b
$ \(IndexName
aName, Value
v) -> do
          let indexAlias :: IndexAlias
indexAlias = IndexName -> IndexAliasName -> IndexAlias
IndexAlias IndexName
indexName (IndexName -> IndexAliasName
IndexAliasName IndexName
aName)
          IndexAlias -> IndexAliasCreate -> IndexAliasSummary
IndexAliasSummary IndexAlias
indexAlias (IndexAliasCreate -> IndexAliasSummary)
-> Parser IndexAliasCreate -> Parser IndexAliasSummary
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser IndexAliasCreate
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v

indexAliasesSummaryLens :: Lens' IndexAliasesSummary [IndexAliasSummary]
indexAliasesSummaryLens :: Lens' IndexAliasesSummary [IndexAliasSummary]
indexAliasesSummaryLens = (IndexAliasesSummary -> [IndexAliasSummary])
-> (IndexAliasesSummary
    -> [IndexAliasSummary] -> IndexAliasesSummary)
-> Lens' IndexAliasesSummary [IndexAliasSummary]
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens IndexAliasesSummary -> [IndexAliasSummary]
indexAliasesSummary (\IndexAliasesSummary
x [IndexAliasSummary]
y -> IndexAliasesSummary
x {indexAliasesSummary = y})

instance ToJSON IndexAliasAction where
  toJSON :: IndexAliasAction -> Value
toJSON (AddAlias IndexAlias
ia IndexAliasCreate
opts) = [Pair] -> Value
object [Key
"add" Key -> Object -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (IndexAlias -> Object
forall a. ToJSON a => a -> Object
jsonObject IndexAlias
ia Object -> Object -> Object
forall a. Semigroup a => a -> a -> a
<> IndexAliasCreate -> Object
forall a. ToJSON a => a -> Object
jsonObject IndexAliasCreate
opts)]
  toJSON (RemoveAlias IndexAlias
ia) = [Pair] -> Value
object [Key
"remove" Key -> Object -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= IndexAlias -> Object
forall a. ToJSON a => a -> Object
jsonObject IndexAlias
ia]

instance ToJSON IndexAlias where
  toJSON :: IndexAlias -> Value
toJSON IndexAlias {IndexAliasName
IndexName
srcIndex :: IndexAlias -> IndexName
indexAlias :: IndexAlias -> IndexAliasName
srcIndex :: IndexName
indexAlias :: IndexAliasName
..} =
    [Pair] -> Value
object
      [ Key
"index" Key -> IndexName -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= IndexName
srcIndex,
        Key
"alias" Key -> IndexAliasName -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= IndexAliasName
indexAlias
      ]

instance ToJSON IndexAliasCreate where
  toJSON :: IndexAliasCreate -> Value
toJSON IndexAliasCreate {Maybe Filter
Maybe AliasRouting
aliasCreateRouting :: IndexAliasCreate -> Maybe AliasRouting
aliasCreateFilter :: IndexAliasCreate -> Maybe Filter
aliasCreateRouting :: Maybe AliasRouting
aliasCreateFilter :: Maybe Filter
..} = Object -> Value
Object (Object
filterObj Object -> Object -> Object
forall a. Semigroup a => a -> a -> a
<> Object
routingObj)
    where
      filterObj :: Object
filterObj = Object -> (Filter -> Object) -> Maybe Filter -> Object
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Object
forall a. Monoid a => a
mempty (Key -> Value -> Object
forall v. Key -> v -> KeyMap v
X.singleton Key
"filter" (Value -> Object) -> (Filter -> Value) -> Filter -> Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Filter -> Value
forall a. ToJSON a => a -> Value
toJSON) Maybe Filter
aliasCreateFilter
      routingObj :: Object
routingObj = Value -> Object
forall a. ToJSON a => a -> Object
jsonObject (Value -> Object) -> Value -> Object
forall a b. (a -> b) -> a -> b
$ Value -> (AliasRouting -> Value) -> Maybe AliasRouting -> Value
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Object -> Value
Object Object
forall a. Monoid a => a
mempty) AliasRouting -> Value
forall a. ToJSON a => a -> Value
toJSON Maybe AliasRouting
aliasCreateRouting

instance ToJSON AliasRouting where
  toJSON :: AliasRouting -> Value
toJSON (AllAliasRouting RoutingValue
v) = [Pair] -> Value
object [Key
"routing" Key -> RoutingValue -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= RoutingValue
v]
  toJSON (GranularAliasRouting Maybe SearchAliasRouting
srch Maybe IndexAliasRouting
idx) = [Pair] -> Value
object ([Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
catMaybes [Maybe Pair]
prs)
    where
      prs :: [Maybe Pair]
prs =
        [ (Key
"search_routing" Key -> SearchAliasRouting -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.=) (SearchAliasRouting -> Pair)
-> Maybe SearchAliasRouting -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe SearchAliasRouting
srch,
          (Key
"index_routing" Key -> IndexAliasRouting -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.=) (IndexAliasRouting -> Pair)
-> Maybe IndexAliasRouting -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe IndexAliasRouting
idx
        ]

instance FromJSON AliasRouting where
  parseJSON :: Value -> Parser AliasRouting
parseJSON = String
-> (Object -> Parser AliasRouting) -> Value -> Parser AliasRouting
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"AliasRouting" Object -> Parser AliasRouting
parse
    where
      parse :: Object -> Parser AliasRouting
parse Object
o = Object -> Parser AliasRouting
parseAll Object
o Parser AliasRouting -> Parser AliasRouting -> Parser AliasRouting
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Object -> Parser AliasRouting
parseGranular Object
o
      parseAll :: Object -> Parser AliasRouting
parseAll Object
o = RoutingValue -> AliasRouting
AllAliasRouting (RoutingValue -> AliasRouting)
-> Parser RoutingValue -> Parser AliasRouting
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser RoutingValue
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"routing"
      parseGranular :: Object -> Parser AliasRouting
parseGranular Object
o = do
        Maybe SearchAliasRouting
sr <- Object
o Object -> Key -> Parser (Maybe SearchAliasRouting)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"search_routing"
        Maybe IndexAliasRouting
ir <- Object
o Object -> Key -> Parser (Maybe IndexAliasRouting)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"index_routing"
        if Maybe SearchAliasRouting -> Bool
forall a. Maybe a -> Bool
isNothing Maybe SearchAliasRouting
sr Bool -> Bool -> Bool
&& Maybe IndexAliasRouting -> Bool
forall a. Maybe a -> Bool
isNothing Maybe IndexAliasRouting
ir
          then String -> Parser AliasRouting
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Both search_routing and index_routing can't be blank"
          else AliasRouting -> Parser AliasRouting
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe SearchAliasRouting -> Maybe IndexAliasRouting -> AliasRouting
GranularAliasRouting Maybe SearchAliasRouting
sr Maybe IndexAliasRouting
ir)

instance FromJSON IndexAliasCreate where
  parseJSON :: Value -> Parser IndexAliasCreate
parseJSON Value
v = String
-> (Object -> Parser IndexAliasCreate)
-> Value
-> Parser IndexAliasCreate
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"IndexAliasCreate" Object -> Parser IndexAliasCreate
parse Value
v
    where
      parse :: Object -> Parser IndexAliasCreate
parse Object
o =
        Maybe AliasRouting -> Maybe Filter -> IndexAliasCreate
IndexAliasCreate
          (Maybe AliasRouting -> Maybe Filter -> IndexAliasCreate)
-> Parser (Maybe AliasRouting)
-> Parser (Maybe Filter -> IndexAliasCreate)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser AliasRouting -> Parser (Maybe AliasRouting)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Value -> Parser AliasRouting
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v)
          Parser (Maybe Filter -> IndexAliasCreate)
-> Parser (Maybe Filter) -> Parser IndexAliasCreate
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Filter)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"filter"

-- | 'IndexAliasSummary' is a summary of an index alias configured for a server.
data IndexAliasSummary = IndexAliasSummary
  { IndexAliasSummary -> IndexAlias
indexAliasSummaryAlias :: IndexAlias,
    IndexAliasSummary -> IndexAliasCreate
indexAliasSummaryCreate :: IndexAliasCreate
  }
  deriving stock (IndexAliasSummary -> IndexAliasSummary -> Bool
(IndexAliasSummary -> IndexAliasSummary -> Bool)
-> (IndexAliasSummary -> IndexAliasSummary -> Bool)
-> Eq IndexAliasSummary
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: IndexAliasSummary -> IndexAliasSummary -> Bool
== :: IndexAliasSummary -> IndexAliasSummary -> Bool
$c/= :: IndexAliasSummary -> IndexAliasSummary -> Bool
/= :: IndexAliasSummary -> IndexAliasSummary -> Bool
Eq, Int -> IndexAliasSummary -> ShowS
[IndexAliasSummary] -> ShowS
IndexAliasSummary -> String
(Int -> IndexAliasSummary -> ShowS)
-> (IndexAliasSummary -> String)
-> ([IndexAliasSummary] -> ShowS)
-> Show IndexAliasSummary
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> IndexAliasSummary -> ShowS
showsPrec :: Int -> IndexAliasSummary -> ShowS
$cshow :: IndexAliasSummary -> String
show :: IndexAliasSummary -> String
$cshowList :: [IndexAliasSummary] -> ShowS
showList :: [IndexAliasSummary] -> ShowS
Show)

indexAliasSummaryAliasLens :: Lens' IndexAliasSummary IndexAlias
indexAliasSummaryAliasLens :: Lens' IndexAliasSummary IndexAlias
indexAliasSummaryAliasLens = (IndexAliasSummary -> IndexAlias)
-> (IndexAliasSummary -> IndexAlias -> IndexAliasSummary)
-> Lens' IndexAliasSummary IndexAlias
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens IndexAliasSummary -> IndexAlias
indexAliasSummaryAlias (\IndexAliasSummary
x IndexAlias
y -> IndexAliasSummary
x {indexAliasSummaryAlias = y})

indexAliasSummaryCreateLens :: Lens' IndexAliasSummary IndexAliasCreate
indexAliasSummaryCreateLens :: Lens' IndexAliasSummary IndexAliasCreate
indexAliasSummaryCreateLens = (IndexAliasSummary -> IndexAliasCreate)
-> (IndexAliasSummary -> IndexAliasCreate -> IndexAliasSummary)
-> Lens' IndexAliasSummary IndexAliasCreate
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens IndexAliasSummary -> IndexAliasCreate
indexAliasSummaryCreate (\IndexAliasSummary
x IndexAliasCreate
y -> IndexAliasSummary
x {indexAliasSummaryCreate = y})

data JoinRelation
  = ParentDocument FieldName RelationName
  | ChildDocument FieldName RelationName DocId
  deriving stock (JoinRelation -> JoinRelation -> Bool
(JoinRelation -> JoinRelation -> Bool)
-> (JoinRelation -> JoinRelation -> Bool) -> Eq JoinRelation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: JoinRelation -> JoinRelation -> Bool
== :: JoinRelation -> JoinRelation -> Bool
$c/= :: JoinRelation -> JoinRelation -> Bool
/= :: JoinRelation -> JoinRelation -> Bool
Eq, Int -> JoinRelation -> ShowS
[JoinRelation] -> ShowS
JoinRelation -> String
(Int -> JoinRelation -> ShowS)
-> (JoinRelation -> String)
-> ([JoinRelation] -> ShowS)
-> Show JoinRelation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> JoinRelation -> ShowS
showsPrec :: Int -> JoinRelation -> ShowS
$cshow :: JoinRelation -> String
show :: JoinRelation -> String
$cshowList :: [JoinRelation] -> ShowS
showList :: [JoinRelation] -> ShowS
Show)

-- | 'IndexDocumentSettings' are special settings supplied when indexing
-- a document. For the best backwards compatiblity when new fields are
-- added, you should probably prefer to start with 'defaultIndexDocumentSettings'
data IndexDocumentSettings = IndexDocumentSettings
  { IndexDocumentSettings -> VersionControl
idsVersionControl :: VersionControl,
    IndexDocumentSettings -> Maybe JoinRelation
idsJoinRelation :: Maybe JoinRelation
  }
  deriving stock (IndexDocumentSettings -> IndexDocumentSettings -> Bool
(IndexDocumentSettings -> IndexDocumentSettings -> Bool)
-> (IndexDocumentSettings -> IndexDocumentSettings -> Bool)
-> Eq IndexDocumentSettings
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: IndexDocumentSettings -> IndexDocumentSettings -> Bool
== :: IndexDocumentSettings -> IndexDocumentSettings -> Bool
$c/= :: IndexDocumentSettings -> IndexDocumentSettings -> Bool
/= :: IndexDocumentSettings -> IndexDocumentSettings -> Bool
Eq, Int -> IndexDocumentSettings -> ShowS
[IndexDocumentSettings] -> ShowS
IndexDocumentSettings -> String
(Int -> IndexDocumentSettings -> ShowS)
-> (IndexDocumentSettings -> String)
-> ([IndexDocumentSettings] -> ShowS)
-> Show IndexDocumentSettings
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> IndexDocumentSettings -> ShowS
showsPrec :: Int -> IndexDocumentSettings -> ShowS
$cshow :: IndexDocumentSettings -> String
show :: IndexDocumentSettings -> String
$cshowList :: [IndexDocumentSettings] -> ShowS
showList :: [IndexDocumentSettings] -> ShowS
Show)

idsVersionControlLens :: Lens' IndexDocumentSettings VersionControl
idsVersionControlLens :: Lens' IndexDocumentSettings VersionControl
idsVersionControlLens = (IndexDocumentSettings -> VersionControl)
-> (IndexDocumentSettings
    -> VersionControl -> IndexDocumentSettings)
-> Lens' IndexDocumentSettings VersionControl
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens IndexDocumentSettings -> VersionControl
idsVersionControl (\IndexDocumentSettings
x VersionControl
y -> IndexDocumentSettings
x {idsVersionControl = y})

idsJoinRelationLens :: Lens' IndexDocumentSettings (Maybe JoinRelation)
idsJoinRelationLens :: Lens' IndexDocumentSettings (Maybe JoinRelation)
idsJoinRelationLens = (IndexDocumentSettings -> Maybe JoinRelation)
-> (IndexDocumentSettings
    -> Maybe JoinRelation -> IndexDocumentSettings)
-> Lens' IndexDocumentSettings (Maybe JoinRelation)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens IndexDocumentSettings -> Maybe JoinRelation
idsJoinRelation (\IndexDocumentSettings
x Maybe JoinRelation
y -> IndexDocumentSettings
x {idsJoinRelation = y})

-- | Reasonable default settings. Chooses no version control and no parent.
defaultIndexDocumentSettings :: IndexDocumentSettings
defaultIndexDocumentSettings :: IndexDocumentSettings
defaultIndexDocumentSettings = VersionControl -> Maybe JoinRelation -> IndexDocumentSettings
IndexDocumentSettings VersionControl
NoVersionControl Maybe JoinRelation
forall a. Maybe a
Nothing

-- | 'IndexSelection' is used for APIs which take a single index, a list of
--   indexes, or the special @_all@ index.

-- TODO: this does not fully support <https://www.elastic.co/guide/en/elasticsearch/reference/1.7/multi-index.html multi-index syntax>. It wouldn't be too hard to implement but you'd have to add the optional parameters (ignore_unavailable, allow_no_indices, expand_wildcards) to any APIs using it. Also would be a breaking API.
data IndexSelection
  = IndexList (NonEmpty IndexName)
  | AllIndexes
  deriving stock (IndexSelection -> IndexSelection -> Bool
(IndexSelection -> IndexSelection -> Bool)
-> (IndexSelection -> IndexSelection -> Bool) -> Eq IndexSelection
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: IndexSelection -> IndexSelection -> Bool
== :: IndexSelection -> IndexSelection -> Bool
$c/= :: IndexSelection -> IndexSelection -> Bool
/= :: IndexSelection -> IndexSelection -> Bool
Eq, Int -> IndexSelection -> ShowS
[IndexSelection] -> ShowS
IndexSelection -> String
(Int -> IndexSelection -> ShowS)
-> (IndexSelection -> String)
-> ([IndexSelection] -> ShowS)
-> Show IndexSelection
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> IndexSelection -> ShowS
showsPrec :: Int -> IndexSelection -> ShowS
$cshow :: IndexSelection -> String
show :: IndexSelection -> String
$cshowList :: [IndexSelection] -> ShowS
showList :: [IndexSelection] -> ShowS
Show)

-- | 'TemplateName' is used to describe which template to query/create/delete
newtype TemplateName = TemplateName Text deriving newtype (TemplateName -> TemplateName -> Bool
(TemplateName -> TemplateName -> Bool)
-> (TemplateName -> TemplateName -> Bool) -> Eq TemplateName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TemplateName -> TemplateName -> Bool
== :: TemplateName -> TemplateName -> Bool
$c/= :: TemplateName -> TemplateName -> Bool
/= :: TemplateName -> TemplateName -> Bool
Eq, Int -> TemplateName -> ShowS
[TemplateName] -> ShowS
TemplateName -> String
(Int -> TemplateName -> ShowS)
-> (TemplateName -> String)
-> ([TemplateName] -> ShowS)
-> Show TemplateName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TemplateName -> ShowS
showsPrec :: Int -> TemplateName -> ShowS
$cshow :: TemplateName -> String
show :: TemplateName -> String
$cshowList :: [TemplateName] -> ShowS
showList :: [TemplateName] -> ShowS
Show, [TemplateName] -> Value
[TemplateName] -> Encoding
TemplateName -> Bool
TemplateName -> Value
TemplateName -> Encoding
(TemplateName -> Value)
-> (TemplateName -> Encoding)
-> ([TemplateName] -> Value)
-> ([TemplateName] -> Encoding)
-> (TemplateName -> Bool)
-> ToJSON TemplateName
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: TemplateName -> Value
toJSON :: TemplateName -> Value
$ctoEncoding :: TemplateName -> Encoding
toEncoding :: TemplateName -> Encoding
$ctoJSONList :: [TemplateName] -> Value
toJSONList :: [TemplateName] -> Value
$ctoEncodingList :: [TemplateName] -> Encoding
toEncodingList :: [TemplateName] -> Encoding
$comitField :: TemplateName -> Bool
omitField :: TemplateName -> Bool
ToJSON, Maybe TemplateName
Value -> Parser [TemplateName]
Value -> Parser TemplateName
(Value -> Parser TemplateName)
-> (Value -> Parser [TemplateName])
-> Maybe TemplateName
-> FromJSON TemplateName
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser TemplateName
parseJSON :: Value -> Parser TemplateName
$cparseJSONList :: Value -> Parser [TemplateName]
parseJSONList :: Value -> Parser [TemplateName]
$comittedField :: Maybe TemplateName
omittedField :: Maybe TemplateName
FromJSON)

-- | 'IndexPattern' represents a pattern which is matched against index names
newtype IndexPattern = IndexPattern Text deriving newtype (IndexPattern -> IndexPattern -> Bool
(IndexPattern -> IndexPattern -> Bool)
-> (IndexPattern -> IndexPattern -> Bool) -> Eq IndexPattern
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: IndexPattern -> IndexPattern -> Bool
== :: IndexPattern -> IndexPattern -> Bool
$c/= :: IndexPattern -> IndexPattern -> Bool
/= :: IndexPattern -> IndexPattern -> Bool
Eq, Int -> IndexPattern -> ShowS
[IndexPattern] -> ShowS
IndexPattern -> String
(Int -> IndexPattern -> ShowS)
-> (IndexPattern -> String)
-> ([IndexPattern] -> ShowS)
-> Show IndexPattern
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> IndexPattern -> ShowS
showsPrec :: Int -> IndexPattern -> ShowS
$cshow :: IndexPattern -> String
show :: IndexPattern -> String
$cshowList :: [IndexPattern] -> ShowS
showList :: [IndexPattern] -> ShowS
Show, [IndexPattern] -> Value
[IndexPattern] -> Encoding
IndexPattern -> Bool
IndexPattern -> Value
IndexPattern -> Encoding
(IndexPattern -> Value)
-> (IndexPattern -> Encoding)
-> ([IndexPattern] -> Value)
-> ([IndexPattern] -> Encoding)
-> (IndexPattern -> Bool)
-> ToJSON IndexPattern
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: IndexPattern -> Value
toJSON :: IndexPattern -> Value
$ctoEncoding :: IndexPattern -> Encoding
toEncoding :: IndexPattern -> Encoding
$ctoJSONList :: [IndexPattern] -> Value
toJSONList :: [IndexPattern] -> Value
$ctoEncodingList :: [IndexPattern] -> Encoding
toEncodingList :: [IndexPattern] -> Encoding
$comitField :: IndexPattern -> Bool
omitField :: IndexPattern -> Bool
ToJSON, Maybe IndexPattern
Value -> Parser [IndexPattern]
Value -> Parser IndexPattern
(Value -> Parser IndexPattern)
-> (Value -> Parser [IndexPattern])
-> Maybe IndexPattern
-> FromJSON IndexPattern
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser IndexPattern
parseJSON :: Value -> Parser IndexPattern
$cparseJSONList :: Value -> Parser [IndexPattern]
parseJSONList :: Value -> Parser [IndexPattern]
$comittedField :: Maybe IndexPattern
omittedField :: Maybe IndexPattern
FromJSON)

-- * Utils

jsonObject :: (ToJSON a) => a -> Object
jsonObject :: forall a. ToJSON a => a -> Object
jsonObject a
x =
  case a -> Value
forall a. ToJSON a => a -> Value
toJSON a
x of
    Object Object
o -> Object
o
    Value
e -> String -> Object
forall a. HasCallStack => String -> a
error (String -> Object) -> String -> Object
forall a b. (a -> b) -> a -> b
$ String
"Expected Object, but got " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Value -> String
forall a. Show a => a -> String
show Value
e