{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE UndecidableInstances #-}

module Database.Bloodhound.Internal.Client where

import Bloodhound.Import
import qualified Data.Aeson.KeyMap as X
import qualified Data.HashMap.Strict as HM
import Data.Map.Strict (Map)
import Data.Maybe (mapMaybe)
import qualified Data.SemVer as SemVer
import qualified Data.Text as T
import qualified Data.Traversable as DT
import qualified Data.Vector as V
import Database.Bloodhound.Internal.Analysis
import Database.Bloodhound.Internal.Client.BHRequest
import Database.Bloodhound.Internal.Client.Doc
import Database.Bloodhound.Internal.Newtypes
import Database.Bloodhound.Internal.Query
import Database.Bloodhound.Internal.StringlyTyped
import GHC.Generics
import Network.HTTP.Client
import Text.Read (Read (..))
import qualified Text.Read as TR

-- | Common environment for Elasticsearch calls. Connections will be
--    pipelined according to the provided HTTP connection manager.
data BHEnv = BHEnv
  { BHEnv -> Server
bhServer :: Server,
    BHEnv -> Manager
bhManager :: Manager,
    -- | Low-level hook that is run before every request is sent. Used to implement custom authentication strategies. Defaults to 'return' with 'mkBHEnv'.
    BHEnv -> Request -> IO Request
bhRequestHook :: Request -> IO Request
  }

instance (Functor m, Applicative m, MonadIO m) => MonadBH (ReaderT BHEnv m) where
  getBHEnv :: ReaderT BHEnv m BHEnv
getBHEnv = forall r (m :: * -> *). MonadReader r m => m r
ask

-- | All API calls to Elasticsearch operate within
--    MonadBH
--    . The idea is that it can be easily embedded in your
--    own monad transformer stack. A default instance for a ReaderT and
--    alias 'BH' is provided for the simple case.
class (Functor m, Applicative m, MonadIO m) => MonadBH m where
  getBHEnv :: m BHEnv

-- | Create a 'BHEnv' with all optional fields defaulted. HTTP hook
-- will be a noop. You can use the exported fields to customize
-- it further, e.g.:
--
-- >> (mkBHEnv myServer myManager) { bhRequestHook = customHook }
mkBHEnv :: Server -> Manager -> BHEnv
mkBHEnv :: Server -> Manager -> BHEnv
mkBHEnv Server
s Manager
m = Server -> Manager -> (Request -> IO Request) -> BHEnv
BHEnv Server
s Manager
m forall (m :: * -> *) a. Monad m => a -> m a
return

newtype BH m a = BH
  { forall (m :: * -> *) a. BH m a -> ReaderT BHEnv m a
unBH :: ReaderT BHEnv m a
  }
  deriving
    ( forall a b. a -> BH m b -> BH m a
forall a b. (a -> b) -> BH m a -> BH m b
forall (m :: * -> *) a b. Functor m => a -> BH m b -> BH m a
forall (m :: * -> *) a b. Functor m => (a -> b) -> BH m a -> BH m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> BH m b -> BH m a
$c<$ :: forall (m :: * -> *) a b. Functor m => a -> BH m b -> BH m a
fmap :: forall a b. (a -> b) -> BH m a -> BH m b
$cfmap :: forall (m :: * -> *) a b. Functor m => (a -> b) -> BH m a -> BH m b
Functor,
      forall a. a -> BH m a
forall a b. BH m a -> BH m b -> BH m a
forall a b. BH m a -> BH m b -> BH m b
forall a b. BH m (a -> b) -> BH m a -> BH m b
forall a b c. (a -> b -> c) -> BH m a -> BH m b -> BH m c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
forall {m :: * -> *}. Applicative m => Functor (BH m)
forall (m :: * -> *) a. Applicative m => a -> BH m a
forall (m :: * -> *) a b.
Applicative m =>
BH m a -> BH m b -> BH m a
forall (m :: * -> *) a b.
Applicative m =>
BH m a -> BH m b -> BH m b
forall (m :: * -> *) a b.
Applicative m =>
BH m (a -> b) -> BH m a -> BH m b
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c) -> BH m a -> BH m b -> BH m c
<* :: forall a b. BH m a -> BH m b -> BH m a
$c<* :: forall (m :: * -> *) a b.
Applicative m =>
BH m a -> BH m b -> BH m a
*> :: forall a b. BH m a -> BH m b -> BH m b
$c*> :: forall (m :: * -> *) a b.
Applicative m =>
BH m a -> BH m b -> BH m b
liftA2 :: forall a b c. (a -> b -> c) -> BH m a -> BH m b -> BH m c
$cliftA2 :: forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c) -> BH m a -> BH m b -> BH m c
<*> :: forall a b. BH m (a -> b) -> BH m a -> BH m b
$c<*> :: forall (m :: * -> *) a b.
Applicative m =>
BH m (a -> b) -> BH m a -> BH m b
pure :: forall a. a -> BH m a
$cpure :: forall (m :: * -> *) a. Applicative m => a -> BH m a
Applicative,
      forall a. a -> BH m a
forall a b. BH m a -> BH m b -> BH m b
forall a b. BH m a -> (a -> BH m b) -> BH m b
forall {m :: * -> *}. Monad m => Applicative (BH m)
forall (m :: * -> *) a. Monad m => a -> BH m a
forall (m :: * -> *) a b. Monad m => BH m a -> BH m b -> BH m b
forall (m :: * -> *) a b.
Monad m =>
BH m a -> (a -> BH m b) -> BH m b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: forall a. a -> BH m a
$creturn :: forall (m :: * -> *) a. Monad m => a -> BH m a
>> :: forall a b. BH m a -> BH m b -> BH m b
$c>> :: forall (m :: * -> *) a b. Monad m => BH m a -> BH m b -> BH m b
>>= :: forall a b. BH m a -> (a -> BH m b) -> BH m b
$c>>= :: forall (m :: * -> *) a b.
Monad m =>
BH m a -> (a -> BH m b) -> BH m b
Monad,
      forall a. IO a -> BH m a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
forall {m :: * -> *}. MonadIO m => Monad (BH m)
forall (m :: * -> *) a. MonadIO m => IO a -> BH m a
liftIO :: forall a. IO a -> BH m a
$cliftIO :: forall (m :: * -> *) a. MonadIO m => IO a -> BH m a
MonadIO,
      MonadState s,
      MonadWriter w,
      MonadError e,
      forall a. BH m a
forall a. BH m a -> BH m [a]
forall a. BH m a -> BH m a -> BH m a
forall (f :: * -> *).
Applicative f
-> (forall a. f a)
-> (forall a. f a -> f a -> f a)
-> (forall a. f a -> f [a])
-> (forall a. f a -> f [a])
-> Alternative f
forall {m :: * -> *}. Alternative m => Applicative (BH m)
forall (m :: * -> *) a. Alternative m => BH m a
forall (m :: * -> *) a. Alternative m => BH m a -> BH m [a]
forall (m :: * -> *) a. Alternative m => BH m a -> BH m a -> BH m a
many :: forall a. BH m a -> BH m [a]
$cmany :: forall (m :: * -> *) a. Alternative m => BH m a -> BH m [a]
some :: forall a. BH m a -> BH m [a]
$csome :: forall (m :: * -> *) a. Alternative m => BH m a -> BH m [a]
<|> :: forall a. BH m a -> BH m a -> BH m a
$c<|> :: forall (m :: * -> *) a. Alternative m => BH m a -> BH m a -> BH m a
empty :: forall a. BH m a
$cempty :: forall (m :: * -> *) a. Alternative m => BH m a
Alternative,
      forall a. BH m a
forall a. BH m a -> BH m a -> BH m a
forall (m :: * -> *).
Alternative m
-> Monad m
-> (forall a. m a)
-> (forall a. m a -> m a -> m a)
-> MonadPlus m
forall {m :: * -> *}. MonadPlus m => Monad (BH m)
forall {m :: * -> *}. MonadPlus m => Alternative (BH m)
forall (m :: * -> *) a. MonadPlus m => BH m a
forall (m :: * -> *) a. MonadPlus m => BH m a -> BH m a -> BH m a
mplus :: forall a. BH m a -> BH m a -> BH m a
$cmplus :: forall (m :: * -> *) a. MonadPlus m => BH m a -> BH m a -> BH m a
mzero :: forall a. BH m a
$cmzero :: forall (m :: * -> *) a. MonadPlus m => BH m a
MonadPlus,
      forall a. (a -> BH m a) -> BH m a
forall (m :: * -> *).
Monad m -> (forall a. (a -> m a) -> m a) -> MonadFix m
forall {m :: * -> *}. MonadFix m => Monad (BH m)
forall (m :: * -> *) a. MonadFix m => (a -> BH m a) -> BH m a
mfix :: forall a. (a -> BH m a) -> BH m a
$cmfix :: forall (m :: * -> *) a. MonadFix m => (a -> BH m a) -> BH m a
MonadFix,
      forall e a. Exception e => e -> BH m a
forall (m :: * -> *).
Monad m -> (forall e a. Exception e => e -> m a) -> MonadThrow m
forall {m :: * -> *}. MonadThrow m => Monad (BH m)
forall (m :: * -> *) e a.
(MonadThrow m, Exception e) =>
e -> BH m a
throwM :: forall e a. Exception e => e -> BH m a
$cthrowM :: forall (m :: * -> *) e a.
(MonadThrow m, Exception e) =>
e -> BH m a
MonadThrow,
      forall e a. Exception e => BH m a -> (e -> BH m a) -> BH m a
forall (m :: * -> *).
MonadThrow m
-> (forall e a. Exception e => m a -> (e -> m a) -> m a)
-> MonadCatch m
forall {m :: * -> *}. MonadCatch m => MonadThrow (BH m)
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
BH m a -> (e -> BH m a) -> BH m a
catch :: forall e a. Exception e => BH m a -> (e -> BH m a) -> BH m a
$ccatch :: forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
BH m a -> (e -> BH m a) -> BH m a
MonadCatch,
      forall a. String -> BH m a
forall (m :: * -> *).
Monad m -> (forall a. String -> m a) -> MonadFail m
forall {m :: * -> *}. MonadFail m => Monad (BH m)
forall (m :: * -> *) a. MonadFail m => String -> BH m a
fail :: forall a. String -> BH m a
$cfail :: forall (m :: * -> *) a. MonadFail m => String -> BH m a
MonadFail,
      forall b. ((forall a. BH m a -> BH m a) -> BH m b) -> BH m b
forall a b c.
BH m a
-> (a -> ExitCase b -> BH m c) -> (a -> BH m b) -> BH m (b, c)
forall {m :: * -> *}. MonadMask m => MonadCatch (BH m)
forall (m :: * -> *) b.
MonadMask m =>
((forall a. BH m a -> BH m a) -> BH m b) -> BH m b
forall (m :: * -> *) a b c.
MonadMask m =>
BH m a
-> (a -> ExitCase b -> BH m c) -> (a -> BH m b) -> BH m (b, c)
forall (m :: * -> *).
MonadCatch m
-> (forall b. ((forall a. m a -> m a) -> m b) -> m b)
-> (forall b. ((forall a. m a -> m a) -> m b) -> m b)
-> (forall a b c.
    m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c))
-> MonadMask m
generalBracket :: forall a b c.
BH m a
-> (a -> ExitCase b -> BH m c) -> (a -> BH m b) -> BH m (b, c)
$cgeneralBracket :: forall (m :: * -> *) a b c.
MonadMask m =>
BH m a
-> (a -> ExitCase b -> BH m c) -> (a -> BH m b) -> BH m (b, c)
uninterruptibleMask :: forall b. ((forall a. BH m a -> BH m a) -> BH m b) -> BH m b
$cuninterruptibleMask :: forall (m :: * -> *) b.
MonadMask m =>
((forall a. BH m a -> BH m a) -> BH m b) -> BH m b
mask :: forall b. ((forall a. BH m a -> BH m a) -> BH m b) -> BH m b
$cmask :: forall (m :: * -> *) b.
MonadMask m =>
((forall a. BH m a -> BH m a) -> BH m b) -> BH m b
MonadMask
    )

instance MonadTrans BH where
  lift :: forall (m :: * -> *) a. Monad m => m a -> BH m a
lift = forall (m :: * -> *) a. ReaderT BHEnv m a -> BH m a
BH forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift

instance (MonadReader r m) => MonadReader r (BH m) where
  ask :: BH m r
ask = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall r (m :: * -> *). MonadReader r m => m r
ask
  local :: forall a. (r -> r) -> BH m a -> BH m a
local r -> r
f (BH (ReaderT BHEnv -> m a
m)) = forall (m :: * -> *) a. ReaderT BHEnv m a -> BH m a
BH forall a b. (a -> b) -> a -> b
$
    forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$ \BHEnv
r ->
      forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local r -> r
f (BHEnv -> m a
m BHEnv
r)

instance (Functor m, Applicative m, MonadIO m) => MonadBH (BH m) where
  getBHEnv :: BH m BHEnv
getBHEnv = forall (m :: * -> *) a. ReaderT BHEnv m a -> BH m a
BH forall (m :: * -> *). MonadBH m => m BHEnv
getBHEnv

runBH :: BHEnv -> BH m a -> m a
runBH :: forall (m :: * -> *) a. BHEnv -> BH m a -> m a
runBH BHEnv
e BH m a
f = forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (forall (m :: * -> *) a. BH m a -> ReaderT BHEnv m a
unBH BH m a
f) BHEnv
e

-- | 'Version' is embedded in 'Status'
data Version = Version
  { Version -> VersionNumber
number :: VersionNumber,
    Version -> BuildHash
build_hash :: BuildHash,
    Version -> UTCTime
build_date :: UTCTime,
    Version -> Bool
build_snapshot :: Bool,
    Version -> VersionNumber
lucene_version :: VersionNumber
  }
  deriving (Version -> Version -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Version -> Version -> Bool
$c/= :: Version -> Version -> Bool
== :: Version -> Version -> Bool
$c== :: Version -> Version -> Bool
Eq, Int -> Version -> ShowS
[Version] -> ShowS
Version -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Version] -> ShowS
$cshowList :: [Version] -> ShowS
show :: Version -> String
$cshow :: Version -> String
showsPrec :: Int -> Version -> ShowS
$cshowsPrec :: Int -> Version -> ShowS
Show, forall x. Rep Version x -> Version
forall x. Version -> Rep Version x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Version x -> Version
$cfrom :: forall x. Version -> Rep Version x
Generic)

-- | Traditional software versioning number
newtype VersionNumber = VersionNumber
  {VersionNumber -> Version
versionNumber :: SemVer.Version}
  deriving (VersionNumber -> VersionNumber -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VersionNumber -> VersionNumber -> Bool
$c/= :: VersionNumber -> VersionNumber -> Bool
== :: VersionNumber -> VersionNumber -> Bool
$c== :: VersionNumber -> VersionNumber -> Bool
Eq, Eq VersionNumber
VersionNumber -> VersionNumber -> Bool
VersionNumber -> VersionNumber -> Ordering
VersionNumber -> VersionNumber -> VersionNumber
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
min :: VersionNumber -> VersionNumber -> VersionNumber
$cmin :: VersionNumber -> VersionNumber -> VersionNumber
max :: VersionNumber -> VersionNumber -> VersionNumber
$cmax :: VersionNumber -> VersionNumber -> VersionNumber
>= :: VersionNumber -> VersionNumber -> Bool
$c>= :: VersionNumber -> VersionNumber -> Bool
> :: VersionNumber -> VersionNumber -> Bool
$c> :: VersionNumber -> VersionNumber -> Bool
<= :: VersionNumber -> VersionNumber -> Bool
$c<= :: VersionNumber -> VersionNumber -> Bool
< :: VersionNumber -> VersionNumber -> Bool
$c< :: VersionNumber -> VersionNumber -> Bool
compare :: VersionNumber -> VersionNumber -> Ordering
$ccompare :: VersionNumber -> VersionNumber -> Ordering
Ord, Int -> VersionNumber -> ShowS
[VersionNumber] -> ShowS
VersionNumber -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VersionNumber] -> ShowS
$cshowList :: [VersionNumber] -> ShowS
show :: VersionNumber -> String
$cshow :: VersionNumber -> String
showsPrec :: Int -> VersionNumber -> ShowS
$cshowsPrec :: Int -> VersionNumber -> ShowS
Show)

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

-- | A measure of bytes used for various configurations. You may want
-- to use smart constructors like 'gigabytes' for larger values.
--
-- >>> gigabytes 9
-- Bytes 9000000000
--
-- >>> megabytes 9
-- Bytes 9000000
--
-- >>> kilobytes 9
-- Bytes 9000
newtype Bytes
  = Bytes Int
  deriving (Bytes -> Bytes -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Bytes -> Bytes -> Bool
$c/= :: Bytes -> Bytes -> Bool
== :: Bytes -> Bytes -> Bool
$c== :: Bytes -> Bytes -> Bool
Eq, Int -> Bytes -> ShowS
[Bytes] -> ShowS
Bytes -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Bytes] -> ShowS
$cshowList :: [Bytes] -> ShowS
show :: Bytes -> String
$cshow :: Bytes -> String
showsPrec :: Int -> Bytes -> ShowS
$cshowsPrec :: Int -> Bytes -> ShowS
Show, forall x. Rep Bytes x -> Bytes
forall x. Bytes -> Rep Bytes x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Bytes x -> Bytes
$cfrom :: forall x. Bytes -> Rep Bytes x
Generic, Eq Bytes
Bytes -> Bytes -> Bool
Bytes -> Bytes -> Ordering
Bytes -> Bytes -> Bytes
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
min :: Bytes -> Bytes -> Bytes
$cmin :: Bytes -> Bytes -> Bytes
max :: Bytes -> Bytes -> Bytes
$cmax :: Bytes -> Bytes -> Bytes
>= :: Bytes -> Bytes -> Bool
$c>= :: Bytes -> Bytes -> Bool
> :: Bytes -> Bytes -> Bool
$c> :: Bytes -> Bytes -> Bool
<= :: Bytes -> Bytes -> Bool
$c<= :: Bytes -> Bytes -> Bool
< :: Bytes -> Bytes -> Bool
$c< :: Bytes -> Bytes -> Bool
compare :: Bytes -> Bytes -> Ordering
$ccompare :: Bytes -> Bytes -> Ordering
Ord, [Bytes] -> Encoding
[Bytes] -> Value
Bytes -> Encoding
Bytes -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Bytes] -> Encoding
$ctoEncodingList :: [Bytes] -> Encoding
toJSONList :: [Bytes] -> Value
$ctoJSONList :: [Bytes] -> Value
toEncoding :: Bytes -> Encoding
$ctoEncoding :: Bytes -> Encoding
toJSON :: Bytes -> Value
$ctoJSON :: Bytes -> Value
ToJSON, Value -> Parser [Bytes]
Value -> Parser Bytes
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Bytes]
$cparseJSONList :: Value -> Parser [Bytes]
parseJSON :: Value -> Parser Bytes
$cparseJSON :: Value -> Parser Bytes
FromJSON)

gigabytes :: Int -> Bytes
gigabytes :: Int -> Bytes
gigabytes Int
n = Int -> Bytes
megabytes (Int
1000 forall a. Num a => a -> a -> a
* Int
n)

megabytes :: Int -> Bytes
megabytes :: Int -> Bytes
megabytes Int
n = Int -> Bytes
kilobytes (Int
1000 forall a. Num a => a -> a -> a
* Int
n)

kilobytes :: Int -> Bytes
kilobytes :: Int -> Bytes
kilobytes Int
n = Int -> Bytes
Bytes (Int
1000 forall a. Num a => a -> a -> a
* Int
n)

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

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

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

data InitialShardCount
  = QuorumShards
  | QuorumMinus1Shards
  | FullShards
  | FullMinus1Shards
  | ExplicitShards Int
  deriving (InitialShardCount -> InitialShardCount -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InitialShardCount -> InitialShardCount -> Bool
$c/= :: InitialShardCount -> InitialShardCount -> Bool
== :: InitialShardCount -> InitialShardCount -> Bool
$c== :: InitialShardCount -> InitialShardCount -> Bool
Eq, Int -> InitialShardCount -> ShowS
[InitialShardCount] -> ShowS
InitialShardCount -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InitialShardCount] -> ShowS
$cshowList :: [InitialShardCount] -> ShowS
show :: InitialShardCount -> String
$cshow :: InitialShardCount -> String
showsPrec :: Int -> InitialShardCount -> ShowS
$cshowsPrec :: Int -> InitialShardCount -> ShowS
Show, forall x. Rep InitialShardCount x -> InitialShardCount
forall x. InitialShardCount -> Rep InitialShardCount x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep InitialShardCount x -> InitialShardCount
$cfrom :: forall x. InitialShardCount -> Rep InitialShardCount x
Generic)

instance FromJSON InitialShardCount where
  parseJSON :: Value -> Parser InitialShardCount
parseJSON Value
v =
    forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"InitialShardCount" forall {a} {f :: * -> *}.
(Eq a, IsString a, MonadPlus f) =>
a -> f InitialShardCount
parseText Value
v
      forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Int -> InitialShardCount
ExplicitShards forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
    where
      parseText :: a -> f InitialShardCount
parseText a
"quorum" = forall (f :: * -> *) a. Applicative f => a -> f a
pure InitialShardCount
QuorumShards
      parseText a
"quorum-1" = forall (f :: * -> *) a. Applicative f => a -> f a
pure InitialShardCount
QuorumMinus1Shards
      parseText a
"full" = forall (f :: * -> *) a. Applicative f => a -> f a
pure InitialShardCount
FullShards
      parseText a
