{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}

module Database.Bloodhound.Internal.Versions.Common.Types.Snapshots
  ( FsSnapshotRepo (..),
    GenericSnapshotRepo (..),
    GenericSnapshotRepoSettings (..),
    RRGroupRefNum (..),
    RestoreIndexSettings (..),
    RestoreRenamePattern (..),
    RestoreRenameToken (..),
    SnapshotCreateSettings (..),
    SnapshotInfo (..),
    SnapshotNodeVerification (..),
    SnapshotPattern (..),
    SnapshotRepo (..),
    SnapshotRepoConversionError (..),
    SnapshotRepoName (..),
    SnapshotRepoPattern (..),
    SnapshotRepoSelection (..),
    SnapshotRepoType (..),
    SnapshotRepoUpdateSettings (..),
    SnapshotRestoreSettings (..),
    SnapshotSelection (..),
    SnapshotShardFailure (..),
    SnapshotState (..),
    SnapshotVerification (..),
    defaultSnapshotCreateSettings,
    defaultSnapshotRepoUpdateSettings,
    defaultSnapshotRestoreSettings,
    mkRRGroupRefNum,

    -- * Optics
    snapshotRepoNameLens,
    gSnapshotRepoNameLens,
    gSnapshotRepoTypeLens,
    gSnapshotRepoSettingsLens,
    snapshotRepoTypeLens,
    gSnapshotRepoSettingsObjectLens,
    snapshotNodeVerificationsLens,
    snvFullIdLens,
    snvNodeNameLens,
    snapRestoreWaitForCompletionLens,
    snapRestoreIndicesLens,
    snapRestoreIgnoreUnavailableLens,
    snapRestoreIncludeGlobalStateLens,
    snapRestoreRenamePatternLens,
    snapRestoreRenameReplacementLens,
    snapRestorePartialLens,
    snapRestoreIncludeAliasesLens,
    snapRestoreIndexSettingsOverridesLens,
    snapRestoreIgnoreIndexSettingsLens,
    repoUpdateVerifyLens,
    fsrNameLens,
    fsrLocationLens,
    fsrCompressMetadataLens,
    fsrChunkSizeLens,
    fsrMaxRestoreBytesPerSecLens,
    fsrMaxSnapshotBytesPerSecLens,
    snapWaitForCompletionLens,
    snapIndicesLens,
    snapIgnoreUnavailableLens,
    snapIncludeGlobalStateLens,
    snapPartialLens,
    snapInfoShardsLens,
    snapInfoFailuresLens,
    snapInfoDurationLens,
    snapInfoEndTimeLens,
    snapInfoStartTimeLens,
    snapInfoStateLens,
    snapInfoIndicesLens,
    snapInfoNameLens,
    snapShardFailureIndexLens,
    snapShardFailureNodeIdLens,
    snapShardFailureReasonLens,
    snapShardFailureShardIdLens,
    rrPatternLens,
    restoreOverrideReplicasLens,
  )
where

import Control.Monad.Catch
import qualified Data.Aeson.Key as X
import qualified Data.Aeson.KeyMap as X
import qualified Data.HashMap.Strict as HM
import qualified Data.Text as T
import Database.Bloodhound.Internal.Utils.Imports
import Database.Bloodhound.Internal.Utils.StringlyTyped
import Database.Bloodhound.Internal.Versions.Common.Types.Indices
import Database.Bloodhound.Internal.Versions.Common.Types.Newtypes
import Database.Bloodhound.Internal.Versions.Common.Types.Nodes
import Database.Bloodhound.Internal.Versions.Common.Types.Units
import GHC.Generics

data SnapshotRepoSelection
  = SnapshotRepoList (NonEmpty SnapshotRepoPattern)
  | AllSnapshotRepos
  deriving stock (SnapshotRepoSelection -> SnapshotRepoSelection -> Bool
(SnapshotRepoSelection -> SnapshotRepoSelection -> Bool)
-> (SnapshotRepoSelection -> SnapshotRepoSelection -> Bool)
-> Eq SnapshotRepoSelection
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SnapshotRepoSelection -> SnapshotRepoSelection -> Bool
== :: SnapshotRepoSelection -> SnapshotRepoSelection -> Bool
$c/= :: SnapshotRepoSelection -> SnapshotRepoSelection -> Bool
/= :: SnapshotRepoSelection -> SnapshotRepoSelection -> Bool
Eq, Int -> SnapshotRepoSelection -> ShowS
[SnapshotRepoSelection] -> ShowS
SnapshotRepoSelection -> String
(Int -> SnapshotRepoSelection -> ShowS)
-> (SnapshotRepoSelection -> String)
-> ([SnapshotRepoSelection] -> ShowS)
-> Show SnapshotRepoSelection
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SnapshotRepoSelection -> ShowS
showsPrec :: Int -> SnapshotRepoSelection -> ShowS
$cshow :: SnapshotRepoSelection -> String
show :: SnapshotRepoSelection -> String
$cshowList :: [SnapshotRepoSelection] -> ShowS
showList :: [SnapshotRepoSelection] -> ShowS
Show)

-- | Either specifies an exact repo name or one with globs in it,
-- e.g. @RepoPattern "foo*"@ __NOTE__: Patterns are not supported on ES < 1.7
data SnapshotRepoPattern
  = ExactRepo SnapshotRepoName
  | RepoPattern Text
  deriving stock (SnapshotRepoPattern -> SnapshotRepoPattern -> Bool
(SnapshotRepoPattern -> SnapshotRepoPattern -> Bool)
-> (SnapshotRepoPattern -> SnapshotRepoPattern -> Bool)
-> Eq SnapshotRepoPattern
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SnapshotRepoPattern -> SnapshotRepoPattern -> Bool
== :: SnapshotRepoPattern -> SnapshotRepoPattern -> Bool
$c/= :: SnapshotRepoPattern -> SnapshotRepoPattern -> Bool
/= :: SnapshotRepoPattern -> SnapshotRepoPattern -> Bool
Eq, Int -> SnapshotRepoPattern -> ShowS
[SnapshotRepoPattern] -> ShowS
SnapshotRepoPattern -> String
(Int -> SnapshotRepoPattern -> ShowS)
-> (SnapshotRepoPattern -> String)
-> ([SnapshotRepoPattern] -> ShowS)
-> Show SnapshotRepoPattern
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SnapshotRepoPattern -> ShowS
showsPrec :: Int -> SnapshotRepoPattern -> ShowS
$cshow :: SnapshotRepoPattern -> String
show :: SnapshotRepoPattern -> String
$cshowList :: [SnapshotRepoPattern] -> ShowS
showList :: [SnapshotRepoPattern] -> ShowS
Show)

-- | The unique name of a snapshot repository.
newtype SnapshotRepoName = SnapshotRepoName {SnapshotRepoName -> Text
snapshotRepoName :: Text}
  deriving newtype (SnapshotRepoName -> SnapshotRepoName -> Bool
(SnapshotRepoName -> SnapshotRepoName -> Bool)
-> (SnapshotRepoName -> SnapshotRepoName -> Bool)
-> Eq SnapshotRepoName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SnapshotRepoName -> SnapshotRepoName -> Bool
== :: SnapshotRepoName -> SnapshotRepoName -> Bool
$c/= :: SnapshotRepoName -> SnapshotRepoName -> Bool
/= :: SnapshotRepoName -> SnapshotRepoName -> Bool
Eq, Eq SnapshotRepoName
Eq SnapshotRepoName =>
(SnapshotRepoName -> SnapshotRepoName -> Ordering)
-> (SnapshotRepoName -> SnapshotRepoName -> Bool)
-> (SnapshotRepoName -> SnapshotRepoName -> Bool)
-> (SnapshotRepoName -> SnapshotRepoName -> Bool)
-> (SnapshotRepoName -> SnapshotRepoName -> Bool)
-> (SnapshotRepoName -> SnapshotRepoName -> SnapshotRepoName)
-> (SnapshotRepoName -> SnapshotRepoName -> SnapshotRepoName)
-> Ord SnapshotRepoName
SnapshotRepoName -> SnapshotRepoName -> Bool
SnapshotRepoName -> SnapshotRepoName -> Ordering
SnapshotRepoName -> SnapshotRepoName -> SnapshotRepoName
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: SnapshotRepoName -> SnapshotRepoName -> Ordering
compare :: SnapshotRepoName -> SnapshotRepoName -> Ordering
$c< :: SnapshotRepoName -> SnapshotRepoName -> Bool
< :: SnapshotRepoName -> SnapshotRepoName -> Bool
$c<= :: SnapshotRepoName -> SnapshotRepoName -> Bool
<= :: SnapshotRepoName -> SnapshotRepoName -> Bool
$c> :: SnapshotRepoName -> SnapshotRepoName -> Bool
> :: SnapshotRepoName -> SnapshotRepoName -> Bool
$c>= :: SnapshotRepoName -> SnapshotRepoName -> Bool
>= :: SnapshotRepoName -> SnapshotRepoName -> Bool
$cmax :: SnapshotRepoName -> SnapshotRepoName -> SnapshotRepoName
max :: SnapshotRepoName -> SnapshotRepoName -> SnapshotRepoName
$cmin :: SnapshotRepoName -> SnapshotRepoName -> SnapshotRepoName
min :: SnapshotRepoName -> SnapshotRepoName -> SnapshotRepoName
Ord, Int -> SnapshotRepoName -> ShowS
[SnapshotRepoName] -> ShowS
SnapshotRepoName -> String
(Int -> SnapshotRepoName -> ShowS)
-> (SnapshotRepoName -> String)
-> ([SnapshotRepoName] -> ShowS)
-> Show SnapshotRepoName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SnapshotRepoName -> ShowS
showsPrec :: Int -> SnapshotRepoName -> ShowS
$cshow :: SnapshotRepoName -> String
show :: SnapshotRepoName -> String
$cshowList :: [SnapshotRepoName] -> ShowS
showList :: [SnapshotRepoName] -> ShowS
Show, [SnapshotRepoName] -> Value
[SnapshotRepoName] -> Encoding
SnapshotRepoName -> Bool
SnapshotRepoName -> Value
SnapshotRepoName -> Encoding
(SnapshotRepoName -> Value)
-> (SnapshotRepoName -> Encoding)
-> ([SnapshotRepoName] -> Value)
-> ([SnapshotRepoName] -> Encoding)
-> (SnapshotRepoName -> Bool)
-> ToJSON SnapshotRepoName
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: SnapshotRepoName -> Value
toJSON :: SnapshotRepoName -> Value
$ctoEncoding :: SnapshotRepoName -> Encoding
toEncoding :: SnapshotRepoName -> Encoding
$ctoJSONList :: [SnapshotRepoName] -> Value
toJSONList :: [SnapshotRepoName] -> Value
$ctoEncodingList :: [SnapshotRepoName] -> Encoding
toEncodingList :: [SnapshotRepoName] -> Encoding
$comitField :: SnapshotRepoName -> Bool
omitField :: SnapshotRepoName -> Bool
ToJSON, Maybe SnapshotRepoName
Value -> Parser [SnapshotRepoName]
Value -> Parser SnapshotRepoName
(Value -> Parser SnapshotRepoName)
-> (Value -> Parser [SnapshotRepoName])
-> Maybe SnapshotRepoName
-> FromJSON SnapshotRepoName
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser SnapshotRepoName
parseJSON :: Value -> Parser SnapshotRepoName
$cparseJSONList :: Value -> Parser [SnapshotRepoName]
parseJSONList :: Value -> Parser [SnapshotRepoName]
$comittedField :: Maybe SnapshotRepoName
omittedField :: Maybe SnapshotRepoName
FromJSON)

snapshotRepoNameLens :: Lens' SnapshotRepoName Text
snapshotRepoNameLens :: Lens' SnapshotRepoName Text
snapshotRepoNameLens = (SnapshotRepoName -> Text)
-> (SnapshotRepoName -> Text -> SnapshotRepoName)
-> Lens' SnapshotRepoName Text
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens SnapshotRepoName -> Text
snapshotRepoName (\SnapshotRepoName
x Text
y -> SnapshotRepoName
x {snapshotRepoName = y})

