{-# LANGUAGE CPP                        #-}
{-# 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           GHC.Enum
import           Network.HTTP.Client
import           Text.Read                                  (Read (..))
import qualified Text.Read                                  as TR

import           Database.Bloodhound.Internal.Analysis
import           Database.Bloodhound.Internal.Newtypes
import           Database.Bloodhound.Internal.Query
import           Database.Bloodhound.Internal.StringlyTyped

{-| 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
                   , BHEnv -> Request -> IO Request
bhRequestHook :: Request -> IO Request
                   -- ^ Low-level hook that is run before every request is sent. Used to implement custom authentication strategies. Defaults to 'return' with 'mkBHEnv'.
                   }

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

{-| 'Server' is used with the client functions to point at the ES instance
-}
newtype Server = Server Text deriving (Server -> Server -> Bool
(Server -> Server -> Bool)
-> (Server -> Server -> Bool) -> Eq Server
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Server -> Server -> Bool
$c/= :: Server -> Server -> Bool
== :: Server -> Server -> Bool
$c== :: Server -> Server -> Bool
Eq, Int -> Server -> ShowS
[Server] -> ShowS
Server -> String
(Int -> Server -> ShowS)
-> (Server -> String) -> ([Server] -> ShowS) -> Show Server
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Server] -> ShowS
$cshowList :: [Server] -> ShowS
show :: Server -> String
$cshow :: Server -> String
showsPrec :: Int -> Server -> ShowS
$cshowsPrec :: Int -> Server -> ShowS
Show, Value -> Parser [Server]
Value -> Parser Server
(Value -> Parser Server)
-> (Value -> Parser [Server]) -> FromJSON Server
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Server]
$cparseJSONList :: Value -> Parser [Server]
parseJSON :: Value -> Parser Server
$cparseJSON :: Value -> Parser Server
FromJSON)

{-| 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 Request -> IO Request
forall (m :: * -> *) a. Monad m => a -> m a
return

newtype BH m a = BH {
      BH m a -> ReaderT BHEnv m a
unBH :: ReaderT BHEnv m a
    } deriving ( a -> BH m b -> BH m a
(a -> b) -> BH m a -> BH m b
(forall a b. (a -> b) -> BH m a -> BH m b)
-> (forall a b. a -> BH m b -> BH m a) -> Functor (BH m)
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
<$ :: a -> BH m b -> BH m a
$c<$ :: forall (m :: * -> *) a b. Functor m => a -> BH m b -> BH m a
fmap :: (a -> b) -> BH m a -> BH m b
$cfmap :: forall (m :: * -> *) a b. Functor m => (a -> b) -> BH m a -> BH m b
Functor
               , Functor (BH m)
a -> BH m a
Functor (BH m)
-> (forall a. a -> BH m a)
-> (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 a b. BH m a -> BH m b -> BH m b)
-> (forall a b. BH m a -> BH m b -> BH m a)
-> Applicative (BH m)
BH m a -> BH m b -> BH m b
BH m a -> BH m b -> BH m a
BH m (a -> b) -> BH m a -> BH m b
(a -> b -> c) -> BH m a -> BH m b -> BH m c
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
<* :: 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
*> :: 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 :: (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
<*> :: 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 :: a -> BH m a
$cpure :: forall (m :: * -> *) a. Applicative m => a -> BH m a
$cp1Applicative :: forall (m :: * -> *). Applicative m => Functor (BH m)
Applicative
               , Applicative (BH m)
a -> BH m a
Applicative (BH m)
-> (forall a b. BH m a -> (a -> BH m b) -> BH m b)
-> (forall a b. BH m a -> BH m b -> BH m b)
-> (forall a. a -> BH m a)
-> Monad (BH m)
BH m a -> (a -> BH m b) -> BH m b
BH m a -> BH m b -> BH m b
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 :: a -> BH m a
$creturn :: forall (m :: * -> *) a. Monad m => a -> BH m a
>> :: 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
>>= :: 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
$cp1Monad :: forall (m :: * -> *). Monad m => Applicative (BH m)
Monad
               , Monad (BH m)
Monad (BH m) -> (forall a. IO a -> BH m a) -> MonadIO (BH m)
IO a -> BH m a
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 :: IO a -> BH m a
$cliftIO :: forall (m :: * -> *) a. MonadIO m => IO a -> BH m a
$cp1MonadIO :: forall (m :: * -> *). MonadIO m => Monad (BH m)
MonadIO
               , MonadState s
               , MonadWriter w
               , MonadError e
               , Applicative (BH m)
BH m a
Applicative (BH m)
-> (forall a. BH m a)
-> (forall a. BH m a -> BH m a -> BH m a)
-> (forall a. BH m a -> BH m [a])
-> (forall a. BH m a -> BH m [a])
-> Alternative (BH m)
BH m a -> BH m a -> BH m a
BH m a -> BH m [a]
BH m a -> BH m [a]
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 :: BH m a -> BH m [a]
$cmany :: forall (m :: * -> *) a. Alternative m => BH m a -> BH m [a]
some :: BH m a -> BH m [a]
$csome :: forall (m :: * -> *) a. Alternative m => BH m a -> BH m [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 :: BH m a
$cempty :: forall (m :: * -> *) a. Alternative m => BH m a
$cp1Alternative :: forall (m :: * -> *). Alternative m => Applicative (BH m)
Alternative
               , Monad (BH m)
Alternative (BH m)
BH m a
Alternative (BH m)
-> Monad (BH m)
-> (forall a. BH m a)
-> (forall a. BH m a -> BH m a -> BH m a)
-> MonadPlus (BH m)
BH m a -> BH m a -> BH m a
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 :: 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 :: BH m a
$cmzero :: forall (m :: * -> *) a. MonadPlus m => BH m a
$cp2MonadPlus :: forall (m :: * -> *). MonadPlus m => Monad (BH m)
$cp1MonadPlus :: forall (m :: * -> *). MonadPlus m => Alternative (BH m)
MonadPlus
               , Monad (BH m)
Monad (BH m)
-> (forall a. (a -> BH m a) -> BH m a) -> MonadFix (BH m)
(a -> BH m a) -> BH m a
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 :: (a -> BH m a) -> BH m a
$cmfix :: forall (m :: * -> *) a. MonadFix m => (a -> BH m a) -> BH m a
$cp1MonadFix :: forall (m :: * -> *). MonadFix m => Monad (BH m)
MonadFix
               , Monad (BH m)
e -> BH m a
Monad (BH m)
-> (forall e a. Exception e => e -> BH m a) -> MonadThrow (BH m)
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 :: e -> BH m a
$cthrowM :: forall (m :: * -> *) e a.
(MonadThrow m, Exception e) =>
e -> BH m a
$cp1MonadThrow :: forall (m :: * -> *). MonadThrow m => Monad (BH m)
MonadThrow
               , MonadThrow (BH m)
MonadThrow (BH m)
-> (forall e a. Exception e => BH m a -> (e -> BH m a) -> BH m a)
-> MonadCatch (BH m)
BH m a -> (e -> BH m a) -> BH m a
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 :: 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
$cp1MonadCatch :: forall (m :: * -> *). MonadCatch m => MonadThrow (BH m)
MonadCatch
#if defined(MIN_VERSION_GLASGOW_HASKELL)
#if MIN_VERSION_GLASGOW_HASKELL(8,6,0,0)
               , Monad (BH m)
Monad (BH m) -> (forall a. String -> BH m a) -> MonadFail (BH m)
String -> BH m a
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 :: String -> BH m a
$cfail :: forall (m :: * -> *) a. MonadFail m => String -> BH m a
$cp1MonadFail :: forall (m :: * -> *). MonadFail m => Monad (BH m)
MonadFail
#endif
#endif
               , MonadCatch (BH m)
MonadCatch (BH m)
-> (forall b. ((forall a. BH m a -> BH m a) -> BH m b) -> BH m b)
-> (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))
-> MonadMask (BH m)
BH m a
-> (a -> ExitCase b -> BH m c) -> (a -> BH m b) -> BH m (b, c)
((forall a. BH m a -> BH m a) -> BH m b) -> BH m b
((forall a. BH m a -> BH m a) -> BH m b) -> BH m b
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 :: * -> *).
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
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)
generalBracket :: 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 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 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
$cp1MonadMask :: forall (m :: * -> *). MonadMask m => MonadCatch (BH m)
MonadMask)

instance MonadTrans BH where
  lift :: m a -> BH m a
lift = ReaderT BHEnv m a -> BH m a
forall (m :: * -> *) a. ReaderT BHEnv m a -> BH m a
BH (ReaderT BHEnv m a -> BH m a)
-> (m a -> ReaderT BHEnv m a) -> m a -> BH m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> ReaderT BHEnv m a
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 = m r -> BH m r
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m r
forall r (m :: * -> *). MonadReader r m => m r
ask
    local :: (r -> r) -> BH m a -> BH m a
local r -> r
f (BH (ReaderT BHEnv -> m a
m)) = ReaderT BHEnv m a -> BH m a
forall (m :: * -> *) a. ReaderT BHEnv m a -> BH m a
BH (ReaderT BHEnv m a -> BH m a) -> ReaderT BHEnv m a -> BH m a
forall a b. (a -> b) -> a -> b
$ (BHEnv -> m a) -> ReaderT BHEnv m a
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((BHEnv -> m a) -> ReaderT BHEnv m a)
-> (BHEnv -> m a) -> ReaderT BHEnv m a
forall a b. (a -> b) -> a -> b
$ \BHEnv
r ->
      (r -> r) -> m a -> m a
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 = ReaderT BHEnv m BHEnv -> BH m BHEnv
forall (m :: * -> *) a. ReaderT BHEnv m a -> BH m a
BH ReaderT BHEnv m BHEnv
forall (m :: * -> *). MonadBH m => m BHEnv
getBHEnv

runBH :: BHEnv -> BH m a -> m a
runBH :: BHEnv -> BH m a -> m a
runBH BHEnv
e BH m a
f = ReaderT BHEnv m a -> BHEnv -> m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (BH m a -> ReaderT BHEnv m a
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
(Version -> Version -> Bool)
-> (Version -> Version -> Bool) -> Eq Version
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
(Int -> Version -> ShowS)
-> (Version -> String) -> ([Version] -> ShowS) -> Show Version
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)

-- | Traditional software versioning number
newtype VersionNumber = VersionNumber
  { VersionNumber -> Version
versionNumber :: SemVer.Version }
  deriving (VersionNumber -> VersionNumber -> Bool
(VersionNumber -> VersionNumber -> Bool)
-> (VersionNumber -> VersionNumber -> Bool) -> Eq VersionNumber
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
Eq VersionNumber
-> (VersionNumber -> VersionNumber -> Ordering)
-> (VersionNumber -> VersionNumber -> Bool)
-> (VersionNumber -> VersionNumber -> Bool)
-> (VersionNumber -> VersionNumber -> Bool)
-> (VersionNumber -> VersionNumber -> Bool)
-> (VersionNumber -> VersionNumber -> VersionNumber)
-> (VersionNumber -> VersionNumber -> VersionNumber)
-> Ord 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
$cp1Ord :: Eq VersionNumber
Ord, Int -> VersionNumber -> ShowS
[VersionNumber] -> ShowS
VersionNumber -> String
(Int -> VersionNumber -> ShowS)
-> (VersionNumber -> String)
-> ([VersionNumber] -> ShowS)
-> Show VersionNumber
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.elasticsearch.org/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
(Status -> Status -> Bool)
-> (Status -> Status -> Bool) -> Eq Status
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
(Int -> Status -> ShowS)
-> (Status -> String) -> ([Status] -> ShowS) -> Show Status
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 (Text -> Text -> Text -> Version -> Text -> Status)
-> Parser Text
-> Parser (Text -> Text -> Version -> Text -> Status)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                         Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name" Parser (Text -> Text -> Version -> Text -> Status)
-> Parser Text -> Parser (Text -> Version -> Text -> Status)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
                         Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"cluster_name" Parser (Text -> Version -> Text -> Status)
-> Parser Text -> Parser (Version -> Text -> Status)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
                         Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"cluster_uuid" Parser (Version -> Text -> Status)
-> Parser Version -> Parser (Text -> Status)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
                         Object
v Object -> Key -> Parser Version
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"version" Parser (Text -> Status) -> Parser Text -> Parser Status
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
                         Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"tagline"
  parseJSON Value
_          = Parser Status
forall (f :: * -> *) a. Alternative f => f a
empty

{-| 'IndexSettings' is used to configure the shards and replicas when
    you create an Elasticsearch Index.

   <http://www.elasticsearch.org/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
(IndexSettings -> IndexSettings -> Bool)
-> (IndexSettings -> IndexSettings -> Bool) -> Eq IndexSettings
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
(Int -> IndexSettings -> ShowS)
-> (IndexSettings -> String)
-> ([IndexSettings] -> ShowS)
-> Show IndexSettings
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)

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

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

{-| '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
(IndexMappingsLimits -> IndexMappingsLimits -> Bool)
-> (IndexMappingsLimits -> IndexMappingsLimits -> Bool)
-> Eq IndexMappingsLimits
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
(Int -> IndexMappingsLimits -> ShowS)
-> (IndexMappingsLimits -> String)
-> ([IndexMappingsLimits] -> ShowS)
-> Show IndexMappingsLimits
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)

instance ToJSON IndexMappingsLimits where
  toJSON :: IndexMappingsLimits -> Value
toJSON (IndexMappingsLimits Maybe Int
d Maybe Int
f Maybe Int
o Maybe Int
n) = [Pair] -> Value
object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$
                                            ((Key, Maybe Int) -> Maybe Pair) -> [(Key, Maybe Int)] -> [Pair]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Key, Maybe Int) -> Maybe Pair
forall (f :: * -> *) b v.
(Functor f, KeyValue b, ToJSON v) =>
(Key, f v) -> 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 v) -> f b
go (Key
name, f v
value) = (Key
name Key -> v -> b
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.=) (v -> b) -> f v -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f v
value

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

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