"full-1" = forall (f :: * -> *) a. Applicative f => a -> f a
pure InitialShardCount
FullMinus1Shards
      parseText a
_ = forall (m :: * -> *) a. MonadPlus m => m a
mzero

instance ToJSON InitialShardCount where
  toJSON :: InitialShardCount -> Value
toJSON InitialShardCount
QuorumShards = Text -> Value
String Text
"quorum"
  toJSON InitialShardCount
QuorumMinus1Shards = Text -> Value
String Text
"quorum-1"
  toJSON InitialShardCount
FullShards = Text -> Value
String Text
"full"
  toJSON InitialShardCount
FullMinus1Shards = Text -> Value
String Text
"full-1"
  toJSON (ExplicitShards Int
x) = forall a. ToJSON a => a -> Value
toJSON Int
x

data NodeAttrFilter = NodeAttrFilter
  { NodeAttrFilter -> NodeAttrName
nodeAttrFilterName :: NodeAttrName,
    NodeAttrFilter -> NonEmpty Text
nodeAttrFilterValues :: NonEmpty Text
  }
  deriving (NodeAttrFilter -> NodeAttrFilter -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NodeAttrFilter -> NodeAttrFilter -> Bool
$c/= :: NodeAttrFilter -> NodeAttrFilter -> Bool
== :: NodeAttrFilter -> NodeAttrFilter -> Bool
$c== :: NodeAttrFilter -> NodeAttrFilter -> Bool
Eq, Eq NodeAttrFilter
NodeAttrFilter -> NodeAttrFilter -> Bool
NodeAttrFilter -> NodeAttrFilter -> Ordering
NodeAttrFilter -> NodeAttrFilter -> NodeAttrFilter
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
min :: NodeAttrFilter -> NodeAttrFilter -> NodeAttrFilter
$cmin :: NodeAttrFilter -> NodeAttrFilter -> NodeAttrFilter
max :: NodeAttrFilter -> NodeAttrFilter -> NodeAttrFilter
$cmax :: NodeAttrFilter -> NodeAttrFilter -> NodeAttrFilter
>= :: NodeAttrFilter -> NodeAttrFilter -> Bool
$c>= :: NodeAttrFilter -> NodeAttrFilter -> Bool
> :: NodeAttrFilter -> NodeAttrFilter -> Bool
$c> :: NodeAttrFilter -> NodeAttrFilter -> Bool
<= :: NodeAttrFilter -> NodeAttrFilter -> Bool
$c<= :: NodeAttrFilter -> NodeAttrFilter -> Bool
< :: NodeAttrFilter -> NodeAttrFilter -> Bool
$c< :: NodeAttrFilter -> NodeAttrFilter -> Bool
compare :: NodeAttrFilter -> NodeAttrFilter -> Ordering
$ccompare :: NodeAttrFilter -> NodeAttrFilter -> Ordering
Ord, Int -> NodeAttrFilter -> ShowS
[NodeAttrFilter] -> ShowS
NodeAttrFilter -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NodeAttrFilter] -> ShowS
$cshowList :: [NodeAttrFilter] -> ShowS
show :: NodeAttrFilter -> String
$cshow :: NodeAttrFilter -> String
showsPrec :: Int -> NodeAttrFilter -> ShowS
$cshowsPrec :: Int -> NodeAttrFilter -> ShowS
Show)

newtype NodeAttrName = NodeAttrName Text deriving (NodeAttrName -> NodeAttrName -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NodeAttrName -> NodeAttrName -> Bool
$c/= :: NodeAttrName -> NodeAttrName -> Bool
== :: NodeAttrName -> NodeAttrName -> Bool
$c== :: NodeAttrName -> NodeAttrName -> Bool
Eq, Eq NodeAttrName
NodeAttrName -> NodeAttrName -> Bool
NodeAttrName -> NodeAttrName -> Ordering
NodeAttrName -> NodeAttrName -> NodeAttrName
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
min :: NodeAttrName -> NodeAttrName -> NodeAttrName
$cmin :: NodeAttrName -> NodeAttrName -> NodeAttrName
max :: NodeAttrName -> NodeAttrName -> NodeAttrName
$cmax :: NodeAttrName -> NodeAttrName -> NodeAttrName
>= :: NodeAttrName -> NodeAttrName -> Bool
$c>= :: NodeAttrName -> NodeAttrName -> Bool
> :: NodeAttrName -> NodeAttrName -> Bool
$c> :: NodeAttrName -> NodeAttrName -> Bool
<= :: NodeAttrName -> NodeAttrName -> Bool
$c<= :: NodeAttrName -> NodeAttrName -> Bool
< :: NodeAttrName -> NodeAttrName -> Bool
$c< :: NodeAttrName -> NodeAttrName -> Bool
compare :: NodeAttrName -> NodeAttrName -> Ordering
$ccompare :: NodeAttrName -> NodeAttrName -> Ordering
Ord, Int -> NodeAttrName -> ShowS
[NodeAttrName] -> ShowS
NodeAttrName -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NodeAttrName] -> ShowS
$cshowList :: [NodeAttrName] -> ShowS
show :: NodeAttrName -> String
$cshow :: NodeAttrName -> String
showsPrec :: Int -> NodeAttrName -> ShowS
$cshowsPrec :: Int -> NodeAttrName -> ShowS
Show)

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

data UpsertActionMetadata
  = UA_RetryOnConflict Int
  | UA_Version Int
  deriving (UpsertActionMetadata -> UpsertActionMetadata -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpsertActionMetadata -> UpsertActionMetadata -> Bool
$c/= :: UpsertActionMetadata -> UpsertActionMetadata -> Bool
== :: UpsertActionMetadata -> UpsertActionMetadata -> Bool
$c== :: UpsertActionMetadata -> UpsertActionMetadata -> Bool
Eq, Int -> UpsertActionMetadata -> ShowS
[UpsertActionMetadata] -> ShowS
UpsertActionMetadata -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpsertActionMetadata] -> ShowS
$cshowList :: [UpsertActionMetadata] -> ShowS
show :: UpsertActionMetadata -> String
$cshow :: UpsertActionMetadata -> String
showsPrec :: Int -> UpsertActionMetadata -> ShowS
$cshowsPrec :: Int -> UpsertActionMetadata -> ShowS
Show)

buildUpsertActionMetadata :: UpsertActionMetadata -> Pair
buildUpsertActionMetadata :: UpsertActionMetadata -> Pair
buildUpsertActionMetadata (UA_RetryOnConflict Int
i) = Key
"retry_on_conflict" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Int
i
buildUpsertActionMetadata (UA_Version Int
i) = Key
"_version" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Int
i

data UpsertPayload
  = UpsertDoc Value
  | UpsertScript Bool Script Value
  deriving (UpsertPayload -> UpsertPayload -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpsertPayload -> UpsertPayload -> Bool
$c/= :: UpsertPayload -> UpsertPayload -> Bool
== :: UpsertPayload -> UpsertPayload -> Bool
$c== :: UpsertPayload -> UpsertPayload -> Bool
Eq, Int -> UpsertPayload -> ShowS
[UpsertPayload] -> ShowS
UpsertPayload -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpsertPayload] -> ShowS
$cshowList :: [UpsertPayload] -> ShowS
show :: UpsertPayload -> String
$cshow :: UpsertPayload -> String
showsPrec :: Int -> UpsertPayload -> ShowS
$cshowsPrec :: Int -> UpsertPayload -> ShowS
Show)

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

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

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

-- | 'BulkOperation' is a sum type for expressing the four kinds of bulk
--    operation index, create, delete, and update. 'BulkIndex' behaves like an
--    "upsert", 'BulkCreate' will fail if a document already exists at the DocId.
--    Consult the <http://www.elastic.co/guide/en/elasticsearch/reference/current/docs-bulk.html#docs-bulk Bulk API documentation>
--    for further explanation.
--    Warning: Bulk operations suffixed with @Auto@ rely on Elasticsearch to
--    generate the id. Often, people use auto-generated identifiers when
--    Elasticsearch is the only place that their data is stored. Do not let
--    Elasticsearch be the only place your data is stored. It does not guarantee
--    durability, and it may silently discard data.
--    This <https://github.com/elastic/elasticsearch/issues/10708 issue> is
--    discussed further on github.
data BulkOperation
  = -- | Create the document, replacing it if it already exists.
    BulkIndex IndexName DocId Value
  | -- | Create a document with an autogenerated id.
    BulkIndexAuto IndexName Value
  | -- | Create a document with an autogenerated id. Use fast JSON encoding.
    BulkIndexEncodingAuto IndexName Encoding
  | -- | Create a document, failing if it already exists.
    BulkCreate IndexName DocId Value
  | -- | Create a document, failing if it already exists. Use fast JSON encoding.
    BulkCreateEncoding IndexName DocId Encoding
  | -- | Delete the document
    BulkDelete IndexName DocId
  | -- | Update the document, merging the new value with the existing one.
    BulkUpdate IndexName DocId Value
  | -- | Update the document if it already exists, otherwise insert it.
    BulkUpsert IndexName DocId UpsertPayload [UpsertActionMetadata]
  deriving (BulkOperation -> BulkOperation -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BulkOperation -> BulkOperation -> Bool
$c/= :: BulkOperation -> BulkOperation -> Bool
== :: BulkOperation -> BulkOperation -> Bool
$c== :: BulkOperation -> BulkOperation -> Bool
Eq, Int -> BulkOperation -> ShowS
[BulkOperation] -> ShowS
BulkOperation -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BulkOperation] -> ShowS
$cshowList :: [BulkOperation] -> ShowS
show :: BulkOperation -> String
$cshow :: BulkOperation -> String
showsPrec :: Int -> BulkOperation -> ShowS
$cshowsPrec :: Int -> BulkOperation -> ShowS
Show)

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

-- | 'NodeSelection' is used for most cluster APIs. See <https://www.elastic.co/guide/en/elasticsearch/reference/current/cluster.html#cluster-nodes here> for more details.
data NodeSelection
  = -- | Whatever node receives this request
    LocalNode
  | NodeList (NonEmpty NodeSelector)
  | AllNodes
  deriving (NodeSelection -> NodeSelection -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NodeSelection -> NodeSelection -> Bool
$c/= :: NodeSelection -> NodeSelection -> Bool
== :: NodeSelection -> NodeSelection -> Bool
$c== :: NodeSelection -> NodeSelection -> Bool
Eq, Int -> NodeSelection -> ShowS
[NodeSelection] -> ShowS
NodeSelection -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NodeSelection] -> ShowS
$cshowList :: [NodeSelection] -> ShowS
show :: NodeSelection -> String
$cshow :: NodeSelection -> String
showsPrec :: Int -> NodeSelection -> ShowS
$cshowsPrec :: Int -> NodeSelection -> ShowS
Show)

-- | An exact match or pattern to identify a node. Note that All of
-- these options support wildcarding, so your node name, server, attr
-- name can all contain * characters to be a fuzzy match.
data NodeSelector
  = NodeByName NodeName
  | NodeByFullNodeId FullNodeId
  | -- | e.g. 10.0.0.1 or even 10.0.0.*
    NodeByHost Server
  | -- | NodeAttrName can be a pattern, e.g. rack*. The value can too.
    NodeByAttribute NodeAttrName Text
  deriving (NodeSelector -> NodeSelector -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NodeSelector -> NodeSelector -> Bool
$c/= :: NodeSelector -> NodeSelector -> Bool
== :: NodeSelector -> NodeSelector -> Bool
$c== :: NodeSelector -> NodeSelector -> Bool
Eq, Int -> NodeSelector -> ShowS
[NodeSelector] -> ShowS
NodeSelector -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NodeSelector] -> ShowS
$cshowList :: [NodeSelector] -> ShowS
show :: NodeSelector -> String
$cshow :: NodeSelector -> String
showsPrec :: Int -> NodeSelector -> ShowS
$cshowsPrec :: Int -> NodeSelector -> ShowS
Show)

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

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

-- | Username type used for HTTP Basic authentication. See 'basicAuthHook'.
newtype EsUsername = EsUsername {EsUsername -> Text
esUsername :: Text} deriving (ReadPrec [EsUsername]
ReadPrec EsUsername
Int -> ReadS EsUsername
ReadS [EsUsername]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [EsUsername]
$creadListPrec :: ReadPrec [EsUsername]
readPrec :: ReadPrec EsUsername
$creadPrec :: ReadPrec EsUsername
readList :: ReadS [EsUsername]
$creadList :: ReadS [EsUsername]
readsPrec :: Int -> ReadS EsUsername
$creadsPrec :: Int -> ReadS EsUsername
Read, Int -> EsUsername -> ShowS
[EsUsername] -> ShowS
EsUsername -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EsUsername] -> ShowS
$cshowList :: [EsUsername] -> ShowS
show :: EsUsername -> String
$cshow :: EsUsername -> String
showsPrec :: Int -> EsUsername -> ShowS
$cshowsPrec :: Int -> EsUsername -> ShowS
Show, EsUsername -> EsUsername -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EsUsername -> EsUsername -> Bool
$c/= :: EsUsername -> EsUsername -> Bool
== :: EsUsername -> EsUsername -> Bool
$c== :: EsUsername -> EsUsername -> Bool
Eq)

-- | Password type used for HTTP Basic authentication. See 'basicAuthHook'.
newtype EsPassword = EsPassword {EsPassword -> Text
esPassword :: Text} deriving (ReadPrec [EsPassword]
ReadPrec EsPassword
Int -> ReadS EsPassword
ReadS [EsPassword]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [EsPassword]
$creadListPrec :: ReadPrec [EsPassword]
readPrec :: ReadPrec EsPassword
$creadPrec :: ReadPrec EsPassword
readList :: ReadS [EsPassword]
$creadList :: ReadS [EsPassword]
readsPrec :: Int -> ReadS EsPassword
$creadsPrec :: Int -> ReadS EsPassword
Read, Int -> EsPassword -> ShowS
[EsPassword] -> ShowS
EsPassword -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EsPassword] -> ShowS
$cshowList :: [EsPassword] -> ShowS
show :: EsPassword -> String
$cshow :: EsPassword -> String
showsPrec :: Int -> EsPassword -> ShowS
$cshowsPrec :: Int -> EsPassword -> ShowS
Show, EsPassword -> EsPassword -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EsPassword -> EsPassword -> Bool
$c/= :: EsPassword -> EsPassword -> Bool
== :: EsPassword -> EsPassword -> Bool
$c== :: EsPassword -> EsPassword -> Bool
Eq)

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

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

-- | 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 (GenericSnapshotRepo -> GenericSnapshotRepo -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GenericSnapshotRepo -> GenericSnapshotRepo -> Bool
$c/= :: GenericSnapshotRepo -> GenericSnapshotRepo -> Bool
== :: GenericSnapshotRepo -> GenericSnapshotRepo -> Bool
$c== :: GenericSnapshotRepo -> GenericSnapshotRepo -> Bool
Eq, Int -> GenericSnapshotRepo -> ShowS
[GenericSnapshotRepo] -> ShowS
GenericSnapshotRepo -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GenericSnapshotRepo] -> ShowS
$cshowList :: [GenericSnapshotRepo] -> ShowS
show :: GenericSnapshotRepo -> String
$cshow :: GenericSnapshotRepo -> String
showsPrec :: Int -> GenericSnapshotRepo -> ShowS
$cshowsPrec :: Int -> GenericSnapshotRepo -> ShowS
Show)

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

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

-- | Opaque representation of snapshot repo settings. Instances of
-- 'SnapshotRepo' will produce this.
newtype GenericSnapshotRepoSettings = GenericSnapshotRepoSettings {GenericSnapshotRepoSettings -> Object
gSnapshotRepoSettingsObject :: Object}
  deriving (GenericSnapshotRepoSettings -> GenericSnapshotRepoSettings -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GenericSnapshotRepoSettings -> GenericSnapshotRepoSettings -> Bool
$c/= :: GenericSnapshotRepoSettings -> GenericSnapshotRepoSettings -> Bool
== :: GenericSnapshotRepoSettings -> GenericSnapshotRepoSettings -> Bool
$c== :: GenericSnapshotRepoSettings -> GenericSnapshotRepoSettings -> Bool
Eq, Int -> GenericSnapshotRepoSettings -> ShowS
[GenericSnapshotRepoSettings] -> ShowS
GenericSnapshotRepoSettings -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GenericSnapshotRepoSettings] -> ShowS
$cshowList :: [GenericSnapshotRepoSettings] -> ShowS
show :: GenericSnapshotRepoSettings -> String
$cshow :: GenericSnapshotRepoSettings -> String
showsPrec :: Int -> GenericSnapshotRepoSettings -> ShowS
$cshowsPrec :: Int -> GenericSnapshotRepoSettings -> ShowS
Show, [GenericSnapshotRepoSettings] -> Encoding
[GenericSnapshotRepoSettings] -> Value
GenericSnapshotRepoSettings -> Encoding
GenericSnapshotRepoSettings -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [GenericSnapshotRepoSettings] -> Encoding
$ctoEncodingList :: [GenericSnapshotRepoSettings] -> Encoding
toJSONList :: [GenericSnapshotRepoSettings] -> Value
$ctoJSONList :: [GenericSnapshotRepoSettings] -> Value
toEncoding :: GenericSnapshotRepoSettings -> Encoding
$ctoEncoding :: GenericSnapshotRepoSettings -> Encoding
toJSON :: GenericSnapshotRepoSettings -> Value
$ctoJSON :: GenericSnapshotRepoSettings -> Value
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 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Object -> GenericSnapshotRepoSettings
GenericSnapshotRepoSettings forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Value -> Value
unStringlyTypeJSON) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. FromJSON a => Value -> Parser a
parseJSON

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

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

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

-- | Unique, automatically-generated name assigned to nodes that are
-- usually returned in node-oriented APIs.
newtype FullNodeId = FullNodeId {FullNodeId -> Text
fullNodeId :: Text}
  deriving (FullNodeId -> FullNodeId -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FullNodeId -> FullNodeId -> Bool
$c/= :: FullNodeId -> FullNodeId -> Bool
== :: FullNodeId -> FullNodeId -> Bool
$c== :: FullNodeId -> FullNodeId -> Bool
Eq, Eq FullNodeId
FullNodeId -> FullNodeId -> Bool
FullNodeId -> FullNodeId -> Ordering
FullNodeId -> FullNodeId -> FullNodeId
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
min :: FullNodeId -> FullNodeId -> FullNodeId
$cmin :: FullNodeId -> FullNodeId -> FullNodeId
max :: FullNodeId -> FullNodeId -> FullNodeId
$cmax :: FullNodeId -> FullNodeId -> FullNodeId
>= :: FullNodeId -> FullNodeId -> Bool
$c>= :: FullNodeId -> FullNodeId -> Bool
> :: FullNodeId -> FullNodeId -> Bool
$c> :: FullNodeId -> FullNodeId -> Bool
<= :: FullNodeId -> FullNodeId -> Bool
$c<= :: FullNodeId -> FullNodeId -> Bool
< :: FullNodeId -> FullNodeId -> Bool
$c< :: FullNodeId -> FullNodeId -> Bool
compare :: FullNodeId -> FullNodeId -> Ordering
$ccompare :: FullNodeId -> FullNodeId -> Ordering
Ord, Int -> FullNodeId -> ShowS
[FullNodeId] -> ShowS
FullNodeId -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FullNodeId] -> ShowS
$cshowList :: [FullNodeId] -> ShowS
show :: FullNodeId -> String
$cshow :: FullNodeId -> String
showsPrec :: Int -> FullNodeId -> ShowS
$cshowsPrec :: Int -> FullNodeId -> ShowS
Show, Value -> Parser [FullNodeId]
Value -> Parser FullNodeId
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [FullNodeId]
$cparseJSONList :: Value -> Parser [FullNodeId]
parseJSON :: Value -> Parser FullNodeId
$cparseJSON :: Value -> Parser FullNodeId
FromJSON)

-- | A human-readable node name that is supplied by the user in the
-- node config or automatically generated by Elasticsearch.
newtype NodeName = NodeName {NodeName -> Text
nodeName :: Text}
  deriving (NodeName -> NodeName -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NodeName -> NodeName -> Bool
$c/= :: NodeName -> NodeName -> Bool
== :: NodeName -> NodeName -> Bool
$c== :: NodeName -> NodeName -> Bool
Eq, Eq NodeName
NodeName -> NodeName -> Bool
NodeName -> NodeName -> Ordering
NodeName -> NodeName -> NodeName
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
min :: NodeName -> NodeName -> NodeName
$cmin :: NodeName -> NodeName -> NodeName
max :: NodeName -> NodeName -> NodeName
$cmax :: NodeName -> NodeName -> NodeName
>= :: NodeName -> NodeName -> Bool
$c>= :: NodeName -> NodeName -> Bool
> :: NodeName -> NodeName -> Bool
$c> :: NodeName -> NodeName -> Bool
<= :: NodeName -> NodeName -> Bool
$c<= :: NodeName -> NodeName -> Bool
< :: NodeName -> NodeName -> Bool
$c< :: NodeName -> NodeName -> Bool
compare :: NodeName -> NodeName -> Ordering
$ccompare :: NodeName -> NodeName -> Ordering
Ord, Int -> NodeName -> ShowS
[NodeName] -> ShowS
NodeName -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NodeName] -> ShowS
$cshowList :: [NodeName] -> ShowS
show :: NodeName -> String
$cshow :: NodeName -> String
showsPrec :: Int -> NodeName -> ShowS
$cshowsPrec :: Int -> NodeName -> ShowS
Show, Value -> Parser [NodeName]
Value -> Parser NodeName
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [NodeName]
$cparseJSONList :: Value -> Parser [NodeName]
parseJSON :: Value -> Parser NodeName
$cparseJSON :: Value -> Parser NodeName
FromJSON)