-- | A generic representation of a snapshot repo. This is what gets
-- sent to and parsed from the server. For repo types enabled by
-- plugins that aren't exported by this library, consider making a
-- custom type which implements 'SnapshotRepo'. If it is a common repo
-- type, consider submitting a pull request to have it included in the
-- library proper
data GenericSnapshotRepo = GenericSnapshotRepo
  { GenericSnapshotRepo -> SnapshotRepoName
gSnapshotRepoName :: SnapshotRepoName,
    GenericSnapshotRepo -> SnapshotRepoType
gSnapshotRepoType :: SnapshotRepoType,
    GenericSnapshotRepo -> GenericSnapshotRepoSettings
gSnapshotRepoSettings :: GenericSnapshotRepoSettings
  }
  deriving stock (GenericSnapshotRepo -> GenericSnapshotRepo -> Bool
(GenericSnapshotRepo -> GenericSnapshotRepo -> Bool)
-> (GenericSnapshotRepo -> GenericSnapshotRepo -> Bool)
-> Eq GenericSnapshotRepo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GenericSnapshotRepo -> GenericSnapshotRepo -> Bool
== :: GenericSnapshotRepo -> GenericSnapshotRepo -> Bool
$c/= :: GenericSnapshotRepo -> GenericSnapshotRepo -> Bool
/= :: GenericSnapshotRepo -> GenericSnapshotRepo -> Bool
Eq, Int -> GenericSnapshotRepo -> ShowS
[GenericSnapshotRepo] -> ShowS
GenericSnapshotRepo -> String
(Int -> GenericSnapshotRepo -> ShowS)
-> (GenericSnapshotRepo -> String)
-> ([GenericSnapshotRepo] -> ShowS)
-> Show GenericSnapshotRepo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GenericSnapshotRepo -> ShowS
showsPrec :: Int -> GenericSnapshotRepo -> ShowS
$cshow :: GenericSnapshotRepo -> String
show :: GenericSnapshotRepo -> String
$cshowList :: [GenericSnapshotRepo] -> ShowS
showList :: [GenericSnapshotRepo] -> ShowS
Show)

instance SnapshotRepo GenericSnapshotRepo where
  toGSnapshotRepo :: GenericSnapshotRepo -> GenericSnapshotRepo
toGSnapshotRepo = GenericSnapshotRepo -> GenericSnapshotRepo
forall a. a -> a
id
  fromGSnapshotRepo :: GenericSnapshotRepo
-> Either SnapshotRepoConversionError GenericSnapshotRepo
fromGSnapshotRepo = GenericSnapshotRepo
-> Either SnapshotRepoConversionError GenericSnapshotRepo
forall a b. b -> Either a b
Right

gSnapshotRepoNameLens :: Lens' GenericSnapshotRepo SnapshotRepoName
gSnapshotRepoNameLens :: Lens' GenericSnapshotRepo SnapshotRepoName
gSnapshotRepoNameLens = (GenericSnapshotRepo -> SnapshotRepoName)
-> (GenericSnapshotRepo -> SnapshotRepoName -> GenericSnapshotRepo)
-> Lens' GenericSnapshotRepo SnapshotRepoName
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens GenericSnapshotRepo -> SnapshotRepoName
gSnapshotRepoName (\GenericSnapshotRepo
x SnapshotRepoName
y -> GenericSnapshotRepo
x {gSnapshotRepoName = y})

gSnapshotRepoTypeLens :: Lens' GenericSnapshotRepo SnapshotRepoType
gSnapshotRepoTypeLens :: Lens' GenericSnapshotRepo SnapshotRepoType
gSnapshotRepoTypeLens = (GenericSnapshotRepo -> SnapshotRepoType)
-> (GenericSnapshotRepo -> SnapshotRepoType -> GenericSnapshotRepo)
-> Lens' GenericSnapshotRepo SnapshotRepoType
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens GenericSnapshotRepo -> SnapshotRepoType
gSnapshotRepoType (\GenericSnapshotRepo
x SnapshotRepoType
y -> GenericSnapshotRepo
x {gSnapshotRepoType = y})

gSnapshotRepoSettingsLens :: Lens' GenericSnapshotRepo GenericSnapshotRepoSettings
gSnapshotRepoSettingsLens :: Lens' GenericSnapshotRepo GenericSnapshotRepoSettings
gSnapshotRepoSettingsLens = (GenericSnapshotRepo -> GenericSnapshotRepoSettings)
-> (GenericSnapshotRepo
    -> GenericSnapshotRepoSettings -> GenericSnapshotRepo)
-> Lens' GenericSnapshotRepo GenericSnapshotRepoSettings
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens GenericSnapshotRepo -> GenericSnapshotRepoSettings
gSnapshotRepoSettings (\GenericSnapshotRepo
x GenericSnapshotRepoSettings
y -> GenericSnapshotRepo
x {gSnapshotRepoSettings = y})

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

snapshotRepoTypeLens :: Lens' SnapshotRepoType Text
snapshotRepoTypeLens :: Lens' SnapshotRepoType Text
snapshotRepoTypeLens = (SnapshotRepoType -> Text)
-> (SnapshotRepoType -> Text -> SnapshotRepoType)
-> Lens' SnapshotRepoType Text
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens SnapshotRepoType -> Text
snapshotRepoType (\SnapshotRepoType
x Text
y -> SnapshotRepoType
x {snapshotRepoType = y})

-- | Opaque representation of snapshot repo settings. Instances of
-- 'SnapshotRepo' will produce this.
newtype GenericSnapshotRepoSettings = GenericSnapshotRepoSettings {GenericSnapshotRepoSettings -> Object
gSnapshotRepoSettingsObject :: Object}
  deriving newtype (GenericSnapshotRepoSettings -> GenericSnapshotRepoSettings -> Bool
(GenericSnapshotRepoSettings
 -> GenericSnapshotRepoSettings -> Bool)
-> (GenericSnapshotRepoSettings
    -> GenericSnapshotRepoSettings -> Bool)
-> Eq GenericSnapshotRepoSettings
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GenericSnapshotRepoSettings -> GenericSnapshotRepoSettings -> Bool
== :: GenericSnapshotRepoSettings -> GenericSnapshotRepoSettings -> Bool
$c/= :: GenericSnapshotRepoSettings -> GenericSnapshotRepoSettings -> Bool
/= :: GenericSnapshotRepoSettings -> GenericSnapshotRepoSettings -> Bool
Eq, Int -> GenericSnapshotRepoSettings -> ShowS
[GenericSnapshotRepoSettings] -> ShowS
GenericSnapshotRepoSettings -> String
(Int -> GenericSnapshotRepoSettings -> ShowS)
-> (GenericSnapshotRepoSettings -> String)
-> ([GenericSnapshotRepoSettings] -> ShowS)
-> Show GenericSnapshotRepoSettings
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GenericSnapshotRepoSettings -> ShowS
showsPrec :: Int -> GenericSnapshotRepoSettings -> ShowS
$cshow :: GenericSnapshotRepoSettings -> String
show :: GenericSnapshotRepoSettings -> String
$cshowList :: [GenericSnapshotRepoSettings] -> ShowS
showList :: [GenericSnapshotRepoSettings] -> ShowS
Show, [GenericSnapshotRepoSettings] -> Value
[GenericSnapshotRepoSettings] -> Encoding
GenericSnapshotRepoSettings -> Bool
GenericSnapshotRepoSettings -> Value
GenericSnapshotRepoSettings -> Encoding
(GenericSnapshotRepoSettings -> Value)
-> (GenericSnapshotRepoSettings -> Encoding)
-> ([GenericSnapshotRepoSettings] -> Value)
-> ([GenericSnapshotRepoSettings] -> Encoding)
-> (GenericSnapshotRepoSettings -> Bool)
-> ToJSON GenericSnapshotRepoSettings
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: GenericSnapshotRepoSettings -> Value
toJSON :: GenericSnapshotRepoSettings -> Value
$ctoEncoding :: GenericSnapshotRepoSettings -> Encoding
toEncoding :: GenericSnapshotRepoSettings -> Encoding
$ctoJSONList :: [GenericSnapshotRepoSettings] -> Value
toJSONList :: [GenericSnapshotRepoSettings] -> Value
$ctoEncodingList :: [GenericSnapshotRepoSettings] -> Encoding
toEncodingList :: [GenericSnapshotRepoSettings] -> Encoding
$comitField :: GenericSnapshotRepoSettings -> Bool
omitField :: GenericSnapshotRepoSettings -> Bool
ToJSON)

-- Regardless of whether you send strongly typed json, my version of
-- ES sends back stringly typed json in the settings, e.g. booleans
-- as strings, so we'll try to convert them.
instance FromJSON GenericSnapshotRepoSettings where
  parseJSON :: Value -> Parser GenericSnapshotRepoSettings
parseJSON = (Object -> GenericSnapshotRepoSettings)
-> Parser Object -> Parser GenericSnapshotRepoSettings
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Object -> GenericSnapshotRepoSettings
GenericSnapshotRepoSettings (Object -> GenericSnapshotRepoSettings)
-> (Object -> Object) -> Object -> GenericSnapshotRepoSettings
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value -> Value) -> Object -> Object
forall a b. (a -> b) -> KeyMap a -> KeyMap b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Value -> Value
unStringlyTypeJSON) (Parser Object -> Parser GenericSnapshotRepoSettings)
-> (Value -> Parser Object)
-> Value
-> Parser GenericSnapshotRepoSettings
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser Object
forall a. FromJSON a => Value -> Parser a
parseJSON

gSnapshotRepoSettingsObjectLens :: Lens' GenericSnapshotRepoSettings Object
gSnapshotRepoSettingsObjectLens :: Lens' GenericSnapshotRepoSettings Object
gSnapshotRepoSettingsObjectLens = (GenericSnapshotRepoSettings -> Object)
-> (GenericSnapshotRepoSettings
    -> Object -> GenericSnapshotRepoSettings)
-> Lens' GenericSnapshotRepoSettings Object
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens GenericSnapshotRepoSettings -> Object
gSnapshotRepoSettingsObject (\GenericSnapshotRepoSettings
x Object
y -> GenericSnapshotRepoSettings
x {gSnapshotRepoSettingsObject = y})

-- | The result of running 'verifySnapshotRepo'.
newtype SnapshotVerification = SnapshotVerification
  { SnapshotVerification -> [SnapshotNodeVerification]
snapshotNodeVerifications :: [SnapshotNodeVerification]
  }
  deriving stock (SnapshotVerification -> SnapshotVerification -> Bool
(SnapshotVerification -> SnapshotVerification -> Bool)
-> (SnapshotVerification -> SnapshotVerification -> Bool)
-> Eq SnapshotVerification
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SnapshotVerification -> SnapshotVerification -> Bool
== :: SnapshotVerification -> SnapshotVerification -> Bool
$c/= :: SnapshotVerification -> SnapshotVerification -> Bool
/= :: SnapshotVerification -> SnapshotVerification -> Bool
Eq, Int -> SnapshotVerification -> ShowS
[SnapshotVerification] -> ShowS
SnapshotVerification -> String
(Int -> SnapshotVerification -> ShowS)
-> (SnapshotVerification -> String)
-> ([SnapshotVerification] -> ShowS)
-> Show SnapshotVerification
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SnapshotVerification -> ShowS
showsPrec :: Int -> SnapshotVerification -> ShowS
$cshow :: SnapshotVerification -> String
show :: SnapshotVerification -> String
$cshowList :: [SnapshotVerification] -> ShowS
showList :: [SnapshotVerification] -> ShowS
Show)

instance FromJSON SnapshotVerification where
  parseJSON :: Value -> Parser SnapshotVerification
parseJSON = String
-> (Object -> Parser SnapshotVerification)
-> Value
-> Parser SnapshotVerification
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"SnapshotVerification" Object -> Parser SnapshotVerification
parse
    where
      parse :: Object -> Parser SnapshotVerification
parse Object
o = do
        HashMap Text Value
o2 <- Object
o Object -> Key -> Parser (HashMap Text Value)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"nodes"
        [SnapshotNodeVerification] -> SnapshotVerification
SnapshotVerification ([SnapshotNodeVerification] -> SnapshotVerification)
-> Parser [SnapshotNodeVerification] -> Parser SnapshotVerification
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Text, Value) -> Parser SnapshotNodeVerification)
-> [(Text, Value)] -> Parser [SnapshotNodeVerification]
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 ((Text -> Value -> Parser SnapshotNodeVerification)
-> (Text, Value) -> Parser SnapshotNodeVerification
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Text -> Value -> Parser SnapshotNodeVerification
parse') (HashMap Text Value -> [(Text, Value)]
forall k v. HashMap k v -> [(k, v)]
HM.toList HashMap Text Value
o2)
      parse' :: Text -> Value -> Parser SnapshotNodeVerification
parse' Text
rawFullId = String
-> (Object -> Parser SnapshotNodeVerification)
-> Value
-> Parser SnapshotNodeVerification
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"SnapshotNodeVerification" ((Object -> Parser SnapshotNodeVerification)
 -> Value -> Parser SnapshotNodeVerification)
-> (Object -> Parser SnapshotNodeVerification)
-> Value
-> Parser SnapshotNodeVerification
forall a b. (a -> b) -> a -> b
$ \Object
o ->
        FullNodeId -> NodeName -> SnapshotNodeVerification
SnapshotNodeVerification (Text -> FullNodeId
FullNodeId Text
rawFullId) (NodeName -> SnapshotNodeVerification)
-> Parser NodeName -> Parser SnapshotNodeVerification
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser NodeName
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"