{-| 'ForceMergeIndexSettings' is used to configure index optimization. See
    <https://www.elastic.co/guide/en/elasticsearch/reference/current/indices-forcemerge.html>
    for more info.
-}
data ForceMergeIndexSettings =
  ForceMergeIndexSettings { ForceMergeIndexSettings -> Maybe Int
maxNumSegments       :: Maybe Int
                            -- ^ 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 -> Bool
onlyExpungeDeletes :: Bool
                            -- ^ 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
flushAfterOptimize :: Bool
                            -- ^ Should a flush be performed after the optimize.
                            } deriving (ForceMergeIndexSettings -> ForceMergeIndexSettings -> Bool
(ForceMergeIndexSettings -> ForceMergeIndexSettings -> Bool)
-> (ForceMergeIndexSettings -> ForceMergeIndexSettings -> Bool)
-> Eq ForceMergeIndexSettings
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
(Int -> ForceMergeIndexSettings -> ShowS)
-> (ForceMergeIndexSettings -> String)
-> ([ForceMergeIndexSettings] -> ShowS)
-> Show ForceMergeIndexSettings
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 Maybe Int
forall a. Maybe a
Nothing Bool
False Bool
True

{-| 'UpdatableIndexSetting' are settings which may be updated after an index is created.

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

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

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

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

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

data ReplicaBounds = ReplicasBounded Int Int
                   | ReplicasLowerBounded Int
                   | ReplicasUnbounded
                   deriving (ReplicaBounds -> ReplicaBounds -> Bool
(ReplicaBounds -> ReplicaBounds -> Bool)
-> (ReplicaBounds -> ReplicaBounds -> Bool) -> Eq ReplicaBounds
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
(Int -> ReplicaBounds -> ShowS)
-> (ReplicaBounds -> String)
-> ([ReplicaBounds] -> ShowS)
-> Show ReplicaBounds
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 (Int -> Text
forall a. Show a => a -> Text
showText Int
a Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
showText Int
b)
  toJSON (ReplicasLowerBounded Int
a) = Text -> Value
String (Int -> Text
forall a. Show a => a -> Text
showText Int
a Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"-all")
  toJSON ReplicaBounds
ReplicasUnbounded        = Bool -> Value
Bool Bool
False

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

data Compression
  = CompressionDefault
    -- ^ Compress with LZ4
  | CompressionBest
    -- ^ 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%.
  deriving (Compression -> Compression -> Bool
(Compression -> Compression -> Bool)
-> (Compression -> Compression -> Bool) -> Eq Compression
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
(Int -> Compression -> ShowS)
-> (Compression -> String)
-> ([Compression] -> ShowS)
-> Show Compression
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)

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

instance FromJSON Compression where
  parseJSON :: Value -> Parser Compression
parseJSON = String
-> (Text -> Parser Compression) -> Value -> Parser Compression
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"Compression" ((Text -> Parser Compression) -> Value -> Parser Compression)
-> (Text -> Parser Compression) -> Value -> Parser Compression
forall a b. (a -> b) -> a -> b
$ \Text
t -> case Text
t of
    Text
"default" -> Compression -> Parser Compression
forall (m :: * -> *) a. Monad m => a -> m a
return Compression
CompressionDefault
    Text
"best_compression" -> Compression -> Parser Compression
forall (m :: * -> *) a. Monad m => a -> m a
return Compression
CompressionBest
    Text
_ -> String -> Parser Compression
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
(Bytes -> Bytes -> Bool) -> (Bytes -> Bytes -> Bool) -> Eq Bytes
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
(Int -> Bytes -> ShowS)
-> (Bytes -> String) -> ([Bytes] -> ShowS) -> Show Bytes
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, Eq Bytes
Eq Bytes
-> (Bytes -> Bytes -> Ordering)
-> (Bytes -> Bytes -> Bool)
-> (Bytes -> Bytes -> Bool)
-> (Bytes -> Bytes -> Bool)
-> (Bytes -> Bytes -> Bool)
-> (Bytes -> Bytes -> Bytes)
-> (Bytes -> Bytes -> Bytes)
-> Ord 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
$cp1Ord :: Eq Bytes
Ord, [Bytes] -> Encoding
[Bytes] -> Value
Bytes -> Encoding
Bytes -> Value
(Bytes -> Value)
-> (Bytes -> Encoding)
-> ([Bytes] -> Value)
-> ([Bytes] -> Encoding)
-> ToJSON Bytes
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
(Value -> Parser Bytes)
-> (Value -> Parser [Bytes]) -> FromJSON 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 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
n)


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


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


data FSType = FSSimple
            | FSBuffered deriving (FSType -> FSType -> Bool
(FSType -> FSType -> Bool)
-> (FSType -> FSType -> Bool) -> Eq FSType
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
(Int -> FSType -> ShowS)
-> (FSType -> String) -> ([FSType] -> ShowS) -> Show FSType
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)

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

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

data InitialShardCount = QuorumShards
                       | QuorumMinus1Shards
                       | FullShards
                       | FullMinus1Shards
                       | ExplicitShards Int
                       deriving (InitialShardCount -> InitialShardCount -> Bool
(InitialShardCount -> InitialShardCount -> Bool)
-> (InitialShardCount -> InitialShardCount -> Bool)
-> Eq InitialShardCount
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
(Int -> InitialShardCount -> ShowS)
-> (InitialShardCount -> String)
-> ([InitialShardCount] -> ShowS)
-> Show InitialShardCount
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)

instance FromJSON InitialShardCount where
  parseJSON :: Value -> Parser InitialShardCount
parseJSON Value
v = String
-> (Text -> Parser InitialShardCount)
-> Value
-> Parser InitialShardCount
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"InitialShardCount" Text -> Parser InitialShardCount
forall a (f :: * -> *).
(Eq a, IsString a, MonadPlus f) =>
a -> f InitialShardCount
parseText Value
v
            Parser InitialShardCount
-> Parser InitialShardCount -> Parser InitialShardCount
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Int -> InitialShardCount
ExplicitShards (Int -> InitialShardCount)
-> Parser Int -> Parser InitialShardCount
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser Int
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
    where parseText :: a -> f InitialShardCount
parseText a
"quorum"   = InitialShardCount -> f InitialShardCount
forall (f :: * -> *) a. Applicative f => a -> f a
pure InitialShardCount
QuorumShards
          parseText a
"quorum-1" = InitialShardCount -> f InitialShardCount
forall (f :: * -> *) a. Applicative f => a -> f a
pure InitialShardCount
QuorumMinus1Shards
          parseText a
"full"     = InitialShardCount -> f InitialShardCount
forall (f :: * -> *) a. Applicative f => a -> f a
pure InitialShardCount
FullShards
          parseText a
"full-1"   = InitialShardCount -> f InitialShardCount
forall (f :: * -> *) a. Applicative f => a -> f a
pure InitialShardCount
FullMinus1Shards
          parseText a
_          = f InitialShardCount
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) = Int -> Value
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
(NodeAttrFilter -> NodeAttrFilter -> Bool)
-> (NodeAttrFilter -> NodeAttrFilter -> Bool) -> Eq NodeAttrFilter
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
Eq NodeAttrFilter
-> (NodeAttrFilter -> NodeAttrFilter -> Ordering)
-> (NodeAttrFilter -> NodeAttrFilter -> Bool)
-> (NodeAttrFilter -> NodeAttrFilter -> Bool)
-> (NodeAttrFilter -> NodeAttrFilter -> Bool)
-> (NodeAttrFilter -> NodeAttrFilter -> Bool)
-> (NodeAttrFilter -> NodeAttrFilter -> NodeAttrFilter)
-> (NodeAttrFilter -> NodeAttrFilter -> NodeAttrFilter)
-> Ord 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
$cp1Ord :: Eq NodeAttrFilter
Ord, Int -> NodeAttrFilter -> ShowS
[NodeAttrFilter] -> ShowS
NodeAttrFilter -> String
(Int -> NodeAttrFilter -> ShowS)
-> (NodeAttrFilter -> String)
-> ([NodeAttrFilter] -> ShowS)
-> Show NodeAttrFilter
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
(NodeAttrName -> NodeAttrName -> Bool)
-> (NodeAttrName -> NodeAttrName -> Bool) -> Eq NodeAttrName
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
Eq NodeAttrName
-> (NodeAttrName -> NodeAttrName -> Ordering)
-> (NodeAttrName -> NodeAttrName -> Bool)
-> (NodeAttrName -> NodeAttrName -> Bool)
-> (NodeAttrName -> NodeAttrName -> Bool)
-> (NodeAttrName -> NodeAttrName -> Bool)
-> (NodeAttrName -> NodeAttrName -> NodeAttrName)
-> (NodeAttrName -> NodeAttrName -> NodeAttrName)
-> Ord 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
$cp1Ord :: Eq NodeAttrName
Ord, Int -> NodeAttrName -> ShowS
[NodeAttrName] -> ShowS
NodeAttrName -> String
(Int -> NodeAttrName -> ShowS)
-> (NodeAttrName -> String)
-> ([NodeAttrName] -> ShowS)
-> Show NodeAttrName
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
                    | MergeSegmentVsTotalIndex Double
                    -- ^ percentage between 0 and 1 where 0 is false, 1 is true
                    deriving (CompoundFormat -> CompoundFormat -> Bool
(CompoundFormat -> CompoundFormat -> Bool)
-> (CompoundFormat -> CompoundFormat -> Bool) -> Eq CompoundFormat
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
(Int -> CompoundFormat -> ShowS)
-> (CompoundFormat -> String)
-> ([CompoundFormat] -> ShowS)
-> Show CompoundFormat
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)

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

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

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

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

instance FromJSON NominalDiffTimeJSON where
  parseJSON :: Value -> Parser NominalDiffTimeJSON
parseJSON = String
-> (Text -> Parser NominalDiffTimeJSON)
-> Value
-> Parser NominalDiffTimeJSON
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"NominalDiffTime" Text -> Parser NominalDiffTimeJSON
parse
    where parse :: Text -> Parser NominalDiffTimeJSON
parse Text
t = case Int -> Text -> Text
T.takeEnd Int
1 Text
t of
                      Text
"s" -> NominalDiffTime -> NominalDiffTimeJSON
NominalDiffTimeJSON (NominalDiffTime -> NominalDiffTimeJSON)
-> (Integer -> NominalDiffTime) -> Integer -> NominalDiffTimeJSON
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> NominalDiffTime
forall a. Num a => Integer -> a
fromInteger (Integer -> NominalDiffTimeJSON)
-> Parser Integer -> Parser NominalDiffTimeJSON
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Parser Integer
forall a. Read a => Text -> Parser a
parseReadText (Int -> Text -> Text
T.dropEnd Int
1 Text
t)
                      Text
_ -> String -> Parser NominalDiffTimeJSON
forall (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
(IndexSettingsSummary -> IndexSettingsSummary -> Bool)
-> (IndexSettingsSummary -> IndexSettingsSummary -> Bool)
-> Eq IndexSettingsSummary
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
(Int -> IndexSettingsSummary -> ShowS)
-> (IndexSettingsSummary -> String)
-> ([IndexSettingsSummary] -> ShowS)
-> Show IndexSettingsSummary
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 Object -> Key -> Parser (HashMap Key Value)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"index"
  -- slice the index object into singleton hashmaps and try to parse each
  [Maybe UpdatableIndexSetting]
parses <- [Pair]
-> (Pair -> Parser (Maybe UpdatableIndexSetting))
-> Parser [Maybe UpdatableIndexSetting]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (HashMap Key Value -> [Pair]
forall k v. HashMap k v -> [(k, v)]
HM.toList HashMap Key Value
o') ((Pair -> Parser (Maybe UpdatableIndexSetting))
 -> Parser [Maybe UpdatableIndexSetting])
-> (Pair -> Parser (Maybe UpdatableIndexSetting))
-> Parser [Maybe UpdatableIndexSetting]
forall a b. (a -> b) -> a -> b
$ \(Key
k, Value
v) -> do
    -- blocks are now nested into the "index" key, which is not how they're serialized
    let atRoot :: Value
atRoot = Object -> Value
Object (Key -> Value -> Object
forall v. Key -> v -> KeyMap v
X.singleton Key
k Value
v)
    let atIndex :: Value
atIndex = Object -> Value
Object (Key -> Value -> Object
forall v. Key -> v -> KeyMap v
X.singleton Key
"index" Value
atRoot)
    Parser UpdatableIndexSetting
-> Parser (Maybe UpdatableIndexSetting)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Value -> Parser UpdatableIndexSetting
forall a. FromJSON a => Value -> Parser a
parseJSON Value
atRoot Parser UpdatableIndexSetting
-> Parser UpdatableIndexSetting -> Parser UpdatableIndexSetting
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Value -> Parser UpdatableIndexSetting
forall a. FromJSON a => Value -> Parser a
parseJSON Value
atIndex)
  [UpdatableIndexSetting] -> Parser [UpdatableIndexSetting]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Maybe UpdatableIndexSetting] -> [UpdatableIndexSetting]
forall a. [Maybe a] -> [a]
catMaybes [Maybe UpdatableIndexSetting]
parses)

instance FromJSON IndexSettingsSummary where
  parseJSON :: Value -> Parser IndexSettingsSummary
parseJSON = String
-> (Object -> Parser IndexSettingsSummary)
-> Value
-> Parser IndexSettingsSummary
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"IndexSettingsSummary" Object -> Parser IndexSettingsSummary
parse
    where parse :: Object -> Parser IndexSettingsSummary