newtype ClusterName = ClusterName {ClusterName -> Text
clusterName :: Text}
  deriving (ClusterName -> ClusterName -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ClusterName -> ClusterName -> Bool
$c/= :: ClusterName -> ClusterName -> Bool
== :: ClusterName -> ClusterName -> Bool
$c== :: ClusterName -> ClusterName -> Bool
Eq, Eq ClusterName
ClusterName -> ClusterName -> Bool
ClusterName -> ClusterName -> Ordering
ClusterName -> ClusterName -> ClusterName
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
min :: ClusterName -> ClusterName -> ClusterName
$cmin :: ClusterName -> ClusterName -> ClusterName
max :: ClusterName -> ClusterName -> ClusterName
$cmax :: ClusterName -> ClusterName -> ClusterName
>= :: ClusterName -> ClusterName -> Bool
$c>= :: ClusterName -> ClusterName -> Bool
> :: ClusterName -> ClusterName -> Bool
$c> :: ClusterName -> ClusterName -> Bool
<= :: ClusterName -> ClusterName -> Bool
$c<= :: ClusterName -> ClusterName -> Bool
< :: ClusterName -> ClusterName -> Bool
$c< :: ClusterName -> ClusterName -> Bool
compare :: ClusterName -> ClusterName -> Ordering
$ccompare :: ClusterName -> ClusterName -> Ordering
Ord, Int -> ClusterName -> ShowS
[ClusterName] -> ShowS
ClusterName -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ClusterName] -> ShowS
$cshowList :: [ClusterName] -> ShowS
show :: ClusterName -> String
$cshow :: ClusterName -> String
showsPrec :: Int -> ClusterName -> ShowS
$cshowsPrec :: Int -> ClusterName -> ShowS
Show, Value -> Parser [ClusterName]
Value -> Parser ClusterName
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [ClusterName]
$cparseJSONList :: Value -> Parser [ClusterName]
parseJSON :: Value -> Parser ClusterName
$cparseJSON :: Value -> Parser ClusterName
FromJSON)

data NodesInfo = NodesInfo
  { NodesInfo -> [NodeInfo]
nodesInfo :: [NodeInfo],
    NodesInfo -> ClusterName
nodesClusterName :: ClusterName
  }
  deriving (NodesInfo -> NodesInfo -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NodesInfo -> NodesInfo -> Bool
$c/= :: NodesInfo -> NodesInfo -> Bool
== :: NodesInfo -> NodesInfo -> Bool
$c== :: NodesInfo -> NodesInfo -> Bool
Eq, Int -> NodesInfo -> ShowS
[NodesInfo] -> ShowS
NodesInfo -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NodesInfo] -> ShowS
$cshowList :: [NodesInfo] -> ShowS
show :: NodesInfo -> String
$cshow :: NodesInfo -> String
showsPrec :: Int -> NodesInfo -> ShowS
$cshowsPrec :: Int -> NodesInfo -> ShowS
Show)

data NodesStats = NodesStats
  { NodesStats -> [NodeStats]
nodesStats :: [NodeStats],
    NodesStats -> ClusterName
nodesStatsClusterName :: ClusterName
  }
  deriving (NodesStats -> NodesStats -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NodesStats -> NodesStats -> Bool
$c/= :: NodesStats -> NodesStats -> Bool
== :: NodesStats -> NodesStats -> Bool
$c== :: NodesStats -> NodesStats -> Bool
Eq, Int -> NodesStats -> ShowS
[NodesStats] -> ShowS
NodesStats -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NodesStats] -> ShowS
$cshowList :: [NodesStats] -> ShowS
show :: NodesStats -> String
$cshow :: NodesStats -> String
showsPrec :: Int -> NodesStats -> ShowS
$cshowsPrec :: Int -> NodesStats -> ShowS
Show)

data NodeStats = NodeStats
  { NodeStats -> NodeName
nodeStatsName :: NodeName,
    NodeStats -> FullNodeId
nodeStatsFullId :: FullNodeId,
    NodeStats -> Maybe NodeBreakersStats
nodeStatsBreakersStats :: Maybe NodeBreakersStats,
    NodeStats -> NodeHTTPStats
nodeStatsHTTP :: NodeHTTPStats,
    NodeStats -> NodeTransportStats
nodeStatsTransport :: NodeTransportStats,
    NodeStats -> NodeFSStats
nodeStatsFS :: NodeFSStats,
    NodeStats -> Maybe NodeNetworkStats
nodeStatsNetwork :: Maybe NodeNetworkStats,
    NodeStats -> Map Text NodeThreadPoolStats
nodeStatsThreadPool :: Map Text NodeThreadPoolStats,
    NodeStats -> NodeJVMStats
nodeStatsJVM :: NodeJVMStats,
    NodeStats -> NodeProcessStats
nodeStatsProcess :: NodeProcessStats,
    NodeStats -> NodeOSStats
nodeStatsOS :: NodeOSStats,
    NodeStats -> NodeIndicesStats
nodeStatsIndices :: NodeIndicesStats
  }
  deriving (NodeStats -> NodeStats -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NodeStats -> NodeStats -> Bool
$c/= :: NodeStats -> NodeStats -> Bool
== :: NodeStats -> NodeStats -> Bool
$c== :: NodeStats -> NodeStats -> Bool
Eq, Int -> NodeStats -> ShowS
[NodeStats] -> ShowS
NodeStats -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NodeStats] -> ShowS
$cshowList :: [NodeStats] -> ShowS
show :: NodeStats -> String
$cshow :: NodeStats -> String
showsPrec :: Int -> NodeStats -> ShowS
$cshowsPrec :: Int -> NodeStats -> ShowS
Show)

data NodeBreakersStats = NodeBreakersStats
  { NodeBreakersStats -> NodeBreakerStats
nodeStatsParentBreaker :: NodeBreakerStats,
    NodeBreakersStats -> NodeBreakerStats
nodeStatsRequestBreaker :: NodeBreakerStats,
    NodeBreakersStats -> NodeBreakerStats
nodeStatsFieldDataBreaker :: NodeBreakerStats
  }
  deriving (NodeBreakersStats -> NodeBreakersStats -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NodeBreakersStats -> NodeBreakersStats -> Bool
$c/= :: NodeBreakersStats -> NodeBreakersStats -> Bool
== :: NodeBreakersStats -> NodeBreakersStats -> Bool
$c== :: NodeBreakersStats -> NodeBreakersStats -> Bool
Eq, Int -> NodeBreakersStats -> ShowS
[NodeBreakersStats] -> ShowS
NodeBreakersStats -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NodeBreakersStats] -> ShowS
$cshowList :: [NodeBreakersStats] -> ShowS
show :: NodeBreakersStats -> String
$cshow :: NodeBreakersStats -> String
showsPrec :: Int -> NodeBreakersStats -> ShowS
$cshowsPrec :: Int -> NodeBreakersStats -> ShowS
Show)

data NodeBreakerStats = NodeBreakerStats
  { NodeBreakerStats -> Int
nodeBreakersTripped :: Int,
    NodeBreakerStats -> Double
nodeBreakersOverhead :: Double,
    NodeBreakerStats -> Bytes
nodeBreakersEstSize :: Bytes,
    NodeBreakerStats -> Bytes
nodeBreakersLimitSize :: Bytes
  }
  deriving (NodeBreakerStats -> NodeBreakerStats -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NodeBreakerStats -> NodeBreakerStats -> Bool
$c/= :: NodeBreakerStats -> NodeBreakerStats -> Bool
== :: NodeBreakerStats -> NodeBreakerStats -> Bool
$c== :: NodeBreakerStats -> NodeBreakerStats -> Bool
Eq, Int -> NodeBreakerStats -> ShowS
[NodeBreakerStats] -> ShowS
NodeBreakerStats -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NodeBreakerStats] -> ShowS
$cshowList :: [NodeBreakerStats] -> ShowS
show :: NodeBreakerStats -> String
$cshow :: NodeBreakerStats -> String
showsPrec :: Int -> NodeBreakerStats -> ShowS
$cshowsPrec :: Int -> NodeBreakerStats -> ShowS
Show)

data NodeHTTPStats = NodeHTTPStats
  { NodeHTTPStats -> Int
nodeHTTPTotalOpened :: Int,
    NodeHTTPStats -> Int
nodeHTTPCurrentOpen :: Int
  }
  deriving (NodeHTTPStats -> NodeHTTPStats -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NodeHTTPStats -> NodeHTTPStats -> Bool
$c/= :: NodeHTTPStats -> NodeHTTPStats -> Bool
== :: NodeHTTPStats -> NodeHTTPStats -> Bool
$c== :: NodeHTTPStats -> NodeHTTPStats -> Bool
Eq, Int -> NodeHTTPStats -> ShowS
[NodeHTTPStats] -> ShowS
NodeHTTPStats -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NodeHTTPStats] -> ShowS
$cshowList :: [NodeHTTPStats] -> ShowS
show :: NodeHTTPStats -> String
$cshow :: NodeHTTPStats -> String
showsPrec :: Int -> NodeHTTPStats -> ShowS
$cshowsPrec :: Int -> NodeHTTPStats -> ShowS
Show)

data NodeTransportStats = NodeTransportStats
  { NodeTransportStats -> Bytes
nodeTransportTXSize :: Bytes,
    NodeTransportStats -> Int
nodeTransportCount :: Int,
    NodeTransportStats -> Bytes
nodeTransportRXSize :: Bytes,
    NodeTransportStats -> Int
nodeTransportRXCount :: Int,
    NodeTransportStats -> Int
nodeTransportServerOpen :: Int
  }
  deriving (NodeTransportStats -> NodeTransportStats -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NodeTransportStats -> NodeTransportStats -> Bool
$c/= :: NodeTransportStats -> NodeTransportStats -> Bool
== :: NodeTransportStats -> NodeTransportStats -> Bool
$c== :: NodeTransportStats -> NodeTransportStats -> Bool
Eq, Int -> NodeTransportStats -> ShowS
[NodeTransportStats] -> ShowS
NodeTransportStats -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NodeTransportStats] -> ShowS
$cshowList :: [NodeTransportStats] -> ShowS
show :: NodeTransportStats -> String
$cshow :: NodeTransportStats -> String
showsPrec :: Int -> NodeTransportStats -> ShowS
$cshowsPrec :: Int -> NodeTransportStats -> ShowS
Show)

data NodeFSStats = NodeFSStats
  { NodeFSStats -> [NodeDataPathStats]
nodeFSDataPaths :: [NodeDataPathStats],
    NodeFSStats -> NodeFSTotalStats
nodeFSTotal :: NodeFSTotalStats,
    NodeFSStats -> UTCTime
nodeFSTimestamp :: UTCTime
  }
  deriving (NodeFSStats -> NodeFSStats -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NodeFSStats -> NodeFSStats -> Bool
$c/= :: NodeFSStats -> NodeFSStats -> Bool
== :: NodeFSStats -> NodeFSStats -> Bool
$c== :: NodeFSStats -> NodeFSStats -> Bool
Eq, Int -> NodeFSStats -> ShowS
[NodeFSStats] -> ShowS
NodeFSStats -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NodeFSStats] -> ShowS
$cshowList :: [NodeFSStats] -> ShowS
show :: NodeFSStats -> String
$cshow :: NodeFSStats -> String
showsPrec :: Int -> NodeFSStats -> ShowS
$cshowsPrec :: Int -> NodeFSStats -> ShowS
Show)

data NodeDataPathStats = NodeDataPathStats
  { NodeDataPathStats -> Maybe Double
nodeDataPathDiskServiceTime :: Maybe Double,
    NodeDataPathStats -> Maybe Double
nodeDataPathDiskQueue :: Maybe Double,
    NodeDataPathStats -> Maybe Bytes
nodeDataPathIOSize :: Maybe Bytes,
    NodeDataPathStats -> Maybe Bytes
nodeDataPathWriteSize :: Maybe Bytes,
    NodeDataPathStats -> Maybe Bytes
nodeDataPathReadSize :: Maybe Bytes,
    NodeDataPathStats -> Maybe Int
nodeDataPathIOOps :: Maybe Int,
    NodeDataPathStats -> Maybe Int
nodeDataPathWrites :: Maybe Int,
    NodeDataPathStats -> Maybe Int
nodeDataPathReads :: Maybe Int,
    NodeDataPathStats -> Bytes
nodeDataPathAvailable :: Bytes,
    NodeDataPathStats -> Bytes
nodeDataPathFree :: Bytes,
    NodeDataPathStats -> Bytes
nodeDataPathTotal :: Bytes,
    NodeDataPathStats -> Maybe Text
nodeDataPathType :: Maybe Text,
    NodeDataPathStats -> Maybe Text
nodeDataPathDevice :: Maybe Text,
    NodeDataPathStats -> Text
nodeDataPathMount :: Text,
    NodeDataPathStats -> Text
nodeDataPathPath :: Text
  }
  deriving (NodeDataPathStats -> NodeDataPathStats -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NodeDataPathStats -> NodeDataPathStats -> Bool
$c/= :: NodeDataPathStats -> NodeDataPathStats -> Bool
== :: NodeDataPathStats -> NodeDataPathStats -> Bool
$c== :: NodeDataPathStats -> NodeDataPathStats -> Bool
Eq, Int -> NodeDataPathStats -> ShowS
[NodeDataPathStats] -> ShowS
NodeDataPathStats -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NodeDataPathStats] -> ShowS
$cshowList :: [NodeDataPathStats] -> ShowS
show :: NodeDataPathStats -> String
$cshow :: NodeDataPathStats -> String
showsPrec :: Int -> NodeDataPathStats -> ShowS
$cshowsPrec :: Int -> NodeDataPathStats -> ShowS
Show)

data NodeFSTotalStats = NodeFSTotalStats
  { NodeFSTotalStats -> Maybe Double
nodeFSTotalDiskServiceTime :: Maybe Double,
    NodeFSTotalStats -> Maybe Double
nodeFSTotalDiskQueue :: Maybe Double,
    NodeFSTotalStats -> Maybe Bytes
nodeFSTotalIOSize :: Maybe Bytes,
    NodeFSTotalStats -> Maybe Bytes
nodeFSTotalWriteSize :: Maybe Bytes,
    NodeFSTotalStats -> Maybe Bytes
nodeFSTotalReadSize :: Maybe Bytes,
    NodeFSTotalStats -> Maybe Int
nodeFSTotalIOOps :: Maybe Int,
    NodeFSTotalStats -> Maybe Int
nodeFSTotalWrites :: Maybe Int,
    NodeFSTotalStats -> Maybe Int
nodeFSTotalReads :: Maybe Int,
    NodeFSTotalStats -> Bytes
nodeFSTotalAvailable :: Bytes,
    NodeFSTotalStats -> Bytes
nodeFSTotalFree :: Bytes,
    NodeFSTotalStats -> Bytes
nodeFSTotalTotal :: Bytes
  }
  deriving (NodeFSTotalStats -> NodeFSTotalStats -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NodeFSTotalStats -> NodeFSTotalStats -> Bool
$c/= :: NodeFSTotalStats -> NodeFSTotalStats -> Bool
== :: NodeFSTotalStats -> NodeFSTotalStats -> Bool
$c== :: NodeFSTotalStats -> NodeFSTotalStats -> Bool
Eq, Int -> NodeFSTotalStats -> ShowS
[NodeFSTotalStats] -> ShowS
NodeFSTotalStats -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NodeFSTotalStats] -> ShowS
$cshowList :: [NodeFSTotalStats] -> ShowS
show :: NodeFSTotalStats -> String
$cshow :: NodeFSTotalStats -> String
showsPrec :: Int -> NodeFSTotalStats -> ShowS
$cshowsPrec :: Int -> NodeFSTotalStats -> ShowS
Show)

data NodeNetworkStats = NodeNetworkStats
  { NodeNetworkStats -> Int
nodeNetTCPOutRSTs :: Int,
    NodeNetworkStats -> Int
nodeNetTCPInErrs :: Int,
    NodeNetworkStats -> Int
nodeNetTCPAttemptFails :: Int,
    NodeNetworkStats -> Int
nodeNetTCPEstabResets :: Int,
    NodeNetworkStats -> Int
nodeNetTCPRetransSegs :: Int,
    NodeNetworkStats -> Int
nodeNetTCPOutSegs :: Int,
    NodeNetworkStats -> Int
nodeNetTCPInSegs :: Int,
    NodeNetworkStats -> Int
nodeNetTCPCurrEstab :: Int,
    NodeNetworkStats -> Int
nodeNetTCPPassiveOpens :: Int,
    NodeNetworkStats -> Int
nodeNetTCPActiveOpens :: Int
  }
  deriving (NodeNetworkStats -> NodeNetworkStats -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NodeNetworkStats -> NodeNetworkStats -> Bool
$c/= :: NodeNetworkStats -> NodeNetworkStats -> Bool
== :: NodeNetworkStats -> NodeNetworkStats -> Bool
$c== :: NodeNetworkStats -> NodeNetworkStats -> Bool
Eq, Int -> NodeNetworkStats -> ShowS
[NodeNetworkStats] -> ShowS
NodeNetworkStats -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NodeNetworkStats] -> ShowS
$cshowList :: [NodeNetworkStats] -> ShowS
show :: NodeNetworkStats -> String
$cshow :: NodeNetworkStats -> String
showsPrec :: Int -> NodeNetworkStats -> ShowS
$cshowsPrec :: Int -> NodeNetworkStats -> ShowS
Show)

data NodeThreadPoolStats = NodeThreadPoolStats
  { NodeThreadPoolStats -> Int
nodeThreadPoolCompleted :: Int,
    NodeThreadPoolStats -> Int
nodeThreadPoolLargest :: Int,
    NodeThreadPoolStats -> Int
nodeThreadPoolRejected :: Int,
    NodeThreadPoolStats -> Int
nodeThreadPoolActive :: Int,
    NodeThreadPoolStats -> Int
nodeThreadPoolQueue :: Int,
    NodeThreadPoolStats -> Int
nodeThreadPoolThreads :: Int
  }
  deriving (NodeThreadPoolStats -> NodeThreadPoolStats -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NodeThreadPoolStats -> NodeThreadPoolStats -> Bool
$c/= :: NodeThreadPoolStats -> NodeThreadPoolStats -> Bool
== :: NodeThreadPoolStats -> NodeThreadPoolStats -> Bool
$c== :: NodeThreadPoolStats -> NodeThreadPoolStats -> Bool
Eq, Int -> NodeThreadPoolStats -> ShowS
[NodeThreadPoolStats] -> ShowS
NodeThreadPoolStats -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NodeThreadPoolStats] -> ShowS
$cshowList :: [NodeThreadPoolStats] -> ShowS
show :: NodeThreadPoolStats -> String
$cshow :: NodeThreadPoolStats -> String
showsPrec :: Int -> NodeThreadPoolStats -> ShowS
$cshowsPrec :: Int -> NodeThreadPoolStats -> ShowS
Show)

data NodeJVMStats = NodeJVMStats
  { NodeJVMStats -> JVMBufferPoolStats
nodeJVMStatsMappedBufferPool :: JVMBufferPoolStats,
    NodeJVMStats -> JVMBufferPoolStats
nodeJVMStatsDirectBufferPool :: JVMBufferPoolStats,
    NodeJVMStats -> JVMGCStats
nodeJVMStatsGCOldCollector :: JVMGCStats,
    NodeJVMStats -> JVMGCStats
nodeJVMStatsGCYoungCollector :: JVMGCStats,
    NodeJVMStats -> Int
nodeJVMStatsPeakThreadsCount :: Int,
    NodeJVMStats -> Int
nodeJVMStatsThreadsCount :: Int,
    NodeJVMStats -> JVMPoolStats
nodeJVMStatsOldPool :: JVMPoolStats,
    NodeJVMStats -> JVMPoolStats
nodeJVMStatsSurvivorPool :: JVMPoolStats,
    NodeJVMStats -> JVMPoolStats
nodeJVMStatsYoungPool :: JVMPoolStats,
    NodeJVMStats -> Bytes
nodeJVMStatsNonHeapCommitted :: Bytes,
    NodeJVMStats -> Bytes
nodeJVMStatsNonHeapUsed :: Bytes,
    NodeJVMStats -> Bytes
nodeJVMStatsHeapMax :: Bytes,
    NodeJVMStats -> Bytes
nodeJVMStatsHeapCommitted :: Bytes,
    NodeJVMStats -> Int
nodeJVMStatsHeapUsedPercent :: Int,
    NodeJVMStats -> Bytes
nodeJVMStatsHeapUsed :: Bytes,
    NodeJVMStats -> NominalDiffTime
nodeJVMStatsUptime :: NominalDiffTime,
    NodeJVMStats -> UTCTime
nodeJVMStatsTimestamp :: UTCTime
  }
  deriving (NodeJVMStats -> NodeJVMStats -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NodeJVMStats -> NodeJVMStats -> Bool
$c/= :: NodeJVMStats -> NodeJVMStats -> Bool
== :: NodeJVMStats -> NodeJVMStats -> Bool
$c== :: NodeJVMStats -> NodeJVMStats -> Bool
Eq, Int -> NodeJVMStats -> ShowS
[NodeJVMStats] -> ShowS
NodeJVMStats -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NodeJVMStats] -> ShowS
$cshowList :: [NodeJVMStats] -> ShowS
show :: NodeJVMStats -> String
$cshow :: NodeJVMStats -> String
showsPrec :: Int -> NodeJVMStats -> ShowS
$cshowsPrec :: Int -> NodeJVMStats -> ShowS
Show)