snapshotNodeVerificationsLens :: Lens' SnapshotVerification [SnapshotNodeVerification]
snapshotNodeVerificationsLens :: Lens' SnapshotVerification [SnapshotNodeVerification]
snapshotNodeVerificationsLens = (SnapshotVerification -> [SnapshotNodeVerification])
-> (SnapshotVerification
    -> [SnapshotNodeVerification] -> SnapshotVerification)
-> Lens' SnapshotVerification [SnapshotNodeVerification]
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens SnapshotVerification -> [SnapshotNodeVerification]
snapshotNodeVerifications (\SnapshotVerification
x [SnapshotNodeVerification]
y -> SnapshotVerification
x {snapshotNodeVerifications = y})

-- | A node that has verified a snapshot
data SnapshotNodeVerification = SnapshotNodeVerification
  { SnapshotNodeVerification -> FullNodeId
snvFullId :: FullNodeId,
    SnapshotNodeVerification -> NodeName
snvNodeName :: NodeName
  }
  deriving stock (SnapshotNodeVerification -> SnapshotNodeVerification -> Bool
(SnapshotNodeVerification -> SnapshotNodeVerification -> Bool)
-> (SnapshotNodeVerification -> SnapshotNodeVerification -> Bool)
-> Eq SnapshotNodeVerification
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SnapshotNodeVerification -> SnapshotNodeVerification -> Bool
== :: SnapshotNodeVerification -> SnapshotNodeVerification -> Bool
$c/= :: SnapshotNodeVerification -> SnapshotNodeVerification -> Bool
/= :: SnapshotNodeVerification -> SnapshotNodeVerification -> Bool
Eq, Int -> SnapshotNodeVerification -> ShowS
[SnapshotNodeVerification] -> ShowS
SnapshotNodeVerification -> String
(Int -> SnapshotNodeVerification -> ShowS)
-> (SnapshotNodeVerification -> String)
-> ([SnapshotNodeVerification] -> ShowS)
-> Show SnapshotNodeVerification
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SnapshotNodeVerification -> ShowS
showsPrec :: Int -> SnapshotNodeVerification -> ShowS
$cshow :: SnapshotNodeVerification -> String
show :: SnapshotNodeVerification -> String
$cshowList :: [SnapshotNodeVerification] -> ShowS
showList :: [SnapshotNodeVerification] -> ShowS
Show)

snvFullIdLens :: Lens' SnapshotNodeVerification FullNodeId
snvFullIdLens :: Lens' SnapshotNodeVerification FullNodeId
snvFullIdLens = (SnapshotNodeVerification -> FullNodeId)
-> (SnapshotNodeVerification
    -> FullNodeId -> SnapshotNodeVerification)
-> Lens' SnapshotNodeVerification FullNodeId
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens SnapshotNodeVerification -> FullNodeId
snvFullId (\SnapshotNodeVerification
x FullNodeId
y -> SnapshotNodeVerification
x {snvFullId = y})

snvNodeNameLens :: Lens' SnapshotNodeVerification NodeName
snvNodeNameLens :: Lens' SnapshotNodeVerification NodeName
snvNodeNameLens = (SnapshotNodeVerification -> NodeName)
-> (SnapshotNodeVerification
    -> NodeName -> SnapshotNodeVerification)
-> Lens' SnapshotNodeVerification NodeName
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens SnapshotNodeVerification -> NodeName
snvNodeName (\SnapshotNodeVerification
x NodeName
y -> SnapshotNodeVerification
x {snvNodeName = y})

data SnapshotState
  = SnapshotInit
  | SnapshotStarted
  | SnapshotSuccess
  | SnapshotFailed
  | SnapshotAborted
  | SnapshotMissing
  | SnapshotWaiting
  deriving stock (SnapshotState -> SnapshotState -> Bool
(SnapshotState -> SnapshotState -> Bool)
-> (SnapshotState -> SnapshotState -> Bool) -> Eq SnapshotState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SnapshotState -> SnapshotState -> Bool
== :: SnapshotState -> SnapshotState -> Bool
$c/= :: SnapshotState -> SnapshotState -> Bool
/= :: SnapshotState -> SnapshotState -> Bool
Eq, Int -> SnapshotState -> ShowS
[SnapshotState] -> ShowS
SnapshotState -> String
(Int -> SnapshotState -> ShowS)
-> (SnapshotState -> String)
-> ([SnapshotState] -> ShowS)
-> Show SnapshotState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SnapshotState -> ShowS
showsPrec :: Int -> SnapshotState -> ShowS
$cshow :: SnapshotState -> String
show :: SnapshotState -> String
$cshowList :: [SnapshotState] -> ShowS
showList :: [SnapshotState] -> ShowS
Show)

instance FromJSON SnapshotState where
  parseJSON :: Value -> Parser SnapshotState
parseJSON = String
-> (Text -> Parser SnapshotState) -> Value -> Parser SnapshotState
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"SnapshotState" Text -> Parser SnapshotState
forall {m :: * -> *}. MonadFail m => Text -> m SnapshotState
parse
    where
      parse :: Text -> m SnapshotState
parse Text
"INIT" = SnapshotState -> m SnapshotState
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return SnapshotState
SnapshotInit
      parse Text
"STARTED" = SnapshotState -> m SnapshotState
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return SnapshotState
SnapshotStarted
      parse Text
"SUCCESS" = SnapshotState -> m SnapshotState
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return SnapshotState
SnapshotSuccess
      parse Text
"FAILED" = SnapshotState -> m SnapshotState
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return SnapshotState
SnapshotFailed
      parse Text
"ABORTED" = SnapshotState -> m SnapshotState
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return SnapshotState
SnapshotAborted
      parse Text
"MISSING" = SnapshotState -> m SnapshotState
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return SnapshotState
SnapshotMissing
      parse Text
"WAITING" = SnapshotState -> m SnapshotState
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return SnapshotState
SnapshotWaiting
      parse Text
t = String -> m SnapshotState
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Invalid snapshot state " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
t)

data SnapshotRestoreSettings = SnapshotRestoreSettings
  { -- | Should the API call return immediately after initializing
    -- the restore or wait until completed? Note that if this is
    -- enabled, it could wait a long time, so you should adjust your
    -- 'ManagerSettings' accordingly to set long timeouts or
    -- explicitly handle timeouts.
    SnapshotRestoreSettings -> Bool
snapRestoreWaitForCompletion :: Bool,
    -- | Nothing will restore all indices in the snapshot. Just [] is
    -- permissable and will essentially be a no-op restore.
    SnapshotRestoreSettings -> Maybe IndexSelection
snapRestoreIndices :: Maybe IndexSelection,
    -- | If set to True, any indices that do not exist will be ignored
    -- during snapshot rather than failing the restore.
    SnapshotRestoreSettings -> Bool
snapRestoreIgnoreUnavailable :: Bool,
    -- | If set to false, will ignore any global state in the snapshot
    -- and will not restore it.
    SnapshotRestoreSettings -> Bool
snapRestoreIncludeGlobalState :: Bool,
    -- | A regex pattern for matching indices. Used with
    -- 'snapRestoreRenameReplacement', the restore can reference the
    -- matched index and create a new index name upon restore.
    SnapshotRestoreSettings -> Maybe RestoreRenamePattern
snapRestoreRenamePattern :: Maybe RestoreRenamePattern,
    -- | Expression of how index renames should be constructed.
    SnapshotRestoreSettings -> Maybe (NonEmpty RestoreRenameToken)
snapRestoreRenameReplacement :: Maybe (NonEmpty RestoreRenameToken),
    -- | If some indices fail to restore, should the process proceed?
    SnapshotRestoreSettings -> Bool
snapRestorePartial :: Bool,
    -- | Should the restore also restore the aliases captured in the
    -- snapshot.
    SnapshotRestoreSettings -> Bool
snapRestoreIncludeAliases :: Bool,
    -- | Settings to apply during the restore process. __NOTE:__ This
    -- option is not supported in ES < 1.5 and should be set to
    -- Nothing in that case.
    SnapshotRestoreSettings -> Maybe RestoreIndexSettings
snapRestoreIndexSettingsOverrides :: Maybe RestoreIndexSettings,
    -- | This type could be more rich but it isn't clear which
    -- settings are allowed to be ignored during restore, so we're
    -- going with including this feature in a basic form rather than
    -- omitting it. One example here would be
    -- "index.refresh_interval". Any setting specified here will
    -- revert back to the server default during the restore process.
    SnapshotRestoreSettings -> Maybe (NonEmpty Text)
snapRestoreIgnoreIndexSettings :: Maybe (NonEmpty Text)
  }
  deriving stock (SnapshotRestoreSettings -> SnapshotRestoreSettings -> Bool
(SnapshotRestoreSettings -> SnapshotRestoreSettings -> Bool)
-> (SnapshotRestoreSettings -> SnapshotRestoreSettings -> Bool)
-> Eq SnapshotRestoreSettings
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SnapshotRestoreSettings -> SnapshotRestoreSettings -> Bool
== :: SnapshotRestoreSettings -> SnapshotRestoreSettings -> Bool
$c/= :: SnapshotRestoreSettings -> SnapshotRestoreSettings -> Bool
/= :: SnapshotRestoreSettings -> SnapshotRestoreSettings -> Bool
Eq, Int -> SnapshotRestoreSettings -> ShowS
[SnapshotRestoreSettings] -> ShowS
SnapshotRestoreSettings -> String
(Int -> SnapshotRestoreSettings -> ShowS)
-> (SnapshotRestoreSettings -> String)
-> ([SnapshotRestoreSettings] -> ShowS)
-> Show SnapshotRestoreSettings
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SnapshotRestoreSettings -> ShowS
showsPrec :: Int -> SnapshotRestoreSettings -> ShowS
$cshow :: SnapshotRestoreSettings -> String
show :: SnapshotRestoreSettings -> String
$cshowList :: [SnapshotRestoreSettings] -> ShowS
showList :: [SnapshotRestoreSettings] -> ShowS
Show)

snapRestoreWaitForCompletionLens :: Lens' SnapshotRestoreSettings Bool
snapRestoreWaitForCompletionLens :: Lens' SnapshotRestoreSettings Bool
snapRestoreWaitForCompletionLens = (SnapshotRestoreSettings -> Bool)
-> (SnapshotRestoreSettings -> Bool -> SnapshotRestoreSettings)
-> Lens' SnapshotRestoreSettings Bool
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens SnapshotRestoreSettings -> Bool
snapRestoreWaitForCompletion (\SnapshotRestoreSettings
x Bool
y -> SnapshotRestoreSettings
x {snapRestoreWaitForCompletion = y})

snapRestoreIndicesLens :: Lens' SnapshotRestoreSettings (Maybe IndexSelection)
snapRestoreIndicesLens :: Lens' SnapshotRestoreSettings (Maybe IndexSelection)
snapRestoreIndicesLens = (SnapshotRestoreSettings -> Maybe IndexSelection)
-> (SnapshotRestoreSettings
    -> Maybe IndexSelection -> SnapshotRestoreSettings)
-> Lens' SnapshotRestoreSettings (Maybe IndexSelection)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens SnapshotRestoreSettings -> Maybe IndexSelection
snapRestoreIndices (\SnapshotRestoreSettings
x Maybe IndexSelection
y -> SnapshotRestoreSettings
x {snapRestoreIndices = y})

snapRestoreIgnoreUnavailableLens :: Lens' SnapshotRestoreSettings Bool
snapRestoreIgnoreUnavailableLens :: Lens' SnapshotRestoreSettings Bool
snapRestoreIgnoreUnavailableLens = (SnapshotRestoreSettings -> Bool)
-> (SnapshotRestoreSettings -> Bool -> SnapshotRestoreSettings)
-> Lens' SnapshotRestoreSettings Bool
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens SnapshotRestoreSettings -> Bool
snapRestoreIgnoreUnavailable (\SnapshotRestoreSettings
x Bool
y -> SnapshotRestoreSettings
x {snapRestoreIgnoreUnavailable = y})

snapRestoreIncludeGlobalStateLens :: Lens' SnapshotRestoreSettings Bool
snapRestoreIncludeGlobalStateLens :: Lens' SnapshotRestoreSettings Bool
snapRestoreIncludeGlobalStateLens = (SnapshotRestoreSettings -> Bool)
-> (SnapshotRestoreSettings -> Bool -> SnapshotRestoreSettings)
-> Lens' SnapshotRestoreSettings Bool
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens SnapshotRestoreSettings -> Bool
snapRestoreIncludeGlobalState (\SnapshotRestoreSettings
x Bool
y -> SnapshotRestoreSettings
x {snapRestoreIncludeGlobalState = y})

snapRestoreRenamePatternLens :: Lens' SnapshotRestoreSettings (Maybe RestoreRenamePattern)
snapRestoreRenamePatternLens :: Lens' SnapshotRestoreSettings (Maybe RestoreRenamePattern)
snapRestoreRenamePatternLens = (SnapshotRestoreSettings -> Maybe RestoreRenamePattern)
-> (SnapshotRestoreSettings
    -> Maybe RestoreRenamePattern -> SnapshotRestoreSettings)