parse Object
o = case Object -> [Pair]
forall v. KeyMap v -> [(Key, v)]
X.toList Object
o of
                      [(Key
ixn, v :: Value
v@(Object Object
o'))] -> IndexName
-> IndexSettings -> [UpdatableIndexSetting] -> IndexSettingsSummary
IndexSettingsSummary (Text -> IndexName
IndexName (Text -> IndexName) -> Text -> IndexName
forall a b. (a -> b) -> a -> b
$ Key -> Text
toText Key
ixn)
                                                (IndexSettings -> [UpdatableIndexSetting] -> IndexSettingsSummary)
-> Parser IndexSettings
-> Parser ([UpdatableIndexSetting] -> IndexSettingsSummary)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser IndexSettings
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
                                                Parser ([UpdatableIndexSetting] -> IndexSettingsSummary)
-> Parser [UpdatableIndexSetting] -> Parser IndexSettingsSummary
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (([UpdatableIndexSetting] -> [UpdatableIndexSetting])
-> Parser [UpdatableIndexSetting] -> Parser [UpdatableIndexSetting]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((UpdatableIndexSetting -> Bool)
-> [UpdatableIndexSetting] -> [UpdatableIndexSetting]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> (UpdatableIndexSetting -> Bool) -> UpdatableIndexSetting -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UpdatableIndexSetting -> Bool
redundant)) (Parser [UpdatableIndexSetting] -> Parser [UpdatableIndexSetting])
-> (Object -> Parser [UpdatableIndexSetting])
-> Object
-> Parser [UpdatableIndexSetting]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Object -> Parser [UpdatableIndexSetting]
parseSettings (Object -> Parser [UpdatableIndexSetting])
-> Parser Object -> Parser [UpdatableIndexSetting]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Object
o' Object -> Key -> Parser Object
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"settings")
                      [Pair]
_ -> String -> Parser IndexSettingsSummary
forall (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

{-| 'Reply' and 'Method' are type synonyms from 'Network.HTTP.Types.Method.Method' -}
type Reply = Network.HTTP.Client.Response LByteString

{-| 'OpenCloseIndex' is a sum type for opening and closing indices.

   <http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/indices-open-close.html>
-}
data OpenCloseIndex = OpenIndex | CloseIndex deriving (OpenCloseIndex -> OpenCloseIndex -> Bool
(OpenCloseIndex -> OpenCloseIndex -> Bool)
-> (OpenCloseIndex -> OpenCloseIndex -> Bool) -> Eq OpenCloseIndex
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
(Int -> OpenCloseIndex -> ShowS)
-> (OpenCloseIndex -> String)
-> ([OpenCloseIndex] -> ShowS)
-> Show OpenCloseIndex
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
(FieldType -> FieldType -> Bool)
-> (FieldType -> FieldType -> Bool) -> Eq FieldType
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
(Int -> FieldType -> ShowS)
-> (FieldType -> String)
-> ([FieldType] -> ShowS)
-> Show FieldType
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
(FieldDefinition -> FieldDefinition -> Bool)
-> (FieldDefinition -> FieldDefinition -> Bool)
-> Eq FieldDefinition
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
(Int -> FieldDefinition -> ShowS)
-> (FieldDefinition -> String)
-> ([FieldDefinition] -> ShowS)
-> Show FieldDefinition
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" Key -> [IndexPattern] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [IndexPattern]
p
            , Key
"mappings" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Value
m
            ])
    (Maybe IndexSettings -> Value
forall a. ToJSON a => a -> Value
toJSON Maybe IndexSettings
s)
   where
     merge :: Value -> Value -> Value
merge (Object Object
o1) (Object Object
o2) = Object -> Value
forall a. ToJSON a => a -> Value
toJSON (Object -> Value) -> Object -> Value
forall a b. (a -> b) -> a -> b
$ Object -> Object -> Object
forall v. KeyMap v -> KeyMap v -> KeyMap v
X.union Object
o1 Object
o2
     merge Value
o           Value
Null        = Value
o
     merge Value
_           Value
_           = Value
forall a. HasCallStack => a
undefined

data MappingField =
  MappingField { MappingField -> FieldName
mappingFieldName :: FieldName
               , MappingField -> FieldDefinition
fieldDefinition  :: FieldDefinition }
  deriving (MappingField -> MappingField -> Bool
(MappingField -> MappingField -> Bool)
-> (MappingField -> MappingField -> Bool) -> Eq MappingField
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
(Int -> MappingField -> ShowS)
-> (MappingField -> String)
-> ([MappingField] -> ShowS)
-> Show MappingField
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
(Mapping -> Mapping -> Bool)
-> (Mapping -> Mapping -> Bool) -> Eq Mapping
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
(Int -> Mapping -> ShowS)
-> (Mapping -> String) -> ([Mapping] -> ShowS) -> Show Mapping
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
(UpsertActionMetadata -> UpsertActionMetadata -> Bool)
-> (UpsertActionMetadata -> UpsertActionMetadata -> Bool)
-> Eq UpsertActionMetadata
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
(Int -> UpsertActionMetadata -> ShowS)
-> (UpsertActionMetadata -> String)
-> ([UpsertActionMetadata] -> ShowS)
-> Show UpsertActionMetadata
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"  Key -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Int
i
buildUpsertActionMetadata (UA_Version Int
i)         = Key
"_version"           Key -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Int
i

data UpsertPayload
  = UpsertDoc Value
  | UpsertScript Bool Script Value
  deriving (UpsertPayload -> UpsertPayload -> Bool
(UpsertPayload -> UpsertPayload -> Bool)
-> (UpsertPayload -> UpsertPayload -> Bool) -> Eq UpsertPayload
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
(Int -> UpsertPayload -> ShowS)
-> (UpsertPayload -> String)
-> ([UpsertPayload] -> ShowS)
-> Show UpsertPayload
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 = AllocAll
                      -- ^ Allows shard allocation for all shards.
                      | AllocPrimaries
                      -- ^ Allows shard allocation only for primary shards.
                      | AllocNewPrimaries
                      -- ^ Allows shard allocation only for primary shards for new indices.
                      | AllocNone
                      -- ^ No shard allocation is allowed
                      deriving (AllocationPolicy -> AllocationPolicy -> Bool
(AllocationPolicy -> AllocationPolicy -> Bool)
-> (AllocationPolicy -> AllocationPolicy -> Bool)
-> Eq AllocationPolicy
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
(Int -> AllocationPolicy -> ShowS)
-> (AllocationPolicy -> String)
-> ([AllocationPolicy] -> ShowS)
-> Show AllocationPolicy
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)

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

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

{-| '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.elasticsearch.org/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 =
    BulkIndex  IndexName DocId Value
    -- ^ Create the document, replacing it if it already exists.
  | BulkIndexAuto IndexName Value
    -- ^ Create a document with an autogenerated id.
  | BulkIndexEncodingAuto IndexName Encoding
    -- ^ Create a document with an autogenerated id. Use fast JSON encoding.
  | BulkCreate IndexName DocId Value
    -- ^ Create a document, failing if it already exists.
  | BulkCreateEncoding IndexName DocId Encoding
    -- ^ Create a document, failing if it already exists. Use fast JSON encoding.
  | BulkDelete IndexName DocId
    -- ^ Delete the document
  | BulkUpdate IndexName DocId Value
    -- ^ Update the document, merging the new value with the existing one.
  | BulkUpsert IndexName DocId UpsertPayload [UpsertActionMetadata]
    -- ^ Update the document if it already exists, otherwise insert it.
    deriving (BulkOperation -> BulkOperation -> Bool
(BulkOperation -> BulkOperation -> Bool)
-> (BulkOperation -> BulkOperation -> Bool) -> Eq BulkOperation
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
(Int -> BulkOperation -> ShowS)
-> (BulkOperation -> String)
-> ([BulkOperation] -> ShowS)
-> Show BulkOperation
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)

{-| 'EsResult' describes the standard wrapper JSON document that you see in
    successful Elasticsearch lookups or lookups that couldn't find the document.
-}
data EsResult a = EsResult { EsResult a -> Text
_index      :: Text
                           , EsResult a -> Text
_type       :: Text
                           , EsResult a -> Text
_id         :: Text
                           , EsResult a -> Maybe (EsResultFound a)
foundResult :: Maybe (EsResultFound a)} deriving (EsResult a -> EsResult a -> Bool
(EsResult a -> EsResult a -> Bool)
-> (EsResult a -> EsResult a -> Bool) -> Eq (EsResult a)
forall a. Eq a => EsResult a -> EsResult a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EsResult a -> EsResult a -> Bool
$c/= :: forall a. Eq a => EsResult a -> EsResult a -> Bool
== :: EsResult a -> EsResult a -> Bool
$c== :: forall a. Eq a => EsResult a -> EsResult a -> Bool
Eq, Int -> EsResult a -> ShowS
[EsResult a] -> ShowS
EsResult a -> String
(Int -> EsResult a -> ShowS)
-> (EsResult a -> String)
-> ([EsResult a] -> ShowS)
-> Show (EsResult a)
forall a. Show a => Int -> EsResult a -> ShowS
forall a. Show a => [EsResult a] -> ShowS
forall a. Show a => EsResult a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EsResult a] -> ShowS
$cshowList :: forall a. Show a => [EsResult a] -> ShowS
show :: EsResult a -> String
$cshow :: forall a. Show a => EsResult a -> String
showsPrec :: Int -> EsResult a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> EsResult a -> ShowS
Show)

{-| 'EsResultFound' contains the document and its metadata inside of an
    'EsResult' when the document was successfully found.
-}
data EsResultFound a =
  EsResultFound {  EsResultFound a -> DocVersion
_version :: DocVersion
                , EsResultFound a -> a
_source   :: a }
  deriving (EsResultFound a -> EsResultFound a -> Bool
(EsResultFound a -> EsResultFound a -> Bool)
-> (EsResultFound a -> EsResultFound a -> Bool)
-> Eq (EsResultFound a)
forall a. Eq a => EsResultFound a -> EsResultFound a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EsResultFound a -> EsResultFound a -> Bool
$c/= :: forall a. Eq a => EsResultFound a -> EsResultFound a -> Bool
== :: EsResultFound a -> EsResultFound a -> Bool
$c== :: forall a. Eq a => EsResultFound a -> EsResultFound a -> Bool
Eq, Int -> EsResultFound a -> ShowS
[EsResultFound a] -> ShowS
EsResultFound a -> String
(Int -> EsResultFound a -> ShowS)
-> (EsResultFound a -> String)
-> ([EsResultFound a] -> ShowS)
-> Show (EsResultFound a)
forall a. Show a => Int -> EsResultFound a -> ShowS
forall a. Show a => [EsResultFound a] -> ShowS
forall a. Show a => EsResultFound a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EsResultFound a] -> ShowS
$cshowList :: forall a. Show a => [EsResultFound a] -> ShowS
show :: EsResultFound a -> String
$cshow :: forall a. Show a => EsResultFound a -> String
showsPrec :: Int -> EsResultFound a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> EsResultFound a -> ShowS
Show)

instance (FromJSON a) => FromJSON (EsResult a) where
  parseJSON :: Value -> Parser (EsResult a)
parseJSON jsonVal :: Value
jsonVal@(Object Object
v) = do
    Bool
found <- Object
v Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"found" Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
False
    Maybe (EsResultFound a)
fr <- if Bool
found
             then Value -> Parser (Maybe (EsResultFound a))
forall a. FromJSON a => Value -> Parser a
parseJSON Value
jsonVal
             else Maybe (EsResultFound a) -> Parser (Maybe (EsResultFound a))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (EsResultFound a)
forall a. Maybe a
Nothing
    Text -> Text -> Text -> Maybe (EsResultFound a) -> EsResult a
forall a.
Text -> Text -> Text -> Maybe (EsResultFound a) -> EsResult a
EsResult (Text -> Text -> Text -> Maybe (EsResultFound a) -> EsResult a)
-> Parser Text
-> Parser (Text -> Text -> Maybe (EsResultFound a) -> EsResult a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"_index"   Parser (Text -> Text -> Maybe (EsResultFound a) -> EsResult a)
-> Parser Text
-> Parser (Text -> Maybe (EsResultFound a) -> EsResult a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
                 Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"_type"    Parser (Text -> Maybe (EsResultFound a) -> EsResult a)
-> Parser Text -> Parser (Maybe (EsResultFound a) -> EsResult a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
                 Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"_id"      Parser (Maybe (EsResultFound a) -> EsResult a)
-> Parser (Maybe (EsResultFound a)) -> Parser (EsResult a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
                 Maybe (EsResultFound a) -> Parser (Maybe (EsResultFound a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (EsResultFound a)
fr
  parseJSON Value
_          = Parser (EsResult a)
forall (f :: * -> *) a. Alternative f => f a
empty

instance (FromJSON a) => FromJSON (EsResultFound a) where
  parseJSON :: Value -> Parser (EsResultFound a)
parseJSON (Object Object
v) = DocVersion -> a -> EsResultFound a
forall a. DocVersion -> a -> EsResultFound a
EsResultFound (DocVersion -> a -> EsResultFound a)
-> Parser DocVersion -> Parser (a -> EsResultFound a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                         Object
v Object -> Key -> Parser DocVersion
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"_version" Parser (a -> EsResultFound a)
-> Parser a -> Parser (EsResultFound a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
                         Object
v Object -> Key -> Parser a
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"_source"
  parseJSON Value
_          = Parser (EsResultFound a)
forall (f :: * -> *) a. Alternative f => f a
empty

{-| 'EsError' is the generic type that will be returned when there was a
    problem. If you can't parse the expected response, its a good idea to
    try parsing this.
-}
data EsError =
  EsError { EsError -> Int
errorStatus  :: Int
          , EsError -> Text
errorMessage :: Text }
  deriving (EsError -> EsError -> Bool
(EsError -> EsError -> Bool)
-> (EsError -> EsError -> Bool) -> Eq EsError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EsError -> EsError -> Bool
$c/= :: EsError -> EsError -> Bool
== :: EsError -> EsError -> Bool
$c== :: EsError -> EsError -> Bool
Eq, Int -> EsError -> ShowS
[EsError] -> ShowS
EsError -> String
(Int -> EsError -> ShowS)
-> (EsError -> String) -> ([EsError] -> ShowS) -> Show EsError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EsError] -> ShowS
$cshowList :: [EsError] -> ShowS
show :: EsError -> String
$cshow :: EsError -> String
showsPrec :: Int -> EsError -> ShowS
$cshowsPrec :: Int -> EsError -> ShowS
Show)

instance FromJSON EsError where
  parseJSON :: Value -> Parser EsError
parseJSON (Object Object
v) = Int -> Text -> EsError
EsError (Int -> Text -> EsError) -> Parser Int -> Parser (Text -> EsError)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                         Object
v Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"status" Parser (Text -> EsError) -> Parser Text -> Parser EsError
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
                         (Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"error" Parser Text -> Parser Text -> Parser Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Object
v Object -> Key -> Parser Object
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"error" Parser Object -> (Object -> Parser Text) -> Parser Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"reason")))
  parseJSON Value
_ = Parser EsError
forall (f :: * -> *) a. Alternative f => f a
empty

{-| 'EsProtocolException' will be thrown if Bloodhound cannot parse a response
returned by the Elasticsearch server. If you encounter this error, please
verify that your domain data types and FromJSON instances are working properly
(for example, the 'a' of '[Hit a]' in 'SearchResult.searchHits.hits'). If you're
sure that your mappings are correct, then this error may be an indication of an
incompatibility between Bloodhound and Elasticsearch. Please open a bug report
and be sure to include the exception body.
-}
data EsProtocolException = EsProtocolException
  { EsProtocolException -> Text
esProtoExMessage :: !Text
  , EsProtocolException -> LByteString
esProtoExBody :: !LByteString
  } deriving (EsProtocolException -> EsProtocolException -> Bool
(EsProtocolException -> EsProtocolException -> Bool)
-> (EsProtocolException -> EsProtocolException -> Bool)
-> Eq EsProtocolException
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EsProtocolException -> EsProtocolException -> Bool
$c/= :: EsProtocolException -> EsProtocolException -> Bool
== :: EsProtocolException -> EsProtocolException -> Bool
$c== :: EsProtocolException -> EsProtocolException -> Bool
Eq, Int -> EsProtocolException -> ShowS
[EsProtocolException] -> ShowS
EsProtocolException -> String
(Int -> EsProtocolException -> ShowS)
-> (EsProtocolException -> String)
-> ([EsProtocolException] -> ShowS)
-> Show EsProtocolException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EsProtocolException] -> ShowS
$cshowList :: [EsProtocolException] -> ShowS
show :: EsProtocolException -> String
$cshow :: EsProtocolException -> String
showsPrec :: Int -> EsProtocolException -> ShowS
$cshowsPrec :: Int -> EsProtocolException -> ShowS
Show)

instance Exception EsProtocolException

data IndexAlias = IndexAlias { IndexAlias -> IndexName
srcIndex   :: IndexName
                             , IndexAlias -> IndexAliasName
indexAlias :: IndexAliasName } deriving (IndexAlias -> IndexAlias -> Bool
(IndexAlias -> IndexAlias -> Bool)
-> (IndexAlias -> IndexAlias -> Bool) -> Eq IndexAlias
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
(Int -> IndexAlias -> ShowS)
-> (IndexAlias -> String)
-> ([IndexAlias] -> ShowS)
-> Show IndexAlias
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
(IndexAliasAction -> IndexAliasAction -> Bool)
-> (IndexAliasAction -> IndexAliasAction -> Bool)
-> Eq IndexAliasAction
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
(Int -> IndexAliasAction -> ShowS)
-> (IndexAliasAction -> String)
-> ([IndexAliasAction] -> ShowS)
-> Show IndexAliasAction
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
(IndexAliasCreate -> IndexAliasCreate -> Bool)
-> (IndexAliasCreate -> IndexAliasCreate -> Bool)
-> Eq IndexAliasCreate
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
(Int -> IndexAliasCreate -> ShowS)
-> (IndexAliasCreate -> String)
-> ([IndexAliasCreate] -> ShowS)
-> Show IndexAliasCreate
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
(AliasRouting -> AliasRouting -> Bool)
-> (AliasRouting -> AliasRouting -> Bool) -> Eq AliasRouting
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
(Int -> AliasRouting -> ShowS)
-> (AliasRouting -> String)
-> ([AliasRouting] -> ShowS)
-> Show AliasRouting
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
(SearchAliasRouting -> SearchAliasRouting -> Bool)
-> (SearchAliasRouting -> SearchAliasRouting -> Bool)
-> Eq SearchAliasRouting
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
(Int -> SearchAliasRouting -> ShowS)
-> (SearchAliasRouting -> String)
-> ([SearchAliasRouting] -> ShowS)
-> Show SearchAliasRouting
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)

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

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

newtype IndexAliasRouting =
  IndexAliasRouting RoutingValue
  deriving (IndexAliasRouting -> IndexAliasRouting -> Bool
(IndexAliasRouting -> IndexAliasRouting -> Bool)
-> (IndexAliasRouting -> IndexAliasRouting -> Bool)
-> Eq IndexAliasRouting
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
(Int -> IndexAliasRouting -> ShowS)
-> (IndexAliasRouting -> String)
-> ([IndexAliasRouting] -> ShowS)
-> Show IndexAliasRouting
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, [IndexAliasRouting] -> Encoding
[IndexAliasRouting] -> Value
IndexAliasRouting -> Encoding
IndexAliasRouting -> Value
(IndexAliasRouting -> Value)
-> (IndexAliasRouting -> Encoding)
-> ([IndexAliasRouting] -> Value)
-> ([IndexAliasRouting] -> Encoding)
-> ToJSON IndexAliasRouting
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
(Value -> Parser IndexAliasRouting)
-> (Value -> Parser [IndexAliasRouting])
-> FromJSON 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
(RoutingValue -> RoutingValue -> Bool)
-> (RoutingValue -> RoutingValue -> Bool) -> Eq RoutingValue
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
(Int -> RoutingValue -> ShowS)
-> (RoutingValue -> String)
-> ([RoutingValue] -> ShowS)
-> Show RoutingValue
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
(RoutingValue -> Value)
-> (RoutingValue -> Encoding)
-> ([RoutingValue] -> Value)
-> ([RoutingValue] -> Encoding)
-> ToJSON RoutingValue
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
(Value -> Parser RoutingValue)
-> (Value -> Parser [RoutingValue]) -> FromJSON 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
(IndexAliasesSummary -> IndexAliasesSummary -> Bool)
-> (IndexAliasesSummary -> IndexAliasesSummary -> Bool)
-> Eq IndexAliasesSummary
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
(Int -> IndexAliasesSummary -> ShowS)
-> (IndexAliasesSummary -> String)
-> ([IndexAliasesSummary] -> ShowS)
-> Show IndexAliasesSummary
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 = String
-> (Object -> Parser IndexAliasesSummary)
-> Value
-> Parser IndexAliasesSummary
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"IndexAliasesSummary" Object -> Parser IndexAliasesSummary
parse
    where parse :: Object -> Parser IndexAliasesSummary
parse Object
o = [IndexAliasSummary] -> IndexAliasesSummary
IndexAliasesSummary ([IndexAliasSummary] -> IndexAliasesSummary)
-> ([[IndexAliasSummary]] -> [IndexAliasSummary])
-> [[IndexAliasSummary]]
-> IndexAliasesSummary
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[IndexAliasSummary]] -> [IndexAliasSummary]
forall a. Monoid a => [a] -> a
mconcat ([[IndexAliasSummary]] -> IndexAliasesSummary)
-> Parser [[IndexAliasSummary]] -> Parser IndexAliasesSummary
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Pair -> Parser [IndexAliasSummary])
-> [Pair] -> Parser [[IndexAliasSummary]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((Key -> Value -> Parser [IndexAliasSummary])
-> Pair -> Parser [IndexAliasSummary]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Key -> Value -> Parser [IndexAliasSummary]
go) (Object -> [Pair]
forall v. KeyMap v -> [(Key, v)]
X.toList Object
o)
          go :: Key -> Value -> Parser [IndexAliasSummary]
go Key
ixn = String
-> (Object -> Parser [IndexAliasSummary])
-> Value
-> Parser [IndexAliasSummary]
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"index aliases" ((Object -> Parser [IndexAliasSummary])
 -> Value -> Parser [IndexAliasSummary])
-> (Object -> Parser [IndexAliasSummary])
-> Value
-> Parser [IndexAliasSummary]
forall a b. (a -> b) -> a -> b
$ \Object
ia -> do
                     HashMap Key Value
aliases <- Object
ia Object -> Key -> Parser (Maybe (HashMap Key Value))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"aliases" Parser (Maybe (HashMap Key Value))
-> HashMap Key Value -> Parser (HashMap Key Value)
forall a. Parser (Maybe a) -> a -> Parser a
.!= HashMap Key Value
forall a. Monoid a => a
mempty
                     [Pair]
-> (Pair -> Parser IndexAliasSummary) -> Parser [IndexAliasSummary]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (HashMap Key Value -> [Pair]
forall k v. HashMap k v -> [(k, v)]
HM.toList HashMap Key Value
aliases) ((Pair -> Parser IndexAliasSummary) -> Parser [IndexAliasSummary])
-> (Pair -> Parser IndexAliasSummary) -> Parser [IndexAliasSummary]
forall a b. (a -> b) -> a -> b
$ \(Key
aName, Value
v) -> do
                       let indexAlias :: IndexAlias
indexAlias = IndexName -> IndexAliasName -> IndexAlias
IndexAlias (Text -> IndexName
IndexName (Text -> IndexName) -> Text -> IndexName
forall a b. (a -> b) -> a -> b
$ Key -> Text
toText Key
ixn) (IndexName -> IndexAliasName
IndexAliasName (Text -> IndexName
IndexName (Text -> IndexName) -> Text -> IndexName
forall a b. (a -> b) -> a -> b
$ Key -> Text
toText Key
aName))
                       IndexAlias -> IndexAliasCreate -> IndexAliasSummary
IndexAliasSummary IndexAlias
indexAlias (IndexAliasCreate -> IndexAliasSummary)
-> Parser IndexAliasCreate -> Parser IndexAliasSummary
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser IndexAliasCreate
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v


instance ToJSON IndexAliasAction where
  toJSON :: IndexAliasAction -> Value
toJSON (AddAlias IndexAlias
ia IndexAliasCreate
opts) = [Pair] -> Value
object [Key
"add" Key -> Object -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Object
iaObj Object -> Object -> Object
forall a. Semigroup a => a -> a -> a
<> Object
optsObj)]
    where Object Object
iaObj = IndexAlias -> Value
forall a. ToJSON a => a -> Value
toJSON IndexAlias
ia
          Object Object
optsObj = IndexAliasCreate -> Value
forall a. ToJSON a => a -> Value
toJSON IndexAliasCreate
opts
  toJSON (RemoveAlias IndexAlias
ia) = [Pair] -> Value
object [Key
"remove" Key -> Object -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Object
iaObj]
    where Object Object
iaObj = IndexAlias -> Value
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" Key -> IndexName -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= IndexName
srcIndex
                                  , Key
"alias" Key -> IndexAliasName -> Pair
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 Object -> Object -> Object
forall a. Semigroup a => a -> a -> a
<> Object
routingObj)
    where filterObj :: Object
filterObj = Object -> (Filter -> Object) -> Maybe Filter -> Object
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Object
forall a. Monoid a => a
mempty (Key -> Value -> Object
forall v. Key -> v -> KeyMap v
X.singleton Key
"filter" (Value -> Object) -> (Filter -> Value) -> Filter -> Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Filter -> Value
forall a. ToJSON a => a -> Value
toJSON) Maybe Filter
aliasCreateFilter
          Object Object
routingObj = Value -> (AliasRouting -> Value) -> Maybe AliasRouting -> Value
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Object -> Value
Object Object
forall a. Monoid a => a
mempty) AliasRouting -> Value
forall a. ToJSON a => a -> Value
toJSON Maybe AliasRouting
aliasCreateRouting

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

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

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

{-| 'IndexAliasSummary' is a summary of an index alias configured for a server. -}
data IndexAliasSummary = IndexAliasSummary
  { IndexAliasSummary -> IndexAlias
indexAliasSummaryAlias  :: IndexAlias
  , IndexAliasSummary -> IndexAliasCreate
indexAliasSummaryCreate :: IndexAliasCreate }
  deriving (IndexAliasSummary -> IndexAliasSummary -> Bool
(IndexAliasSummary -> IndexAliasSummary -> Bool)
-> (IndexAliasSummary -> IndexAliasSummary -> Bool)
-> Eq IndexAliasSummary
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
(Int -> IndexAliasSummary -> ShowS)
-> (IndexAliasSummary -> String)
-> ([IndexAliasSummary] -> ShowS)
-> Show IndexAliasSummary
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)

{-| 'DocVersion' is an integer version number for a document between 1
and 9.2e+18 used for <<https://www.elastic.co/guide/en/elasticsearch/guide/current/optimistic-concurrency-control.html optimistic concurrency control>>.
-}
newtype DocVersion = DocVersion {
      DocVersion -> Int
docVersionNumber :: Int
    } deriving (DocVersion -> DocVersion -> Bool
(DocVersion -> DocVersion -> Bool)
-> (DocVersion -> DocVersion -> Bool) -> Eq DocVersion
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DocVersion -> DocVersion -> Bool
$c/= :: DocVersion -> DocVersion -> Bool
== :: DocVersion -> DocVersion -> Bool
$c== :: DocVersion -> DocVersion -> Bool
Eq, Int -> DocVersion -> ShowS
[DocVersion] -> ShowS
DocVersion -> String
(Int -> DocVersion -> ShowS)
-> (DocVersion -> String)
-> ([DocVersion] -> ShowS)
-> Show DocVersion
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DocVersion] -> ShowS
$cshowList :: [DocVersion] -> ShowS
show :: DocVersion -> String
$cshow :: DocVersion -> String
showsPrec :: Int -> DocVersion -> ShowS
$cshowsPrec :: Int -> DocVersion -> ShowS
Show, Eq DocVersion
Eq DocVersion
-> (DocVersion -> DocVersion -> Ordering)
-> (DocVersion -> DocVersion -> Bool)
-> (DocVersion -> DocVersion -> Bool)
-> (DocVersion -> DocVersion -> Bool)
-> (DocVersion -> DocVersion -> Bool)
-> (DocVersion -> DocVersion -> DocVersion)
-> (DocVersion -> DocVersion -> DocVersion)
-> Ord DocVersion
DocVersion -> DocVersion -> Bool
DocVersion -> DocVersion -> Ordering
DocVersion -> DocVersion -> DocVersion
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 :: DocVersion -> DocVersion -> DocVersion
$cmin :: DocVersion -> DocVersion -> DocVersion
max :: DocVersion -> DocVersion -> DocVersion
$cmax :: DocVersion -> DocVersion -> DocVersion
>= :: DocVersion -> DocVersion -> Bool
$c>= :: DocVersion -> DocVersion -> Bool
> :: DocVersion -> DocVersion -> Bool
$c> :: DocVersion -> DocVersion -> Bool
<= :: DocVersion -> DocVersion -> Bool
$c<= :: DocVersion -> DocVersion -> Bool
< :: DocVersion -> DocVersion -> Bool
$c< :: DocVersion -> DocVersion -> Bool
compare :: DocVersion -> DocVersion -> Ordering
$ccompare :: DocVersion -> DocVersion -> Ordering
$cp1Ord :: Eq DocVersion
Ord, [DocVersion] -> Encoding
[DocVersion] -> Value
DocVersion -> Encoding
DocVersion -> Value
(DocVersion -> Value)
-> (DocVersion -> Encoding)
-> ([DocVersion] -> Value)
-> ([DocVersion] -> Encoding)
-> ToJSON DocVersion
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [DocVersion] -> Encoding
$ctoEncodingList :: [DocVersion] -> Encoding
toJSONList :: [DocVersion] -> Value
$ctoJSONList :: [DocVersion] -> Value
toEncoding :: DocVersion -> Encoding
$ctoEncoding :: DocVersion -> Encoding
toJSON :: DocVersion -> Value
$ctoJSON :: DocVersion -> Value
ToJSON)

-- | Smart constructor for in-range doc version
mkDocVersion :: Int -> Maybe DocVersion
mkDocVersion :: Int -> Maybe DocVersion
mkDocVersion Int
i
  |    Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= DocVersion -> Int
docVersionNumber DocVersion
forall a. Bounded a => a
minBound
    Bool -> Bool -> Bool
&& Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= DocVersion -> Int
docVersionNumber DocVersion
forall a. Bounded a => a
maxBound =
    DocVersion -> Maybe DocVersion
forall a. a -> Maybe a
Just (DocVersion -> Maybe DocVersion) -> DocVersion -> Maybe DocVersion
forall a b. (a -> b) -> a -> b
$ Int -> DocVersion
DocVersion Int
i
  | Bool
otherwise = Maybe DocVersion
forall a. Maybe a
Nothing

instance Bounded DocVersion where
  minBound :: DocVersion
minBound = Int -> DocVersion
DocVersion Int
1
  maxBound :: DocVersion
maxBound = Int -> DocVersion
DocVersion Int
9200000000000000000 -- 9.2e+18

instance Enum DocVersion where
  succ :: DocVersion -> DocVersion
succ DocVersion
x
    | DocVersion
x DocVersion -> DocVersion -> Bool
forall a. Eq a => a -> a -> Bool
/= DocVersion
forall a. Bounded a => a
maxBound = Int -> DocVersion
DocVersion (Int -> Int
forall a. Enum a => a -> a
succ (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ DocVersion -> Int
docVersionNumber DocVersion
x)
    | Bool
otherwise     = String -> DocVersion
forall a. String -> a
succError String
"DocVersion"
  pred :: DocVersion -> DocVersion
pred DocVersion
x
    | DocVersion
x DocVersion -> DocVersion -> Bool
forall a. Eq a => a -> a -> Bool
/= DocVersion
forall a. Bounded a => a
minBound = Int -> DocVersion
DocVersion (Int -> Int
forall a. Enum a => a -> a
pred (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ DocVersion -> Int
docVersionNumber DocVersion
x)
    | Bool
otherwise     = String -> DocVersion
forall a. String -> a
predError String
"DocVersion"
  toEnum :: Int -> DocVersion
toEnum Int
i =
    DocVersion -> Maybe DocVersion -> DocVersion
forall a. a -> Maybe a -> a
fromMaybe (String -> DocVersion
forall a. HasCallStack => String -> a
error (String -> DocVersion) -> String -> DocVersion
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show Int
i String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" out of DocVersion range") (Maybe DocVersion -> DocVersion) -> Maybe DocVersion -> DocVersion
forall a b. (a -> b) -> a -> b
$ Int -> Maybe DocVersion
mkDocVersion Int
i
  fromEnum :: DocVersion -> Int
fromEnum = DocVersion -> Int
docVersionNumber
  enumFrom :: DocVersion -> [DocVersion]
enumFrom = DocVersion -> [DocVersion]
forall a. (Enum a, Bounded a) => a -> [a]
boundedEnumFrom
  enumFromThen :: DocVersion -> DocVersion -> [DocVersion]
enumFromThen = DocVersion -> DocVersion -> [DocVersion]
forall a. (Enum a, Bounded a) => a -> a -> [a]
boundedEnumFromThen

instance FromJSON DocVersion where
  parseJSON :: Value -> Parser DocVersion
parseJSON Value
v = do
    Int
i <- Value -> Parser Int
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
    Parser DocVersion
-> (DocVersion -> Parser DocVersion)
-> Maybe DocVersion
-> Parser DocVersion
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Parser DocVersion
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"DocVersion out of range") DocVersion -> Parser DocVersion
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe DocVersion -> Parser DocVersion)
-> Maybe DocVersion -> Parser DocVersion
forall a b. (a -> b) -> a -> b
$ Int -> Maybe DocVersion
mkDocVersion Int
i

{-| 'ExternalDocVersion' is a convenience wrapper if your code uses its
own version numbers instead of ones from ES.
-}
newtype ExternalDocVersion = ExternalDocVersion DocVersion
    deriving (ExternalDocVersion -> ExternalDocVersion -> Bool
(ExternalDocVersion -> ExternalDocVersion -> Bool)
-> (ExternalDocVersion -> ExternalDocVersion -> Bool)
-> Eq ExternalDocVersion
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExternalDocVersion -> ExternalDocVersion -> Bool
$c/= :: ExternalDocVersion -> ExternalDocVersion -> Bool
== :: ExternalDocVersion -> ExternalDocVersion -> Bool
$c== :: ExternalDocVersion -> ExternalDocVersion -> Bool
Eq, Int -> ExternalDocVersion -> ShowS
[ExternalDocVersion] -> ShowS
ExternalDocVersion -> String
(Int -> ExternalDocVersion -> ShowS)
-> (ExternalDocVersion -> String)
-> ([ExternalDocVersion] -> ShowS)
-> Show ExternalDocVersion
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExternalDocVersion] -> ShowS
$cshowList :: [ExternalDocVersion] -> ShowS
show :: ExternalDocVersion -> String
$cshow :: ExternalDocVersion -> String
showsPrec :: Int -> ExternalDocVersion -> ShowS
$cshowsPrec :: Int -> ExternalDocVersion -> ShowS
Show, Eq ExternalDocVersion
Eq ExternalDocVersion
-> (ExternalDocVersion -> ExternalDocVersion -> Ordering)
-> (ExternalDocVersion -> ExternalDocVersion -> Bool)
-> (ExternalDocVersion -> ExternalDocVersion -> Bool)
-> (ExternalDocVersion -> ExternalDocVersion -> Bool)
-> (ExternalDocVersion -> ExternalDocVersion -> Bool)
-> (ExternalDocVersion -> ExternalDocVersion -> ExternalDocVersion)
-> (ExternalDocVersion -> ExternalDocVersion -> ExternalDocVersion)
-> Ord ExternalDocVersion
ExternalDocVersion -> ExternalDocVersion -> Bool
ExternalDocVersion -> ExternalDocVersion -> Ordering
ExternalDocVersion -> ExternalDocVersion -> ExternalDocVersion
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 :: ExternalDocVersion -> ExternalDocVersion -> ExternalDocVersion
$cmin :: ExternalDocVersion -> ExternalDocVersion -> ExternalDocVersion
max :: ExternalDocVersion -> ExternalDocVersion -> ExternalDocVersion
$cmax :: ExternalDocVersion -> ExternalDocVersion -> ExternalDocVersion
>= :: ExternalDocVersion -> ExternalDocVersion -> Bool
$c>= :: ExternalDocVersion -> ExternalDocVersion -> Bool
> :: ExternalDocVersion -> ExternalDocVersion -> Bool
$c> :: ExternalDocVersion -> ExternalDocVersion -> Bool
<= :: ExternalDocVersion -> ExternalDocVersion -> Bool
$c<= :: ExternalDocVersion -> ExternalDocVersion -> Bool
< :: ExternalDocVersion -> ExternalDocVersion -> Bool
$c< :: ExternalDocVersion -> ExternalDocVersion -> Bool
compare :: ExternalDocVersion -> ExternalDocVersion -> Ordering
$ccompare :: ExternalDocVersion -> ExternalDocVersion -> Ordering
$cp1Ord :: Eq ExternalDocVersion
Ord, ExternalDocVersion
ExternalDocVersion
-> ExternalDocVersion -> Bounded ExternalDocVersion
forall a. a -> a -> Bounded a
maxBound :: ExternalDocVersion
$cmaxBound :: ExternalDocVersion
minBound :: ExternalDocVersion
$cminBound :: ExternalDocVersion
Bounded, Int -> ExternalDocVersion
ExternalDocVersion -> Int
ExternalDocVersion -> [ExternalDocVersion]
ExternalDocVersion -> ExternalDocVersion
ExternalDocVersion -> ExternalDocVersion -> [ExternalDocVersion]
ExternalDocVersion
-> ExternalDocVersion -> ExternalDocVersion -> [ExternalDocVersion]
(ExternalDocVersion -> ExternalDocVersion)
-> (ExternalDocVersion -> ExternalDocVersion)
-> (Int -> ExternalDocVersion)
-> (ExternalDocVersion -> Int)
-> (ExternalDocVersion -> [ExternalDocVersion])
-> (ExternalDocVersion
    -> ExternalDocVersion -> [ExternalDocVersion])
-> (ExternalDocVersion
    -> ExternalDocVersion -> [ExternalDocVersion])
-> (ExternalDocVersion
    -> ExternalDocVersion
    -> ExternalDocVersion
    -> [ExternalDocVersion])
-> Enum ExternalDocVersion
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: ExternalDocVersion
-> ExternalDocVersion -> ExternalDocVersion -> [ExternalDocVersion]
$cenumFromThenTo :: ExternalDocVersion
-> ExternalDocVersion -> ExternalDocVersion -> [ExternalDocVersion]
enumFromTo :: ExternalDocVersion -> ExternalDocVersion -> [ExternalDocVersion]
$cenumFromTo :: ExternalDocVersion -> ExternalDocVersion -> [ExternalDocVersion]
enumFromThen :: ExternalDocVersion -> ExternalDocVersion -> [ExternalDocVersion]
$cenumFromThen :: ExternalDocVersion -> ExternalDocVersion -> [ExternalDocVersion]
enumFrom :: ExternalDocVersion -> [ExternalDocVersion]
$cenumFrom :: ExternalDocVersion -> [ExternalDocVersion]
fromEnum :: ExternalDocVersion -> Int
$cfromEnum :: ExternalDocVersion -> Int
toEnum :: Int -> ExternalDocVersion
$ctoEnum :: Int -> ExternalDocVersion
pred :: ExternalDocVersion -> ExternalDocVersion
$cpred :: ExternalDocVersion -> ExternalDocVersion
succ :: ExternalDocVersion -> ExternalDocVersion
$csucc :: ExternalDocVersion -> ExternalDocVersion
Enum, [ExternalDocVersion] -> Encoding
[ExternalDocVersion] -> Value
ExternalDocVersion -> Encoding
ExternalDocVersion -> Value
(ExternalDocVersion -> Value)
-> (ExternalDocVersion -> Encoding)
-> ([ExternalDocVersion] -> Value)
-> ([ExternalDocVersion] -> Encoding)
-> ToJSON ExternalDocVersion
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [ExternalDocVersion] -> Encoding
$ctoEncodingList :: [ExternalDocVersion] -> Encoding
toJSONList :: [ExternalDocVersion] -> Value
$ctoJSONList :: [ExternalDocVersion] -> Value
toEncoding :: ExternalDocVersion -> Encoding
$ctoEncoding :: ExternalDocVersion -> Encoding
toJSON :: ExternalDocVersion -> Value
$ctoJSON :: ExternalDocVersion -> Value
ToJSON)

{-| 'VersionControl' is specified when indexing documents as a
optimistic concurrency control.
-}
data VersionControl = NoVersionControl
                    -- ^ Don't send a version. This is a pure overwrite.
                    | InternalVersion DocVersion
                    -- ^ Use the default ES versioning scheme. Only
                    -- index the document if the version is the same
                    -- as the one specified. Only applicable to
                    -- updates, as you should be getting Version from
                    -- a search result.
                    | ExternalGT ExternalDocVersion
                    -- ^ Use your own version numbering. Only index
                    -- the document if the version is strictly higher
                    -- OR the document doesn't exist. The given
                    -- version will be used as the new version number
                    -- for the stored document. N.B. All updates must
                    -- increment this number, meaning there is some
                    -- global, external ordering of updates.
                    | ExternalGTE ExternalDocVersion
                    -- ^ Use your own version numbering. Only index
                    -- the document if the version is equal or higher
                    -- than the stored version. Will succeed if there
                    -- is no existing document. The given version will
                    -- be used as the new version number for the
                    -- stored document. Use with care, as this could
                    -- result in data loss.
                    | ForceVersion ExternalDocVersion
                    -- ^ The document will always be indexed and the
                    -- given version will be the new version. This is
                    -- typically used for correcting errors. Use with
                    -- care, as this could result in data loss.
                    deriving (VersionControl -> VersionControl -> Bool
(VersionControl -> VersionControl -> Bool)
-> (VersionControl -> VersionControl -> Bool) -> Eq VersionControl
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VersionControl -> VersionControl -> Bool
$c/= :: VersionControl -> VersionControl -> Bool
== :: VersionControl -> VersionControl -> Bool
$c== :: VersionControl -> VersionControl -> Bool
Eq, Int -> VersionControl -> ShowS
[VersionControl] -> ShowS
VersionControl -> String
(Int -> VersionControl -> ShowS)
-> (VersionControl -> String)
-> ([VersionControl] -> ShowS)
-> Show VersionControl
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VersionControl] -> ShowS
$cshowList :: [VersionControl] -> ShowS
show :: VersionControl -> String
$cshow :: VersionControl -> String
showsPrec :: Int -> VersionControl -> ShowS
$cshowsPrec :: Int -> VersionControl -> ShowS
Show, Eq VersionControl
Eq VersionControl
-> (VersionControl -> VersionControl -> Ordering)
-> (VersionControl -> VersionControl -> Bool)
-> (VersionControl -> VersionControl -> Bool)
-> (VersionControl -> VersionControl -> Bool)
-> (VersionControl -> VersionControl -> Bool)
-> (VersionControl -> VersionControl -> VersionControl)
-> (VersionControl -> VersionControl -> VersionControl)
-> Ord VersionControl
VersionControl -> VersionControl -> Bool
VersionControl -> VersionControl -> Ordering
VersionControl -> VersionControl -> VersionControl
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 :: VersionControl -> VersionControl -> VersionControl
$cmin :: VersionControl -> VersionControl -> VersionControl
max :: VersionControl -> VersionControl -> VersionControl
$cmax :: VersionControl -> VersionControl -> VersionControl
>= :: VersionControl -> VersionControl -> Bool
$c>= :: VersionControl -> VersionControl -> Bool
> :: VersionControl -> VersionControl -> Bool
$c> :: VersionControl -> VersionControl -> Bool
<= :: VersionControl -> VersionControl -> Bool
$c<= :: VersionControl -> VersionControl -> Bool
< :: VersionControl -> VersionControl -> Bool
$c< :: VersionControl -> VersionControl -> Bool
compare :: VersionControl -> VersionControl -> Ordering
$ccompare :: VersionControl -> VersionControl -> Ordering
$cp1Ord :: Eq VersionControl
Ord)

data JoinRelation
  = ParentDocument FieldName RelationName
  | ChildDocument FieldName RelationName DocId
  deriving (Int -> JoinRelation -> ShowS
[JoinRelation] -> ShowS
JoinRelation -> String
(Int -> JoinRelation -> ShowS)
-> (JoinRelation -> String)
-> ([JoinRelation] -> ShowS)
-> Show JoinRelation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [JoinRelation] -> ShowS
$cshowList :: [JoinRelation] -> ShowS
show :: JoinRelation -> String
$cshow :: JoinRelation -> String
showsPrec :: Int -> JoinRelation -> ShowS
$cshowsPrec :: Int -> JoinRelation -> ShowS
Show, JoinRelation -> JoinRelation -> Bool
(JoinRelation -> JoinRelation -> Bool)
-> (JoinRelation -> JoinRelation -> Bool) -> Eq JoinRelation
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
(IndexDocumentSettings -> IndexDocumentSettings -> Bool)
-> (IndexDocumentSettings -> IndexDocumentSettings -> Bool)
-> Eq IndexDocumentSettings
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
(Int -> IndexDocumentSettings -> ShowS)
-> (IndexDocumentSettings -> String)
-> ([IndexDocumentSettings] -> ShowS)
-> Show IndexDocumentSettings
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 Maybe JoinRelation
forall a. Maybe a
Nothing

{-| 'IndexSelection' is used for APIs which take a single index, a list of
    indexes, or the special @_all@ index.
-}
--TODO: this does not fully support <https://www.elastic.co/guide/en/elasticsearch/reference/1.7/multi-index.html multi-index syntax>. It wouldn't be too hard to implement but you'd have to add the optional parameters (ignore_unavailable, allow_no_indices, expand_wildcards) to any APIs using it. Also would be a breaking API.
data IndexSelection =
    IndexList (NonEmpty IndexName)
  | AllIndexes
  deriving (IndexSelection -> IndexSelection -> Bool
(IndexSelection -> IndexSelection -> Bool)
-> (IndexSelection -> IndexSelection -> Bool) -> Eq IndexSelection
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
(Int -> IndexSelection -> ShowS)
-> (IndexSelection -> String)
-> ([IndexSelection] -> ShowS)
-> Show IndexSelection
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 =
    LocalNode
    -- ^ Whatever node receives this request
  | NodeList (NonEmpty NodeSelector)
  | AllNodes
  deriving (NodeSelection -> NodeSelection -> Bool
(NodeSelection -> NodeSelection -> Bool)
-> (NodeSelection -> NodeSelection -> Bool) -> Eq NodeSelection
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
(Int -> NodeSelection -> ShowS)
-> (NodeSelection -> String)
-> ([NodeSelection] -> ShowS)
-> Show NodeSelection
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
  | NodeByHost Server
    -- ^ e.g. 10.0.0.1 or even 10.0.0.*
  | NodeByAttribute NodeAttrName Text
    -- ^ NodeAttrName can be a pattern, e.g. rack*. The value can too.
  deriving (NodeSelector -> NodeSelector -> Bool
(NodeSelector -> NodeSelector -> Bool)
-> (NodeSelector -> NodeSelector -> Bool) -> Eq NodeSelector
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
(Int -> NodeSelector -> ShowS)
-> (NodeSelector -> String)
-> ([NodeSelector] -> ShowS)
-> Show NodeSelector
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
(TemplateName -> TemplateName -> Bool)
-> (TemplateName -> TemplateName -> Bool) -> Eq TemplateName
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
(Int -> TemplateName -> ShowS)
-> (TemplateName -> String)
-> ([TemplateName] -> ShowS)
-> Show TemplateName
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, [TemplateName] -> Encoding
[TemplateName] -> Value
TemplateName -> Encoding
TemplateName -> Value
(TemplateName -> Value)
-> (TemplateName -> Encoding)
-> ([TemplateName] -> Value)
-> ([TemplateName] -> Encoding)
-> ToJSON TemplateName
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
(Value -> Parser TemplateName)
-> (Value -> Parser [TemplateName]) -> FromJSON 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
(IndexPattern -> IndexPattern -> Bool)
-> (IndexPattern -> IndexPattern -> Bool) -> Eq IndexPattern
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
(Int -> IndexPattern -> ShowS)
-> (IndexPattern -> String)
-> ([IndexPattern] -> ShowS)
-> Show IndexPattern
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, [IndexPattern] -> Encoding
[IndexPattern] -> Value
IndexPattern -> Encoding
IndexPattern -> Value
(IndexPattern -> Value)
-> (IndexPattern -> Encoding)
-> ([IndexPattern] -> Value)
-> ([IndexPattern] -> Encoding)
-> ToJSON IndexPattern
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
(Value -> Parser IndexPattern)
-> (Value -> Parser [IndexPattern]) -> FromJSON 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]
(Int -> ReadS EsUsername)
-> ReadS [EsUsername]
-> ReadPrec EsUsername
-> ReadPrec [EsUsername]
-> Read 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
(Int -> EsUsername -> ShowS)
-> (EsUsername -> String)
-> ([EsUsername] -> ShowS)
-> Show EsUsername
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
(EsUsername -> EsUsername -> Bool)
-> (EsUsername -> EsUsername -> Bool) -> Eq EsUsername
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]
(Int -> ReadS EsPassword)
-> ReadS [EsPassword]
-> ReadPrec EsPassword
-> ReadPrec [EsPassword]
-> Read 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
(Int -> EsPassword -> ShowS)
-> (EsPassword -> String)
-> ([EsPassword] -> ShowS)
-> Show EsPassword
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
(EsPassword -> EsPassword -> Bool)
-> (EsPassword -> EsPassword -> Bool) -> Eq EsPassword
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
(SnapshotRepoSelection -> SnapshotRepoSelection -> Bool)
-> (SnapshotRepoSelection -> SnapshotRepoSelection -> Bool)
-> Eq SnapshotRepoSelection
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
(Int -> SnapshotRepoSelection -> ShowS)
-> (SnapshotRepoSelection -> String)
-> ([SnapshotRepoSelection] -> ShowS)
-> Show SnapshotRepoSelection
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
(SnapshotRepoPattern -> SnapshotRepoPattern -> Bool)
-> (SnapshotRepoPattern -> SnapshotRepoPattern -> Bool)
-> Eq SnapshotRepoPattern
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
(Int -> SnapshotRepoPattern -> ShowS)
-> (SnapshotRepoPattern -> String)
-> ([SnapshotRepoPattern] -> ShowS)
-> Show SnapshotRepoPattern
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
(SnapshotRepoName -> SnapshotRepoName -> Bool)
-> (SnapshotRepoName -> SnapshotRepoName -> Bool)
-> Eq SnapshotRepoName
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
Eq SnapshotRepoName
-> (SnapshotRepoName -> SnapshotRepoName -> Ordering)
-> (SnapshotRepoName -> SnapshotRepoName -> Bool)
-> (SnapshotRepoName -> SnapshotRepoName -> Bool)
-> (SnapshotRepoName -> SnapshotRepoName -> Bool)
-> (SnapshotRepoName -> SnapshotRepoName -> Bool)
-> (SnapshotRepoName -> SnapshotRepoName -> SnapshotRepoName)
-> (SnapshotRepoName -> SnapshotRepoName -> SnapshotRepoName)
-> Ord SnapshotRepoName
SnapshotRepoName -> SnapshotRepoName -> Bool
SnapshotRepoName -> SnapshotRepoName -> Ordering
SnapshotRepoName -> SnapshotRepoName -> SnapshotRepoName
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
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
$cp1Ord :: Eq SnapshotRepoName
Ord, Int -> SnapshotRepoName -> ShowS
[SnapshotRepoName] -> ShowS
SnapshotRepoName -> String
(Int -> SnapshotRepoName -> ShowS)
-> (SnapshotRepoName -> String)
-> ([SnapshotRepoName] -> ShowS)
-> Show SnapshotRepoName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SnapshotRepoName] -> ShowS
$cshowList :: [SnapshotRepoName] -> ShowS
show :: SnapshotRepoName -> String
$cshow :: SnapshotRepoName -> String
showsPrec :: Int -> SnapshotRepoName -> ShowS
$cshowsPrec :: Int -> SnapshotRepoName -> ShowS
Show, [SnapshotRepoName] -> Encoding
[SnapshotRepoName] -> Value
SnapshotRepoName -> Encoding
SnapshotRepoName -> Value
(SnapshotRepoName -> Value)
-> (SnapshotRepoName -> Encoding)
-> ([SnapshotRepoName] -> Value)
-> ([SnapshotRepoName] -> Encoding)
-> ToJSON SnapshotRepoName
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
(Value -> Parser SnapshotRepoName)
-> (Value -> Parser [SnapshotRepoName])
-> FromJSON 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
(GenericSnapshotRepo -> GenericSnapshotRepo -> Bool)
-> (GenericSnapshotRepo -> GenericSnapshotRepo -> Bool)
-> Eq GenericSnapshotRepo
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
(Int -> GenericSnapshotRepo -> ShowS)
-> (GenericSnapshotRepo -> String)
-> ([GenericSnapshotRepo] -> ShowS)
-> Show GenericSnapshotRepo
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 = GenericSnapshotRepo -> GenericSnapshotRepo
forall a. a -> a
id
  fromGSnapshotRepo :: GenericSnapshotRepo
-> Either SnapshotRepoConversionError GenericSnapshotRepo
fromGSnapshotRepo = GenericSnapshotRepo
-> Either SnapshotRepoConversionError GenericSnapshotRepo
forall a b. b -> Either a b
Right


newtype SnapshotRepoType =
  SnapshotRepoType { SnapshotRepoType -> Text
snapshotRepoType :: Text }
  deriving (SnapshotRepoType -> SnapshotRepoType -> Bool
(SnapshotRepoType -> SnapshotRepoType -> Bool)
-> (SnapshotRepoType -> SnapshotRepoType -> Bool)
-> Eq SnapshotRepoType
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
Eq SnapshotRepoType
-> (SnapshotRepoType -> SnapshotRepoType -> Ordering)
-> (SnapshotRepoType -> SnapshotRepoType -> Bool)
-> (SnapshotRepoType -> SnapshotRepoType -> Bool)
-> (SnapshotRepoType -> SnapshotRepoType -> Bool)
-> (SnapshotRepoType -> SnapshotRepoType -> Bool)
-> (SnapshotRepoType -> SnapshotRepoType -> SnapshotRepoType)
-> (SnapshotRepoType -> SnapshotRepoType -> SnapshotRepoType)
-> Ord SnapshotRepoType
SnapshotRepoType -> SnapshotRepoType -> Bool
SnapshotRepoType -> SnapshotRepoType -> Ordering
SnapshotRepoType -> SnapshotRepoType -> SnapshotRepoType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
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
$cp1Ord :: Eq SnapshotRepoType
Ord, Int -> SnapshotRepoType -> ShowS
[SnapshotRepoType] -> ShowS
SnapshotRepoType -> String
(Int -> SnapshotRepoType -> ShowS)
-> (SnapshotRepoType -> String)
-> ([SnapshotRepoType] -> ShowS)
-> Show SnapshotRepoType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
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
(SnapshotRepoType -> Value)
-> (SnapshotRepoType -> Encoding)
-> ([SnapshotRepoType] -> Value)
-> ([SnapshotRepoType] -> Encoding)
-> ToJSON SnapshotRepoType
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
(Value -> Parser SnapshotRepoType)
-> (Value -> Parser [SnapshotRepoType])
-> FromJSON 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
(GenericSnapshotRepoSettings
 -> GenericSnapshotRepoSettings -> Bool)
-> (GenericSnapshotRepoSettings
    -> GenericSnapshotRepoSettings -> Bool)
-> Eq GenericSnapshotRepoSettings
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
(Int -> GenericSnapshotRepoSettings -> ShowS)
-> (GenericSnapshotRepoSettings -> String)
-> ([GenericSnapshotRepoSettings] -> ShowS)
-> Show GenericSnapshotRepoSettings
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
(GenericSnapshotRepoSettings -> Value)
-> (GenericSnapshotRepoSettings -> Encoding)
-> ([GenericSnapshotRepoSettings] -> Value)
-> ([GenericSnapshotRepoSettings] -> Encoding)
-> ToJSON GenericSnapshotRepoSettings
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 = (Object -> GenericSnapshotRepoSettings)
-> Parser Object -> Parser GenericSnapshotRepoSettings
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Object -> GenericSnapshotRepoSettings
GenericSnapshotRepoSettings (Object -> GenericSnapshotRepoSettings)
-> (Object -> Object) -> Object -> GenericSnapshotRepoSettings
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value -> Value) -> Object -> Object
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Value -> Value
unStringlyTypeJSON)(Parser Object -> Parser GenericSnapshotRepoSettings)
-> (Value -> Parser Object)
-> Value
-> Parser GenericSnapshotRepoSettings
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser Object
forall a. FromJSON a => Value -> Parser a
parseJSON

-- | The result of running 'verifySnapshotRepo'.
newtype SnapshotVerification =
  SnapshotVerification {
    SnapshotVerification -> [SnapshotNodeVerification]
snapshotNodeVerifications :: [SnapshotNodeVerification]
  } deriving (SnapshotVerification -> SnapshotVerification -> Bool
(SnapshotVerification -> SnapshotVerification -> Bool)
-> (SnapshotVerification -> SnapshotVerification -> Bool)
-> Eq SnapshotVerification
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
(Int -> SnapshotVerification -> ShowS)
-> (SnapshotVerification -> String)
-> ([SnapshotVerification] -> ShowS)
-> Show SnapshotVerification
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 = String
-> (Object -> Parser SnapshotVerification)
-> Value
-> Parser SnapshotVerification
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"SnapshotVerification" Object -> Parser SnapshotVerification
parse
    where
      parse :: Object -> Parser SnapshotVerification
parse Object
o = do
        HashMap Text Value
o2 <- Object
o Object -> Key -> Parser (HashMap Text Value)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"nodes"
        [SnapshotNodeVerification] -> SnapshotVerification
SnapshotVerification ([SnapshotNodeVerification] -> SnapshotVerification)
-> Parser [SnapshotNodeVerification] -> Parser SnapshotVerification
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Text, Value) -> Parser SnapshotNodeVerification)
-> [(Text, Value)] -> Parser [SnapshotNodeVerification]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((Text -> Value -> Parser SnapshotNodeVerification)
-> (Text, Value) -> Parser SnapshotNodeVerification
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Text -> Value -> Parser SnapshotNodeVerification
parse') (HashMap Text Value -> [(Text, Value)]
forall k v. HashMap k v -> [(k, v)]
HM.toList HashMap Text Value
o2)
      parse' :: Text -> Value -> Parser SnapshotNodeVerification