data JVMBufferPoolStats = JVMBufferPoolStats
  { JVMBufferPoolStats -> Bytes
jvmBufferPoolStatsTotalCapacity :: Bytes,
    JVMBufferPoolStats -> Bytes
jvmBufferPoolStatsUsed :: Bytes,
    JVMBufferPoolStats -> Int
jvmBufferPoolStatsCount :: Int
  }
  deriving (JVMBufferPoolStats -> JVMBufferPoolStats -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: JVMBufferPoolStats -> JVMBufferPoolStats -> Bool
$c/= :: JVMBufferPoolStats -> JVMBufferPoolStats -> Bool
== :: JVMBufferPoolStats -> JVMBufferPoolStats -> Bool
$c== :: JVMBufferPoolStats -> JVMBufferPoolStats -> Bool
Eq, Int -> JVMBufferPoolStats -> ShowS
[JVMBufferPoolStats] -> ShowS
JVMBufferPoolStats -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [JVMBufferPoolStats] -> ShowS
$cshowList :: [JVMBufferPoolStats] -> ShowS
show :: JVMBufferPoolStats -> String
$cshow :: JVMBufferPoolStats -> String
showsPrec :: Int -> JVMBufferPoolStats -> ShowS
$cshowsPrec :: Int -> JVMBufferPoolStats -> ShowS
Show)

data JVMGCStats = JVMGCStats
  { JVMGCStats -> NominalDiffTime
jvmGCStatsCollectionTime :: NominalDiffTime,
    JVMGCStats -> Int
jvmGCStatsCollectionCount :: Int
  }
  deriving (JVMGCStats -> JVMGCStats -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: JVMGCStats -> JVMGCStats -> Bool
$c/= :: JVMGCStats -> JVMGCStats -> Bool
== :: JVMGCStats -> JVMGCStats -> Bool
$c== :: JVMGCStats -> JVMGCStats -> Bool
Eq, Int -> JVMGCStats -> ShowS
[JVMGCStats] -> ShowS
JVMGCStats -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [JVMGCStats] -> ShowS
$cshowList :: [JVMGCStats] -> ShowS
show :: JVMGCStats -> String
$cshow :: JVMGCStats -> String
showsPrec :: Int -> JVMGCStats -> ShowS
$cshowsPrec :: Int -> JVMGCStats -> ShowS
Show)

data JVMPoolStats = JVMPoolStats
  { JVMPoolStats -> Bytes
jvmPoolStatsPeakMax :: Bytes,
    JVMPoolStats -> Bytes
jvmPoolStatsPeakUsed :: Bytes,
    JVMPoolStats -> Bytes
jvmPoolStatsMax :: Bytes,
    JVMPoolStats -> Bytes
jvmPoolStatsUsed :: Bytes
  }
  deriving (JVMPoolStats -> JVMPoolStats -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: JVMPoolStats -> JVMPoolStats -> Bool
$c/= :: JVMPoolStats -> JVMPoolStats -> Bool
== :: JVMPoolStats -> JVMPoolStats -> Bool
$c== :: JVMPoolStats -> JVMPoolStats -> Bool
Eq, Int -> JVMPoolStats -> ShowS
[JVMPoolStats] -> ShowS
JVMPoolStats -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [JVMPoolStats] -> ShowS
$cshowList :: [JVMPoolStats] -> ShowS
show :: JVMPoolStats -> String
$cshow :: JVMPoolStats -> String
showsPrec :: Int -> JVMPoolStats -> ShowS
$cshowsPrec :: Int -> JVMPoolStats -> ShowS
Show)

data NodeProcessStats = NodeProcessStats
  { NodeProcessStats -> UTCTime
nodeProcessTimestamp :: UTCTime,
    NodeProcessStats -> Int
nodeProcessOpenFDs :: Int,
    NodeProcessStats -> Int
nodeProcessMaxFDs :: Int,
    NodeProcessStats -> Int
nodeProcessCPUPercent :: Int,
    NodeProcessStats -> NominalDiffTime
nodeProcessCPUTotal :: NominalDiffTime,
    NodeProcessStats -> Bytes
nodeProcessMemTotalVirtual :: Bytes
  }
  deriving (NodeProcessStats -> NodeProcessStats -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NodeProcessStats -> NodeProcessStats -> Bool
$c/= :: NodeProcessStats -> NodeProcessStats -> Bool
== :: NodeProcessStats -> NodeProcessStats -> Bool
$c== :: NodeProcessStats -> NodeProcessStats -> Bool
Eq, Int -> NodeProcessStats -> ShowS
[NodeProcessStats] -> ShowS
NodeProcessStats -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NodeProcessStats] -> ShowS
$cshowList :: [NodeProcessStats] -> ShowS
show :: NodeProcessStats -> String
$cshow :: NodeProcessStats -> String
showsPrec :: Int -> NodeProcessStats -> ShowS
$cshowsPrec :: Int -> NodeProcessStats -> ShowS
Show)

data NodeOSStats = NodeOSStats
  { NodeOSStats -> UTCTime
nodeOSTimestamp :: UTCTime,
    NodeOSStats -> Int
nodeOSCPUPercent :: Int,
    NodeOSStats -> Maybe LoadAvgs
nodeOSLoad :: Maybe LoadAvgs,
    NodeOSStats -> Bytes
nodeOSMemTotal :: Bytes,
    NodeOSStats -> Bytes
nodeOSMemFree :: Bytes,
    NodeOSStats -> Int
nodeOSMemFreePercent :: Int,
    NodeOSStats -> Bytes
nodeOSMemUsed :: Bytes,
    NodeOSStats -> Int
nodeOSMemUsedPercent :: Int,
    NodeOSStats -> Bytes
nodeOSSwapTotal :: Bytes,
    NodeOSStats -> Bytes
nodeOSSwapFree :: Bytes,
    NodeOSStats -> Bytes
nodeOSSwapUsed :: Bytes
  }
  deriving (NodeOSStats -> NodeOSStats -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NodeOSStats -> NodeOSStats -> Bool
$c/= :: NodeOSStats -> NodeOSStats -> Bool
== :: NodeOSStats -> NodeOSStats -> Bool
$c== :: NodeOSStats -> NodeOSStats -> Bool
Eq, Int -> NodeOSStats -> ShowS
[NodeOSStats] -> ShowS
NodeOSStats -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NodeOSStats] -> ShowS
$cshowList :: [NodeOSStats] -> ShowS
show :: NodeOSStats -> String
$cshow :: NodeOSStats -> String
showsPrec :: Int -> NodeOSStats -> ShowS
$cshowsPrec :: Int -> NodeOSStats -> ShowS
Show)

data LoadAvgs = LoadAvgs
  { LoadAvgs -> Double
loadAvg1Min :: Double,
    LoadAvgs -> Double
loadAvg5Min :: Double,
    LoadAvgs -> Double
loadAvg15Min :: Double
  }
  deriving (LoadAvgs -> LoadAvgs -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LoadAvgs -> LoadAvgs -> Bool
$c/= :: LoadAvgs -> LoadAvgs -> Bool
== :: LoadAvgs -> LoadAvgs -> Bool
$c== :: LoadAvgs -> LoadAvgs -> Bool
Eq, Int -> LoadAvgs -> ShowS
[LoadAvgs] -> ShowS
LoadAvgs -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LoadAvgs] -> ShowS
$cshowList :: [LoadAvgs] -> ShowS
show :: LoadAvgs -> String
$cshow :: LoadAvgs -> String
showsPrec :: Int -> LoadAvgs -> ShowS
$cshowsPrec :: Int -> LoadAvgs -> ShowS
Show)

data NodeIndicesStats = NodeIndicesStats
  { NodeIndicesStats -> Maybe NominalDiffTime
nodeIndicesStatsRecoveryThrottleTime :: Maybe NominalDiffTime,
    NodeIndicesStats -> Maybe Int
nodeIndicesStatsRecoveryCurrentAsTarget :: Maybe Int,
    NodeIndicesStats -> Maybe Int
nodeIndicesStatsRecoveryCurrentAsSource :: Maybe Int,
    NodeIndicesStats -> Maybe Int
nodeIndicesStatsQueryCacheMisses :: Maybe Int,
    NodeIndicesStats -> Maybe Int
nodeIndicesStatsQueryCacheHits :: Maybe Int,
    NodeIndicesStats -> Maybe Int
nodeIndicesStatsQueryCacheEvictions :: Maybe Int,
    NodeIndicesStats -> Maybe Bytes
nodeIndicesStatsQueryCacheSize :: Maybe Bytes,
    NodeIndicesStats -> Maybe Int
nodeIndicesStatsSuggestCurrent :: Maybe Int,
    NodeIndicesStats -> Maybe NominalDiffTime
nodeIndicesStatsSuggestTime :: Maybe NominalDiffTime,
    NodeIndicesStats -> Maybe Int
nodeIndicesStatsSuggestTotal :: Maybe Int,
    NodeIndicesStats -> Bytes
nodeIndicesStatsTranslogSize :: Bytes,
    NodeIndicesStats -> Int
nodeIndicesStatsTranslogOps :: Int,
    NodeIndicesStats -> Maybe Bytes
nodeIndicesStatsSegFixedBitSetMemory :: Maybe Bytes,
    NodeIndicesStats -> Bytes
nodeIndicesStatsSegVersionMapMemory :: Bytes,
    NodeIndicesStats -> Maybe Bytes
nodeIndicesStatsSegIndexWriterMaxMemory :: Maybe Bytes,
    NodeIndicesStats -> Bytes
nodeIndicesStatsSegIndexWriterMemory :: Bytes,
    NodeIndicesStats -> Bytes
nodeIndicesStatsSegMemory :: Bytes,
    NodeIndicesStats -> Int
nodeIndicesStatsSegCount :: Int,
    NodeIndicesStats -> Bytes
nodeIndicesStatsCompletionSize :: Bytes,
    NodeIndicesStats -> Maybe Int
nodeIndicesStatsPercolateQueries :: Maybe Int,
    NodeIndicesStats -> Maybe Bytes
nodeIndicesStatsPercolateMemory :: Maybe Bytes,
    NodeIndicesStats -> Maybe Int
nodeIndicesStatsPercolateCurrent :: Maybe Int,
    NodeIndicesStats -> Maybe NominalDiffTime
nodeIndicesStatsPercolateTime :: Maybe NominalDiffTime,
    NodeIndicesStats -> Maybe Int
nodeIndicesStatsPercolateTotal :: Maybe Int,
    NodeIndicesStats -> Int
nodeIndicesStatsFieldDataEvictions :: Int,
    NodeIndicesStats -> Bytes
nodeIndicesStatsFieldDataMemory :: Bytes,
    NodeIndicesStats -> NominalDiffTime
nodeIndicesStatsWarmerTotalTime :: NominalDiffTime,
    NodeIndicesStats -> Int
nodeIndicesStatsWarmerTotal :: Int,
    NodeIndicesStats -> Int
nodeIndicesStatsWarmerCurrent :: Int,
    NodeIndicesStats -> NominalDiffTime
nodeIndicesStatsFlushTotalTime :: NominalDiffTime,
    NodeIndicesStats -> Int
nodeIndicesStatsFlushTotal :: Int,
    NodeIndicesStats -> NominalDiffTime
nodeIndicesStatsRefreshTotalTime :: NominalDiffTime,
    NodeIndicesStats -> Int
nodeIndicesStatsRefreshTotal :: Int,
    NodeIndicesStats -> Bytes
nodeIndicesStatsMergesTotalSize :: Bytes,
    NodeIndicesStats -> Int
nodeIndicesStatsMergesTotalDocs :: Int,
    NodeIndicesStats -> NominalDiffTime
nodeIndicesStatsMergesTotalTime :: NominalDiffTime,
    NodeIndicesStats -> Int
nodeIndicesStatsMergesTotal :: Int,
    NodeIndicesStats -> Bytes
nodeIndicesStatsMergesCurrentSize :: Bytes,
    NodeIndicesStats -> Int
nodeIndicesStatsMergesCurrentDocs :: Int,
    NodeIndicesStats -> Int
nodeIndicesStatsMergesCurrent :: Int,
    NodeIndicesStats -> Int
nodeIndicesStatsSearchFetchCurrent :: Int,
    NodeIndicesStats -> NominalDiffTime
nodeIndicesStatsSearchFetchTime :: NominalDiffTime,
    NodeIndicesStats -> Int
nodeIndicesStatsSearchFetchTotal :: Int,
    NodeIndicesStats -> Int
nodeIndicesStatsSearchQueryCurrent :: Int,
    NodeIndicesStats -> NominalDiffTime
nodeIndicesStatsSearchQueryTime :: NominalDiffTime,
    NodeIndicesStats -> Int
nodeIndicesStatsSearchQueryTotal :: Int,
    NodeIndicesStats -> Int
nodeIndicesStatsSearchOpenContexts :: Int,
    NodeIndicesStats -> Int
nodeIndicesStatsGetCurrent :: Int,
    NodeIndicesStats -> NominalDiffTime
nodeIndicesStatsGetMissingTime :: NominalDiffTime,
    NodeIndicesStats -> Int
nodeIndicesStatsGetMissingTotal :: Int,
    NodeIndicesStats -> NominalDiffTime
nodeIndicesStatsGetExistsTime :: NominalDiffTime,
    NodeIndicesStats -> Int
nodeIndicesStatsGetExistsTotal :: Int,
    NodeIndicesStats -> NominalDiffTime
nodeIndicesStatsGetTime :: NominalDiffTime,
    NodeIndicesStats -> Int
nodeIndicesStatsGetTotal :: Int,
    NodeIndicesStats -> Maybe NominalDiffTime
nodeIndicesStatsIndexingThrottleTime :: Maybe NominalDiffTime,
    NodeIndicesStats -> Maybe Bool
nodeIndicesStatsIndexingIsThrottled :: Maybe Bool,
    NodeIndicesStats -> Maybe Int
nodeIndicesStatsIndexingNoopUpdateTotal :: Maybe Int,
    NodeIndicesStats -> Int
nodeIndicesStatsIndexingDeleteCurrent :: Int,
    NodeIndicesStats -> NominalDiffTime
nodeIndicesStatsIndexingDeleteTime :: NominalDiffTime,
    NodeIndicesStats -> Int
nodeIndicesStatsIndexingDeleteTotal :: Int,
    NodeIndicesStats -> Int
nodeIndicesStatsIndexingIndexCurrent :: Int,
    NodeIndicesStats -> NominalDiffTime
nodeIndicesStatsIndexingIndexTime :: NominalDiffTime,
    NodeIndicesStats -> Int
nodeIndicesStatsIndexingTotal :: Int,
    NodeIndicesStats -> Maybe NominalDiffTime
nodeIndicesStatsStoreThrottleTime :: Maybe NominalDiffTime,
    NodeIndicesStats -> Bytes
nodeIndicesStatsStoreSize :: Bytes,
    NodeIndicesStats -> Int
nodeIndicesStatsDocsDeleted :: Int,
    NodeIndicesStats -> Int
nodeIndicesStatsDocsCount :: Int
  }
  deriving (NodeIndicesStats -> NodeIndicesStats -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NodeIndicesStats -> NodeIndicesStats -> Bool
$c/= :: NodeIndicesStats -> NodeIndicesStats -> Bool
== :: NodeIndicesStats -> NodeIndicesStats -> Bool
$c== :: NodeIndicesStats -> NodeIndicesStats -> Bool
Eq, Int -> NodeIndicesStats -> ShowS
[NodeIndicesStats] -> ShowS
NodeIndicesStats -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NodeIndicesStats] -> ShowS
$cshowList :: [NodeIndicesStats] -> ShowS
show :: NodeIndicesStats -> String
$cshow :: NodeIndicesStats -> String
showsPrec :: Int -> NodeIndicesStats -> ShowS
$cshowsPrec :: Int -> NodeIndicesStats -> ShowS
Show)

-- | A quirky address format used throughout Elasticsearch. An example
-- would be inet[/1.1.1.1:9200]. inet may be a placeholder for a
-- <https://en.wikipedia.org/wiki/Fully_qualified_domain_name FQDN>.
newtype EsAddress = EsAddress {EsAddress -> Text
esAddress :: Text}
  deriving (EsAddress -> EsAddress -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EsAddress -> EsAddress -> Bool
$c/= :: EsAddress -> EsAddress -> Bool
== :: EsAddress -> EsAddress -> Bool
$c== :: EsAddress -> EsAddress -> Bool
Eq, Eq EsAddress
EsAddress -> EsAddress -> Bool
EsAddress -> EsAddress -> Ordering
EsAddress -> EsAddress -> EsAddress
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
min :: EsAddress -> EsAddress -> EsAddress
$cmin :: EsAddress -> EsAddress -> EsAddress
max :: EsAddress -> EsAddress -> EsAddress
$cmax :: EsAddress -> EsAddress -> EsAddress
>= :: EsAddress -> EsAddress -> Bool
$c>= :: EsAddress -> EsAddress -> Bool
> :: EsAddress -> EsAddress -> Bool
$c> :: EsAddress -> EsAddress -> Bool
<= :: EsAddress -> EsAddress -> Bool
$c<= :: EsAddress -> EsAddress -> Bool
< :: EsAddress -> EsAddress -> Bool
$c< :: EsAddress -> EsAddress -> Bool
compare :: EsAddress -> EsAddress -> Ordering
$ccompare :: EsAddress -> EsAddress -> Ordering
Ord, Int -> EsAddress -> ShowS
[EsAddress] -> ShowS
EsAddress -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EsAddress] -> ShowS
$cshowList :: [EsAddress] -> ShowS
show :: EsAddress -> String
$cshow :: EsAddress -> String
showsPrec :: Int -> EsAddress -> ShowS
$cshowsPrec :: Int -> EsAddress -> ShowS
Show, Value -> Parser [EsAddress]
Value -> Parser EsAddress
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [EsAddress]
$cparseJSONList :: Value -> Parser [EsAddress]
parseJSON :: Value -> Parser EsAddress
$cparseJSON :: Value -> Parser EsAddress
FromJSON)

-- | Typically a 7 character hex string.
newtype BuildHash = BuildHash {BuildHash -> Text
buildHash :: Text}
  deriving (BuildHash -> BuildHash -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BuildHash -> BuildHash -> Bool
$c/= :: BuildHash -> BuildHash -> Bool
== :: BuildHash -> BuildHash -> Bool
$c== :: BuildHash -> BuildHash -> Bool
Eq, Eq BuildHash
BuildHash -> BuildHash -> Bool
BuildHash -> BuildHash -> Ordering
BuildHash -> BuildHash -> BuildHash
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
min :: BuildHash -> BuildHash -> BuildHash
$cmin :: BuildHash -> BuildHash -> BuildHash
max :: BuildHash -> BuildHash -> BuildHash
$cmax :: BuildHash -> BuildHash -> BuildHash
>= :: BuildHash -> BuildHash -> Bool
$c>= :: BuildHash -> BuildHash -> Bool
> :: BuildHash -> BuildHash -> Bool
$c> :: BuildHash -> BuildHash -> Bool
<= :: BuildHash -> BuildHash -> Bool
$c<= :: BuildHash -> BuildHash -> Bool
< :: BuildHash -> BuildHash -> Bool
$c< :: BuildHash -> BuildHash -> Bool
compare :: BuildHash -> BuildHash -> Ordering
$ccompare :: BuildHash -> BuildHash -> Ordering
Ord, Int -> BuildHash -> ShowS
[BuildHash] -> ShowS
BuildHash -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BuildHash] -> ShowS
$cshowList :: [BuildHash] -> ShowS
show :: BuildHash -> String
$cshow :: BuildHash -> String
showsPrec :: Int -> BuildHash -> ShowS
$cshowsPrec :: Int -> BuildHash -> ShowS
Show, forall x. Rep BuildHash x -> BuildHash
forall x. BuildHash -> Rep BuildHash x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BuildHash x -> BuildHash
$cfrom :: forall x. BuildHash -> Rep BuildHash x
Generic, Value -> Parser [BuildHash]
Value -> Parser BuildHash
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [BuildHash]
$cparseJSONList :: Value -> Parser [BuildHash]
parseJSON :: Value -> Parser BuildHash
$cparseJSON :: Value -> Parser BuildHash
FromJSON, [BuildHash] -> Encoding
[BuildHash] -> Value
BuildHash -> Encoding
BuildHash -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [BuildHash] -> Encoding
$ctoEncodingList :: [BuildHash] -> Encoding
toJSONList :: [BuildHash] -> Value
$ctoJSONList :: [BuildHash] -> Value
toEncoding :: BuildHash -> Encoding
$ctoEncoding :: BuildHash -> Encoding
toJSON :: BuildHash -> Value
$ctoJSON :: BuildHash -> Value
ToJSON)