-> Lens' SnapshotRestoreSettings (Maybe RestoreRenamePattern)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens SnapshotRestoreSettings -> Maybe RestoreRenamePattern
snapRestoreRenamePattern (\SnapshotRestoreSettings
x Maybe RestoreRenamePattern
y -> SnapshotRestoreSettings
x {snapRestoreRenamePattern = y})

snapRestoreRenameReplacementLens :: Lens' SnapshotRestoreSettings (Maybe (NonEmpty RestoreRenameToken))
snapRestoreRenameReplacementLens :: Lens' SnapshotRestoreSettings (Maybe (NonEmpty RestoreRenameToken))
snapRestoreRenameReplacementLens = (SnapshotRestoreSettings -> Maybe (NonEmpty RestoreRenameToken))
-> (SnapshotRestoreSettings
    -> Maybe (NonEmpty RestoreRenameToken) -> SnapshotRestoreSettings)
-> Lens'
     SnapshotRestoreSettings (Maybe (NonEmpty RestoreRenameToken))
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens SnapshotRestoreSettings -> Maybe (NonEmpty RestoreRenameToken)
snapRestoreRenameReplacement (\SnapshotRestoreSettings
x Maybe (NonEmpty RestoreRenameToken)
y -> SnapshotRestoreSettings
x {snapRestoreRenameReplacement = y})

snapRestorePartialLens :: Lens' SnapshotRestoreSettings Bool
snapRestorePartialLens :: Lens' SnapshotRestoreSettings Bool
snapRestorePartialLens = (SnapshotRestoreSettings -> Bool)
-> (SnapshotRestoreSettings -> Bool -> SnapshotRestoreSettings)
-> Lens' SnapshotRestoreSettings Bool
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens SnapshotRestoreSettings -> Bool
snapRestorePartial (\SnapshotRestoreSettings
x Bool
y -> SnapshotRestoreSettings
x {snapRestorePartial = y})

snapRestoreIncludeAliasesLens :: Lens' SnapshotRestoreSettings Bool
snapRestoreIncludeAliasesLens :: Lens' SnapshotRestoreSettings Bool
snapRestoreIncludeAliasesLens = (SnapshotRestoreSettings -> Bool)
-> (SnapshotRestoreSettings -> Bool -> SnapshotRestoreSettings)
-> Lens' SnapshotRestoreSettings Bool
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens SnapshotRestoreSettings -> Bool
snapRestoreIncludeAliases (\SnapshotRestoreSettings
x Bool
y -> SnapshotRestoreSettings
x {snapRestoreIncludeAliases = y})

snapRestoreIndexSettingsOverridesLens :: Lens' SnapshotRestoreSettings (Maybe RestoreIndexSettings)
snapRestoreIndexSettingsOverridesLens :: Lens' SnapshotRestoreSettings (Maybe RestoreIndexSettings)
snapRestoreIndexSettingsOverridesLens = (SnapshotRestoreSettings -> Maybe RestoreIndexSettings)
-> (SnapshotRestoreSettings
    -> Maybe RestoreIndexSettings -> SnapshotRestoreSettings)
-> Lens' SnapshotRestoreSettings (Maybe RestoreIndexSettings)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens SnapshotRestoreSettings -> Maybe RestoreIndexSettings
snapRestoreIndexSettingsOverrides (\SnapshotRestoreSettings
x Maybe RestoreIndexSettings
y -> SnapshotRestoreSettings
x {snapRestoreIndexSettingsOverrides = y})

snapRestoreIgnoreIndexSettingsLens :: Lens' SnapshotRestoreSettings (Maybe (NonEmpty Text))
snapRestoreIgnoreIndexSettingsLens :: Lens' SnapshotRestoreSettings (Maybe (NonEmpty Text))
snapRestoreIgnoreIndexSettingsLens = (SnapshotRestoreSettings -> Maybe (NonEmpty Text))
-> (SnapshotRestoreSettings
    -> Maybe (NonEmpty Text) -> SnapshotRestoreSettings)
-> Lens' SnapshotRestoreSettings (Maybe (NonEmpty Text))
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens SnapshotRestoreSettings -> Maybe (NonEmpty Text)
snapRestoreIgnoreIndexSettings (\SnapshotRestoreSettings
x Maybe (NonEmpty Text)
y -> SnapshotRestoreSettings
x {snapRestoreIgnoreIndexSettings = y})

newtype SnapshotRepoUpdateSettings = SnapshotRepoUpdateSettings
  { -- | After creation/update, synchronously check that nodes can
    -- write to this repo. Defaults to True. You may use False if you
    -- need a faster response and plan on verifying manually later
    -- with 'verifySnapshotRepo'.
    SnapshotRepoUpdateSettings -> Bool
repoUpdateVerify :: Bool
  }
  deriving stock (SnapshotRepoUpdateSettings -> SnapshotRepoUpdateSettings -> Bool
(SnapshotRepoUpdateSettings -> SnapshotRepoUpdateSettings -> Bool)
-> (SnapshotRepoUpdateSettings
    -> SnapshotRepoUpdateSettings -> Bool)
-> Eq SnapshotRepoUpdateSettings
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SnapshotRepoUpdateSettings -> SnapshotRepoUpdateSettings -> Bool
== :: SnapshotRepoUpdateSettings -> SnapshotRepoUpdateSettings -> Bool
$c/= :: SnapshotRepoUpdateSettings -> SnapshotRepoUpdateSettings -> Bool
/= :: SnapshotRepoUpdateSettings -> SnapshotRepoUpdateSettings -> Bool
Eq, Int -> SnapshotRepoUpdateSettings -> ShowS
[SnapshotRepoUpdateSettings] -> ShowS
SnapshotRepoUpdateSettings -> String
(Int -> SnapshotRepoUpdateSettings -> ShowS)
-> (SnapshotRepoUpdateSettings -> String)
-> ([SnapshotRepoUpdateSettings] -> ShowS)
-> Show SnapshotRepoUpdateSettings
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SnapshotRepoUpdateSettings -> ShowS
showsPrec :: Int -> SnapshotRepoUpdateSettings -> ShowS
$cshow :: SnapshotRepoUpdateSettings -> String
show :: SnapshotRepoUpdateSettings -> String
$cshowList :: [SnapshotRepoUpdateSettings] -> ShowS
showList :: [SnapshotRepoUpdateSettings] -> ShowS
Show)

repoUpdateVerifyLens :: Lens' SnapshotRepoUpdateSettings Bool
repoUpdateVerifyLens :: Lens' SnapshotRepoUpdateSettings Bool
repoUpdateVerifyLens = (SnapshotRepoUpdateSettings -> Bool)
-> (SnapshotRepoUpdateSettings
    -> Bool -> SnapshotRepoUpdateSettings)
-> Lens' SnapshotRepoUpdateSettings Bool
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens SnapshotRepoUpdateSettings -> Bool
repoUpdateVerify (\SnapshotRepoUpdateSettings
x Bool
y -> SnapshotRepoUpdateSettings
x {repoUpdateVerify = y})

-- | Reasonable defaults for repo creation/update
--
-- * repoUpdateVerify True
defaultSnapshotRepoUpdateSettings :: SnapshotRepoUpdateSettings
defaultSnapshotRepoUpdateSettings :: SnapshotRepoUpdateSettings
defaultSnapshotRepoUpdateSettings = Bool -> SnapshotRepoUpdateSettings
SnapshotRepoUpdateSettings Bool
True

-- | A filesystem-based snapshot repo that ships with
-- Elasticsearch. This is an instance of 'SnapshotRepo' so it can be
-- used with 'updateSnapshotRepo'
data FsSnapshotRepo = FsSnapshotRepo
  { FsSnapshotRepo -> SnapshotRepoName
fsrName :: SnapshotRepoName,
    FsSnapshotRepo -> String
fsrLocation :: FilePath,
    FsSnapshotRepo -> Bool
fsrCompressMetadata :: Bool,
    -- | Size by which to split large files during snapshotting.
    FsSnapshotRepo -> Maybe Bytes
fsrChunkSize :: Maybe Bytes,
    -- | Throttle node restore rate. If not supplied, defaults to 40mb/sec
    FsSnapshotRepo -> Maybe Bytes
fsrMaxRestoreBytesPerSec :: Maybe Bytes,
    -- | Throttle node snapshot rate. If not supplied, defaults to 40mb/sec
    FsSnapshotRepo -> Maybe Bytes
fsrMaxSnapshotBytesPerSec :: Maybe Bytes
  }
  deriving stock (FsSnapshotRepo -> FsSnapshotRepo -> Bool
(FsSnapshotRepo -> FsSnapshotRepo -> Bool)
-> (FsSnapshotRepo -> FsSnapshotRepo -> Bool) -> Eq FsSnapshotRepo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FsSnapshotRepo -> FsSnapshotRepo -> Bool
== :: FsSnapshotRepo -> FsSnapshotRepo -> Bool
$c/= :: FsSnapshotRepo -> FsSnapshotRepo -> Bool
/= :: FsSnapshotRepo -> FsSnapshotRepo -> Bool
Eq, Int -> FsSnapshotRepo -> ShowS
[FsSnapshotRepo] -> ShowS
FsSnapshotRepo -> String
(Int -> FsSnapshotRepo -> ShowS)
-> (FsSnapshotRepo -> String)
-> ([FsSnapshotRepo] -> ShowS)
-> Show FsSnapshotRepo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FsSnapshotRepo -> ShowS
showsPrec :: Int -> FsSnapshotRepo -> ShowS
$cshow :: FsSnapshotRepo -> String
show :: FsSnapshotRepo -> String
$cshowList :: [FsSnapshotRepo] -> ShowS
showList :: [FsSnapshotRepo] -> ShowS
Show, (forall x. FsSnapshotRepo -> Rep FsSnapshotRepo x)
-> (forall x. Rep FsSnapshotRepo x -> FsSnapshotRepo)
-> Generic FsSnapshotRepo
forall x. Rep FsSnapshotRepo x -> FsSnapshotRepo
forall x. FsSnapshotRepo -> Rep FsSnapshotRepo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. FsSnapshotRepo -> Rep FsSnapshotRepo x
from :: forall x. FsSnapshotRepo -> Rep FsSnapshotRepo x
$cto :: forall x. Rep FsSnapshotRepo x -> FsSnapshotRepo
to :: forall x. Rep FsSnapshotRepo x -> FsSnapshotRepo
Generic)

instance SnapshotRepo FsSnapshotRepo where
  toGSnapshotRepo :: FsSnapshotRepo -> GenericSnapshotRepo
toGSnapshotRepo FsSnapshotRepo {Bool
String
Maybe Bytes
SnapshotRepoName
fsrName :: FsSnapshotRepo -> SnapshotRepoName
fsrLocation :: FsSnapshotRepo -> String
fsrCompressMetadata :: FsSnapshotRepo -> Bool
fsrChunkSize :: FsSnapshotRepo -> Maybe Bytes
fsrMaxRestoreBytesPerSec :: FsSnapshotRepo -> Maybe Bytes
fsrMaxSnapshotBytesPerSec :: FsSnapshotRepo -> Maybe Bytes
fsrName :: SnapshotRepoName
fsrLocation :: String
fsrCompressMetadata :: Bool
fsrChunkSize :: Maybe Bytes
fsrMaxRestoreBytesPerSec :: Maybe Bytes
fsrMaxSnapshotBytesPerSec :: Maybe Bytes
..} =
    SnapshotRepoName
-> SnapshotRepoType
-> GenericSnapshotRepoSettings
-> GenericSnapshotRepo
GenericSnapshotRepo SnapshotRepoName
fsrName SnapshotRepoType
fsRepoType (Object -> GenericSnapshotRepoSettings
GenericSnapshotRepoSettings Object
settings)
    where
      settings :: Object
settings =
        [(Key, Value)] -> Object
forall v. [(Key, v)] -> KeyMap v
X.fromList ([(Key, Value)] -> Object) -> [(Key, Value)] -> Object
forall a b. (a -> b) -> a -> b
$
          [ Text -> Key
X.fromText Text
"location" Key -> String -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= String
fsrLocation,
            Text -> Key
X.fromText Text
"compress" Key -> Bool -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Bool
fsrCompressMetadata
          ]
            [(Key, Value)] -> [(Key, Value)] -> [(Key, Value)]
forall a. [a] -> [a] -> [a]
++ [(Key, Value)]
optionalPairs
      optionalPairs :: [(Key, Value)]
optionalPairs =
        [Maybe (Key, Value)] -> [(Key, Value)]
forall a. [Maybe a] -> [a]
catMaybes
          [ (Key
"chunk_size" Key -> Bytes -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.=) (Bytes -> (Key, Value)) -> Maybe Bytes -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Bytes
fsrChunkSize,
            (Key
"max_restore_bytes_per_sec" Key -> Bytes -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.=) (Bytes -> (Key, Value)) -> Maybe Bytes -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Bytes
fsrMaxRestoreBytesPerSec,
            (Key
"max_snapshot_bytes_per_sec" Key -> Bytes -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.=) (Bytes -> (Key, Value)) -> Maybe Bytes -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Bytes
fsrMaxSnapshotBytesPerSec
          ]
  fromGSnapshotRepo :: GenericSnapshotRepo