parse' Text
rawFullId = String
-> (Object -> Parser SnapshotNodeVerification)
-> Value
-> Parser SnapshotNodeVerification
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"SnapshotNodeVerification" ((Object -> Parser SnapshotNodeVerification)
 -> Value -> Parser SnapshotNodeVerification)
-> (Object -> Parser SnapshotNodeVerification)
-> Value
-> Parser SnapshotNodeVerification
forall a b. (a -> b) -> a -> b
$ \Object
o ->
        FullNodeId -> NodeName -> SnapshotNodeVerification
SnapshotNodeVerification (Text -> FullNodeId
FullNodeId Text
rawFullId) (NodeName -> SnapshotNodeVerification)
-> Parser NodeName -> Parser SnapshotNodeVerification
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser NodeName
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"


-- | A node that has verified a snapshot
data SnapshotNodeVerification = SnapshotNodeVerification {
      SnapshotNodeVerification -> FullNodeId
snvFullId   :: FullNodeId
    , SnapshotNodeVerification -> NodeName
snvNodeName :: NodeName
    } deriving (SnapshotNodeVerification -> SnapshotNodeVerification -> Bool
(SnapshotNodeVerification -> SnapshotNodeVerification -> Bool)
-> (SnapshotNodeVerification -> SnapshotNodeVerification -> Bool)
-> Eq SnapshotNodeVerification
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
(Int -> SnapshotNodeVerification -> ShowS)
-> (SnapshotNodeVerification -> String)
-> ([SnapshotNodeVerification] -> ShowS)
-> Show SnapshotNodeVerification
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
(FullNodeId -> FullNodeId -> Bool)
-> (FullNodeId -> FullNodeId -> Bool) -> Eq FullNodeId
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
Eq FullNodeId
-> (FullNodeId -> FullNodeId -> Ordering)
-> (FullNodeId -> FullNodeId -> Bool)
-> (FullNodeId -> FullNodeId -> Bool)
-> (FullNodeId -> FullNodeId -> Bool)
-> (FullNodeId -> FullNodeId -> Bool)
-> (FullNodeId -> FullNodeId -> FullNodeId)
-> (FullNodeId -> FullNodeId -> FullNodeId)
-> Ord 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
$cp1Ord :: Eq FullNodeId
Ord, Int -> FullNodeId -> ShowS
[FullNodeId] -> ShowS
FullNodeId -> String
(Int -> FullNodeId -> ShowS)
-> (FullNodeId -> String)
-> ([FullNodeId] -> ShowS)
-> Show FullNodeId
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
(Value -> Parser FullNodeId)
-> (Value -> Parser [FullNodeId]) -> FromJSON 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
(NodeName -> NodeName -> Bool)
-> (NodeName -> NodeName -> Bool) -> Eq NodeName
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
Eq NodeName
-> (NodeName -> NodeName -> Ordering)
-> (NodeName -> NodeName -> Bool)
-> (NodeName -> NodeName -> Bool)
-> (NodeName -> NodeName -> Bool)
-> (NodeName -> NodeName -> Bool)
-> (NodeName -> NodeName -> NodeName)
-> (NodeName -> NodeName -> NodeName)
-> Ord 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
$cp1Ord :: Eq NodeName
Ord, Int -> NodeName -> ShowS
[NodeName] -> ShowS
NodeName -> String
(Int -> NodeName -> ShowS)
-> (NodeName -> String) -> ([NodeName] -> ShowS) -> Show NodeName
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
(Value -> Parser NodeName)
-> (Value -> Parser [NodeName]) -> FromJSON 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
(ClusterName -> ClusterName -> Bool)
-> (ClusterName -> ClusterName -> Bool) -> Eq ClusterName
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
Eq ClusterName
-> (ClusterName -> ClusterName -> Ordering)
-> (ClusterName -> ClusterName -> Bool)
-> (ClusterName -> ClusterName -> Bool)
-> (ClusterName -> ClusterName -> Bool)
-> (ClusterName -> ClusterName -> Bool)
-> (ClusterName -> ClusterName -> ClusterName)
-> (ClusterName -> ClusterName -> ClusterName)
-> Ord 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
$cp1Ord :: Eq ClusterName
Ord, Int -> ClusterName -> ShowS
[ClusterName] -> ShowS
ClusterName -> String
(Int -> ClusterName -> ShowS)
-> (ClusterName -> String)
-> ([ClusterName] -> ShowS)
-> Show ClusterName
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
(Value -> Parser ClusterName)
-> (Value -> Parser [ClusterName]) -> FromJSON 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
(NodesInfo -> NodesInfo -> Bool)
-> (NodesInfo -> NodesInfo -> Bool) -> Eq NodesInfo
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
(Int -> NodesInfo -> ShowS)
-> (NodesInfo -> String)
-> ([NodesInfo] -> ShowS)
-> Show NodesInfo
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
(NodesStats -> NodesStats -> Bool)
-> (NodesStats -> NodesStats -> Bool) -> Eq NodesStats
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
(Int -> NodesStats -> ShowS)
-> (NodesStats -> String)
-> ([NodesStats] -> ShowS)
-> Show NodesStats
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
(NodeStats -> NodeStats -> Bool)
-> (NodeStats -> NodeStats -> Bool) -> Eq NodeStats
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
(Int -> NodeStats -> ShowS)
-> (NodeStats -> String)
-> ([NodeStats] -> ShowS)
-> Show NodeStats
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
(NodeBreakersStats -> NodeBreakersStats -> Bool)
-> (NodeBreakersStats -> NodeBreakersStats -> Bool)
-> Eq NodeBreakersStats
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
(Int -> NodeBreakersStats -> ShowS)
-> (NodeBreakersStats -> String)
-> ([NodeBreakersStats] -> ShowS)
-> Show NodeBreakersStats
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
(NodeBreakerStats -> NodeBreakerStats -> Bool)
-> (NodeBreakerStats -> NodeBreakerStats -> Bool)
-> Eq NodeBreakerStats
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
(Int -> NodeBreakerStats -> ShowS)
-> (NodeBreakerStats -> String)
-> ([NodeBreakerStats] -> ShowS)
-> Show NodeBreakerStats
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
(NodeHTTPStats -> NodeHTTPStats -> Bool)
-> (NodeHTTPStats -> NodeHTTPStats -> Bool) -> Eq NodeHTTPStats
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
(Int -> NodeHTTPStats -> ShowS)
-> (NodeHTTPStats -> String)
-> ([NodeHTTPStats] -> ShowS)
-> Show NodeHTTPStats
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
(NodeTransportStats -> NodeTransportStats -> Bool)
-> (NodeTransportStats -> NodeTransportStats -> Bool)
-> Eq NodeTransportStats
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
(Int -> NodeTransportStats -> ShowS)
-> (NodeTransportStats -> String)
-> ([NodeTransportStats] -> ShowS)
-> Show NodeTransportStats
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
(NodeFSStats -> NodeFSStats -> Bool)
-> (NodeFSStats -> NodeFSStats -> Bool) -> Eq NodeFSStats
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
(Int -> NodeFSStats -> ShowS)
-> (NodeFSStats -> String)
-> ([NodeFSStats] -> ShowS)
-> Show NodeFSStats
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
(NodeDataPathStats -> NodeDataPathStats -> Bool)
-> (NodeDataPathStats -> NodeDataPathStats -> Bool)
-> Eq NodeDataPathStats
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
(Int -> NodeDataPathStats -> ShowS)
-> (NodeDataPathStats -> String)
-> ([NodeDataPathStats] -> ShowS)
-> Show NodeDataPathStats
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
(NodeFSTotalStats -> NodeFSTotalStats -> Bool)
-> (NodeFSTotalStats -> NodeFSTotalStats -> Bool)
-> Eq NodeFSTotalStats
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
(Int -> NodeFSTotalStats -> ShowS)
-> (NodeFSTotalStats -> String)
-> ([NodeFSTotalStats] -> ShowS)
-> Show NodeFSTotalStats
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
(NodeNetworkStats -> NodeNetworkStats -> Bool)
-> (NodeNetworkStats -> NodeNetworkStats -> Bool)
-> Eq NodeNetworkStats
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
(Int -> NodeNetworkStats -> ShowS)
-> (NodeNetworkStats -> String)
-> ([NodeNetworkStats] -> ShowS)
-> Show NodeNetworkStats
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
(NodeThreadPoolStats -> NodeThreadPoolStats -> Bool)
-> (NodeThreadPoolStats -> NodeThreadPoolStats -> Bool)
-> Eq NodeThreadPoolStats
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
(Int -> NodeThreadPoolStats -> ShowS)
-> (NodeThreadPoolStats -> String)
-> ([NodeThreadPoolStats] -> ShowS)
-> Show NodeThreadPoolStats
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
(NodeJVMStats -> NodeJVMStats -> Bool)
-> (NodeJVMStats -> NodeJVMStats -> Bool) -> Eq NodeJVMStats
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
(Int -> NodeJVMStats -> ShowS)
-> (NodeJVMStats -> String)
-> ([NodeJVMStats] -> ShowS)
-> Show NodeJVMStats
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
(JVMBufferPoolStats -> JVMBufferPoolStats -> Bool)
-> (JVMBufferPoolStats -> JVMBufferPoolStats -> Bool)
-> Eq JVMBufferPoolStats
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
(Int -> JVMBufferPoolStats -> ShowS)
-> (JVMBufferPoolStats -> String)
-> ([JVMBufferPoolStats] -> ShowS)
-> Show JVMBufferPoolStats
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
(JVMGCStats -> JVMGCStats -> Bool)
-> (JVMGCStats -> JVMGCStats -> Bool) -> Eq JVMGCStats
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
(Int -> JVMGCStats -> ShowS)
-> (JVMGCStats -> String)
-> ([JVMGCStats] -> ShowS)
-> Show JVMGCStats
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
(JVMPoolStats -> JVMPoolStats -> Bool)
-> (JVMPoolStats -> JVMPoolStats -> Bool) -> Eq JVMPoolStats
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
(Int -> JVMPoolStats -> ShowS)
-> (JVMPoolStats -> String)
-> ([JVMPoolStats] -> ShowS)
-> Show JVMPoolStats
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
(NodeProcessStats -> NodeProcessStats -> Bool)
-> (NodeProcessStats -> NodeProcessStats -> Bool)
-> Eq NodeProcessStats
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
(Int -> NodeProcessStats -> ShowS)
-> (NodeProcessStats -> String)
-> ([NodeProcessStats] -> ShowS)
-> Show NodeProcessStats
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
(NodeOSStats -> NodeOSStats -> Bool)
-> (NodeOSStats -> NodeOSStats -> Bool) -> Eq NodeOSStats
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
(Int -> NodeOSStats -> ShowS)
-> (NodeOSStats -> String)
-> ([NodeOSStats] -> ShowS)
-> Show NodeOSStats
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
(LoadAvgs -> LoadAvgs -> Bool)
-> (LoadAvgs -> LoadAvgs -> Bool) -> Eq LoadAvgs
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
(Int -> LoadAvgs -> ShowS)
-> (LoadAvgs -> String) -> ([LoadAvgs] -> ShowS) -> Show LoadAvgs
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
(NodeIndicesStats -> NodeIndicesStats -> Bool)
-> (NodeIndicesStats -> NodeIndicesStats -> Bool)
-> Eq NodeIndicesStats
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
(Int -> NodeIndicesStats -> ShowS)
-> (NodeIndicesStats -> String)
-> ([NodeIndicesStats] -> ShowS)
-> Show NodeIndicesStats
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
(EsAddress -> EsAddress -> Bool)
-> (EsAddress -> EsAddress -> Bool) -> Eq EsAddress
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
Eq EsAddress
-> (EsAddress -> EsAddress -> Ordering)
-> (EsAddress -> EsAddress -> Bool)
-> (EsAddress -> EsAddress -> Bool)
-> (EsAddress -> EsAddress -> Bool)
-> (EsAddress -> EsAddress -> Bool)
-> (EsAddress -> EsAddress -> EsAddress)
-> (EsAddress -> EsAddress -> EsAddress)
-> Ord 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
$cp1Ord :: Eq EsAddress
Ord, Int -> EsAddress -> ShowS
[EsAddress] -> ShowS
EsAddress -> String
(Int -> EsAddress -> ShowS)
-> (EsAddress -> String)
-> ([EsAddress] -> ShowS)
-> Show EsAddress
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
(Value -> Parser EsAddress)
-> (Value -> Parser [EsAddress]) -> FromJSON 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
(BuildHash -> BuildHash -> Bool)
-> (BuildHash -> BuildHash -> Bool) -> Eq BuildHash
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
Eq BuildHash
-> (BuildHash -> BuildHash -> Ordering)
-> (BuildHash -> BuildHash -> Bool)
-> (BuildHash -> BuildHash -> Bool)
-> (BuildHash -> BuildHash -> Bool)
-> (BuildHash -> BuildHash -> Bool)
-> (BuildHash -> BuildHash -> BuildHash)
-> (BuildHash -> BuildHash -> BuildHash)
-> Ord 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
$cp1Ord :: Eq BuildHash
Ord, Int -> BuildHash -> ShowS
[BuildHash] -> ShowS
BuildHash -> String
(Int -> BuildHash -> ShowS)
-> (BuildHash -> String)
-> ([BuildHash] -> ShowS)
-> Show BuildHash
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, Value -> Parser [BuildHash]
Value -> Parser BuildHash
(Value -> Parser BuildHash)
-> (Value -> Parser [BuildHash]) -> FromJSON 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
(BuildHash -> Value)
-> (BuildHash -> Encoding)
-> ([BuildHash] -> Value)
-> ([BuildHash] -> Encoding)
-> ToJSON BuildHash
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
(PluginName -> PluginName -> Bool)
-> (PluginName -> PluginName -> Bool) -> Eq PluginName
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
Eq PluginName
-> (PluginName -> PluginName -> Ordering)
-> (PluginName -> PluginName -> Bool)
-> (PluginName -> PluginName -> Bool)
-> (PluginName -> PluginName -> Bool)
-> (PluginName -> PluginName -> Bool)
-> (PluginName -> PluginName -> PluginName)
-> (PluginName -> PluginName -> PluginName)
-> Ord 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
$cp1Ord :: Eq PluginName
Ord, Int -> PluginName -> ShowS
[PluginName] -> ShowS
PluginName -> String
(Int -> PluginName -> ShowS)
-> (PluginName -> String)
-> ([PluginName] -> ShowS)
-> Show PluginName
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
(Value -> Parser PluginName)
-> (Value -> Parser [PluginName]) -> FromJSON 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
    , NodeInfo -> Object
nodeInfoSettings         :: Object
    -- ^ The members of the settings objects are not consistent,
    -- dependent on plugins, etc.
    } deriving (NodeInfo -> NodeInfo -> Bool
(NodeInfo -> NodeInfo -> Bool)
-> (NodeInfo -> NodeInfo -> Bool) -> Eq NodeInfo
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
(Int -> NodeInfo -> ShowS)
-> (NodeInfo -> String) -> ([NodeInfo] -> ShowS) -> Show NodeInfo
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 {
      NodePluginInfo -> Maybe Bool
nodePluginSite        :: Maybe Bool
    -- ^ Is this a site plugin?
    , NodePluginInfo -> Maybe Bool
nodePluginJVM         :: Maybe Bool
    -- ^ Is this plugin running on the JVM
    , NodePluginInfo -> Text
nodePluginDescription :: Text
    , NodePluginInfo -> MaybeNA VersionNumber
nodePluginVersion     :: MaybeNA VersionNumber
    , NodePluginInfo -> PluginName
nodePluginName        :: PluginName
    } deriving (NodePluginInfo -> NodePluginInfo -> Bool
(NodePluginInfo -> NodePluginInfo -> Bool)
-> (NodePluginInfo -> NodePluginInfo -> Bool) -> Eq NodePluginInfo
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
(Int -> NodePluginInfo -> ShowS)
-> (NodePluginInfo -> String)
-> ([NodePluginInfo] -> ShowS)
-> Show NodePluginInfo
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
(NodeHTTPInfo -> NodeHTTPInfo -> Bool)
-> (NodeHTTPInfo -> NodeHTTPInfo -> Bool) -> Eq NodeHTTPInfo
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
(Int -> NodeHTTPInfo -> ShowS)
-> (NodeHTTPInfo -> String)
-> ([NodeHTTPInfo] -> ShowS)
-> Show NodeHTTPInfo
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
(NodeTransportInfo -> NodeTransportInfo -> Bool)
-> (NodeTransportInfo -> NodeTransportInfo -> Bool)
-> Eq NodeTransportInfo
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
(Int -> NodeTransportInfo -> ShowS)
-> (NodeTransportInfo -> String)
-> ([NodeTransportInfo] -> ShowS)
-> Show NodeTransportInfo
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
(BoundTransportAddress -> BoundTransportAddress -> Bool)
-> (BoundTransportAddress -> BoundTransportAddress -> Bool)
-> Eq BoundTransportAddress
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
(Int -> BoundTransportAddress -> ShowS)
-> (BoundTransportAddress -> String)
-> ([BoundTransportAddress] -> ShowS)
-> Show BoundTransportAddress
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
(NodeNetworkInfo -> NodeNetworkInfo -> Bool)
-> (NodeNetworkInfo -> NodeNetworkInfo -> Bool)
-> Eq NodeNetworkInfo
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
(Int -> NodeNetworkInfo -> ShowS)
-> (NodeNetworkInfo -> String)
-> ([NodeNetworkInfo] -> ShowS)
-> Show NodeNetworkInfo
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
(MacAddress -> MacAddress -> Bool)
-> (MacAddress -> MacAddress -> Bool) -> Eq MacAddress
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
Eq MacAddress
-> (MacAddress -> MacAddress -> Ordering)
-> (MacAddress -> MacAddress -> Bool)
-> (MacAddress -> MacAddress -> Bool)
-> (MacAddress -> MacAddress -> Bool)
-> (MacAddress -> MacAddress -> Bool)
-> (MacAddress -> MacAddress -> MacAddress)
-> (MacAddress -> MacAddress -> MacAddress)
-> Ord 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
$cp1Ord :: Eq MacAddress
Ord, Int -> MacAddress -> ShowS
[MacAddress] -> ShowS
MacAddress -> String
(Int -> MacAddress -> ShowS)
-> (MacAddress -> String)
-> ([MacAddress] -> ShowS)
-> Show MacAddress
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
(Value -> Parser MacAddress)
-> (Value -> Parser [MacAddress]) -> FromJSON 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
(NetworkInterfaceName -> NetworkInterfaceName -> Bool)
-> (NetworkInterfaceName -> NetworkInterfaceName -> Bool)
-> Eq NetworkInterfaceName
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
Eq NetworkInterfaceName
-> (NetworkInterfaceName -> NetworkInterfaceName -> Ordering)
-> (NetworkInterfaceName -> NetworkInterfaceName -> Bool)
-> (NetworkInterfaceName -> NetworkInterfaceName -> Bool)
-> (NetworkInterfaceName -> NetworkInterfaceName -> Bool)
-> (NetworkInterfaceName -> NetworkInterfaceName -> Bool)
-> (NetworkInterfaceName
    -> NetworkInterfaceName -> NetworkInterfaceName)
-> (NetworkInterfaceName
    -> NetworkInterfaceName -> NetworkInterfaceName)
-> Ord 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
$cp1Ord :: Eq NetworkInterfaceName
Ord, Int -> NetworkInterfaceName -> ShowS
[NetworkInterfaceName] -> ShowS
NetworkInterfaceName -> String
(Int -> NetworkInterfaceName -> ShowS)
-> (NetworkInterfaceName -> String)
-> ([NetworkInterfaceName] -> ShowS)
-> Show NetworkInterfaceName
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
(Value -> Parser NetworkInterfaceName)
-> (Value -> Parser [NetworkInterfaceName])
-> FromJSON 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
(NodeNetworkInterface -> NodeNetworkInterface -> Bool)
-> (NodeNetworkInterface -> NodeNetworkInterface -> Bool)
-> Eq NodeNetworkInterface
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
(Int -> NodeNetworkInterface -> ShowS)
-> (NodeNetworkInterface -> String)
-> ([NodeNetworkInterface] -> ShowS)
-> Show NodeNetworkInterface
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
(ThreadPool -> ThreadPool -> Bool)
-> (ThreadPool -> ThreadPool -> Bool) -> Eq ThreadPool
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
(Int -> ThreadPool -> ShowS)
-> (ThreadPool -> String)
-> ([ThreadPool] -> ShowS)
-> Show ThreadPool
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
(NodeThreadPoolInfo -> NodeThreadPoolInfo -> Bool)
-> (NodeThreadPoolInfo -> NodeThreadPoolInfo -> Bool)
-> Eq NodeThreadPoolInfo
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
(Int -> NodeThreadPoolInfo -> ShowS)
-> (NodeThreadPoolInfo -> String)
-> ([NodeThreadPoolInfo] -> ShowS)
-> Show NodeThreadPoolInfo
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
(ThreadPoolSize -> ThreadPoolSize -> Bool)
-> (ThreadPoolSize -> ThreadPoolSize -> Bool) -> Eq ThreadPoolSize
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
(Int -> ThreadPoolSize -> ShowS)
-> (ThreadPoolSize -> String)
-> ([ThreadPoolSize] -> ShowS)
-> Show ThreadPoolSize
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
(ThreadPoolType -> ThreadPoolType -> Bool)
-> (ThreadPoolType -> ThreadPoolType -> Bool) -> Eq ThreadPoolType
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
(Int -> ThreadPoolType -> ShowS)
-> (ThreadPoolType -> String)
-> ([ThreadPoolType] -> ShowS)
-> Show ThreadPoolType
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
    , NodeJVMInfo -> VMVersion
nodeJVMVMVersion                   :: VMVersion
    -- ^ JVM doesn't seme to follow normal version conventions
    , NodeJVMInfo -> Text
nodeJVMVMName                      :: Text
    , NodeJVMInfo -> JVMVersion
nodeJVMVersion                     :: JVMVersion
    , NodeJVMInfo -> PID
nodeJVMPID                         :: PID
    } deriving (NodeJVMInfo -> NodeJVMInfo -> Bool
(NodeJVMInfo -> NodeJVMInfo -> Bool)
-> (NodeJVMInfo -> NodeJVMInfo -> Bool) -> Eq NodeJVMInfo
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
(Int -> NodeJVMInfo -> ShowS)
-> (NodeJVMInfo -> String)
-> ([NodeJVMInfo] -> ShowS)
-> Show NodeJVMInfo
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
(JVMVersion -> JVMVersion -> Bool)
-> (JVMVersion -> JVMVersion -> Bool) -> Eq JVMVersion
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
(Int -> JVMVersion -> ShowS)
-> (JVMVersion -> String)
-> ([JVMVersion] -> ShowS)
-> Show JVMVersion
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 = String -> (Text -> Parser JVMVersion) -> Value -> Parser JVMVersion
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"JVMVersion" (JVMVersion -> Parser JVMVersion
forall (f :: * -> *) a. Applicative f => a -> f a
pure (JVMVersion -> Parser JVMVersion)
-> (Text -> JVMVersion) -> Text -> Parser JVMVersion
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
(JVMMemoryInfo -> JVMMemoryInfo -> Bool)
-> (JVMMemoryInfo -> JVMMemoryInfo -> Bool) -> Eq JVMMemoryInfo
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
(Int -> JVMMemoryInfo -> ShowS)
-> (JVMMemoryInfo -> String)
-> ([JVMMemoryInfo] -> ShowS)
-> Show JVMMemoryInfo
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
(VMVersion -> VMVersion -> Bool)
-> (VMVersion -> VMVersion -> Bool) -> Eq VMVersion
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
(Int -> VMVersion -> ShowS)
-> (VMVersion -> String)
-> ([VMVersion] -> ShowS)
-> Show VMVersion
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 = Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value) -> (VMVersion -> Text) -> VMVersion -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VMVersion -> Text
unVMVersion

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

newtype JVMMemoryPool = JVMMemoryPool {
      JVMMemoryPool -> Text
jvmMemoryPool :: Text
    } deriving (JVMMemoryPool -> JVMMemoryPool -> Bool
(JVMMemoryPool -> JVMMemoryPool -> Bool)
-> (JVMMemoryPool -> JVMMemoryPool -> Bool) -> Eq JVMMemoryPool
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
(Int -> JVMMemoryPool -> ShowS)
-> (JVMMemoryPool -> String)
-> ([JVMMemoryPool] -> ShowS)
-> Show JVMMemoryPool
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
(Value -> Parser JVMMemoryPool)
-> (Value -> Parser [JVMMemoryPool]) -> FromJSON 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
(JVMGCCollector -> JVMGCCollector -> Bool)
-> (JVMGCCollector -> JVMGCCollector -> Bool) -> Eq JVMGCCollector
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
(Int -> JVMGCCollector -> ShowS)
-> (JVMGCCollector -> String)
-> ([JVMGCCollector] -> ShowS)
-> Show JVMGCCollector
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
(Value -> Parser JVMGCCollector)
-> (Value -> Parser [JVMGCCollector]) -> FromJSON 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
(PID -> PID -> Bool) -> (PID -> PID -> Bool) -> Eq PID
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
(Int -> PID -> ShowS)
-> (PID -> String) -> ([PID] -> ShowS) -> Show PID
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
(Value -> Parser PID) -> (Value -> Parser [PID]) -> FromJSON 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