newtype PluginName = PluginName {PluginName -> Text
pluginName :: Text}
  deriving (PluginName -> PluginName -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PluginName -> PluginName -> Bool
$c/= :: PluginName -> PluginName -> Bool
== :: PluginName -> PluginName -> Bool
$c== :: PluginName -> PluginName -> Bool
Eq, Eq PluginName
PluginName -> PluginName -> Bool
PluginName -> PluginName -> Ordering
PluginName -> PluginName -> PluginName
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
min :: PluginName -> PluginName -> PluginName
$cmin :: PluginName -> PluginName -> PluginName
max :: PluginName -> PluginName -> PluginName
$cmax :: PluginName -> PluginName -> PluginName
>= :: PluginName -> PluginName -> Bool
$c>= :: PluginName -> PluginName -> Bool
> :: PluginName -> PluginName -> Bool
$c> :: PluginName -> PluginName -> Bool
<= :: PluginName -> PluginName -> Bool
$c<= :: PluginName -> PluginName -> Bool
< :: PluginName -> PluginName -> Bool
$c< :: PluginName -> PluginName -> Bool
compare :: PluginName -> PluginName -> Ordering
$ccompare :: PluginName -> PluginName -> Ordering
Ord, Int -> PluginName -> ShowS
[PluginName] -> ShowS
PluginName -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PluginName] -> ShowS
$cshowList :: [PluginName] -> ShowS
show :: PluginName -> String
$cshow :: PluginName -> String
showsPrec :: Int -> PluginName -> ShowS
$cshowsPrec :: Int -> PluginName -> ShowS
Show, Value -> Parser [PluginName]
Value -> Parser PluginName
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [PluginName]
$cparseJSONList :: Value -> Parser [PluginName]
parseJSON :: Value -> Parser PluginName
$cparseJSON :: Value -> Parser PluginName
FromJSON)

data NodeInfo = NodeInfo
  { NodeInfo -> Maybe EsAddress
nodeInfoHTTPAddress :: Maybe EsAddress,
    NodeInfo -> BuildHash
nodeInfoBuild :: BuildHash,
    NodeInfo -> VersionNumber
nodeInfoESVersion :: VersionNumber,
    NodeInfo -> Server
nodeInfoIP :: Server,
    NodeInfo -> Server
nodeInfoHost :: Server,
    NodeInfo -> EsAddress
nodeInfoTransportAddress :: EsAddress,
    NodeInfo -> NodeName
nodeInfoName :: NodeName,
    NodeInfo -> FullNodeId
nodeInfoFullId :: FullNodeId,
    NodeInfo -> [NodePluginInfo]
nodeInfoPlugins :: [NodePluginInfo],
    NodeInfo -> NodeHTTPInfo
nodeInfoHTTP :: NodeHTTPInfo,
    NodeInfo -> NodeTransportInfo
nodeInfoTransport :: NodeTransportInfo,
    NodeInfo -> Maybe NodeNetworkInfo
nodeInfoNetwork :: Maybe NodeNetworkInfo,
    NodeInfo -> Map Text NodeThreadPoolInfo
nodeInfoThreadPool :: Map Text NodeThreadPoolInfo,
    NodeInfo -> NodeJVMInfo
nodeInfoJVM :: NodeJVMInfo,
    NodeInfo -> NodeProcessInfo
nodeInfoProcess :: NodeProcessInfo,
    NodeInfo -> NodeOSInfo
nodeInfoOS :: NodeOSInfo,
    -- | The members of the settings objects are not consistent,
    -- dependent on plugins, etc.
    NodeInfo -> Object
nodeInfoSettings :: Object
  }
  deriving (NodeInfo -> NodeInfo -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NodeInfo -> NodeInfo -> Bool
$c/= :: NodeInfo -> NodeInfo -> Bool
== :: NodeInfo -> NodeInfo -> Bool
$c== :: NodeInfo -> NodeInfo -> Bool
Eq, Int -> NodeInfo -> ShowS
[NodeInfo] -> ShowS
NodeInfo -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NodeInfo] -> ShowS
$cshowList :: [NodeInfo] -> ShowS
show :: NodeInfo -> String
$cshow :: NodeInfo -> String
showsPrec :: Int -> NodeInfo -> ShowS
$cshowsPrec :: Int -> NodeInfo -> ShowS
Show)

data NodePluginInfo = NodePluginInfo
  { -- | Is this a site plugin?
    NodePluginInfo -> Maybe Bool
nodePluginSite :: Maybe Bool,
    -- | Is this plugin running on the JVM
    NodePluginInfo -> Maybe Bool
nodePluginJVM :: Maybe Bool,
    NodePluginInfo -> Text
nodePluginDescription :: Text,
    NodePluginInfo -> MaybeNA VersionNumber
nodePluginVersion :: MaybeNA VersionNumber,
    NodePluginInfo -> PluginName
nodePluginName :: PluginName
  }
  deriving (NodePluginInfo -> NodePluginInfo -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NodePluginInfo -> NodePluginInfo -> Bool
$c/= :: NodePluginInfo -> NodePluginInfo -> Bool
== :: NodePluginInfo -> NodePluginInfo -> Bool
$c== :: NodePluginInfo -> NodePluginInfo -> Bool
Eq, Int -> NodePluginInfo -> ShowS
[NodePluginInfo] -> ShowS
NodePluginInfo -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NodePluginInfo] -> ShowS
$cshowList :: [NodePluginInfo] -> ShowS
show :: NodePluginInfo -> String
$cshow :: NodePluginInfo -> String
showsPrec :: Int -> NodePluginInfo -> ShowS
$cshowsPrec :: Int -> NodePluginInfo -> ShowS
Show)

data NodeHTTPInfo = NodeHTTPInfo
  { NodeHTTPInfo -> Bytes
nodeHTTPMaxContentLength :: Bytes,
    NodeHTTPInfo -> EsAddress
nodeHTTPpublishAddress :: EsAddress,
    NodeHTTPInfo -> [EsAddress]
nodeHTTPbound_address :: [EsAddress]
  }
  deriving (NodeHTTPInfo -> NodeHTTPInfo -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NodeHTTPInfo -> NodeHTTPInfo -> Bool
$c/= :: NodeHTTPInfo -> NodeHTTPInfo -> Bool
== :: NodeHTTPInfo -> NodeHTTPInfo -> Bool
$c== :: NodeHTTPInfo -> NodeHTTPInfo -> Bool
Eq, Int -> NodeHTTPInfo -> ShowS
[NodeHTTPInfo] -> ShowS
NodeHTTPInfo -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NodeHTTPInfo] -> ShowS
$cshowList :: [NodeHTTPInfo] -> ShowS
show :: NodeHTTPInfo -> String
$cshow :: NodeHTTPInfo -> String
showsPrec :: Int -> NodeHTTPInfo -> ShowS
$cshowsPrec :: Int -> NodeHTTPInfo -> ShowS
Show)

data NodeTransportInfo = NodeTransportInfo
  { NodeTransportInfo -> [BoundTransportAddress]
nodeTransportProfiles :: [BoundTransportAddress],
    NodeTransportInfo -> EsAddress
nodeTransportPublishAddress :: EsAddress,
    NodeTransportInfo -> [EsAddress]
nodeTransportBoundAddress :: [EsAddress]
  }
  deriving (NodeTransportInfo -> NodeTransportInfo -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NodeTransportInfo -> NodeTransportInfo -> Bool
$c/= :: NodeTransportInfo -> NodeTransportInfo -> Bool
== :: NodeTransportInfo -> NodeTransportInfo -> Bool
$c== :: NodeTransportInfo -> NodeTransportInfo -> Bool
Eq, Int -> NodeTransportInfo -> ShowS
[NodeTransportInfo] -> ShowS
NodeTransportInfo -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NodeTransportInfo] -> ShowS
$cshowList :: [NodeTransportInfo] -> ShowS
show :: NodeTransportInfo -> String
$cshow :: NodeTransportInfo -> String
showsPrec :: Int -> NodeTransportInfo -> ShowS
$cshowsPrec :: Int -> NodeTransportInfo -> ShowS
Show)

data BoundTransportAddress = BoundTransportAddress
  { BoundTransportAddress -> EsAddress
publishAddress :: EsAddress,
    BoundTransportAddress -> [EsAddress]
boundAddress :: [EsAddress]
  }
  deriving (BoundTransportAddress -> BoundTransportAddress -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BoundTransportAddress -> BoundTransportAddress -> Bool
$c/= :: BoundTransportAddress -> BoundTransportAddress -> Bool
== :: BoundTransportAddress -> BoundTransportAddress -> Bool
$c== :: BoundTransportAddress -> BoundTransportAddress -> Bool
Eq, Int -> BoundTransportAddress -> ShowS
[BoundTransportAddress] -> ShowS
BoundTransportAddress -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BoundTransportAddress] -> ShowS
$cshowList :: [BoundTransportAddress] -> ShowS
show :: BoundTransportAddress -> String
$cshow :: BoundTransportAddress -> String
showsPrec :: Int -> BoundTransportAddress -> ShowS
$cshowsPrec :: Int -> BoundTransportAddress -> ShowS
Show)

data NodeNetworkInfo = NodeNetworkInfo
  { NodeNetworkInfo -> NodeNetworkInterface
nodeNetworkPrimaryInterface :: NodeNetworkInterface,
    NodeNetworkInfo -> NominalDiffTime
nodeNetworkRefreshInterval :: NominalDiffTime
  }
  deriving (NodeNetworkInfo -> NodeNetworkInfo -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NodeNetworkInfo -> NodeNetworkInfo -> Bool
$c/= :: NodeNetworkInfo -> NodeNetworkInfo -> Bool
== :: NodeNetworkInfo -> NodeNetworkInfo -> Bool
$c== :: NodeNetworkInfo -> NodeNetworkInfo -> Bool
Eq, Int -> NodeNetworkInfo -> ShowS
[NodeNetworkInfo] -> ShowS
NodeNetworkInfo -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NodeNetworkInfo] -> ShowS
$cshowList :: [NodeNetworkInfo] -> ShowS
show :: NodeNetworkInfo -> String
$cshow :: NodeNetworkInfo -> String
showsPrec :: Int -> NodeNetworkInfo -> ShowS
$cshowsPrec :: Int -> NodeNetworkInfo -> ShowS
Show)

newtype MacAddress = MacAddress {MacAddress -> Text
macAddress :: Text}
  deriving (MacAddress -> MacAddress -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MacAddress -> MacAddress -> Bool
$c/= :: MacAddress -> MacAddress -> Bool
== :: MacAddress -> MacAddress -> Bool
$c== :: MacAddress -> MacAddress -> Bool
Eq, Eq MacAddress
MacAddress -> MacAddress -> Bool
MacAddress -> MacAddress -> Ordering
MacAddress -> MacAddress -> MacAddress
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
min :: MacAddress -> MacAddress -> MacAddress
$cmin :: MacAddress -> MacAddress -> MacAddress
max :: MacAddress -> MacAddress -> MacAddress
$cmax :: MacAddress -> MacAddress -> MacAddress
>= :: MacAddress -> MacAddress -> Bool
$c>= :: MacAddress -> MacAddress -> Bool
> :: MacAddress -> MacAddress -> Bool
$c> :: MacAddress -> MacAddress -> Bool
<= :: MacAddress -> MacAddress -> Bool
$c<= :: MacAddress -> MacAddress -> Bool
< :: MacAddress -> MacAddress -> Bool
$c< :: MacAddress -> MacAddress -> Bool
compare :: MacAddress -> MacAddress -> Ordering
$ccompare :: MacAddress -> MacAddress -> Ordering
Ord, Int -> MacAddress -> ShowS
[MacAddress] -> ShowS
MacAddress -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MacAddress] -> ShowS
$cshowList :: [MacAddress] -> ShowS
show :: MacAddress -> String
$cshow :: MacAddress -> String
showsPrec :: Int -> MacAddress -> ShowS
$cshowsPrec :: Int -> MacAddress -> ShowS
Show, Value -> Parser [MacAddress]
Value -> Parser MacAddress
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [MacAddress]
$cparseJSONList :: Value -> Parser [MacAddress]
parseJSON :: Value -> Parser MacAddress
$cparseJSON :: Value -> Parser MacAddress
FromJSON)

newtype NetworkInterfaceName = NetworkInterfaceName {NetworkInterfaceName -> Text
networkInterfaceName :: Text}
  deriving (NetworkInterfaceName -> NetworkInterfaceName -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NetworkInterfaceName -> NetworkInterfaceName -> Bool
$c/= :: NetworkInterfaceName -> NetworkInterfaceName -> Bool
== :: NetworkInterfaceName -> NetworkInterfaceName -> Bool
$c== :: NetworkInterfaceName -> NetworkInterfaceName -> Bool
Eq, Eq NetworkInterfaceName
NetworkInterfaceName -> NetworkInterfaceName -> Bool
NetworkInterfaceName -> NetworkInterfaceName -> Ordering
NetworkInterfaceName
-> NetworkInterfaceName -> NetworkInterfaceName
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
min :: NetworkInterfaceName
-> NetworkInterfaceName -> NetworkInterfaceName
$cmin :: NetworkInterfaceName
-> NetworkInterfaceName -> NetworkInterfaceName
max :: NetworkInterfaceName
-> NetworkInterfaceName -> NetworkInterfaceName
$cmax :: NetworkInterfaceName
-> NetworkInterfaceName -> NetworkInterfaceName
>= :: NetworkInterfaceName -> NetworkInterfaceName -> Bool
$c>= :: NetworkInterfaceName -> NetworkInterfaceName -> Bool
> :: NetworkInterfaceName -> NetworkInterfaceName -> Bool
$c> :: NetworkInterfaceName -> NetworkInterfaceName -> Bool
<= :: NetworkInterfaceName -> NetworkInterfaceName -> Bool
$c<= :: NetworkInterfaceName -> NetworkInterfaceName -> Bool
< :: NetworkInterfaceName -> NetworkInterfaceName -> Bool
$c< :: NetworkInterfaceName -> NetworkInterfaceName -> Bool
compare :: NetworkInterfaceName -> NetworkInterfaceName -> Ordering
$ccompare :: NetworkInterfaceName -> NetworkInterfaceName -> Ordering
Ord, Int -> NetworkInterfaceName -> ShowS
[NetworkInterfaceName] -> ShowS
NetworkInterfaceName -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NetworkInterfaceName] -> ShowS
$cshowList :: [NetworkInterfaceName] -> ShowS
show :: NetworkInterfaceName -> String
$cshow :: NetworkInterfaceName -> String
showsPrec :: Int -> NetworkInterfaceName -> ShowS
$cshowsPrec :: Int -> NetworkInterfaceName -> ShowS
Show, Value -> Parser [NetworkInterfaceName]
Value -> Parser NetworkInterfaceName
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [NetworkInterfaceName]
$cparseJSONList :: Value -> Parser [NetworkInterfaceName]
parseJSON :: Value -> Parser NetworkInterfaceName
$cparseJSON :: Value -> Parser NetworkInterfaceName
FromJSON)

data NodeNetworkInterface = NodeNetworkInterface
  { NodeNetworkInterface -> MacAddress
nodeNetIfaceMacAddress :: MacAddress,
    NodeNetworkInterface -> NetworkInterfaceName
nodeNetIfaceName :: NetworkInterfaceName,
    NodeNetworkInterface -> Server
nodeNetIfaceAddress :: Server
  }
  deriving (NodeNetworkInterface -> NodeNetworkInterface -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NodeNetworkInterface -> NodeNetworkInterface -> Bool
$c/= :: NodeNetworkInterface -> NodeNetworkInterface -> Bool
== :: NodeNetworkInterface -> NodeNetworkInterface -> Bool
$c== :: NodeNetworkInterface -> NodeNetworkInterface -> Bool
Eq, Int -> NodeNetworkInterface -> ShowS
[NodeNetworkInterface] -> ShowS
NodeNetworkInterface -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NodeNetworkInterface] -> ShowS
$cshowList :: [NodeNetworkInterface] -> ShowS
show :: NodeNetworkInterface -> String
$cshow :: NodeNetworkInterface -> String
showsPrec :: Int -> NodeNetworkInterface -> ShowS
$cshowsPrec :: Int -> NodeNetworkInterface -> ShowS
Show)

data ThreadPool = ThreadPool
  { ThreadPool -> Text
nodeThreadPoolName :: Text,
    ThreadPool -> NodeThreadPoolInfo
nodeThreadPoolInfo :: NodeThreadPoolInfo
  }
  deriving (ThreadPool -> ThreadPool -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ThreadPool -> ThreadPool -> Bool
$c/= :: ThreadPool -> ThreadPool -> Bool
== :: ThreadPool -> ThreadPool -> Bool
$c== :: ThreadPool -> ThreadPool -> Bool
Eq, Int -> ThreadPool -> ShowS
[ThreadPool] -> ShowS
ThreadPool -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ThreadPool] -> ShowS
$cshowList :: [ThreadPool] -> ShowS
show :: ThreadPool -> String
$cshow :: ThreadPool -> String
showsPrec :: Int -> ThreadPool -> ShowS
$cshowsPrec :: Int -> ThreadPool -> ShowS
Show)

data NodeThreadPoolInfo = NodeThreadPoolInfo
  { NodeThreadPoolInfo -> ThreadPoolSize
nodeThreadPoolQueueSize :: ThreadPoolSize,
    NodeThreadPoolInfo -> Maybe NominalDiffTime
nodeThreadPoolKeepalive :: Maybe NominalDiffTime,
    NodeThreadPoolInfo -> Maybe Int
nodeThreadPoolMin :: Maybe Int,
    NodeThreadPoolInfo -> Maybe Int
nodeThreadPoolMax :: Maybe Int,
    NodeThreadPoolInfo -> ThreadPoolType
nodeThreadPoolType :: ThreadPoolType
  }
  deriving (NodeThreadPoolInfo -> NodeThreadPoolInfo -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NodeThreadPoolInfo -> NodeThreadPoolInfo -> Bool
$c/= :: NodeThreadPoolInfo -> NodeThreadPoolInfo -> Bool
== :: NodeThreadPoolInfo -> NodeThreadPoolInfo -> Bool
$c== :: NodeThreadPoolInfo -> NodeThreadPoolInfo -> Bool
Eq, Int -> NodeThreadPoolInfo -> ShowS
[NodeThreadPoolInfo] -> ShowS
NodeThreadPoolInfo -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NodeThreadPoolInfo] -> ShowS
$cshowList :: [NodeThreadPoolInfo] -> ShowS
show :: NodeThreadPoolInfo -> String
$cshow :: NodeThreadPoolInfo -> String
showsPrec :: Int -> NodeThreadPoolInfo -> ShowS
$cshowsPrec :: Int -> NodeThreadPoolInfo -> ShowS
Show)

data ThreadPoolSize
  = ThreadPoolBounded Int
  | ThreadPoolUnbounded
  deriving (ThreadPoolSize -> ThreadPoolSize -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ThreadPoolSize -> ThreadPoolSize -> Bool
$c/= :: ThreadPoolSize -> ThreadPoolSize -> Bool
== :: ThreadPoolSize -> ThreadPoolSize -> Bool
$c== :: ThreadPoolSize -> ThreadPoolSize -> Bool
Eq, Int -> ThreadPoolSize -> ShowS
[ThreadPoolSize] -> ShowS
ThreadPoolSize -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ThreadPoolSize] -> ShowS
$cshowList :: [ThreadPoolSize] -> ShowS
show :: ThreadPoolSize -> String
$cshow :: ThreadPoolSize -> String
showsPrec :: Int -> ThreadPoolSize -> ShowS
$cshowsPrec :: Int -> ThreadPoolSize -> ShowS
Show)

data ThreadPoolType
  = ThreadPoolScaling
  | ThreadPoolFixed
  | ThreadPoolCached
  | ThreadPoolFixedAutoQueueSize
  deriving (ThreadPoolType -> ThreadPoolType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ThreadPoolType -> ThreadPoolType -> Bool
$c/= :: ThreadPoolType -> ThreadPoolType -> Bool
== :: ThreadPoolType -> ThreadPoolType -> Bool
$c== :: ThreadPoolType -> ThreadPoolType -> Bool
Eq, Int -> ThreadPoolType -> ShowS
[ThreadPoolType] -> ShowS
ThreadPoolType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ThreadPoolType] -> ShowS
$cshowList :: [ThreadPoolType] -> ShowS
show :: ThreadPoolType -> String
$cshow :: ThreadPoolType -> String
showsPrec :: Int -> ThreadPoolType -> ShowS
$cshowsPrec :: Int -> ThreadPoolType -> ShowS
Show)

data NodeJVMInfo = NodeJVMInfo
  { NodeJVMInfo -> [JVMMemoryPool]
nodeJVMInfoMemoryPools :: [JVMMemoryPool],
    NodeJVMInfo -> [JVMGCCollector]
nodeJVMInfoMemoryPoolsGCCollectors :: [JVMGCCollector],
    NodeJVMInfo -> JVMMemoryInfo
nodeJVMInfoMemoryInfo :: JVMMemoryInfo,
    NodeJVMInfo -> UTCTime
nodeJVMInfoStartTime :: UTCTime,
    NodeJVMInfo -> Text
nodeJVMInfoVMVendor :: Text,
    -- | JVM doesn't seme to follow normal version conventions
    NodeJVMInfo -> VMVersion
nodeJVMVMVersion :: VMVersion,
    NodeJVMInfo -> Text
nodeJVMVMName :: Text,
    NodeJVMInfo -> JVMVersion
nodeJVMVersion :: JVMVersion,
    NodeJVMInfo -> PID
nodeJVMPID :: PID
  }
  deriving (NodeJVMInfo -> NodeJVMInfo -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NodeJVMInfo -> NodeJVMInfo -> Bool
$c/= :: NodeJVMInfo -> NodeJVMInfo -> Bool
== :: NodeJVMInfo -> NodeJVMInfo -> Bool
$c== :: NodeJVMInfo -> NodeJVMInfo -> Bool
Eq, Int -> NodeJVMInfo -> ShowS
[NodeJVMInfo] -> ShowS
NodeJVMInfo -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NodeJVMInfo] -> ShowS
$cshowList :: [NodeJVMInfo] -> ShowS
show :: NodeJVMInfo -> String
$cshow :: NodeJVMInfo -> String
showsPrec :: Int -> NodeJVMInfo -> ShowS
$cshowsPrec :: Int -> NodeJVMInfo -> ShowS
Show)