-> Either SnapshotRepoConversionError FsSnapshotRepo
fromGSnapshotRepo GenericSnapshotRepo {GenericSnapshotRepoSettings
SnapshotRepoType
SnapshotRepoName
gSnapshotRepoName :: GenericSnapshotRepo -> SnapshotRepoName
gSnapshotRepoType :: GenericSnapshotRepo -> SnapshotRepoType
gSnapshotRepoSettings :: GenericSnapshotRepo -> GenericSnapshotRepoSettings
gSnapshotRepoName :: SnapshotRepoName
gSnapshotRepoType :: SnapshotRepoType
gSnapshotRepoSettings :: GenericSnapshotRepoSettings
..}
    | SnapshotRepoType
gSnapshotRepoType SnapshotRepoType -> SnapshotRepoType -> Bool
forall a. Eq a => a -> a -> Bool
== SnapshotRepoType
fsRepoType = do
        let o :: Object
o = GenericSnapshotRepoSettings -> Object
gSnapshotRepoSettingsObject GenericSnapshotRepoSettings
gSnapshotRepoSettings
        Parser FsSnapshotRepo
-> Either SnapshotRepoConversionError FsSnapshotRepo
forall a. Parser a -> Either SnapshotRepoConversionError a
parseRepo (Parser FsSnapshotRepo
 -> Either SnapshotRepoConversionError FsSnapshotRepo)
-> Parser FsSnapshotRepo
-> Either SnapshotRepoConversionError FsSnapshotRepo
forall a b. (a -> b) -> a -> b
$
          SnapshotRepoName
-> String
-> Bool
-> Maybe Bytes
-> Maybe Bytes
-> Maybe Bytes
-> FsSnapshotRepo
FsSnapshotRepo SnapshotRepoName
gSnapshotRepoName
            (String
 -> Bool
 -> Maybe Bytes
 -> Maybe Bytes
 -> Maybe Bytes
 -> FsSnapshotRepo)
-> Parser String
-> Parser
     (Bool
      -> Maybe Bytes -> Maybe Bytes -> Maybe Bytes -> FsSnapshotRepo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o
              Object -> Key -> Parser String
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"location"
            Parser
  (Bool
   -> Maybe Bytes -> Maybe Bytes -> Maybe Bytes -> FsSnapshotRepo)
-> Parser Bool
-> Parser
     (Maybe Bytes -> Maybe Bytes -> Maybe Bytes -> FsSnapshotRepo)
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 Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"compress"
              Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
False
            Parser
  (Maybe Bytes -> Maybe Bytes -> Maybe Bytes -> FsSnapshotRepo)
-> Parser (Maybe Bytes)
-> Parser (Maybe Bytes -> Maybe Bytes -> FsSnapshotRepo)
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 Bytes)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"chunk_size"
            Parser (Maybe Bytes -> Maybe Bytes -> FsSnapshotRepo)
-> Parser (Maybe Bytes) -> Parser (Maybe Bytes -> FsSnapshotRepo)
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 Bytes)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"max_restore_bytes_per_sec"
            Parser (Maybe Bytes -> FsSnapshotRepo)
-> Parser (Maybe Bytes) -> Parser FsSnapshotRepo
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 Bytes)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"max_snapshot_bytes_per_sec"
    | Bool
otherwise = SnapshotRepoConversionError
-> Either SnapshotRepoConversionError FsSnapshotRepo
forall a b. a -> Either a b
Left (SnapshotRepoType -> SnapshotRepoType -> SnapshotRepoConversionError
RepoTypeMismatch SnapshotRepoType
fsRepoType SnapshotRepoType
gSnapshotRepoType)

fsrNameLens :: Lens' FsSnapshotRepo SnapshotRepoName
fsrNameLens :: Lens' FsSnapshotRepo SnapshotRepoName
fsrNameLens = (FsSnapshotRepo -> SnapshotRepoName)
-> (FsSnapshotRepo -> SnapshotRepoName -> FsSnapshotRepo)
-> Lens' FsSnapshotRepo SnapshotRepoName
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens FsSnapshotRepo -> SnapshotRepoName
fsrName (\FsSnapshotRepo
x SnapshotRepoName
y -> FsSnapshotRepo
x {fsrName = y})

fsrLocationLens :: Lens' FsSnapshotRepo FilePath
fsrLocationLens :: Lens' FsSnapshotRepo String
fsrLocationLens = (FsSnapshotRepo -> String)
-> (FsSnapshotRepo -> String -> FsSnapshotRepo)
-> Lens' FsSnapshotRepo String
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens FsSnapshotRepo -> String
fsrLocation (\FsSnapshotRepo
x String
y -> FsSnapshotRepo
x {fsrLocation = y})

fsrCompressMetadataLens :: Lens' FsSnapshotRepo Bool
fsrCompressMetadataLens :: Lens' FsSnapshotRepo Bool
fsrCompressMetadataLens = (FsSnapshotRepo -> Bool)
-> (FsSnapshotRepo -> Bool -> FsSnapshotRepo)
-> Lens' FsSnapshotRepo Bool
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens FsSnapshotRepo -> Bool
fsrCompressMetadata (\FsSnapshotRepo
x Bool
y -> FsSnapshotRepo
x {fsrCompressMetadata = y})

fsrChunkSizeLens :: Lens' FsSnapshotRepo (Maybe Bytes)
fsrChunkSizeLens :: Lens' FsSnapshotRepo (Maybe Bytes)
fsrChunkSizeLens = (FsSnapshotRepo -> Maybe Bytes)
-> (FsSnapshotRepo -> Maybe Bytes -> FsSnapshotRepo)
-> Lens' FsSnapshotRepo (Maybe Bytes)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens FsSnapshotRepo -> Maybe Bytes
fsrChunkSize (\FsSnapshotRepo
x Maybe Bytes
y -> FsSnapshotRepo
x {fsrChunkSize = y})

fsrMaxRestoreBytesPerSecLens :: Lens' FsSnapshotRepo (Maybe Bytes)
fsrMaxRestoreBytesPerSecLens :: Lens' FsSnapshotRepo (Maybe Bytes)
fsrMaxRestoreBytesPerSecLens = (FsSnapshotRepo -> Maybe Bytes)
-> (FsSnapshotRepo -> Maybe Bytes -> FsSnapshotRepo)
-> Lens' FsSnapshotRepo (Maybe Bytes)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens FsSnapshotRepo -> Maybe Bytes
fsrMaxRestoreBytesPerSec (\FsSnapshotRepo
x Maybe Bytes
y -> FsSnapshotRepo
x {fsrMaxRestoreBytesPerSec = y})

fsrMaxSnapshotBytesPerSecLens :: Lens' FsSnapshotRepo (Maybe Bytes)
fsrMaxSnapshotBytesPerSecLens :: Lens' FsSnapshotRepo (Maybe Bytes)
fsrMaxSnapshotBytesPerSecLens = (FsSnapshotRepo -> Maybe Bytes)
-> (FsSnapshotRepo -> Maybe Bytes -> FsSnapshotRepo)
-> Lens' FsSnapshotRepo (Maybe Bytes)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens FsSnapshotRepo -> Maybe Bytes
fsrMaxSnapshotBytesPerSec (\FsSnapshotRepo
x Maybe Bytes
y -> FsSnapshotRepo
x {fsrMaxSnapshotBytesPerSec = y})

parseRepo :: Parser a -> Either SnapshotRepoConversionError a
parseRepo :: forall a. Parser a -> Either SnapshotRepoConversionError a
parseRepo Parser a
parser = case (() -> Parser a) -> () -> Either String a
forall a b. (a -> Parser b) -> a -> Either String b
parseEither (Parser a -> () -> Parser a
forall a b. a -> b -> a
const Parser a
parser) () of
  Left String
e -> SnapshotRepoConversionError -> Either SnapshotRepoConversionError a
forall a b. a -> Either a b
Left (Text -> SnapshotRepoConversionError
OtherRepoConversionError (String -> Text
T.pack String
e))
  Right a
a -> a -> Either SnapshotRepoConversionError a
forall a b. b -> Either a b
Right a
a

fsRepoType :: SnapshotRepoType
fsRepoType :: SnapshotRepoType
fsRepoType = Text -> SnapshotRepoType
SnapshotRepoType Text
"fs"

-- | Law: fromGSnapshotRepo (toGSnapshotRepo r) == Right r
class SnapshotRepo r where
  toGSnapshotRepo :: r -> GenericSnapshotRepo
  fromGSnapshotRepo :: GenericSnapshotRepo -> Either SnapshotRepoConversionError r

data SnapshotRepoConversionError
  = -- | Expected type and actual type
    RepoTypeMismatch SnapshotRepoType SnapshotRepoType
  | OtherRepoConversionError Text
  deriving stock (SnapshotRepoConversionError -> SnapshotRepoConversionError -> Bool
(SnapshotRepoConversionError
 -> SnapshotRepoConversionError -> Bool)
-> (SnapshotRepoConversionError
    -> SnapshotRepoConversionError -> Bool)
-> Eq SnapshotRepoConversionError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SnapshotRepoConversionError -> SnapshotRepoConversionError -> Bool
== :: SnapshotRepoConversionError -> SnapshotRepoConversionError -> Bool
$c/= :: SnapshotRepoConversionError -> SnapshotRepoConversionError -> Bool
/= :: SnapshotRepoConversionError -> SnapshotRepoConversionError -> Bool
Eq, Int -> SnapshotRepoConversionError -> ShowS
[SnapshotRepoConversionError] -> ShowS
SnapshotRepoConversionError -> String
(Int -> SnapshotRepoConversionError -> ShowS)
-> (SnapshotRepoConversionError -> String)
-> ([SnapshotRepoConversionError] -> ShowS)
-> Show SnapshotRepoConversionError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SnapshotRepoConversionError -> ShowS
showsPrec :: Int -> SnapshotRepoConversionError -> ShowS
$cshow :: SnapshotRepoConversionError -> String
show :: SnapshotRepoConversionError -> String
$cshowList :: [SnapshotRepoConversionError] -> ShowS
showList :: [SnapshotRepoConversionError] -> ShowS
Show)

instance Exception SnapshotRepoConversionError

data SnapshotCreateSettings = SnapshotCreateSettings
  { -- | Should the API call return immediately after initializing
    -- the snapshot or wait until completed? Note that if this is
    -- enabled it could wait a long time, so you should adjust your
    -- 'ManagerSettings' accordingly to set long timeouts or
    -- explicitly handle timeouts.
    SnapshotCreateSettings -> Bool
snapWaitForCompletion :: Bool,
    -- | Nothing will snapshot all indices. Just [] is permissable and
    -- will essentially be a no-op snapshot.
    SnapshotCreateSettings -> Maybe IndexSelection
snapIndices :: Maybe IndexSelection,
    -- | If set to True, any matched indices that don't exist will be
    -- ignored. Otherwise it will be an error and fail.
    SnapshotCreateSettings -> Bool
snapIgnoreUnavailable :: Bool,
    SnapshotCreateSettings -> Bool
snapIncludeGlobalState :: Bool,
    -- | If some indices failed to snapshot (e.g. if not all primary
    -- shards are available), should the process proceed?
    SnapshotCreateSettings -> Bool
snapPartial :: Bool
  }
  deriving stock (SnapshotCreateSettings -> SnapshotCreateSettings -> Bool
(SnapshotCreateSettings -> SnapshotCreateSettings -> Bool)
-> (SnapshotCreateSettings -> SnapshotCreateSettings -> Bool)
-> Eq SnapshotCreateSettings
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SnapshotCreateSettings -> SnapshotCreateSettings -> Bool
== :: SnapshotCreateSettings -> SnapshotCreateSettings -> Bool
$c/= :: SnapshotCreateSettings -> SnapshotCreateSettings -> Bool
/= :: SnapshotCreateSettings -> SnapshotCreateSettings -> Bool
Eq, Int -> SnapshotCreateSettings -> ShowS
[SnapshotCreateSettings] -> ShowS
SnapshotCreateSettings -> String
(Int -> SnapshotCreateSettings -> ShowS)
-> (SnapshotCreateSettings -> String)
-> ([SnapshotCreateSettings] -> ShowS)
-> Show SnapshotCreateSettings
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SnapshotCreateSettings -> ShowS
showsPrec :: Int -> SnapshotCreateSettings -> ShowS
$cshow :: SnapshotCreateSettings -> String
show :: SnapshotCreateSettings -> String
$cshowList :: [SnapshotCreateSettings] -> ShowS
showList :: [SnapshotCreateSettings] -> ShowS
Show)

snapWaitForCompletionLens :: Lens' SnapshotCreateSettings Bool
snapWaitForCompletionLens :: Lens' SnapshotCreateSettings Bool
snapWaitForCompletionLens = (SnapshotCreateSettings -> Bool)
-> (SnapshotCreateSettings -> Bool -> SnapshotCreateSettings)
-> Lens' SnapshotCreateSettings Bool
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens SnapshotCreateSettings -> Bool
snapWaitForCompletion (\SnapshotCreateSettings
x Bool
y -> SnapshotCreateSettings
x {snapWaitForCompletion = y})

snapIndicesLens :: Lens' SnapshotCreateSettings (Maybe IndexSelection)
snapIndicesLens :: Lens' SnapshotCreateSettings (Maybe IndexSelection)
snapIndicesLens = (SnapshotCreateSettings -> Maybe IndexSelection)
-> (SnapshotCreateSettings
    -> Maybe IndexSelection -> SnapshotCreateSettings)
-> Lens' SnapshotCreateSettings (Maybe IndexSelection)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens SnapshotCreateSettings -> Maybe IndexSelection
snapIndices (\SnapshotCreateSettings
x Maybe IndexSelection
y -> SnapshotCreateSettings
x {snapIndices = y})

snapIgnoreUnavailableLens :: Lens' SnapshotCreateSettings Bool
snapIgnoreUnavailableLens :: Lens' SnapshotCreateSettings Bool
snapIgnoreUnavailableLens = (SnapshotCreateSettings -> Bool)
-> (SnapshotCreateSettings -> Bool -> SnapshotCreateSettings)
-> Lens' SnapshotCreateSettings Bool
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens SnapshotCreateSettings -> Bool
snapIgnoreUnavailable (\SnapshotCreateSettings
x Bool
y -> SnapshotCreateSettings
x {snapIgnoreUnavailable = y})

snapIncludeGlobalStateLens :: Lens' SnapshotCreateSettings Bool
snapIncludeGlobalStateLens :: Lens' SnapshotCreateSettings Bool
snapIncludeGlobalStateLens = (SnapshotCreateSettings -> Bool)
-> (SnapshotCreateSettings -> Bool -> SnapshotCreateSettings)
-> Lens' SnapshotCreateSettings Bool
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens SnapshotCreateSettings -> Bool
snapIncludeGlobalState (\SnapshotCreateSettings
x Bool
y -> SnapshotCreateSettings
x {snapIncludeGlobalState = y})

snapPartialLens :: Lens' SnapshotCreateSettings Bool
snapPartialLens :: Lens' SnapshotCreateSettings Bool
snapPartialLens = (SnapshotCreateSettings -> Bool)
-> (SnapshotCreateSettings -> Bool -> SnapshotCreateSettings)
-> Lens' SnapshotCreateSettings Bool
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens SnapshotCreateSettings -> Bool
snapPartial (\SnapshotCreateSettings
x Bool
y -> SnapshotCreateSettings
x {snapPartial = y})

-- | Reasonable defaults for snapshot creation
--
-- * snapWaitForCompletion False
-- * snapIndices Nothing
-- * snapIgnoreUnavailable False
-- * snapIncludeGlobalState True
-- * snapPartial False
defaultSnapshotCreateSettings :: SnapshotCreateSettings
defaultSnapshotCreateSettings :: SnapshotCreateSettings
defaultSnapshotCreateSettings =
  SnapshotCreateSettings
    { snapWaitForCompletion :: Bool
snapWaitForCompletion = Bool
False,
      snapIndices :: Maybe IndexSelection
snapIndices = Maybe IndexSelection
forall a. Maybe a
Nothing,
      snapIgnoreUnavailable :: Bool
snapIgnoreUnavailable = Bool
False,
      snapIncludeGlobalState :: Bool
snapIncludeGlobalState = Bool
True,
      snapPartial :: Bool
snapPartial = Bool
False
    }

data SnapshotSelection
  = SnapshotList (NonEmpty SnapshotPattern)
  | AllSnapshots
  deriving stock (SnapshotSelection -> SnapshotSelection -> Bool
(SnapshotSelection -> SnapshotSelection -> Bool)
-> (SnapshotSelection -> SnapshotSelection -> Bool)
-> Eq SnapshotSelection
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SnapshotSelection -> SnapshotSelection -> Bool
== :: SnapshotSelection -> SnapshotSelection -> Bool
$c/= :: SnapshotSelection -> SnapshotSelection -> Bool
/= :: SnapshotSelection -> SnapshotSelection -> Bool
Eq, Int -> SnapshotSelection -> ShowS
[SnapshotSelection] -> ShowS
SnapshotSelection -> String
(Int -> SnapshotSelection -> ShowS)
-> (SnapshotSelection -> String)
-> ([SnapshotSelection] -> ShowS)
-> Show SnapshotSelection
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SnapshotSelection -> ShowS
showsPrec :: Int -> SnapshotSelection -> ShowS
$cshow :: SnapshotSelection -> String
show :: SnapshotSelection -> String
$cshowList :: [SnapshotSelection] -> ShowS
showList :: [SnapshotSelection] -> ShowS
Show)

-- | Either specifies an exact snapshot name or one with globs in it,
-- e.g. @SnapPattern "foo*"@ __NOTE__: Patterns are not supported on
-- ES < 1.7
data SnapshotPattern
  = ExactSnap SnapshotName
  | SnapPattern Text
  deriving stock (SnapshotPattern -> SnapshotPattern -> Bool
(SnapshotPattern -> SnapshotPattern -> Bool)
-> (SnapshotPattern -> SnapshotPattern -> Bool)
-> Eq SnapshotPattern
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SnapshotPattern -> SnapshotPattern -> Bool
== :: SnapshotPattern -> SnapshotPattern -> Bool
$c/= :: SnapshotPattern -> SnapshotPattern -> Bool
/= :: SnapshotPattern -> SnapshotPattern -> Bool
Eq, Int -> SnapshotPattern -> ShowS
[SnapshotPattern] -> ShowS
SnapshotPattern -> String
(Int -> SnapshotPattern -> ShowS)
-> (SnapshotPattern -> String)
-> ([SnapshotPattern] -> ShowS)
-> Show SnapshotPattern
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SnapshotPattern -> ShowS
showsPrec :: Int -> SnapshotPattern -> ShowS
$cshow :: SnapshotPattern -> String
show :: SnapshotPattern -> String
$cshowList :: [SnapshotPattern] -> ShowS
showList :: [SnapshotPattern] -> ShowS
Show)

-- | General information about the state of a snapshot. Has some
-- redundancies with 'SnapshotStatus'
data SnapshotInfo = SnapshotInfo
  { SnapshotInfo -> ShardResult
snapInfoShards :: ShardResult,
    SnapshotInfo -> [SnapshotShardFailure]
snapInfoFailures :: [SnapshotShardFailure],
    SnapshotInfo -> NominalDiffTime
snapInfoDuration :: NominalDiffTime,
    SnapshotInfo -> UTCTime
snapInfoEndTime :: UTCTime,
    SnapshotInfo -> UTCTime
snapInfoStartTime :: UTCTime,
    SnapshotInfo -> SnapshotState
snapInfoState :: SnapshotState,
    SnapshotInfo -> [IndexName]
snapInfoIndices :: [IndexName],
    SnapshotInfo -> SnapshotName
snapInfoName :: SnapshotName
  }
  deriving stock (SnapshotInfo -> SnapshotInfo -> Bool
(SnapshotInfo -> SnapshotInfo -> Bool)
-> (SnapshotInfo -> SnapshotInfo -> Bool) -> Eq SnapshotInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SnapshotInfo -> SnapshotInfo -> Bool
== :: SnapshotInfo -> SnapshotInfo -> Bool
$c/= :: SnapshotInfo -> SnapshotInfo -> Bool
/= :: SnapshotInfo -> SnapshotInfo -> Bool
Eq, Int -> SnapshotInfo -> ShowS
[SnapshotInfo] -> ShowS
SnapshotInfo -> String
(Int -> SnapshotInfo -> ShowS)
-> (SnapshotInfo -> String)
-> ([SnapshotInfo] -> ShowS)
-> Show SnapshotInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SnapshotInfo -> ShowS
showsPrec :: Int -> SnapshotInfo -> ShowS
$cshow :: SnapshotInfo -> String
show :: SnapshotInfo -> String
$cshowList :: [SnapshotInfo] -> ShowS
showList :: [SnapshotInfo] -> ShowS
Show)

instance FromJSON SnapshotInfo where
  parseJSON :: Value -> Parser SnapshotInfo
parseJSON = String
-> (Object -> Parser SnapshotInfo) -> Value -> Parser SnapshotInfo
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"SnapshotInfo" Object -> Parser SnapshotInfo
parse
    where
      parse :: Object -> Parser SnapshotInfo
parse Object
o =
        ShardResult
-> [SnapshotShardFailure]
-> NominalDiffTime
-> UTCTime
-> UTCTime
-> SnapshotState
-> [IndexName]
-> SnapshotName
-> SnapshotInfo
SnapshotInfo
          (ShardResult
 -> [SnapshotShardFailure]
 -> NominalDiffTime
 -> UTCTime
 -> UTCTime
 -> SnapshotState
 -> [IndexName]
 -> SnapshotName
 -> SnapshotInfo)