-- | We cannot parse JVM version numbers and we're not going to try.
newtype JVMVersion = JVMVersion {JVMVersion -> Text
unJVMVersion :: Text}
  deriving (JVMVersion -> JVMVersion -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: JVMVersion -> JVMVersion -> Bool
$c/= :: JVMVersion -> JVMVersion -> Bool
== :: JVMVersion -> JVMVersion -> Bool
$c== :: JVMVersion -> JVMVersion -> Bool
Eq, Int -> JVMVersion -> ShowS
[JVMVersion] -> ShowS
JVMVersion -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [JVMVersion] -> ShowS
$cshowList :: [JVMVersion] -> ShowS
show :: JVMVersion -> String
$cshow :: JVMVersion -> String
showsPrec :: Int -> JVMVersion -> ShowS
$cshowsPrec :: Int -> JVMVersion -> ShowS
Show)

instance FromJSON JVMVersion where
  parseJSON :: Value -> Parser JVMVersion
parseJSON = forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"JVMVersion" (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> JVMVersion
JVMVersion)

data JVMMemoryInfo = JVMMemoryInfo
  { JVMMemoryInfo -> Bytes
jvmMemoryInfoDirectMax :: Bytes,
    JVMMemoryInfo -> Bytes
jvmMemoryInfoNonHeapMax :: Bytes,
    JVMMemoryInfo -> Bytes
jvmMemoryInfoNonHeapInit :: Bytes,
    JVMMemoryInfo -> Bytes
jvmMemoryInfoHeapMax :: Bytes,
    JVMMemoryInfo -> Bytes
jvmMemoryInfoHeapInit :: Bytes
  }
  deriving (JVMMemoryInfo -> JVMMemoryInfo -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: JVMMemoryInfo -> JVMMemoryInfo -> Bool
$c/= :: JVMMemoryInfo -> JVMMemoryInfo -> Bool
== :: JVMMemoryInfo -> JVMMemoryInfo -> Bool
$c== :: JVMMemoryInfo -> JVMMemoryInfo -> Bool
Eq, Int -> JVMMemoryInfo -> ShowS
[JVMMemoryInfo] -> ShowS
JVMMemoryInfo -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [JVMMemoryInfo] -> ShowS
$cshowList :: [JVMMemoryInfo] -> ShowS
show :: JVMMemoryInfo -> String
$cshow :: JVMMemoryInfo -> String
showsPrec :: Int -> JVMMemoryInfo -> ShowS
$cshowsPrec :: Int -> JVMMemoryInfo -> ShowS
Show)

-- VM version numbers don't appear to be SemVer
-- so we're special casing this jawn.
newtype VMVersion = VMVersion {VMVersion -> Text
unVMVersion :: Text}
  deriving (VMVersion -> VMVersion -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VMVersion -> VMVersion -> Bool
$c/= :: VMVersion -> VMVersion -> Bool
== :: VMVersion -> VMVersion -> Bool
$c== :: VMVersion -> VMVersion -> Bool
Eq, Int -> VMVersion -> ShowS
[VMVersion] -> ShowS
VMVersion -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VMVersion] -> ShowS
$cshowList :: [VMVersion] -> ShowS
show :: VMVersion -> String
$cshow :: VMVersion -> String
showsPrec :: Int -> VMVersion -> ShowS
$cshowsPrec :: Int -> VMVersion -> ShowS
Show)

instance ToJSON VMVersion where
  toJSON :: VMVersion -> Value
toJSON = forall a. ToJSON a => a -> Value
toJSON forall b c a. (b -> c) -> (a -> b) -> a -> c
. VMVersion -> Text
unVMVersion

instance FromJSON VMVersion where
  parseJSON :: Value -> Parser VMVersion
parseJSON = forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"VMVersion" (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> VMVersion
VMVersion)

newtype JVMMemoryPool = JVMMemoryPool
  { JVMMemoryPool -> Text
jvmMemoryPool :: Text
  }
  deriving (JVMMemoryPool -> JVMMemoryPool -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: JVMMemoryPool -> JVMMemoryPool -> Bool
$c/= :: JVMMemoryPool -> JVMMemoryPool -> Bool
== :: JVMMemoryPool -> JVMMemoryPool -> Bool
$c== :: JVMMemoryPool -> JVMMemoryPool -> Bool
Eq, Int -> JVMMemoryPool -> ShowS
[JVMMemoryPool] -> ShowS
JVMMemoryPool -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [JVMMemoryPool] -> ShowS
$cshowList :: [JVMMemoryPool] -> ShowS
show :: JVMMemoryPool -> String
$cshow :: JVMMemoryPool -> String
showsPrec :: Int -> JVMMemoryPool -> ShowS
$cshowsPrec :: Int -> JVMMemoryPool -> ShowS
Show, Value -> Parser [JVMMemoryPool]
Value -> Parser JVMMemoryPool
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [JVMMemoryPool]
$cparseJSONList :: Value -> Parser [JVMMemoryPool]
parseJSON :: Value -> Parser JVMMemoryPool
$cparseJSON :: Value -> Parser JVMMemoryPool
FromJSON)

newtype JVMGCCollector = JVMGCCollector
  { JVMGCCollector -> Text
jvmGCCollector :: Text
  }
  deriving (JVMGCCollector -> JVMGCCollector -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: JVMGCCollector -> JVMGCCollector -> Bool
$c/= :: JVMGCCollector -> JVMGCCollector -> Bool
== :: JVMGCCollector -> JVMGCCollector -> Bool
$c== :: JVMGCCollector -> JVMGCCollector -> Bool
Eq, Int -> JVMGCCollector -> ShowS
[JVMGCCollector] -> ShowS
JVMGCCollector -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [JVMGCCollector] -> ShowS
$cshowList :: [JVMGCCollector] -> ShowS
show :: JVMGCCollector -> String
$cshow :: JVMGCCollector -> String
showsPrec :: Int -> JVMGCCollector -> ShowS
$cshowsPrec :: Int -> JVMGCCollector -> ShowS
Show, Value -> Parser [JVMGCCollector]
Value -> Parser JVMGCCollector
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [JVMGCCollector]
$cparseJSONList :: Value -> Parser [JVMGCCollector]
parseJSON :: Value -> Parser JVMGCCollector
$cparseJSON :: Value -> Parser JVMGCCollector
FromJSON)

newtype PID = PID
  { PID -> Int
pid :: Int
  }
  deriving (PID -> PID -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PID -> PID -> Bool
$c/= :: PID -> PID -> Bool
== :: PID -> PID -> Bool
$c== :: PID -> PID -> Bool
Eq, Int -> PID -> ShowS
[PID] -> ShowS
PID -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PID] -> ShowS
$cshowList :: [PID] -> ShowS
show :: PID -> String
$cshow :: PID -> String
showsPrec :: Int -> PID -> ShowS
$cshowsPrec :: Int -> PID -> ShowS
Show, Value -> Parser [PID]
Value -> Parser PID
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [PID]
$cparseJSONList :: Value -> Parser [PID]
parseJSON :: Value -> Parser PID
$cparseJSON :: Value -> Parser PID
FromJSON)

data NodeOSInfo = NodeOSInfo
  { NodeOSInfo -> NominalDiffTime
nodeOSRefreshInterval :: NominalDiffTime,
    NodeOSInfo -> Text
nodeOSName :: Text,
    NodeOSInfo -> Text
nodeOSArch :: Text,
    NodeOSInfo -> Text
nodeOSVersion :: Text, -- semver breaks on "5.10.60.1-microsoft-standard-WSL2"
    NodeOSInfo -> Int
nodeOSAvailableProcessors :: Int,
    NodeOSInfo -> Int
nodeOSAllocatedProcessors :: Int
  }
  deriving (NodeOSInfo -> NodeOSInfo -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NodeOSInfo -> NodeOSInfo -> Bool
$c/= :: NodeOSInfo -> NodeOSInfo -> Bool
== :: NodeOSInfo -> NodeOSInfo -> Bool
$c== :: NodeOSInfo -> NodeOSInfo -> Bool
Eq, Int -> NodeOSInfo -> ShowS
[NodeOSInfo] -> ShowS
NodeOSInfo -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NodeOSInfo] -> ShowS
$cshowList :: [NodeOSInfo] -> ShowS
show :: NodeOSInfo -> String
$cshow :: NodeOSInfo -> String
showsPrec :: Int -> NodeOSInfo -> ShowS
$cshowsPrec :: Int -> NodeOSInfo -> ShowS
Show)

data CPUInfo = CPUInfo
  { CPUInfo -> Bytes
cpuCacheSize :: Bytes,
    CPUInfo -> Int
cpuCoresPerSocket :: Int,
    CPUInfo -> Int
cpuTotalSockets :: Int,
    CPUInfo -> Int
cpuTotalCores :: Int,
    CPUInfo -> Int
cpuMHZ :: Int,
    CPUInfo -> Text
cpuModel :: Text,
    CPUInfo -> Text
cpuVendor :: Text
  }
  deriving (CPUInfo -> CPUInfo -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CPUInfo -> CPUInfo -> Bool
$c/= :: CPUInfo -> CPUInfo -> Bool
== :: CPUInfo -> CPUInfo -> Bool
$c== :: CPUInfo -> CPUInfo -> Bool
Eq, Int -> CPUInfo -> ShowS
[CPUInfo] -> ShowS
CPUInfo -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CPUInfo] -> ShowS
$cshowList :: [CPUInfo] -> ShowS
show :: CPUInfo -> String
$cshow :: CPUInfo -> String
showsPrec :: Int -> CPUInfo -> ShowS
$cshowsPrec :: Int -> CPUInfo -> ShowS
Show)

data NodeProcessInfo = NodeProcessInfo
  { -- | See <https://www.elastic.co/guide/en/elasticsearch/reference/current/setup-configuration.html>
    NodeProcessInfo -> Bool
nodeProcessMLockAll :: Bool,
    NodeProcessInfo -> Maybe Int
nodeProcessMaxFileDescriptors :: Maybe Int,
    NodeProcessInfo -> PID
nodeProcessId :: PID,
    NodeProcessInfo -> NominalDiffTime
nodeProcessRefreshInterval :: NominalDiffTime
  }
  deriving (NodeProcessInfo -> NodeProcessInfo -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NodeProcessInfo -> NodeProcessInfo -> Bool
$c/= :: NodeProcessInfo -> NodeProcessInfo -> Bool
== :: NodeProcessInfo -> NodeProcessInfo -> Bool
$c== :: NodeProcessInfo -> NodeProcessInfo -> Bool
Eq, Int -> NodeProcessInfo -> ShowS
[NodeProcessInfo] -> ShowS
NodeProcessInfo -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NodeProcessInfo] -> ShowS
$cshowList :: [NodeProcessInfo] -> ShowS
show :: NodeProcessInfo -> String
$cshow :: NodeProcessInfo -> String
showsPrec :: Int -> NodeProcessInfo -> ShowS
$cshowsPrec :: Int -> NodeProcessInfo -> ShowS
Show)

data ShardResult = ShardResult
  { ShardResult -> Int
shardTotal :: Int,
    ShardResult -> Int
shardsSuccessful :: Int,
    ShardResult -> Int
shardsSkipped :: Int,
    ShardResult -> Int
shardsFailed :: Int
  }
  deriving (ShardResult -> ShardResult -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ShardResult -> ShardResult -> Bool
$c/= :: ShardResult -> ShardResult -> Bool
== :: ShardResult -> ShardResult -> Bool
$c== :: ShardResult -> ShardResult -> Bool
Eq, Int -> ShardResult -> ShowS
[ShardResult] -> ShowS
ShardResult -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ShardResult] -> ShowS
$cshowList :: [ShardResult] -> ShowS
show :: ShardResult -> String
$cshow :: ShardResult -> String
showsPrec :: Int -> ShardResult -> ShowS
$cshowsPrec :: Int -> ShardResult -> ShowS
Show)

instance FromJSON ShardResult where
  parseJSON :: Value -> Parser ShardResult
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ShardResult" forall a b. (a -> b) -> a -> b
$ \Object
v ->
      Int -> Int -> Int -> Int -> ShardResult
ShardResult
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"total" forall a. Parser (Maybe a) -> a -> Parser a
.!= Int
0
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"successful" forall a. Parser (Maybe a) -> a -> Parser a
.!= Int
0
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"skipped" forall a. Parser (Maybe a) -> a -> Parser a
.!= Int
0
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"failed" forall a. Parser (Maybe a) -> a -> Parser a
.!= Int
0

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

instance FromJSON SnapshotState where
  parseJSON :: Value -> Parser SnapshotState
parseJSON = forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"SnapshotState" forall {m :: * -> *}. MonadFail m => Text -> m SnapshotState
parse
    where
      parse :: Text -> m SnapshotState
parse Text
"INIT" = forall (m :: * -> *) a. Monad m => a -> m a
return SnapshotState
SnapshotInit
      parse Text
"STARTED" = forall (m :: * -> *) a. Monad m => a -> m a
return SnapshotState
SnapshotStarted
      parse Text
"SUCCESS" = forall (m :: * -> *) a. Monad m => a -> m a
return SnapshotState
SnapshotSuccess
      parse Text
"FAILED" = forall (m :: * -> *) a. Monad m => a -> m a
return SnapshotState
SnapshotFailed
      parse Text
"ABORTED" = forall (m :: * -> *) a. Monad m => a -> m a
return SnapshotState
SnapshotAborted
      parse Text
"MISSING" = forall (m :: * -> *) a. Monad m => a -> m a
return SnapshotState
SnapshotMissing
      parse Text
"WAITING" = forall (m :: * -> *) a. Monad m => a -> m a
return SnapshotState
SnapshotWaiting
      parse Text
t = forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Invalid snapshot state " 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 (SnapshotRestoreSettings -> SnapshotRestoreSettings -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SnapshotRestoreSettings -> SnapshotRestoreSettings -> Bool
$c/= :: SnapshotRestoreSettings -> SnapshotRestoreSettings -> Bool
== :: SnapshotRestoreSettings -> SnapshotRestoreSettings -> Bool
$c== :: SnapshotRestoreSettings -> SnapshotRestoreSettings -> Bool
Eq, Int -> SnapshotRestoreSettings -> ShowS
[SnapshotRestoreSettings] -> ShowS
SnapshotRestoreSettings -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SnapshotRestoreSettings] -> ShowS
$cshowList :: [SnapshotRestoreSettings] -> ShowS
show :: SnapshotRestoreSettings -> String
$cshow :: SnapshotRestoreSettings -> String
showsPrec :: Int -> SnapshotRestoreSettings -> ShowS
$cshowsPrec :: Int -> SnapshotRestoreSettings -> ShowS
Show)

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 (SnapshotRepoUpdateSettings -> SnapshotRepoUpdateSettings -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SnapshotRepoUpdateSettings -> SnapshotRepoUpdateSettings -> Bool
$c/= :: SnapshotRepoUpdateSettings -> SnapshotRepoUpdateSettings -> Bool
== :: SnapshotRepoUpdateSettings -> SnapshotRepoUpdateSettings -> Bool
$c== :: SnapshotRepoUpdateSettings -> SnapshotRepoUpdateSettings -> Bool
Eq, Int -> SnapshotRepoUpdateSettings -> ShowS
[SnapshotRepoUpdateSettings] -> ShowS
SnapshotRepoUpdateSettings -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SnapshotRepoUpdateSettings] -> ShowS
$cshowList :: [SnapshotRepoUpdateSettings] -> ShowS
show :: SnapshotRepoUpdateSettings -> String
$cshow :: SnapshotRepoUpdateSettings -> String
showsPrec :: Int -> SnapshotRepoUpdateSettings -> ShowS
$cshowsPrec :: Int -> SnapshotRepoUpdateSettings -> ShowS
Show)

-- | 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 (FsSnapshotRepo -> FsSnapshotRepo -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FsSnapshotRepo -> FsSnapshotRepo -> Bool
$c/= :: FsSnapshotRepo -> FsSnapshotRepo -> Bool
== :: FsSnapshotRepo -> FsSnapshotRepo -> Bool
$c== :: FsSnapshotRepo -> FsSnapshotRepo -> Bool
Eq, Int -> FsSnapshotRepo -> ShowS
[FsSnapshotRepo] -> ShowS
FsSnapshotRepo -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FsSnapshotRepo] -> ShowS
$cshowList :: [FsSnapshotRepo] -> ShowS
show :: FsSnapshotRepo -> String
$cshow :: FsSnapshotRepo -> String
showsPrec :: Int -> FsSnapshotRepo -> ShowS
$cshowsPrec :: Int -> FsSnapshotRepo -> ShowS
Show, 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
$cto :: forall x. Rep FsSnapshotRepo x -> FsSnapshotRepo
$cfrom :: forall x. FsSnapshotRepo -> Rep FsSnapshotRepo x
Generic)

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

parseRepo :: Parser a -> Either SnapshotRepoConversionError a
parseRepo :: forall a. Parser a -> Either SnapshotRepoConversionError a
parseRepo Parser a
parser = case forall a b. (a -> Parser b) -> a -> Either String b
parseEither (forall a b. a -> b -> a
const Parser a
parser) () of
  Left String
e -> forall a b. a -> Either a b
Left (Text -> SnapshotRepoConversionError
OtherRepoConversionError (String -> Text
T.pack String
e))
  Right a
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 (Int -> SnapshotRepoConversionError -> ShowS
[SnapshotRepoConversionError] -> ShowS
SnapshotRepoConversionError -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SnapshotRepoConversionError] -> ShowS
$cshowList :: [SnapshotRepoConversionError] -> ShowS
show :: SnapshotRepoConversionError -> String
$cshow :: SnapshotRepoConversionError -> String
showsPrec :: Int -> SnapshotRepoConversionError -> ShowS
$cshowsPrec :: Int -> SnapshotRepoConversionError -> ShowS
Show, SnapshotRepoConversionError -> SnapshotRepoConversionError -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SnapshotRepoConversionError -> SnapshotRepoConversionError -> Bool
$c/= :: SnapshotRepoConversionError -> SnapshotRepoConversionError -> Bool
== :: SnapshotRepoConversionError -> SnapshotRepoConversionError -> Bool
$c== :: SnapshotRepoConversionError -> SnapshotRepoConversionError -> Bool
Eq)

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 (SnapshotCreateSettings -> SnapshotCreateSettings -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SnapshotCreateSettings -> SnapshotCreateSettings -> Bool
$c/= :: SnapshotCreateSettings -> SnapshotCreateSettings -> Bool
== :: SnapshotCreateSettings -> SnapshotCreateSettings -> Bool
$c== :: SnapshotCreateSettings -> SnapshotCreateSettings -> Bool
Eq, Int -> SnapshotCreateSettings -> ShowS
[SnapshotCreateSettings] -> ShowS
SnapshotCreateSettings -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SnapshotCreateSettings] -> ShowS
$cshowList :: [SnapshotCreateSettings] -> ShowS
show :: SnapshotCreateSettings -> String
$cshow :: SnapshotCreateSettings -> String
showsPrec :: Int -> SnapshotCreateSettings -> ShowS
$cshowsPrec :: Int -> SnapshotCreateSettings -> ShowS
Show)

-- | 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 = 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 (SnapshotSelection -> SnapshotSelection -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SnapshotSelection -> SnapshotSelection -> Bool
$c/= :: SnapshotSelection -> SnapshotSelection -> Bool
== :: SnapshotSelection -> SnapshotSelection -> Bool
$c== :: SnapshotSelection -> SnapshotSelection -> Bool
Eq, Int -> SnapshotSelection -> ShowS
[SnapshotSelection] -> ShowS
SnapshotSelection -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SnapshotSelection] -> ShowS
$cshowList :: [SnapshotSelection] -> ShowS
show :: SnapshotSelection -> String
$cshow :: SnapshotSelection -> String
showsPrec :: Int -> SnapshotSelection -> ShowS
$cshowsPrec :: Int -> 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 (SnapshotPattern -> SnapshotPattern -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SnapshotPattern -> SnapshotPattern -> Bool
$c/= :: SnapshotPattern -> SnapshotPattern -> Bool
== :: SnapshotPattern -> SnapshotPattern -> Bool
$c== :: SnapshotPattern -> SnapshotPattern -> Bool
Eq, Int -> SnapshotPattern -> ShowS
[SnapshotPattern] -> ShowS
SnapshotPattern -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SnapshotPattern] -> ShowS
$cshowList :: [SnapshotPattern] -> ShowS
show :: SnapshotPattern -> String
$cshow :: SnapshotPattern -> String
showsPrec :: Int -> SnapshotPattern -> ShowS
$cshowsPrec :: Int -> 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 (SnapshotInfo -> SnapshotInfo -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SnapshotInfo -> SnapshotInfo -> Bool
$c/= :: SnapshotInfo -> SnapshotInfo -> Bool
== :: SnapshotInfo -> SnapshotInfo -> Bool
$c== :: SnapshotInfo -> SnapshotInfo -> Bool
Eq, Int -> SnapshotInfo -> ShowS
[SnapshotInfo] -> ShowS
SnapshotInfo -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SnapshotInfo] -> ShowS
$cshowList :: [SnapshotInfo] -> ShowS
show :: SnapshotInfo -> String
$cshow :: SnapshotInfo -> String
showsPrec :: Int -> SnapshotInfo -> ShowS
$cshowsPrec :: Int -> SnapshotInfo -> ShowS
Show)

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

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 (SnapshotShardFailure -> SnapshotShardFailure -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SnapshotShardFailure -> SnapshotShardFailure -> Bool
$c/= :: SnapshotShardFailure -> SnapshotShardFailure -> Bool
== :: SnapshotShardFailure -> SnapshotShardFailure -> Bool
$c== :: SnapshotShardFailure -> SnapshotShardFailure -> Bool
Eq, Int -> SnapshotShardFailure -> ShowS
[SnapshotShardFailure] -> ShowS
SnapshotShardFailure -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SnapshotShardFailure] -> ShowS
$cshowList :: [SnapshotShardFailure] -> ShowS
show :: SnapshotShardFailure -> String
$cshow :: SnapshotShardFailure -> String
showsPrec :: Int -> SnapshotShardFailure -> ShowS
$cshowsPrec :: Int -> SnapshotShardFailure -> ShowS
Show)

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

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