-> Parser ShardResult
-> Parser
     ([SnapshotShardFailure]
      -> NominalDiffTime
      -> UTCTime
      -> UTCTime
      -> SnapshotState
      -> [IndexName]
      -> SnapshotName
      -> SnapshotInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o
            Object -> Key -> Parser ShardResult
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"shards"
          Parser
  ([SnapshotShardFailure]
   -> NominalDiffTime
   -> UTCTime
   -> UTCTime
   -> SnapshotState
   -> [IndexName]
   -> SnapshotName
   -> SnapshotInfo)
-> Parser [SnapshotShardFailure]
-> Parser
     (NominalDiffTime
      -> UTCTime
      -> UTCTime
      -> SnapshotState
      -> [IndexName]
      -> SnapshotName
      -> SnapshotInfo)
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 [SnapshotShardFailure]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"failures"
          Parser
  (NominalDiffTime
   -> UTCTime
   -> UTCTime
   -> SnapshotState
   -> [IndexName]
   -> SnapshotName
   -> SnapshotInfo)
-> Parser NominalDiffTime
-> Parser
     (UTCTime
      -> UTCTime
      -> SnapshotState
      -> [IndexName]
      -> SnapshotName
      -> SnapshotInfo)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (MS -> NominalDiffTime
unMS (MS -> NominalDiffTime) -> Parser MS -> Parser NominalDiffTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser MS
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"duration_in_millis")
          Parser
  (UTCTime
   -> UTCTime
   -> SnapshotState
   -> [IndexName]
   -> SnapshotName
   -> SnapshotInfo)
-> Parser UTCTime
-> Parser
     (UTCTime
      -> SnapshotState -> [IndexName] -> SnapshotName -> SnapshotInfo)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (POSIXMS -> UTCTime
posixMS (POSIXMS -> UTCTime) -> Parser POSIXMS -> Parser UTCTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser POSIXMS
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"end_time_in_millis")
          Parser
  (UTCTime
   -> SnapshotState -> [IndexName] -> SnapshotName -> SnapshotInfo)
-> Parser UTCTime
-> Parser
     (SnapshotState -> [IndexName] -> SnapshotName -> SnapshotInfo)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (POSIXMS -> UTCTime
posixMS (POSIXMS -> UTCTime) -> Parser POSIXMS -> Parser UTCTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser POSIXMS
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"start_time_in_millis")
          Parser
  (SnapshotState -> [IndexName] -> SnapshotName -> SnapshotInfo)
-> Parser SnapshotState
-> Parser ([IndexName] -> SnapshotName -> SnapshotInfo)
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 SnapshotState
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"state"
          Parser ([IndexName] -> SnapshotName -> SnapshotInfo)
-> Parser [IndexName] -> Parser (SnapshotName -> SnapshotInfo)
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 [IndexName]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"indices"
          Parser (SnapshotName -> SnapshotInfo)
-> Parser SnapshotName -> Parser SnapshotInfo
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 SnapshotName
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"snapshot"

snapInfoShardsLens :: Lens' SnapshotInfo ShardResult
snapInfoShardsLens :: Lens' SnapshotInfo ShardResult
snapInfoShardsLens = (SnapshotInfo -> ShardResult)
-> (SnapshotInfo -> ShardResult -> SnapshotInfo)
-> Lens' SnapshotInfo ShardResult
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens SnapshotInfo -> ShardResult
snapInfoShards (\SnapshotInfo
x ShardResult
y -> SnapshotInfo
x {snapInfoShards = y})

snapInfoFailuresLens :: Lens' SnapshotInfo [SnapshotShardFailure]
snapInfoFailuresLens :: Lens' SnapshotInfo [SnapshotShardFailure]
snapInfoFailuresLens = (SnapshotInfo -> [SnapshotShardFailure])
-> (SnapshotInfo -> [SnapshotShardFailure] -> SnapshotInfo)
-> Lens' SnapshotInfo [SnapshotShardFailure]
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens SnapshotInfo -> [SnapshotShardFailure]
snapInfoFailures (\SnapshotInfo
x [SnapshotShardFailure]
y -> SnapshotInfo
x {snapInfoFailures = y})

snapInfoDurationLens :: Lens' SnapshotInfo NominalDiffTime
snapInfoDurationLens :: Lens' SnapshotInfo NominalDiffTime
snapInfoDurationLens = (SnapshotInfo -> NominalDiffTime)
-> (SnapshotInfo -> NominalDiffTime -> SnapshotInfo)
-> Lens' SnapshotInfo NominalDiffTime
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens SnapshotInfo -> NominalDiffTime
snapInfoDuration (\SnapshotInfo
x NominalDiffTime
y -> SnapshotInfo
x {snapInfoDuration = y})

snapInfoEndTimeLens :: Lens' SnapshotInfo UTCTime
snapInfoEndTimeLens :: Lens' SnapshotInfo UTCTime
snapInfoEndTimeLens = (SnapshotInfo -> UTCTime)
-> (SnapshotInfo -> UTCTime -> SnapshotInfo)
-> Lens' SnapshotInfo UTCTime
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens SnapshotInfo -> UTCTime
snapInfoEndTime (\SnapshotInfo
x UTCTime
y -> SnapshotInfo
x {snapInfoEndTime = y})

snapInfoStartTimeLens :: Lens' SnapshotInfo UTCTime
snapInfoStartTimeLens :: Lens' SnapshotInfo UTCTime
snapInfoStartTimeLens = (SnapshotInfo -> UTCTime)
-> (SnapshotInfo -> UTCTime -> SnapshotInfo)
-> Lens' SnapshotInfo UTCTime
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens SnapshotInfo -> UTCTime
snapInfoStartTime (\SnapshotInfo
x UTCTime
y -> SnapshotInfo
x {snapInfoStartTime = y})

snapInfoStateLens :: Lens' SnapshotInfo SnapshotState
snapInfoStateLens :: Lens' SnapshotInfo SnapshotState
snapInfoStateLens = (SnapshotInfo -> SnapshotState)
-> (SnapshotInfo -> SnapshotState -> SnapshotInfo)
-> Lens' SnapshotInfo SnapshotState
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens SnapshotInfo -> SnapshotState
snapInfoState (\SnapshotInfo
x SnapshotState
y -> SnapshotInfo
x {snapInfoState = y})

snapInfoIndicesLens :: Lens' SnapshotInfo [IndexName]
snapInfoIndicesLens :: Lens' SnapshotInfo [IndexName]
snapInfoIndicesLens = (SnapshotInfo -> [IndexName])
-> (SnapshotInfo -> [IndexName] -> SnapshotInfo)
-> Lens' SnapshotInfo [IndexName]
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens SnapshotInfo -> [IndexName]
snapInfoIndices (\SnapshotInfo
x [IndexName]
y -> SnapshotInfo
x {snapInfoIndices = y})

snapInfoNameLens :: Lens' SnapshotInfo SnapshotName
snapInfoNameLens :: Lens' SnapshotInfo SnapshotName
snapInfoNameLens = (SnapshotInfo -> SnapshotName)
-> (SnapshotInfo -> SnapshotName -> SnapshotInfo)
-> Lens' SnapshotInfo SnapshotName
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens SnapshotInfo -> SnapshotName
snapInfoName (\SnapshotInfo
x SnapshotName
y -> SnapshotInfo
x {snapInfoName = y})

data SnapshotShardFailure = SnapshotShardFailure
  { SnapshotShardFailure -> IndexName
snapShardFailureIndex :: IndexName,
    SnapshotShardFailure -> Maybe NodeName
snapShardFailureNodeId :: Maybe NodeName, -- I'm not 100% sure this isn't actually 'FullNodeId'
    SnapshotShardFailure -> Text
snapShardFailureReason :: Text,
    SnapshotShardFailure -> ShardId
snapShardFailureShardId :: ShardId
  }
  deriving stock (SnapshotShardFailure -> SnapshotShardFailure -> Bool
(SnapshotShardFailure -> SnapshotShardFailure -> Bool)
-> (SnapshotShardFailure -> SnapshotShardFailure -> Bool)
-> Eq SnapshotShardFailure
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SnapshotShardFailure -> SnapshotShardFailure -> Bool
== :: SnapshotShardFailure -> SnapshotShardFailure -> Bool
$c/= :: SnapshotShardFailure -> SnapshotShardFailure -> Bool
/= :: SnapshotShardFailure -> SnapshotShardFailure -> Bool
Eq, Int -> SnapshotShardFailure -> ShowS
[SnapshotShardFailure] -> ShowS
SnapshotShardFailure -> String
(Int -> SnapshotShardFailure -> ShowS)
-> (SnapshotShardFailure -> String)
-> ([SnapshotShardFailure] -> ShowS)
-> Show SnapshotShardFailure
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SnapshotShardFailure -> ShowS
showsPrec :: Int -> SnapshotShardFailure -> ShowS
$cshow :: SnapshotShardFailure -> String
show :: SnapshotShardFailure -> String
$cshowList :: [SnapshotShardFailure] -> ShowS
showList :: [SnapshotShardFailure] -> ShowS
Show)

instance FromJSON SnapshotShardFailure where
  parseJSON :: Value -> Parser SnapshotShardFailure
parseJSON = String
-> (Object -> Parser SnapshotShardFailure)
-> Value
-> Parser SnapshotShardFailure
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"SnapshotShardFailure" Object -> Parser SnapshotShardFailure
parse
    where
      parse :: Object -> Parser SnapshotShardFailure
parse Object
o =
        IndexName
-> Maybe NodeName -> Text -> ShardId -> SnapshotShardFailure
SnapshotShardFailure
          (IndexName
 -> Maybe NodeName -> Text -> ShardId -> SnapshotShardFailure)
-> Parser IndexName
-> Parser
     (Maybe NodeName -> Text -> ShardId -> SnapshotShardFailure)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o
            Object -> Key -> Parser IndexName
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"index"
          Parser (Maybe NodeName -> Text -> ShardId -> SnapshotShardFailure)
-> Parser (Maybe NodeName)
-> Parser (Text -> ShardId -> SnapshotShardFailure)
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 NodeName)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"node_id"
          Parser (Text -> ShardId -> SnapshotShardFailure)
-> Parser Text -> Parser (ShardId -> SnapshotShardFailure)
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 Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"reason"
          Parser (ShardId -> SnapshotShardFailure)
-> Parser ShardId -> Parser SnapshotShardFailure
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 ShardId
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"shard_id"

snapShardFailureIndexLens :: Lens' SnapshotShardFailure IndexName
snapShardFailureIndexLens :: Lens' SnapshotShardFailure IndexName
snapShardFailureIndexLens = (SnapshotShardFailure -> IndexName)
-> (SnapshotShardFailure -> IndexName -> SnapshotShardFailure)
-> Lens' SnapshotShardFailure IndexName
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens SnapshotShardFailure -> IndexName
snapShardFailureIndex (\SnapshotShardFailure
x IndexName
y -> SnapshotShardFailure
x {snapShardFailureIndex = y})

snapShardFailureNodeIdLens :: Lens' SnapshotShardFailure (Maybe NodeName)
snapShardFailureNodeIdLens :: Lens' SnapshotShardFailure (Maybe NodeName)
snapShardFailureNodeIdLens = (SnapshotShardFailure -> Maybe NodeName)
-> (SnapshotShardFailure -> Maybe NodeName -> SnapshotShardFailure)
-> Lens' SnapshotShardFailure (Maybe NodeName)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens SnapshotShardFailure -> Maybe NodeName
snapShardFailureNodeId (\SnapshotShardFailure
x Maybe NodeName
y -> SnapshotShardFailure
x {snapShardFailureNodeId = y})

snapShardFailureReasonLens :: Lens' SnapshotShardFailure Text
snapShardFailureReasonLens :: Lens' SnapshotShardFailure Text
snapShardFailureReasonLens = (SnapshotShardFailure -> Text)
-> (SnapshotShardFailure -> Text -> SnapshotShardFailure)
-> Lens' SnapshotShardFailure Text
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens SnapshotShardFailure -> Text
snapShardFailureReason (\SnapshotShardFailure
x Text
y -> SnapshotShardFailure
x {snapShardFailureReason = y})

snapShardFailureShardIdLens :: Lens' SnapshotShardFailure ShardId
snapShardFailureShardIdLens :: Lens' SnapshotShardFailure ShardId
snapShardFailureShardIdLens = (SnapshotShardFailure -> ShardId)
-> (SnapshotShardFailure -> ShardId -> SnapshotShardFailure)
-> Lens' SnapshotShardFailure ShardId
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens SnapshotShardFailure -> ShardId
snapShardFailureShardId (\SnapshotShardFailure
x ShardId
y -> SnapshotShardFailure
x {snapShardFailureShardId = y})

-- | Regex-stype pattern, e.g. "index_(.+)" to match index names
newtype RestoreRenamePattern = RestoreRenamePattern {RestoreRenamePattern -> Text
rrPattern :: Text}
  deriving newtype (RestoreRenamePattern -> RestoreRenamePattern -> Bool
(RestoreRenamePattern -> RestoreRenamePattern -> Bool)
-> (RestoreRenamePattern -> RestoreRenamePattern -> Bool)
-> Eq RestoreRenamePattern
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RestoreRenamePattern -> RestoreRenamePattern -> Bool
== :: RestoreRenamePattern -> RestoreRenamePattern -> Bool
$c/= :: RestoreRenamePattern -> RestoreRenamePattern -> Bool
/= :: RestoreRenamePattern -> RestoreRenamePattern -> Bool
Eq, Eq RestoreRenamePattern
Eq RestoreRenamePattern =>
(RestoreRenamePattern -> RestoreRenamePattern -> Ordering)
-> (RestoreRenamePattern -> RestoreRenamePattern -> Bool)
-> (RestoreRenamePattern -> RestoreRenamePattern -> Bool)
-> (RestoreRenamePattern -> RestoreRenamePattern -> Bool)
-> (RestoreRenamePattern -> RestoreRenamePattern -> Bool)
-> (RestoreRenamePattern
    -> RestoreRenamePattern -> RestoreRenamePattern)
-> (RestoreRenamePattern
    -> RestoreRenamePattern -> RestoreRenamePattern)
-> Ord RestoreRenamePattern
RestoreRenamePattern -> RestoreRenamePattern -> Bool
RestoreRenamePattern -> RestoreRenamePattern -> Ordering
RestoreRenamePattern
-> RestoreRenamePattern -> RestoreRenamePattern
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: RestoreRenamePattern -> RestoreRenamePattern -> Ordering
compare :: RestoreRenamePattern -> RestoreRenamePattern -> Ordering
$c< :: RestoreRenamePattern -> RestoreRenamePattern -> Bool
< :: RestoreRenamePattern -> RestoreRenamePattern -> Bool
$c<= :: RestoreRenamePattern -> RestoreRenamePattern -> Bool
<= :: RestoreRenamePattern -> RestoreRenamePattern -> Bool
$c> :: RestoreRenamePattern -> RestoreRenamePattern -> Bool
> :: RestoreRenamePattern -> RestoreRenamePattern -> Bool
$c>= :: RestoreRenamePattern -> RestoreRenamePattern -> Bool
>= :: RestoreRenamePattern -> RestoreRenamePattern -> Bool
$cmax :: RestoreRenamePattern
-> RestoreRenamePattern -> RestoreRenamePattern
max :: RestoreRenamePattern
-> RestoreRenamePattern -> RestoreRenamePattern
$cmin :: RestoreRenamePattern
-> RestoreRenamePattern -> RestoreRenamePattern
min :: RestoreRenamePattern
-> RestoreRenamePattern -> RestoreRenamePattern
Ord, Int -> RestoreRenamePattern -> ShowS
[RestoreRenamePattern] -> ShowS
RestoreRenamePattern -> String
(Int -> RestoreRenamePattern -> ShowS)
-> (RestoreRenamePattern -> String)
-> ([RestoreRenamePattern] -> ShowS)
-> Show RestoreRenamePattern
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RestoreRenamePattern -> ShowS
showsPrec :: Int -> RestoreRenamePattern -> ShowS
$cshow :: RestoreRenamePattern -> String
show :: RestoreRenamePattern -> String
$cshowList :: [RestoreRenamePattern] -> ShowS
showList :: [RestoreRenamePattern] -> ShowS
Show, [RestoreRenamePattern] -> Value
[RestoreRenamePattern] -> Encoding
RestoreRenamePattern -> Bool
RestoreRenamePattern -> Value
RestoreRenamePattern -> Encoding
(RestoreRenamePattern -> Value)
-> (RestoreRenamePattern -> Encoding)
-> ([RestoreRenamePattern] -> Value)
-> ([RestoreRenamePattern] -> Encoding)
-> (RestoreRenamePattern -> Bool)
-> ToJSON RestoreRenamePattern
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: RestoreRenamePattern -> Value
toJSON :: RestoreRenamePattern -> Value
$ctoEncoding :: RestoreRenamePattern -> Encoding
toEncoding :: RestoreRenamePattern -> Encoding
$ctoJSONList :: [RestoreRenamePattern] -> Value
toJSONList :: [RestoreRenamePattern] -> Value
$ctoEncodingList :: [RestoreRenamePattern] -> Encoding
toEncodingList :: [RestoreRenamePattern] -> Encoding
$comitField :: RestoreRenamePattern -> Bool
omitField :: RestoreRenamePattern -> Bool
ToJSON)

rrPatternLens :: Lens' RestoreRenamePattern Text
rrPatternLens :: Lens' RestoreRenamePattern Text
rrPatternLens = (RestoreRenamePattern -> Text)
-> (RestoreRenamePattern -> Text -> RestoreRenamePattern)
-> Lens' RestoreRenamePattern Text
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens RestoreRenamePattern -> Text
rrPattern (\RestoreRenamePattern
x Text
y -> RestoreRenamePattern
x {rrPattern = y})

-- | A single token in a index renaming scheme for a restore. These
-- are concatenated into a string before being sent to
-- Elasticsearch. Check out these Java
-- <https://docs.oracle.com/javase/7/docs/api/java/util/regex/Matcher.html docs> to find out more if you're into that sort of thing.
data RestoreRenameToken
  = -- | Just a literal string of characters
    RRTLit Text
  | -- | Equivalent to $0. The entire matched pattern, not any subgroup
    RRSubWholeMatch
  | -- | A specific reference to a group number
    RRSubGroup RRGroupRefNum
  deriving stock (RestoreRenameToken -> RestoreRenameToken -> Bool
(RestoreRenameToken -> RestoreRenameToken -> Bool)
-> (RestoreRenameToken -> RestoreRenameToken -> Bool)
-> Eq RestoreRenameToken
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RestoreRenameToken -> RestoreRenameToken -> Bool
== :: RestoreRenameToken -> RestoreRenameToken -> Bool
$c/= :: RestoreRenameToken -> RestoreRenameToken -> Bool
/= :: RestoreRenameToken -> RestoreRenameToken -> Bool
Eq, Int -> RestoreRenameToken -> ShowS
[RestoreRenameToken] -> ShowS
RestoreRenameToken -> String
(Int -> RestoreRenameToken -> ShowS)
-> (RestoreRenameToken -> String)
-> ([RestoreRenameToken] -> ShowS)
-> Show RestoreRenameToken
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RestoreRenameToken -> ShowS
showsPrec :: Int -> RestoreRenameToken -> ShowS
$cshow :: RestoreRenameToken -> String
show :: RestoreRenameToken -> String
$cshowList :: [RestoreRenameToken] -> ShowS
showList :: [RestoreRenameToken] -> ShowS
Show)

-- | A group number for regex matching. Only values from 1-9 are
-- supported. Construct with 'mkRRGroupRefNum'
newtype RRGroupRefNum = RRGroupRefNum {RRGroupRefNum -> Int
rrGroupRefNum :: Int}
  deriving stock (RRGroupRefNum -> RRGroupRefNum -> Bool
(RRGroupRefNum -> RRGroupRefNum -> Bool)
-> (RRGroupRefNum -> RRGroupRefNum -> Bool) -> Eq RRGroupRefNum
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RRGroupRefNum -> RRGroupRefNum -> Bool
== :: RRGroupRefNum -> RRGroupRefNum -> Bool
$c/= :: RRGroupRefNum -> RRGroupRefNum -> Bool
/= :: RRGroupRefNum -> RRGroupRefNum -> Bool
Eq, Eq RRGroupRefNum
Eq RRGroupRefNum =>
(RRGroupRefNum -> RRGroupRefNum -> Ordering)
-> (RRGroupRefNum -> RRGroupRefNum -> Bool)
-> (RRGroupRefNum -> RRGroupRefNum -> Bool)
-> (RRGroupRefNum -> RRGroupRefNum -> Bool)
-> (RRGroupRefNum -> RRGroupRefNum -> Bool)
-> (RRGroupRefNum -> RRGroupRefNum -> RRGroupRefNum)
-> (RRGroupRefNum -> RRGroupRefNum -> RRGroupRefNum)
-> Ord RRGroupRefNum
RRGroupRefNum -> RRGroupRefNum -> Bool
RRGroupRefNum -> RRGroupRefNum -> Ordering
RRGroupRefNum -> RRGroupRefNum -> RRGroupRefNum
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: RRGroupRefNum -> RRGroupRefNum -> Ordering
compare :: RRGroupRefNum -> RRGroupRefNum -> Ordering
$c< :: RRGroupRefNum -> RRGroupRefNum -> Bool
< :: RRGroupRefNum -> RRGroupRefNum -> Bool
$c<= :: RRGroupRefNum -> RRGroupRefNum -> Bool
<= :: RRGroupRefNum -> RRGroupRefNum -> Bool
$c> :: RRGroupRefNum -> RRGroupRefNum -> Bool
> :: RRGroupRefNum -> RRGroupRefNum -> Bool
$c>= :: RRGroupRefNum -> RRGroupRefNum -> Bool
>= :: RRGroupRefNum -> RRGroupRefNum -> Bool
$cmax :: RRGroupRefNum -> RRGroupRefNum -> RRGroupRefNum
max :: RRGroupRefNum -> RRGroupRefNum -> RRGroupRefNum
$cmin :: RRGroupRefNum -> RRGroupRefNum -> RRGroupRefNum
min :: RRGroupRefNum -> RRGroupRefNum -> RRGroupRefNum
Ord, Int -> RRGroupRefNum -> ShowS
[RRGroupRefNum] -> ShowS
RRGroupRefNum -> String
(Int -> RRGroupRefNum -> ShowS)
-> (RRGroupRefNum -> String)
-> ([RRGroupRefNum] -> ShowS)
-> Show RRGroupRefNum
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RRGroupRefNum -> ShowS
showsPrec :: Int -> RRGroupRefNum -> ShowS
$cshow :: RRGroupRefNum -> String
show :: RRGroupRefNum -> String
$cshowList :: [RRGroupRefNum] -> ShowS
showList :: [RRGroupRefNum] -> ShowS
Show)

instance Bounded RRGroupRefNum where
  minBound :: RRGroupRefNum
minBound = Int -> RRGroupRefNum
RRGroupRefNum Int
1
  maxBound :: RRGroupRefNum
maxBound = Int -> RRGroupRefNum
RRGroupRefNum Int
9

-- | Only allows valid group number references (1-9).
mkRRGroupRefNum :: Int -> Maybe RRGroupRefNum
mkRRGroupRefNum :: Int -> Maybe RRGroupRefNum
mkRRGroupRefNum Int
i
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= RRGroupRefNum -> Int
rrGroupRefNum RRGroupRefNum
forall a. Bounded a => a
minBound
      Bool -> Bool -> Bool
&& Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= RRGroupRefNum -> Int
rrGroupRefNum RRGroupRefNum
forall a. Bounded a => a
maxBound =
      RRGroupRefNum -> Maybe RRGroupRefNum
forall a. a -> Maybe a
Just (RRGroupRefNum -> Maybe RRGroupRefNum)
-> RRGroupRefNum -> Maybe RRGroupRefNum
forall a b. (a -> b) -> a -> b
$ Int -> RRGroupRefNum
RRGroupRefNum Int
i
  | Bool
otherwise = Maybe RRGroupRefNum
forall a. Maybe a
Nothing

-- | Reasonable defaults for snapshot restores
--
-- * snapRestoreWaitForCompletion False
-- * snapRestoreIndices Nothing
-- * snapRestoreIgnoreUnavailable False
-- * snapRestoreIncludeGlobalState True
-- * snapRestoreRenamePattern Nothing
-- * snapRestoreRenameReplacement Nothing
-- * snapRestorePartial False
-- * snapRestoreIncludeAliases True
-- * snapRestoreIndexSettingsOverrides Nothing
-- * snapRestoreIgnoreIndexSettings Nothing
defaultSnapshotRestoreSettings :: SnapshotRestoreSettings
defaultSnapshotRestoreSettings :: SnapshotRestoreSettings
defaultSnapshotRestoreSettings =
  SnapshotRestoreSettings
    { snapRestoreWaitForCompletion :: Bool
snapRestoreWaitForCompletion = Bool
False,
      snapRestoreIndices :: Maybe IndexSelection
snapRestoreIndices = Maybe IndexSelection
forall a. Maybe a
Nothing,
      snapRestoreIgnoreUnavailable :: Bool
snapRestoreIgnoreUnavailable = Bool
False,
      snapRestoreIncludeGlobalState :: Bool
snapRestoreIncludeGlobalState = Bool
True,
      snapRestoreRenamePattern :: Maybe RestoreRenamePattern
snapRestoreRenamePattern = Maybe RestoreRenamePattern
forall a. Maybe a
Nothing,
      snapRestoreRenameReplacement :: Maybe (NonEmpty RestoreRenameToken)
snapRestoreRenameReplacement = Maybe (NonEmpty RestoreRenameToken)
forall a. Maybe a
Nothing,
      snapRestorePartial :: Bool
snapRestorePartial = Bool
False,
      snapRestoreIncludeAliases :: Bool
snapRestoreIncludeAliases = Bool
True,
      snapRestoreIndexSettingsOverrides :: Maybe RestoreIndexSettings
snapRestoreIndexSettingsOverrides = Maybe RestoreIndexSettings
forall a. Maybe a
Nothing,
      snapRestoreIgnoreIndexSettings :: Maybe (NonEmpty Text)
snapRestoreIgnoreIndexSettings = Maybe (NonEmpty Text)
forall a. Maybe a
Nothing
    }

-- | Index settings that can be overridden. The docs only mention you
-- can update number of replicas, but there may be more. You
-- definitely cannot override shard count.
newtype RestoreIndexSettings = RestoreIndexSettings
  { RestoreIndexSettings -> Maybe ReplicaCount
restoreOverrideReplicas :: Maybe ReplicaCount
  }
  deriving stock (RestoreIndexSettings -> RestoreIndexSettings -> Bool
(RestoreIndexSettings -> RestoreIndexSettings -> Bool)
-> (RestoreIndexSettings -> RestoreIndexSettings -> Bool)
-> Eq RestoreIndexSettings
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RestoreIndexSettings -> RestoreIndexSettings -> Bool
== :: RestoreIndexSettings -> RestoreIndexSettings -> Bool
$c/= :: RestoreIndexSettings -> RestoreIndexSettings -> Bool
/= :: RestoreIndexSettings -> RestoreIndexSettings -> Bool
Eq, Int -> RestoreIndexSettings -> ShowS
[RestoreIndexSettings] -> ShowS
RestoreIndexSettings -> String
(Int -> RestoreIndexSettings -> ShowS)
-> (RestoreIndexSettings -> String)
-> ([RestoreIndexSettings] -> ShowS)
-> Show RestoreIndexSettings
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RestoreIndexSettings -> ShowS
showsPrec :: Int -> RestoreIndexSettings -> ShowS
$cshow :: RestoreIndexSettings -> String
show :: RestoreIndexSettings -> String
$cshowList :: [RestoreIndexSettings] -> ShowS
showList :: [RestoreIndexSettings] -> ShowS
Show)

instance ToJSON RestoreIndexSettings where
  toJSON :: RestoreIndexSettings -> Value
toJSON RestoreIndexSettings {Maybe ReplicaCount
restoreOverrideReplicas :: RestoreIndexSettings -> Maybe ReplicaCount
restoreOverrideReplicas :: Maybe ReplicaCount
..} = [(Key, Value)] -> Value
object [(Key, Value)]
prs
    where
      prs :: [(Key, Value)]
prs = [Maybe (Key, Value)] -> [(Key, Value)]
forall a. [Maybe a] -> [a]
catMaybes [(Key
"index.number_of_replicas" Key -> ReplicaCount -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.=) (ReplicaCount -> (Key, Value))
-> Maybe ReplicaCount -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ReplicaCount
restoreOverrideReplicas]

restoreOverrideReplicasLens :: Lens' RestoreIndexSettings (Maybe ReplicaCount)
restoreOverrideReplicasLens :: Lens' RestoreIndexSettings (Maybe ReplicaCount)
restoreOverrideReplicasLens = (RestoreIndexSettings -> Maybe ReplicaCount)
-> (RestoreIndexSettings
    -> Maybe ReplicaCount -> RestoreIndexSettings)
-> Lens' RestoreIndexSettings (Maybe ReplicaCount)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens RestoreIndexSettings -> Maybe ReplicaCount
restoreOverrideReplicas (\RestoreIndexSettings
x Maybe ReplicaCount
y -> RestoreIndexSettings
x {restoreOverrideReplicas = y})