-- | 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 (RestoreRenameToken -> RestoreRenameToken -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RestoreRenameToken -> RestoreRenameToken -> Bool
$c/= :: RestoreRenameToken -> RestoreRenameToken -> Bool
== :: RestoreRenameToken -> RestoreRenameToken -> Bool
$c== :: RestoreRenameToken -> RestoreRenameToken -> Bool
Eq, Int -> RestoreRenameToken -> ShowS
[RestoreRenameToken] -> ShowS
RestoreRenameToken -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RestoreRenameToken] -> ShowS
$cshowList :: [RestoreRenameToken] -> ShowS
show :: RestoreRenameToken -> String
$cshow :: RestoreRenameToken -> String
showsPrec :: Int -> RestoreRenameToken -> ShowS
$cshowsPrec :: Int -> 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 (RRGroupRefNum -> RRGroupRefNum -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RRGroupRefNum -> RRGroupRefNum -> Bool
$c/= :: RRGroupRefNum -> RRGroupRefNum -> Bool
== :: RRGroupRefNum -> RRGroupRefNum -> Bool
$c== :: RRGroupRefNum -> RRGroupRefNum -> Bool
Eq, Eq 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
min :: RRGroupRefNum -> RRGroupRefNum -> RRGroupRefNum
$cmin :: RRGroupRefNum -> RRGroupRefNum -> RRGroupRefNum
max :: RRGroupRefNum -> RRGroupRefNum -> RRGroupRefNum
$cmax :: RRGroupRefNum -> RRGroupRefNum -> RRGroupRefNum
>= :: RRGroupRefNum -> RRGroupRefNum -> Bool
$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
compare :: RRGroupRefNum -> RRGroupRefNum -> Ordering
$ccompare :: RRGroupRefNum -> RRGroupRefNum -> Ordering
Ord, Int -> RRGroupRefNum -> ShowS
[RRGroupRefNum] -> ShowS
RRGroupRefNum -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RRGroupRefNum] -> ShowS
$cshowList :: [RRGroupRefNum] -> ShowS
show :: RRGroupRefNum -> String
$cshow :: RRGroupRefNum -> String
showsPrec :: Int -> RRGroupRefNum -> ShowS
$cshowsPrec :: Int -> 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 forall a. Ord a => a -> a -> Bool
>= RRGroupRefNum -> Int
rrGroupRefNum forall a. Bounded a => a
minBound
      Bool -> Bool -> Bool
&& Int
i forall a. Ord a => a -> a -> Bool
<= RRGroupRefNum -> Int
rrGroupRefNum forall a. Bounded a => a
maxBound =
      forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Int -> RRGroupRefNum
RRGroupRefNum Int
i
  | Bool
otherwise = 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 = forall a. Maybe a
Nothing,
      snapRestoreIgnoreUnavailable :: Bool
snapRestoreIgnoreUnavailable = Bool
False,
      snapRestoreIncludeGlobalState :: Bool
snapRestoreIncludeGlobalState = Bool
True,
      snapRestoreRenamePattern :: Maybe RestoreRenamePattern
snapRestoreRenamePattern = forall a. Maybe a
Nothing,
      snapRestoreRenameReplacement :: Maybe (NonEmpty RestoreRenameToken)
snapRestoreRenameReplacement = forall a. Maybe a
Nothing,
      snapRestorePartial :: Bool
snapRestorePartial = Bool
False,
      snapRestoreIncludeAliases :: Bool
snapRestoreIncludeAliases = Bool
True,
      snapRestoreIndexSettingsOverrides :: Maybe RestoreIndexSettings
snapRestoreIndexSettingsOverrides = forall a. Maybe a
Nothing,
      snapRestoreIgnoreIndexSettings :: Maybe (NonEmpty Text)
snapRestoreIgnoreIndexSettings = 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 (RestoreIndexSettings -> RestoreIndexSettings -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RestoreIndexSettings -> RestoreIndexSettings -> Bool
$c/= :: RestoreIndexSettings -> RestoreIndexSettings -> Bool
== :: RestoreIndexSettings -> RestoreIndexSettings -> Bool
$c== :: RestoreIndexSettings -> RestoreIndexSettings -> Bool
Eq, Int -> RestoreIndexSettings -> ShowS
[RestoreIndexSettings] -> ShowS
RestoreIndexSettings -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RestoreIndexSettings] -> ShowS
$cshowList :: [RestoreIndexSettings] -> ShowS
show :: RestoreIndexSettings -> String
$cshow :: RestoreIndexSettings -> String
showsPrec :: Int -> RestoreIndexSettings -> ShowS
$cshowsPrec :: Int -> RestoreIndexSettings -> ShowS
Show)

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

instance FromJSON NodesInfo where
  parseJSON :: Value -> Parser NodesInfo
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"NodesInfo" Object -> Parser NodesInfo
parse
    where
      parse :: Object -> Parser NodesInfo
parse Object
o = do
        HashMap Text Value
nodes <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"nodes"
        [NodeInfo]
infos <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (forall k v. HashMap k v -> [(k, v)]
HM.toList HashMap Text Value
nodes) forall a b. (a -> b) -> a -> b
$ \(Text
fullNID, Value
v) -> do
          Object
node <- forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
          FullNodeId -> Object -> Parser NodeInfo
parseNodeInfo (Text -> FullNodeId
FullNodeId Text
fullNID) Object
node
        ClusterName
cn <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"cluster_name"
        forall (m :: * -> *) a. Monad m => a -> m a
return ([NodeInfo] -> ClusterName -> NodesInfo
NodesInfo [NodeInfo]
infos ClusterName
cn)

instance FromJSON NodesStats where
  parseJSON :: Value -> Parser NodesStats
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"NodesStats" Object -> Parser NodesStats
parse
    where
      parse :: Object -> Parser NodesStats
parse Object
o = do
        HashMap Text Value
nodes <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"nodes"
        [NodeStats]
stats <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (forall k v. HashMap k v -> [(k, v)]
HM.toList HashMap Text Value
nodes) forall a b. (a -> b) -> a -> b
$ \(Text
fullNID, Value
v) -> do
          Object
node <- forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
          FullNodeId -> Object -> Parser NodeStats
parseNodeStats (Text -> FullNodeId
FullNodeId Text
fullNID) Object
node
        ClusterName
cn <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"cluster_name"
        forall (m :: * -> *) a. Monad m => a -> m a
return ([NodeStats] -> ClusterName -> NodesStats
NodesStats [NodeStats]
stats ClusterName
cn)

instance FromJSON NodeBreakerStats where
  parseJSON :: Value -> Parser NodeBreakerStats
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"NodeBreakerStats" Object -> Parser NodeBreakerStats
parse
    where
      parse :: Object -> Parser NodeBreakerStats
parse Object
o =
        Int -> Double -> Bytes -> Bytes -> NodeBreakerStats
NodeBreakerStats
          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"tripped"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"overhead"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"estimated_size_in_bytes"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"limit_size_in_bytes"

instance FromJSON NodeHTTPStats where
  parseJSON :: Value -> Parser NodeHTTPStats
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"NodeHTTPStats" Object -> Parser NodeHTTPStats
parse
    where
      parse :: Object -> Parser NodeHTTPStats
parse Object
o =
        Int -> Int -> NodeHTTPStats
NodeHTTPStats
          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"total_opened"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"current_open"

instance FromJSON NodeTransportStats where
  parseJSON :: Value -> Parser NodeTransportStats
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"NodeTransportStats" Object -> Parser NodeTransportStats
parse
    where
      parse :: Object -> Parser NodeTransportStats
parse Object
o =
        Bytes -> Int -> Bytes -> Int -> Int -> NodeTransportStats
NodeTransportStats
          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"tx_size_in_bytes"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"tx_count"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"rx_size_in_bytes"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"rx_count"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"server_open"

instance FromJSON NodeFSStats where
  parseJSON :: Value -> Parser NodeFSStats
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"NodeFSStats" Object -> Parser NodeFSStats
parse
    where
      parse :: Object -> Parser NodeFSStats
parse Object
o =
        [NodeDataPathStats] -> NodeFSTotalStats -> UTCTime -> NodeFSStats
NodeFSStats
          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"data"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"total"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (POSIXMS -> UTCTime
posixMS forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"timestamp")

instance FromJSON NodeDataPathStats where
  parseJSON :: Value -> Parser NodeDataPathStats
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"NodeDataPathStats" Object -> Parser NodeDataPathStats
parse
    where
      parse :: Object -> Parser NodeDataPathStats
parse Object
o =
        Maybe Double
-> Maybe Double
-> Maybe Bytes
-> Maybe Bytes
-> Maybe Bytes
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> Bytes
-> Bytes
-> Bytes
-> Maybe Text
-> Maybe Text
-> Text
-> Text
-> NodeDataPathStats
NodeDataPathStats
          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap StringlyTypedDouble -> Double
unStringlyTypedDouble forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"disk_service_time")
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap StringlyTypedDouble -> Double
unStringlyTypedDouble forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"disk_queue")
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"disk_io_size_in_bytes"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"disk_write_size_in_bytes"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"disk_read_size_in_bytes"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"disk_io_op"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"disk_writes"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"disk_reads"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"available_in_bytes"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"free_in_bytes"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"total_in_bytes"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"type"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"dev"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"mount"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"path"

instance FromJSON NodeFSTotalStats where
  parseJSON :: Value -> Parser NodeFSTotalStats
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"NodeFSTotalStats" Object -> Parser NodeFSTotalStats
parse
    where
      parse :: Object -> Parser NodeFSTotalStats
parse Object
o =
        Maybe Double
-> Maybe Double
-> Maybe Bytes
-> Maybe Bytes
-> Maybe Bytes
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> Bytes
-> Bytes
-> Bytes
-> NodeFSTotalStats
NodeFSTotalStats
          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap StringlyTypedDouble -> Double
unStringlyTypedDouble forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"disk_service_time")
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap StringlyTypedDouble -> Double
unStringlyTypedDouble forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"disk_queue")
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"disk_io_size_in_bytes"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"disk_write_size_in_bytes"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"disk_read_size_in_bytes"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"disk_io_op"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"disk_writes"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"disk_reads"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"available_in_bytes"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"free_in_bytes"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"total_in_bytes"

instance FromJSON NodeNetworkStats where
  parseJSON :: Value -> Parser NodeNetworkStats
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"NodeNetworkStats" Object -> Parser NodeNetworkStats
parse
    where
      parse :: Object -> Parser NodeNetworkStats
parse Object
o = do
        Object
tcp <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"tcp"
        Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> NodeNetworkStats
NodeNetworkStats
          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
tcp forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"out_rsts"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
tcp forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"in_errs"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
tcp forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"attempt_fails"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
tcp forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"estab_resets"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
tcp forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"retrans_segs"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
tcp forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"out_segs"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
tcp forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"in_segs"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
tcp forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"curr_estab"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
tcp forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"passive_opens"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
tcp forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"active_opens"

instance FromJSON NodeThreadPoolStats where
  parseJSON :: Value -> Parser NodeThreadPoolStats
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"NodeThreadPoolStats" Object -> Parser NodeThreadPoolStats
parse
    where
      parse :: Object -> Parser NodeThreadPoolStats
parse Object
o =
        Int -> Int -> Int -> Int -> Int -> Int -> NodeThreadPoolStats
NodeThreadPoolStats
          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"completed"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"largest"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"rejected"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"active"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"queue"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"threads"

instance FromJSON NodeJVMStats where
  parseJSON :: Value -> Parser NodeJVMStats
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"NodeJVMStats" Object -> Parser NodeJVMStats
parse
    where
      parse :: Object -> Parser NodeJVMStats
parse Object
o = do
        Object
bufferPools <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"buffer_pools"
        JVMBufferPoolStats
mapped <- Object
bufferPools forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"mapped"
        JVMBufferPoolStats
direct <- Object
bufferPools forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"direct"
        Object
gc <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"gc"
        Object
collectors <- Object
gc forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"collectors"
        JVMGCStats
oldC <- Object
collectors forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"old"
        JVMGCStats
youngC <- Object
collectors forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"young"
        Object
threads <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"threads"
        Object
mem <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"mem"
        Object
pools <- Object
mem forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"pools"
        JVMPoolStats
oldM <- Object
pools forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"old"
        JVMPoolStats
survivorM <- Object
pools forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"survivor"
        JVMPoolStats
youngM <- Object
pools forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"young"
        JVMBufferPoolStats
-> JVMBufferPoolStats
-> JVMGCStats
-> JVMGCStats
-> Int
-> Int
-> JVMPoolStats
-> JVMPoolStats
-> JVMPoolStats
-> Bytes
-> Bytes
-> Bytes
-> Bytes
-> Int
-> Bytes
-> NominalDiffTime
-> UTCTime
-> NodeJVMStats
NodeJVMStats
          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Applicative f => a -> f a
pure JVMBufferPoolStats
mapped
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure JVMBufferPoolStats
direct
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure JVMGCStats
oldC
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure JVMGCStats
youngC
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
threads forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"peak_count"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
threads forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"count"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure JVMPoolStats
oldM
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure JVMPoolStats
survivorM
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure JVMPoolStats
youngM
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
mem forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"non_heap_committed_in_bytes"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
mem forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"non_heap_used_in_bytes"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
mem forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"heap_max_in_bytes"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
mem forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"heap_committed_in_bytes"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
mem forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"heap_used_percent"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
mem forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"heap_used_in_bytes"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (MS -> NominalDiffTime
unMS forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"uptime_in_millis")
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (POSIXMS -> UTCTime
posixMS forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"timestamp")

instance FromJSON JVMBufferPoolStats where
  parseJSON :: Value -> Parser JVMBufferPoolStats
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"JVMBufferPoolStats" Object -> Parser JVMBufferPoolStats
parse
    where
      parse :: Object -> Parser JVMBufferPoolStats
parse Object
o =
        Bytes -> Bytes -> Int -> JVMBufferPoolStats
JVMBufferPoolStats
          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"total_capacity_in_bytes"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"used_in_bytes"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"count"

instance FromJSON JVMGCStats where
  parseJSON :: Value -> Parser JVMGCStats
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"JVMGCStats" Object -> Parser JVMGCStats
parse
    where
      parse :: Object -> Parser JVMGCStats
parse Object
o =
        NominalDiffTime -> Int -> JVMGCStats
JVMGCStats
          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MS -> NominalDiffTime
unMS forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"collection_time_in_millis")
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"collection_count"

instance FromJSON JVMPoolStats where
  parseJSON :: Value -> Parser JVMPoolStats
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"JVMPoolStats" Object -> Parser JVMPoolStats
parse
    where
      parse :: Object -> Parser JVMPoolStats
parse Object
o =
        Bytes -> Bytes -> Bytes -> Bytes -> JVMPoolStats
JVMPoolStats
          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"peak_max_in_bytes"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"peak_used_in_bytes"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"max_in_bytes"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"used_in_bytes"

instance FromJSON NodeProcessStats where
  parseJSON :: Value -> Parser NodeProcessStats
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"NodeProcessStats" Object -> Parser NodeProcessStats
parse
    where
      parse :: Object -> Parser NodeProcessStats
parse Object
o = do
        Object
mem <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"mem"
        Object
cpu <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"cpu"
        UTCTime
-> Int
-> Int
-> Int
-> NominalDiffTime
-> Bytes
-> NodeProcessStats
NodeProcessStats
          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (POSIXMS -> UTCTime
posixMS forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"timestamp")
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"open_file_descriptors"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"max_file_descriptors"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
cpu forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"percent"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (MS -> NominalDiffTime
unMS forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
cpu forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"total_in_millis")
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
mem forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"total_virtual_in_bytes"

instance FromJSON NodeOSStats where
  parseJSON :: Value -> Parser NodeOSStats
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"NodeOSStats" Object -> Parser NodeOSStats
parse
    where
      parse :: Object -> Parser NodeOSStats
parse Object
o = do
        Object
swap <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"swap"
        Object
mem <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"mem"
        Object
cpu <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"cpu"
        Maybe LoadAvgs
load <- Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"load_average"
        UTCTime
-> Int
-> Maybe LoadAvgs
-> Bytes
-> Bytes
-> Int
-> Bytes
-> Int
-> Bytes
-> Bytes
-> Bytes
-> NodeOSStats
NodeOSStats
          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (POSIXMS -> UTCTime
posixMS forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"timestamp")
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
cpu forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"percent"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe LoadAvgs
load
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
mem forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"total_in_bytes"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
mem forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"free_in_bytes"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
mem forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"free_percent"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
mem forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"used_in_bytes"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
mem forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"used_percent"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
swap forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"total_in_bytes"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
swap forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"free_in_bytes"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
swap forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"used_in_bytes"

instance FromJSON LoadAvgs where
  parseJSON :: Value -> Parser LoadAvgs
parseJSON = forall a. String -> (Array -> Parser a) -> Value -> Parser a
withArray String
"LoadAvgs" Array -> Parser LoadAvgs
parse
    where
      parse :: Array -> Parser LoadAvgs
parse Array
v = case forall a. Vector a -> [a]
V.toList Array
v of
        [Value
one, Value
five, Value
fifteen] ->
          Double -> Double -> Double -> LoadAvgs
LoadAvgs
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Value -> Parser a
parseJSON Value
one
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromJSON a => Value -> Parser a
parseJSON Value
five
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromJSON a => Value -> Parser a
parseJSON Value
fifteen
        [Value]
_ -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Expecting a triple of Doubles"

instance FromJSON NodeIndicesStats where
  parseJSON :: Value -> Parser NodeIndicesStats
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"NodeIndicesStats" Object -> Parser NodeIndicesStats
parse
    where
      parse :: Object -> Parser NodeIndicesStats
parse Object
o = do
        let .:: :: Maybe Object -> Key -> Parser (Maybe a)
(.::) Maybe Object
mv Key
k = case Maybe Object
mv of
              Just Object
v -> forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
k
              Maybe Object
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
        Maybe Object
mRecovery <- Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"recovery"
        Maybe Object
mQueryCache <- Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"query_cache"
        Maybe Object
mSuggest <- Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"suggest"
        Object
translog <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"translog"
        Object
segments <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"segments"
        Object
completion <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"completion"
        Maybe Object
mPercolate <- Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"percolate"
        Object
fielddata <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"fielddata"
        Object
warmer <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"warmer"
        Object
flush <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"flush"
        Object
refresh <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"refresh"
        Object
merges <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"merges"
        Object
search <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"search"
        Object
getStats <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"get"
        Object
indexing <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"indexing"
        Object
store <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"store"
        Object
docs <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"docs"
        Maybe NominalDiffTime
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> Maybe Bytes
-> Maybe Int
-> Maybe NominalDiffTime
-> Maybe Int
-> Bytes
-> Int
-> Maybe Bytes
-> Bytes
-> Maybe Bytes
-> Bytes
-> Bytes
-> Int
-> Bytes
-> Maybe Int
-> Maybe Bytes
-> Maybe Int
-> Maybe NominalDiffTime
-> Maybe Int
-> Int
-> Bytes
-> NominalDiffTime
-> Int
-> Int
-> NominalDiffTime
-> Int
-> NominalDiffTime
-> Int
-> Bytes
-> Int
-> NominalDiffTime
-> Int
-> Bytes
-> Int
-> Int
-> Int
-> NominalDiffTime
-> Int
-> Int
-> NominalDiffTime
-> Int
-> Int
-> Int
-> NominalDiffTime
-> Int
-> NominalDiffTime
-> Int
-> NominalDiffTime
-> Int
-> Maybe NominalDiffTime
-> Maybe Bool
-> Maybe Int
-> Int
-> NominalDiffTime
-> Int
-> Int
-> NominalDiffTime
-> Int
-> Maybe NominalDiffTime
-> Bytes
-> Int
-> Int
-> NodeIndicesStats
NodeIndicesStats
          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap MS -> NominalDiffTime
unMS forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Object
mRecovery forall {a}. FromJSON a => Maybe Object -> Key -> Parser (Maybe a)
.:: Key
"throttle_time_in_millis")
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe Object
mRecovery
          forall {a}. FromJSON a => Maybe Object -> Key -> Parser (Maybe a)
.:: Key
"current_as_target"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe Object
mRecovery
          forall {a}. FromJSON a => Maybe Object -> Key -> Parser (Maybe a)
.:: Key
"current_as_source"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe Object
mQueryCache
          forall {a}. FromJSON a => Maybe Object -> Key -> Parser (Maybe a)
.:: Key
"miss_count"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe Object
mQueryCache
          forall {a}. FromJSON a => Maybe Object -> Key -> Parser (Maybe a)
.:: Key
"hit_count"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe Object
mQueryCache
          forall {a}. FromJSON a => Maybe Object -> Key -> Parser (Maybe a)
.:: Key
"evictions"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe Object
mQueryCache
          forall {a}. FromJSON a => Maybe Object -> Key -> Parser (Maybe a)
.:: Key
"memory_size_in_bytes"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe Object
mSuggest
          forall {a}. FromJSON a => Maybe Object -> Key -> Parser (Maybe a)
.:: Key
"current"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap MS -> NominalDiffTime
unMS forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Object
mSuggest forall {a}. FromJSON a => Maybe Object -> Key -> Parser (Maybe a)
.:: Key
"time_in_millis")
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe Object
mSuggest
          forall {a}. FromJSON a => Maybe Object -> Key -> Parser (Maybe a)
.:: Key
"total"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
translog
          forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"size_in_bytes"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
translog
          forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"operations"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
segments
          forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"fixed_bit_set_memory_in_bytes"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
segments
          forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"version_map_memory_in_bytes"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
segments
          forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"index_writer_max_memory_in_bytes"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
segments
          forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"index_writer_memory_in_bytes"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
segments
          forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"memory_in_bytes"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
segments
          forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"count"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
completion
          forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"size_in_bytes"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe Object
mPercolate
          forall {a}. FromJSON a => Maybe Object -> Key -> Parser (Maybe a)
.:: Key
"queries"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe Object
mPercolate
          forall {a}. FromJSON a => Maybe Object -> Key -> Parser (Maybe a)
.:: Key
"memory_size_in_bytes"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe Object
mPercolate
          forall {a}. FromJSON a => Maybe Object -> Key -> Parser (Maybe a)
.:: Key
"current"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap MS -> NominalDiffTime
unMS forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Object
mPercolate forall {a}. FromJSON a => Maybe Object -> Key -> Parser (Maybe a)
.:: Key
"time_in_millis")
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe Object
mPercolate
          forall {a}. FromJSON a => Maybe Object -> Key -> Parser (Maybe a)
.:: Key
"total"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
fielddata
          forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"evictions"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
fielddata
          forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"memory_size_in_bytes"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (MS -> NominalDiffTime
unMS forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
warmer forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"total_time_in_millis")
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
warmer
          forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"total"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
warmer
          forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"current"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (MS -> NominalDiffTime
unMS forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
flush forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"total_time_in_millis")
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
flush
          forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"total"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (MS -> NominalDiffTime
unMS forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
refresh forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"total_time_in_millis")
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
refresh
          forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"total"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
merges
          forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"total_size_in_bytes"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
merges
          forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"total_docs"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (MS -> NominalDiffTime
unMS forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
merges forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"total_time_in_millis")
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
merges
          forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"total"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
merges
          forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"current_size_in_bytes"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
merges
          forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"current_docs"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
merges
          forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"current"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
search
          forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"fetch_current"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (MS -> NominalDiffTime
unMS forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
search forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"fetch_time_in_millis")
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
search
          forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"fetch_total"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
search
          forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"query_current"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (MS -> NominalDiffTime
unMS forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
search forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"query_time_in_millis")
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
search
          forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"query_total"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
search
          forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"open_contexts"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
getStats
          forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"current"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (MS -> NominalDiffTime
unMS forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
getStats forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"missing_time_in_millis")
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
getStats
          forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"missing_total"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (MS -> NominalDiffTime
unMS forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
getStats forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"exists_time_in_millis")
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
getStats
          forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"exists_total"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (MS -> NominalDiffTime
unMS forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
getStats forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"time_in_millis")
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
getStats
          forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"total"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap MS -> NominalDiffTime
unMS forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
indexing forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"throttle_time_in_millis")
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
indexing
          forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"is_throttled"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
indexing
          forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"noop_update_total"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
indexing
          forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"delete_current"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (MS -> NominalDiffTime
unMS forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
indexing forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"delete_time_in_millis")
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
indexing
          forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"delete_total"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
indexing
          forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"index_current"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (MS -> NominalDiffTime
unMS forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
indexing forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"index_time_in_millis")
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
indexing
          forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"index_total"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap MS -> NominalDiffTime
unMS forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
store forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"throttle_time_in_millis")
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
store
          forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"size_in_bytes"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
docs
          forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"deleted"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
docs
          forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"count"

instance FromJSON NodeBreakersStats where
  parseJSON :: Value -> Parser NodeBreakersStats
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"NodeBreakersStats" Object -> Parser NodeBreakersStats
parse
    where
      parse :: Object -> Parser NodeBreakersStats
parse Object
o =
        NodeBreakerStats
-> NodeBreakerStats -> NodeBreakerStats -> NodeBreakersStats
NodeBreakersStats
          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"parent"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"request"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"fielddata"

parseNodeStats :: FullNodeId -> Object -> Parser NodeStats
parseNodeStats :: FullNodeId -> Object -> Parser NodeStats
parseNodeStats FullNodeId
fnid Object
o =
  NodeName
-> FullNodeId
-> Maybe NodeBreakersStats
-> NodeHTTPStats
-> NodeTransportStats
-> NodeFSStats
-> Maybe NodeNetworkStats
-> Map Text NodeThreadPoolStats
-> NodeJVMStats
-> NodeProcessStats
-> NodeOSStats
-> NodeIndicesStats
-> NodeStats
NodeStats
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure FullNodeId
fnid
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"breakers"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"http"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"transport"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"fs"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"network"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"thread_pool"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"jvm"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"process"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"os"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"indices"

parseNodeInfo :: FullNodeId -> Object -> Parser NodeInfo
parseNodeInfo :: FullNodeId -> Object -> Parser NodeInfo
parseNodeInfo FullNodeId
nid Object
o =
  Maybe EsAddress
-> BuildHash
-> VersionNumber
-> Server
-> Server
-> EsAddress
-> NodeName
-> FullNodeId
-> [NodePluginInfo]
-> NodeHTTPInfo
-> NodeTransportInfo
-> Maybe NodeNetworkInfo
-> Map Text NodeThreadPoolInfo
-> NodeJVMInfo
-> NodeProcessInfo
-> NodeOSInfo
-> Object
-> NodeInfo
NodeInfo
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"http_address"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"build_hash"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"version"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"ip"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"host"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"transport_address"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure FullNodeId
nid
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"plugins"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"http"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"transport"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"network"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"thread_pool"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"jvm"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"process"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"os"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"settings"

instance FromJSON NodePluginInfo where
  parseJSON :: Value -> Parser NodePluginInfo
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"NodePluginInfo" Object -> Parser NodePluginInfo
parse
    where
      parse :: Object -> Parser NodePluginInfo
parse Object
o =
        Maybe Bool
-> Maybe Bool
-> Text
-> MaybeNA VersionNumber
-> PluginName
-> NodePluginInfo
NodePluginInfo
          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"site"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"jvm"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"description"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"version"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"

instance FromJSON NodeHTTPInfo where
  parseJSON :: Value -> Parser NodeHTTPInfo
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"NodeHTTPInfo" Object -> Parser NodeHTTPInfo
parse
    where
      parse :: Object -> Parser NodeHTTPInfo
parse Object
o =
        Bytes -> EsAddress -> [EsAddress] -> NodeHTTPInfo
NodeHTTPInfo
          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"max_content_length_in_bytes"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"publish_address"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"bound_address"

instance FromJSON BoundTransportAddress where
  parseJSON :: Value -> Parser BoundTransportAddress
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"BoundTransportAddress" Object -> Parser BoundTransportAddress
parse
    where
      parse :: Object -> Parser BoundTransportAddress
parse Object
o =
        EsAddress -> [EsAddress] -> BoundTransportAddress
BoundTransportAddress
          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"publish_address"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"bound_address"

instance FromJSON NodeOSInfo where
  parseJSON :: Value -> Parser NodeOSInfo
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"NodeOSInfo" Object -> Parser NodeOSInfo
parse
    where
      parse :: Object -> Parser NodeOSInfo
parse Object
o =
        NominalDiffTime -> Text -> Text -> Text -> Int -> Int -> NodeOSInfo
NodeOSInfo
          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MS -> NominalDiffTime
unMS forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"refresh_interval_in_millis")
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"arch"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"version"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"available_processors"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"allocated_processors"

instance FromJSON CPUInfo where
  parseJSON :: Value -> Parser CPUInfo
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"CPUInfo" Object -> Parser CPUInfo
parse
    where
      parse :: Object -> Parser CPUInfo
parse Object
o =
        Bytes -> Int -> Int -> Int -> Int -> Text -> Text -> CPUInfo
CPUInfo
          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"cache_size_in_bytes"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"cores_per_socket"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"total_sockets"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"total_cores"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"mhz"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"model"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"vendor"

instance FromJSON NodeProcessInfo where
  parseJSON :: Value -> Parser NodeProcessInfo
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"NodeProcessInfo" Object -> Parser NodeProcessInfo
parse
    where
      parse :: Object -> Parser NodeProcessInfo
parse Object
o =
        Bool -> Maybe Int -> PID -> NominalDiffTime -> NodeProcessInfo
NodeProcessInfo
          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"mlockall"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"max_file_descriptors"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (MS -> NominalDiffTime
unMS forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"refresh_interval_in_millis")

instance FromJSON NodeJVMInfo where
  parseJSON :: Value -> Parser NodeJVMInfo
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"NodeJVMInfo" Object -> Parser NodeJVMInfo
parse
    where
      parse :: Object -> Parser NodeJVMInfo
parse Object
o =
        [JVMMemoryPool]
-> [JVMGCCollector]
-> JVMMemoryInfo
-> UTCTime
-> Text
-> VMVersion
-> Text
-> JVMVersion
-> PID
-> NodeJVMInfo
NodeJVMInfo
          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"memory_pools"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"gc_collectors"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"mem"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (POSIXMS -> UTCTime
posixMS forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"start_time_in_millis")
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"vm_vendor"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"vm_version"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"vm_name"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"version"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"pid"

instance FromJSON JVMMemoryInfo where
  parseJSON :: Value -> Parser JVMMemoryInfo
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"JVMMemoryInfo" Object -> Parser JVMMemoryInfo
parse
    where
      parse :: Object -> Parser JVMMemoryInfo
parse Object
o =
        Bytes -> Bytes -> Bytes -> Bytes -> Bytes -> JVMMemoryInfo
JVMMemoryInfo
          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"direct_max_in_bytes"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"non_heap_max_in_bytes"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"non_heap_init_in_bytes"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"heap_max_in_bytes"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"heap_init_in_bytes"

instance FromJSON NodeThreadPoolInfo where
  parseJSON :: Value -> Parser NodeThreadPoolInfo
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"NodeThreadPoolInfo" Object -> Parser NodeThreadPoolInfo
parse
    where
      parse :: Object -> Parser NodeThreadPoolInfo
parse Object
o = do
        Maybe NominalDiffTime
ka <- forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
(Monad m, MonadFail m) =>
String -> m NominalDiffTime
parseStringInterval) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"keep_alive"
        ThreadPoolSize
-> Maybe NominalDiffTime
-> Maybe Int
-> Maybe Int
-> ThreadPoolType
-> NodeThreadPoolInfo
NodeThreadPoolInfo
          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. FromJSON a => Value -> Parser a
parseJSON forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Value
unStringlyTypeJSON forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"queue_size")
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe NominalDiffTime
ka
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"min"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"max"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"type"

data TimeInterval
  = Weeks
  | Days
  | Hours
  | Minutes
  | Seconds
  deriving (TimeInterval -> TimeInterval -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TimeInterval -> TimeInterval -> Bool
$c/= :: TimeInterval -> TimeInterval -> Bool
== :: TimeInterval -> TimeInterval -> Bool
$c== :: TimeInterval -> TimeInterval -> Bool
Eq)

instance Show TimeInterval where
  show :: TimeInterval -> String
show TimeInterval
Weeks = String
"w"
  show TimeInterval
Days = String
"d"
  show TimeInterval
Hours = String
"h"
  show TimeInterval
Minutes = String
"m"
  show TimeInterval
Seconds = String
"s"

instance Read TimeInterval where
  readPrec :: ReadPrec TimeInterval
readPrec = forall {m :: * -> *}. MonadFail m => Char -> m TimeInterval
f forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ReadPrec Char
TR.get
    where
      f :: Char -> m TimeInterval
f Char
'w' = forall (m :: * -> *) a. Monad m => a -> m a
return TimeInterval
Weeks
      f Char
'd' = forall (m :: * -> *) a. Monad m => a -> m a
return TimeInterval
Days
      f Char
'h' = forall (m :: * -> *) a. Monad m => a -> m a
return TimeInterval
Hours
      f Char
'm' = forall (m :: * -> *) a. Monad m => a -> m a
return TimeInterval
Minutes
      f Char
's' = forall (m :: * -> *) a. Monad m => a -> m a
return TimeInterval
Seconds
      f Char
_ = forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"TimeInterval expected one of w, d, h, m, s"

data Interval
  = Year
  | Quarter
  | Month
  | Week
  | Day
  | Hour
  | Minute
  | Second
  deriving (Interval -> Interval -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Interval -> Interval -> Bool
$c/= :: Interval -> Interval -> Bool
== :: Interval -> Interval -> Bool
$c== :: Interval -> Interval -> Bool
Eq, Int -> Interval -> ShowS
[Interval] -> ShowS
Interval -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Interval] -> ShowS
$cshowList :: [Interval] -> ShowS
show :: Interval -> String
$cshow :: Interval -> String
showsPrec :: Int -> Interval -> ShowS
$cshowsPrec :: Int -> Interval -> ShowS
Show)

instance ToJSON Interval where
  toJSON :: Interval -> Value
toJSON Interval
Year = Value
"year"
  toJSON Interval
Quarter = Value
"quarter"
  toJSON Interval
Month = Value
"month"
  toJSON Interval
Week = Value
"week"
  toJSON Interval
Day = Value
"day"
  toJSON Interval
Hour = Value
"hour"
  toJSON Interval
Minute = Value
"minute"
  toJSON Interval
Second = Value
"second"

parseStringInterval :: (Monad m, MonadFail m) => String -> m NominalDiffTime
parseStringInterval :: forall (m :: * -> *).
(Monad m, MonadFail m) =>
String -> m NominalDiffTime
parseStringInterval String
s = case forall a. (a -> Bool) -> [a] -> ([a], [a])
span Char -> Bool
isNumber String
s of
  (String
"", String
_) -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Invalid interval"
  (String
nS, String
unitS) -> case (forall a. Read a => String -> Maybe a
readMay String
nS, forall a. Read a => String -> Maybe a
readMay String
unitS) of
    (Just Integer
n, Just TimeInterval
unit) -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Num a => Integer -> a
fromInteger (Integer
n forall a. Num a => a -> a -> a
* forall {a}. Num a => TimeInterval -> a
unitNDT TimeInterval
unit))
    (Maybe Integer
Nothing, Maybe TimeInterval
_) -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Invalid interval number"
    (Maybe Integer
_, Maybe TimeInterval
Nothing) -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Invalid interval unit"
  where
    unitNDT :: TimeInterval -> a
unitNDT TimeInterval
Seconds = a
1
    unitNDT TimeInterval
Minutes = a
60
    unitNDT TimeInterval
Hours = a
60 forall a. Num a => a -> a -> a
* a
60
    unitNDT TimeInterval
Days = a
24 forall a. Num a => a -> a -> a
* a
60 forall a. Num a => a -> a -> a
* a
60
    unitNDT TimeInterval
Weeks = a
7 forall a. Num a => a -> a -> a
* a
24 forall a. Num a => a -> a -> a
* a
60 forall a. Num a => a -> a -> a
* a
60

instance FromJSON ThreadPoolSize where
  parseJSON :: Value -> Parser ThreadPoolSize
parseJSON Value
v = Value -> Parser ThreadPoolSize
parseAsNumber Value
v forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Value -> Parser ThreadPoolSize
parseAsString Value
v
    where
      parseAsNumber :: Value -> Parser ThreadPoolSize
parseAsNumber = forall {m :: * -> *}. MonadFail m => Int -> m ThreadPoolSize
parseAsInt forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< forall a. FromJSON a => Value -> Parser a
parseJSON
      parseAsInt :: Int -> m ThreadPoolSize
parseAsInt (-1) = forall (m :: * -> *) a. Monad m => a -> m a
return ThreadPoolSize
ThreadPoolUnbounded
      parseAsInt Int
n
        | Int
n forall a. Ord a => a -> a -> Bool
>= Int
0 = forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> ThreadPoolSize
ThreadPoolBounded Int
n)
        | Bool
otherwise = forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Thread pool size must be >= -1."
      parseAsString :: Value -> Parser ThreadPoolSize
parseAsString = forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"ThreadPoolSize" forall a b. (a -> b) -> a -> b
$ \Text
t ->
        case forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (forall a. Read a => String -> Maybe a
readMay forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack) ((Char -> Bool) -> Text -> (Text, Text)
T.span Char -> Bool
isNumber Text
t) of
          (Just Int
n, Text
"k") -> forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> ThreadPoolSize
ThreadPoolBounded (Int
n forall a. Num a => a -> a -> a
* Int
1000))
          (Just Int
n, Text
"") -> forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> ThreadPoolSize
ThreadPoolBounded Int
n)
          (Maybe Int, Text)
_ -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Invalid thread pool size " forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
t)

instance FromJSON ThreadPoolType where
  parseJSON :: Value -> Parser ThreadPoolType
parseJSON = forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"ThreadPoolType" forall {m :: * -> *}. MonadFail m => Text -> m ThreadPoolType
parse
    where
      parse :: Text -> m ThreadPoolType
parse Text
"scaling" = forall (m :: * -> *) a. Monad m => a -> m a
return ThreadPoolType
ThreadPoolScaling
      parse Text
"fixed" = forall (m :: * -> *) a. Monad m => a -> m a
return ThreadPoolType
ThreadPoolFixed
      parse Text
"cached" = forall (m :: * -> *) a. Monad m => a -> m a
return ThreadPoolType
ThreadPoolCached
      parse Text
"fixed_auto_queue_size" = forall (m :: * -> *) a. Monad m => a -> m a
return ThreadPoolType
ThreadPoolFixedAutoQueueSize
      parse Text
e = forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Unexpected thread pool type" forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
e)

instance FromJSON NodeTransportInfo where
  parseJSON :: Value -> Parser NodeTransportInfo
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"NodeTransportInfo" Object -> Parser NodeTransportInfo
parse
    where
      parse :: Object -> Parser NodeTransportInfo
parse Object
o =
        [BoundTransportAddress]
-> EsAddress -> [EsAddress] -> NodeTransportInfo
NodeTransportInfo
          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty) forall {a}. FromJSON a => Value -> Parser [a]
parseProfiles forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"profiles")
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"publish_address"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"bound_address"
      parseProfiles :: Value -> Parser [a]
parseProfiles (Object Object
o) | forall v. KeyMap v -> Bool
X.null Object
o = forall (m :: * -> *) a. Monad m => a -> m a
return []
      parseProfiles v :: Value
v@(Array Array
_) = forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
      parseProfiles Value
Null = forall (m :: * -> *) a. Monad m => a -> m a
return []
      parseProfiles Value
_ = forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Could not parse profiles"

instance FromJSON NodeNetworkInfo where
  parseJSON :: Value -> Parser NodeNetworkInfo
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"NodeNetworkInfo" Object -> Parser NodeNetworkInfo
parse
    where
      parse :: Object -> Parser NodeNetworkInfo
parse Object
o =
        NodeNetworkInterface -> NominalDiffTime -> NodeNetworkInfo
NodeNetworkInfo
          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"primary_interface"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (MS -> NominalDiffTime
unMS forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"refresh_interval_in_millis")

instance FromJSON NodeNetworkInterface where
  parseJSON :: Value -> Parser NodeNetworkInterface
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"NodeNetworkInterface" Object -> Parser NodeNetworkInterface
parse
    where
      parse :: Object -> Parser NodeNetworkInterface
parse Object
o =
        MacAddress
-> NetworkInterfaceName -> Server -> NodeNetworkInterface
NodeNetworkInterface
          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"mac_address"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"address"

instance ToJSON Version where
  toJSON :: Version -> Value
toJSON Version {Bool
UTCTime
BuildHash
VersionNumber
lucene_version :: VersionNumber
build_snapshot :: Bool
build_date :: UTCTime
build_hash :: BuildHash
number :: VersionNumber
lucene_version :: Version -> VersionNumber
build_snapshot :: Version -> Bool
build_date :: Version -> UTCTime
build_hash :: Version -> BuildHash
number :: Version -> VersionNumber
..} =
    [Pair] -> Value
object
      [ Key
"number" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= VersionNumber
number,
        Key
"build_hash" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= BuildHash
build_hash,
        Key
"build_date" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= UTCTime
build_date,
        Key
"build_snapshot" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Bool
build_snapshot,
        Key
"lucene_version" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= VersionNumber
lucene_version
      ]

instance FromJSON Version where
  parseJSON :: Value -> Parser Version
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Version" Object -> Parser Version
parse
    where
      parse :: Object -> Parser Version
parse Object
o =
        VersionNumber
-> BuildHash -> UTCTime -> Bool -> VersionNumber -> Version
Version
          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"number"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"build_hash"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"build_date"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"build_snapshot"
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"lucene_version"

instance ToJSON VersionNumber where
  toJSON :: VersionNumber -> Value
toJSON = forall a. ToJSON a => a -> Value
toJSON forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version -> Text
SemVer.toText forall b c a. (b -> c) -> (a -> b) -> a -> c
. VersionNumber -> Version
versionNumber

instance FromJSON VersionNumber where
  parseJSON :: Value -> Parser VersionNumber
parseJSON = forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"VersionNumber" forall {m :: * -> *}. MonadFail m => Text -> m VersionNumber
parse
    where
      parse :: Text -> m VersionNumber
parse Text
t =
        case Text -> Either String Version
SemVer.fromText Text
t of
          (Left String
err) -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
err
          (Right Version
v) -> forall (m :: * -> *) a. Monad m => a -> m a
return (Version -> VersionNumber
VersionNumber Version
v)