bloodhound-0.20.0.0: src/Database/Bloodhound/Internal/Client.hs
{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE UndecidableInstances #-}
module Database.Bloodhound.Internal.Client where
import Bloodhound.Import
import qualified Data.Aeson.KeyMap as X
import qualified Data.HashMap.Strict as HM
import Data.Map.Strict (Map)
import Data.Maybe (mapMaybe)
import qualified Data.SemVer as SemVer
import qualified Data.Text as T
import qualified Data.Traversable as DT
import qualified Data.Vector as V
import Database.Bloodhound.Internal.Analysis
import Database.Bloodhound.Internal.Client.BHRequest
import Database.Bloodhound.Internal.Client.Doc
import Database.Bloodhound.Internal.Newtypes
import Database.Bloodhound.Internal.Query
import Database.Bloodhound.Internal.StringlyTyped
import GHC.Generics
import Network.HTTP.Client
import Text.Read (Read (..))
import qualified Text.Read as TR
-- | Common environment for Elasticsearch calls. Connections will be
-- pipelined according to the provided HTTP connection manager.
data BHEnv = BHEnv
{ bhServer :: Server,
bhManager :: Manager,
-- | Low-level hook that is run before every request is sent. Used to implement custom authentication strategies. Defaults to 'return' with 'mkBHEnv'.
bhRequestHook :: Request -> IO Request
}
instance (Functor m, Applicative m, MonadIO m) => MonadBH (ReaderT BHEnv m) where
getBHEnv = ask
-- | All API calls to Elasticsearch operate within
-- MonadBH
-- . The idea is that it can be easily embedded in your
-- own monad transformer stack. A default instance for a ReaderT and
-- alias 'BH' is provided for the simple case.
class (Functor m, Applicative m, MonadIO m) => MonadBH m where
getBHEnv :: m BHEnv
-- | Create a 'BHEnv' with all optional fields defaulted. HTTP hook
-- will be a noop. You can use the exported fields to customize
-- it further, e.g.:
--
-- >> (mkBHEnv myServer myManager) { bhRequestHook = customHook }
mkBHEnv :: Server -> Manager -> BHEnv
mkBHEnv s m = BHEnv s m return
newtype BH m a = BH
{ unBH :: ReaderT BHEnv m a
}
deriving
( Functor,
Applicative,
Monad,
MonadIO,
MonadState s,
MonadWriter w,
MonadError e,
Alternative,
MonadPlus,
MonadFix,
MonadThrow,
MonadCatch,
MonadFail,
MonadMask
)
instance MonadTrans BH where
lift = BH . lift
instance (MonadReader r m) => MonadReader r (BH m) where
ask = lift ask
local f (BH (ReaderT m)) = BH $
ReaderT $ \r ->
local f (m r)
instance (Functor m, Applicative m, MonadIO m) => MonadBH (BH m) where
getBHEnv = BH getBHEnv
runBH :: BHEnv -> BH m a -> m a
runBH e f = runReaderT (unBH f) e
-- | 'Version' is embedded in 'Status'
data Version = Version
{ number :: VersionNumber,
build_hash :: BuildHash,
build_date :: UTCTime,
build_snapshot :: Bool,
lucene_version :: VersionNumber
}
deriving (Eq, Show, Generic)
-- | Traditional software versioning number
newtype VersionNumber = VersionNumber
{versionNumber :: SemVer.Version}
deriving (Eq, Ord, Show)
-- | 'Status' is a data type for describing the JSON body returned by
-- Elasticsearch when you query its status. This was deprecated in 1.2.0.
--
-- <http://www.elastic.co/guide/en/elasticsearch/reference/current/indices-status.html#indices-status>
data Status = Status
{ name :: Text,
cluster_name :: Text,
cluster_uuid :: Text,
version :: Version,
tagline :: Text
}
deriving (Eq, Show)
instance FromJSON Status where
parseJSON (Object v) =
Status
<$> v .: "name"
<*> v .: "cluster_name"
<*> v .: "cluster_uuid"
<*> v .: "version"
<*> v .: "tagline"
parseJSON _ = empty
-- | 'IndexSettings' is used to configure the shards and replicas when
-- you create an Elasticsearch Index.
--
-- <http://www.elastic.co/guide/en/elasticsearch/reference/current/indices-create-index.html>
data IndexSettings = IndexSettings
{ indexShards :: ShardCount,
indexReplicas :: ReplicaCount,
indexMappingsLimits :: IndexMappingsLimits
}
deriving (Eq, Show, Generic)
instance ToJSON IndexSettings where
toJSON (IndexSettings s r l) =
object
[ "settings"
.= object
[ "index"
.= object ["number_of_shards" .= s, "number_of_replicas" .= r, "mapping" .= l]
]
]
instance FromJSON IndexSettings where
parseJSON = withObject "IndexSettings" parse
where
parse o = do
s <- o .: "settings"
i <- s .: "index"
IndexSettings <$> i .: "number_of_shards"
<*> i .: "number_of_replicas"
<*> i .:? "mapping" .!= defaultIndexMappingsLimits
-- | 'defaultIndexSettings' is an 'IndexSettings' with 3 shards and
-- 2 replicas.
defaultIndexSettings :: IndexSettings
defaultIndexSettings = IndexSettings (ShardCount 3) (ReplicaCount 2) 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
{ indexMappingsLimitDepth :: Maybe Int,
indexMappingsLimitNestedFields :: Maybe Int,
indexMappingsLimitNestedObjects :: Maybe Int,
indexMappingsLimitFieldNameLength :: Maybe Int
}
deriving (Eq, Show, Generic)
instance ToJSON IndexMappingsLimits where
toJSON (IndexMappingsLimits d f o n) =
object $
mapMaybe
go
[ ("depth.limit", d),
("nested_fields.limit", f),
("nested_objects.limit", o),
("field_name_length.limit", n)
]
where
go (name, value) = (name .=) <$> value
instance FromJSON IndexMappingsLimits where
parseJSON = withObject "IndexMappingsLimits" $ \o ->
IndexMappingsLimits
<$> o .:?? "depth"
<*> o .:?? "nested_fields"
<*> o .:?? "nested_objects"
<*> o .:?? "field_name_length"
where
o .:?? name = optional $ do
f <- o .: name
f .: "limit"
defaultIndexMappingsLimits :: IndexMappingsLimits
defaultIndexMappingsLimits = IndexMappingsLimits Nothing Nothing Nothing Nothing
-- | 'ForceMergeIndexSettings' is used to configure index optimization. See
-- <https://www.elastic.co/guide/en/elasticsearch/reference/current/indices-forcemerge.html>
-- for more info.
data ForceMergeIndexSettings = ForceMergeIndexSettings
{ -- | Number of segments to optimize to. 1 will fully optimize the index. If omitted, the default behavior is to only optimize if the server deems it necessary.
maxNumSegments :: Maybe Int,
-- | Should the optimize process only expunge segments with deletes in them? If the purpose of the optimization is to free disk space, this should be set to True.
onlyExpungeDeletes :: Bool,
-- | Should a flush be performed after the optimize.
flushAfterOptimize :: Bool
}
deriving (Eq, 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 Nothing False True
-- | 'UpdatableIndexSetting' are settings which may be updated after an index is created.
--
-- <https://www.elastic.co/guide/en/elasticsearch/reference/current/indices-update-settings.html>
data UpdatableIndexSetting
= -- | The number of replicas each shard has.
NumberOfReplicas ReplicaCount
| AutoExpandReplicas ReplicaBounds
| -- | Set to True to have the index read only. False to allow writes and metadata changes.
BlocksReadOnly Bool
| -- | Set to True to disable read operations against the index.
BlocksRead Bool
| -- | Set to True to disable write operations against the index.
BlocksWrite Bool
| -- | Set to True to disable metadata operations against the index.
BlocksMetaData Bool
| -- | The async refresh interval of a shard
RefreshInterval NominalDiffTime
| IndexConcurrency Int
| FailOnMergeFailure Bool
| -- | When to flush on operations.
TranslogFlushThresholdOps Int
| -- | When to flush based on translog (bytes) size.
TranslogFlushThresholdSize Bytes
| -- | When to flush based on a period of not flushing.
TranslogFlushThresholdPeriod NominalDiffTime
| -- | Disables flushing. Note, should be set for a short interval and then enabled.
TranslogDisableFlush Bool
| -- | The maximum size of filter cache (per segment in shard).
CacheFilterMaxSize (Maybe Bytes)
| -- | The expire after access time for filter cache.
CacheFilterExpire (Maybe NominalDiffTime)
| -- | The gateway snapshot interval (only applies to shared gateways).
GatewaySnapshotInterval NominalDiffTime
| -- | A node matching any rule will be allowed to host shards from the index.
RoutingAllocationInclude (NonEmpty NodeAttrFilter)
| -- | A node matching any rule will NOT be allowed to host shards from the index.
RoutingAllocationExclude (NonEmpty NodeAttrFilter)
| -- | Only nodes matching all rules will be allowed to host shards from the index.
RoutingAllocationRequire (NonEmpty NodeAttrFilter)
| -- | Enables shard allocation for a specific index.
RoutingAllocationEnable AllocationPolicy
| -- | Controls the total number of shards (replicas and primaries) allowed to be allocated on a single node.
RoutingAllocationShardsPerNode ShardCount
| -- | When using local gateway a particular shard is recovered only if there can be allocated quorum shards in the cluster.
RecoveryInitialShards InitialShardCount
| GCDeletes NominalDiffTime
| -- | Disables temporarily the purge of expired docs.
TTLDisablePurge Bool
| TranslogFSType FSType
| CompressionSetting Compression
| IndexCompoundFormat CompoundFormat
| IndexCompoundOnFlush Bool
| WarmerEnabled Bool
| MappingTotalFieldsLimit Int
| -- | Analysis is not a dynamic setting and can only be performed on a closed index.
AnalysisSetting Analysis
| -- | Sets a delay to the allocation of replica shards which become unassigned because a node has left, giving them chance to return. See <https://www.elastic.co/guide/en/elasticsearch/reference/5.6/delayed-allocation.html>
UnassignedNodeLeftDelayedTimeout NominalDiffTime
deriving (Eq, Show, Generic)
attrFilterJSON :: NonEmpty NodeAttrFilter -> Value
attrFilterJSON fs =
object
[ fromText n .= T.intercalate "," (toList vs)
| NodeAttrFilter (NodeAttrName n) vs <- toList fs
]
parseAttrFilter :: Value -> Parser (NonEmpty NodeAttrFilter)
parseAttrFilter = withObject "NonEmpty NodeAttrFilter" parse
where
parse o = case X.toList o of
[] -> fail "Expected non-empty list of NodeAttrFilters"
x : xs -> DT.mapM (uncurry parse') (x :| xs)
parse' n = withText "Text" $ \t ->
case T.splitOn "," t of
fv : fvs -> return (NodeAttrFilter (NodeAttrName $ toText n) (fv :| fvs))
[] -> fail "Expected non-empty list of filter values"
instance ToJSON UpdatableIndexSetting where
toJSON (NumberOfReplicas x) = oPath ("index" :| ["number_of_replicas"]) x
toJSON (AutoExpandReplicas x) = oPath ("index" :| ["auto_expand_replicas"]) x
toJSON (RefreshInterval x) = oPath ("index" :| ["refresh_interval"]) (NominalDiffTimeJSON x)
toJSON (IndexConcurrency x) = oPath ("index" :| ["concurrency"]) x
toJSON (FailOnMergeFailure x) = oPath ("index" :| ["fail_on_merge_failure"]) x
toJSON (TranslogFlushThresholdOps x) = oPath ("index" :| ["translog", "flush_threshold_ops"]) x
toJSON (TranslogFlushThresholdSize x) = oPath ("index" :| ["translog", "flush_threshold_size"]) x
toJSON (TranslogFlushThresholdPeriod x) = oPath ("index" :| ["translog", "flush_threshold_period"]) (NominalDiffTimeJSON x)
toJSON (TranslogDisableFlush x) = oPath ("index" :| ["translog", "disable_flush"]) x
toJSON (CacheFilterMaxSize x) = oPath ("index" :| ["cache", "filter", "max_size"]) x
toJSON (CacheFilterExpire x) = oPath ("index" :| ["cache", "filter", "expire"]) (NominalDiffTimeJSON <$> x)
toJSON (GatewaySnapshotInterval x) = oPath ("index" :| ["gateway", "snapshot_interval"]) (NominalDiffTimeJSON x)
toJSON (RoutingAllocationInclude fs) = oPath ("index" :| ["routing", "allocation", "include"]) (attrFilterJSON fs)
toJSON (RoutingAllocationExclude fs) = oPath ("index" :| ["routing", "allocation", "exclude"]) (attrFilterJSON fs)
toJSON (RoutingAllocationRequire fs) = oPath ("index" :| ["routing", "allocation", "require"]) (attrFilterJSON fs)
toJSON (RoutingAllocationEnable x) = oPath ("index" :| ["routing", "allocation", "enable"]) x
toJSON (RoutingAllocationShardsPerNode x) = oPath ("index" :| ["routing", "allocation", "total_shards_per_node"]) x
toJSON (RecoveryInitialShards x) = oPath ("index" :| ["recovery", "initial_shards"]) x
toJSON (GCDeletes x) = oPath ("index" :| ["gc_deletes"]) (NominalDiffTimeJSON x)
toJSON (TTLDisablePurge x) = oPath ("index" :| ["ttl", "disable_purge"]) x
toJSON (TranslogFSType x) = oPath ("index" :| ["translog", "fs", "type"]) x
toJSON (CompressionSetting x) = oPath ("index" :| ["codec"]) x
toJSON (IndexCompoundFormat x) = oPath ("index" :| ["compound_format"]) x
toJSON (IndexCompoundOnFlush x) = oPath ("index" :| ["compound_on_flush"]) x
toJSON (WarmerEnabled x) = oPath ("index" :| ["warmer", "enabled"]) x
toJSON (BlocksReadOnly x) = oPath ("blocks" :| ["read_only"]) x
toJSON (BlocksRead x) = oPath ("blocks" :| ["read"]) x
toJSON (BlocksWrite x) = oPath ("blocks" :| ["write"]) x
toJSON (BlocksMetaData x) = oPath ("blocks" :| ["metadata"]) x
toJSON (MappingTotalFieldsLimit x) = oPath ("index" :| ["mapping", "total_fields", "limit"]) x
toJSON (AnalysisSetting x) = oPath ("index" :| ["analysis"]) x
toJSON (UnassignedNodeLeftDelayedTimeout x) = oPath ("index" :| ["unassigned", "node_left", "delayed_timeout"]) (NominalDiffTimeJSON x)
instance FromJSON UpdatableIndexSetting where
parseJSON = withObject "UpdatableIndexSetting" parse
where
parse o =
numberOfReplicas `taggedAt` ["index", "number_of_replicas"]
<|> autoExpandReplicas `taggedAt` ["index", "auto_expand_replicas"]
<|> refreshInterval `taggedAt` ["index", "refresh_interval"]
<|> indexConcurrency `taggedAt` ["index", "concurrency"]
<|> failOnMergeFailure `taggedAt` ["index", "fail_on_merge_failure"]
<|> translogFlushThresholdOps `taggedAt` ["index", "translog", "flush_threshold_ops"]
<|> translogFlushThresholdSize `taggedAt` ["index", "translog", "flush_threshold_size"]
<|> translogFlushThresholdPeriod `taggedAt` ["index", "translog", "flush_threshold_period"]
<|> translogDisableFlush `taggedAt` ["index", "translog", "disable_flush"]
<|> cacheFilterMaxSize `taggedAt` ["index", "cache", "filter", "max_size"]
<|> cacheFilterExpire `taggedAt` ["index", "cache", "filter", "expire"]
<|> gatewaySnapshotInterval `taggedAt` ["index", "gateway", "snapshot_interval"]
<|> routingAllocationInclude `taggedAt` ["index", "routing", "allocation", "include"]
<|> routingAllocationExclude `taggedAt` ["index", "routing", "allocation", "exclude"]
<|> routingAllocationRequire `taggedAt` ["index", "routing", "allocation", "require"]
<|> routingAllocationEnable `taggedAt` ["index", "routing", "allocation", "enable"]
<|> routingAllocationShardsPerNode `taggedAt` ["index", "routing", "allocation", "total_shards_per_node"]
<|> recoveryInitialShards `taggedAt` ["index", "recovery", "initial_shards"]
<|> gcDeletes `taggedAt` ["index", "gc_deletes"]
<|> ttlDisablePurge `taggedAt` ["index", "ttl", "disable_purge"]
<|> translogFSType `taggedAt` ["index", "translog", "fs", "type"]
<|> compressionSetting `taggedAt` ["index", "codec"]
<|> compoundFormat `taggedAt` ["index", "compound_format"]
<|> compoundOnFlush `taggedAt` ["index", "compound_on_flush"]
<|> warmerEnabled `taggedAt` ["index", "warmer", "enabled"]
<|> blocksReadOnly `taggedAt` ["blocks", "read_only"]
<|> blocksRead `taggedAt` ["blocks", "read"]
<|> blocksWrite `taggedAt` ["blocks", "write"]
<|> blocksMetaData `taggedAt` ["blocks", "metadata"]
<|> mappingTotalFieldsLimit `taggedAt` ["index", "mapping", "total_fields", "limit"]
<|> analysisSetting `taggedAt` ["index", "analysis"]
<|> unassignedNodeLeftDelayedTimeout `taggedAt` ["index", "unassigned", "node_left", "delayed_timeout"]
where
taggedAt f ks = taggedAt' f (Object o) ks
taggedAt' f v [] =
f =<< (parseJSON v <|> parseJSON (unStringlyTypeJSON v))
taggedAt' f v (k : ks) =
withObject
"Object"
( \o -> do
v' <- o .: k
taggedAt' f v' ks
)
v
numberOfReplicas = pure . NumberOfReplicas
autoExpandReplicas = pure . AutoExpandReplicas
refreshInterval = pure . RefreshInterval . ndtJSON
indexConcurrency = pure . IndexConcurrency
failOnMergeFailure = pure . FailOnMergeFailure
translogFlushThresholdOps = pure . TranslogFlushThresholdOps
translogFlushThresholdSize = pure . TranslogFlushThresholdSize
translogFlushThresholdPeriod = pure . TranslogFlushThresholdPeriod . ndtJSON
translogDisableFlush = pure . TranslogDisableFlush
cacheFilterMaxSize = pure . CacheFilterMaxSize
cacheFilterExpire = pure . CacheFilterExpire . fmap ndtJSON
gatewaySnapshotInterval = pure . GatewaySnapshotInterval . ndtJSON
routingAllocationInclude = fmap RoutingAllocationInclude . parseAttrFilter
routingAllocationExclude = fmap RoutingAllocationExclude . parseAttrFilter
routingAllocationRequire = fmap RoutingAllocationRequire . parseAttrFilter
routingAllocationEnable = pure . RoutingAllocationEnable
routingAllocationShardsPerNode = pure . RoutingAllocationShardsPerNode
recoveryInitialShards = pure . RecoveryInitialShards
gcDeletes = pure . GCDeletes . ndtJSON
ttlDisablePurge = pure . TTLDisablePurge
translogFSType = pure . TranslogFSType
compressionSetting = pure . CompressionSetting
compoundFormat = pure . IndexCompoundFormat
compoundOnFlush = pure . IndexCompoundOnFlush
warmerEnabled = pure . WarmerEnabled
blocksReadOnly = pure . BlocksReadOnly
blocksRead = pure . BlocksRead
blocksWrite = pure . BlocksWrite
blocksMetaData = pure . BlocksMetaData
mappingTotalFieldsLimit = pure . MappingTotalFieldsLimit
analysisSetting = pure . AnalysisSetting
unassignedNodeLeftDelayedTimeout = pure . UnassignedNodeLeftDelayedTimeout . ndtJSON
data ReplicaBounds
= ReplicasBounded Int Int
| ReplicasLowerBounded Int
| ReplicasUnbounded
deriving (Eq, Show)
instance ToJSON ReplicaBounds where
toJSON (ReplicasBounded a b) = String (showText a <> "-" <> showText b)
toJSON (ReplicasLowerBounded a) = String (showText a <> "-all")
toJSON ReplicasUnbounded = Bool False
instance FromJSON ReplicaBounds where
parseJSON v =
withText "ReplicaBounds" parseText v
<|> withBool "ReplicaBounds" parseBool v
where
parseText t = case T.splitOn "-" t of
[a, "all"] -> ReplicasLowerBounded <$> parseReadText a
[a, b] ->
ReplicasBounded <$> parseReadText a
<*> parseReadText b
_ -> fail ("Could not parse ReplicaBounds: " <> show t)
parseBool False = pure ReplicasUnbounded
parseBool _ = fail "ReplicasUnbounded cannot be represented with True"
data Compression
= -- | Compress with LZ4
CompressionDefault
| -- | Compress with DEFLATE. Elastic
-- <https://www.elastic.co/blog/elasticsearch-storage-the-true-story-2.0 blogs>
-- that this can reduce disk use by 15%-25%.
CompressionBest
deriving (Eq, Show, Generic)
instance ToJSON Compression where
toJSON x = case x of
CompressionDefault -> toJSON ("default" :: Text)
CompressionBest -> toJSON ("best_compression" :: Text)
instance FromJSON Compression where
parseJSON = withText "Compression" $ \t -> case t of
"default" -> return CompressionDefault
"best_compression" -> return CompressionBest
_ -> fail "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 (Eq, Show, Generic, Ord, ToJSON, FromJSON)
gigabytes :: Int -> Bytes
gigabytes n = megabytes (1000 * n)
megabytes :: Int -> Bytes
megabytes n = kilobytes (1000 * n)
kilobytes :: Int -> Bytes
kilobytes n = Bytes (1000 * n)
data FSType
= FSSimple
| FSBuffered
deriving (Eq, Show, Generic)
instance ToJSON FSType where
toJSON FSSimple = "simple"
toJSON FSBuffered = "buffered"
instance FromJSON FSType where
parseJSON = withText "FSType" parse
where
parse "simple" = pure FSSimple
parse "buffered" = pure FSBuffered
parse t = fail ("Invalid FSType: " <> show t)
data InitialShardCount
= QuorumShards
| QuorumMinus1Shards
| FullShards
| FullMinus1Shards
| ExplicitShards Int
deriving (Eq, Show, Generic)
instance FromJSON InitialShardCount where
parseJSON v =
withText "InitialShardCount" parseText v
<|> ExplicitShards <$> parseJSON v
where
parseText "quorum" = pure QuorumShards
parseText "quorum-1" = pure QuorumMinus1Shards
parseText "full" = pure FullShards
parseText "full-1" = pure FullMinus1Shards
parseText _ = mzero
instance ToJSON InitialShardCount where
toJSON QuorumShards = String "quorum"
toJSON QuorumMinus1Shards = String "quorum-1"
toJSON FullShards = String "full"
toJSON FullMinus1Shards = String "full-1"
toJSON (ExplicitShards x) = toJSON x
data NodeAttrFilter = NodeAttrFilter
{ nodeAttrFilterName :: NodeAttrName,
nodeAttrFilterValues :: NonEmpty Text
}
deriving (Eq, Ord, Show)
newtype NodeAttrName = NodeAttrName Text deriving (Eq, Ord, Show)
data CompoundFormat
= CompoundFileFormat Bool
| -- | percentage between 0 and 1 where 0 is false, 1 is true
MergeSegmentVsTotalIndex Double
deriving (Eq, Show, Generic)
instance ToJSON CompoundFormat where
toJSON (CompoundFileFormat x) = Bool x
toJSON (MergeSegmentVsTotalIndex x) = toJSON x
instance FromJSON CompoundFormat where
parseJSON v =
CompoundFileFormat <$> parseJSON v
<|> MergeSegmentVsTotalIndex <$> parseJSON v
newtype NominalDiffTimeJSON = NominalDiffTimeJSON {ndtJSON :: NominalDiffTime}
instance ToJSON NominalDiffTimeJSON where
toJSON (NominalDiffTimeJSON t) = String (showText (round t :: Integer) <> "s")
instance FromJSON NominalDiffTimeJSON where
parseJSON = withText "NominalDiffTime" parse
where
parse t = case T.takeEnd 1 t of
"s" -> NominalDiffTimeJSON . fromInteger <$> parseReadText (T.dropEnd 1 t)
_ -> fail "Invalid or missing NominalDiffTime unit (expected s)"
data IndexSettingsSummary = IndexSettingsSummary
{ sSummaryIndexName :: IndexName,
sSummaryFixedSettings :: IndexSettings,
sSummaryUpdateable :: [UpdatableIndexSetting]
}
deriving (Eq, Show)
parseSettings :: Object -> Parser [UpdatableIndexSetting]
parseSettings o = do
o' <- o .: "index"
-- slice the index object into singleton hashmaps and try to parse each
parses <- forM (HM.toList o') $ \(k, v) -> do
-- blocks are now nested into the "index" key, which is not how they're serialized
let atRoot = Object (X.singleton k v)
let atIndex = Object (X.singleton "index" atRoot)
optional (parseJSON atRoot <|> parseJSON atIndex)
return (catMaybes parses)
instance FromJSON IndexSettingsSummary where
parseJSON = withObject "IndexSettingsSummary" parse
where
parse o = case X.toList o of
[(ixn, v@(Object o'))] ->
IndexSettingsSummary (IndexName $ toText ixn)
<$> parseJSON v
<*> (fmap (filter (not . redundant)) . parseSettings =<< o' .: "settings")
_ -> fail "Expected single-key object with index name"
redundant (NumberOfReplicas _) = True
redundant _ = False
-- | 'OpenCloseIndex' is a sum type for opening and closing indices.
--
-- <http://www.elastic.co/guide/en/elasticsearch/reference/current/indices-open-close.html>
data OpenCloseIndex = OpenIndex | CloseIndex deriving (Eq, Show)
data FieldType
= GeoPointType
| GeoShapeType
| FloatType
| IntegerType
| LongType
| ShortType
| ByteType
deriving (Eq, Show)
newtype FieldDefinition = FieldDefinition
{ fieldType :: FieldType
}
deriving (Eq, 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
{ templatePatterns :: [IndexPattern],
templateSettings :: Maybe IndexSettings,
templateMappings :: Value
}
instance ToJSON IndexTemplate where
toJSON (IndexTemplate p s m) =
merge
( object
[ "index_patterns" .= p,
"mappings" .= m
]
)
(toJSON s)
where
merge (Object o1) (Object o2) = toJSON $ X.union o1 o2
merge o Null = o
merge _ _ = undefined
data MappingField = MappingField
{ mappingFieldName :: FieldName,
fieldDefinition :: FieldDefinition
}
deriving (Eq, 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 {mappingFields :: [MappingField]}
deriving (Eq, Show)
data UpsertActionMetadata
= UA_RetryOnConflict Int
| UA_Version Int
deriving (Eq, Show)
buildUpsertActionMetadata :: UpsertActionMetadata -> Pair
buildUpsertActionMetadata (UA_RetryOnConflict i) = "retry_on_conflict" .= i
buildUpsertActionMetadata (UA_Version i) = "_version" .= i
data UpsertPayload
= UpsertDoc Value
| UpsertScript Bool Script Value
deriving (Eq, Show)
data AllocationPolicy
= -- | Allows shard allocation for all shards.
AllocAll
| -- | Allows shard allocation only for primary shards.
AllocPrimaries
| -- | Allows shard allocation only for primary shards for new indices.
AllocNewPrimaries
| -- | No shard allocation is allowed
AllocNone
deriving (Eq, Show, Generic)
instance ToJSON AllocationPolicy where
toJSON AllocAll = String "all"
toJSON AllocPrimaries = String "primaries"
toJSON AllocNewPrimaries = String "new_primaries"
toJSON AllocNone = String "none"
instance FromJSON AllocationPolicy where
parseJSON = withText "AllocationPolicy" parse
where
parse "all" = pure AllocAll
parse "primaries" = pure AllocPrimaries
parse "new_primaries" = pure AllocNewPrimaries
parse "none" = pure AllocNone
parse t = fail ("Invlaid AllocationPolicy: " <> show t)
-- | 'BulkOperation' is a sum type for expressing the four kinds of bulk
-- operation index, create, delete, and update. 'BulkIndex' behaves like an
-- "upsert", 'BulkCreate' will fail if a document already exists at the DocId.
-- Consult the <http://www.elastic.co/guide/en/elasticsearch/reference/current/docs-bulk.html#docs-bulk Bulk API documentation>
-- for further explanation.
-- Warning: Bulk operations suffixed with @Auto@ rely on Elasticsearch to
-- generate the id. Often, people use auto-generated identifiers when
-- Elasticsearch is the only place that their data is stored. Do not let
-- Elasticsearch be the only place your data is stored. It does not guarantee
-- durability, and it may silently discard data.
-- This <https://github.com/elastic/elasticsearch/issues/10708 issue> is
-- discussed further on github.
data BulkOperation
= -- | Create the document, replacing it if it already exists.
BulkIndex IndexName DocId Value
| -- | Create a document with an autogenerated id.
BulkIndexAuto IndexName Value
| -- | Create a document with an autogenerated id. Use fast JSON encoding.
BulkIndexEncodingAuto IndexName Encoding
| -- | Create a document, failing if it already exists.
BulkCreate IndexName DocId Value
| -- | Create a document, failing if it already exists. Use fast JSON encoding.
BulkCreateEncoding IndexName DocId Encoding
| -- | Delete the document
BulkDelete IndexName DocId
| -- | Update the document, merging the new value with the existing one.
BulkUpdate IndexName DocId Value
| -- | Update the document if it already exists, otherwise insert it.
BulkUpsert IndexName DocId UpsertPayload [UpsertActionMetadata]
deriving (Eq, Show)
data IndexAlias = IndexAlias
{ srcIndex :: IndexName,
indexAlias :: IndexAliasName
}
deriving (Eq, Show)
data IndexAliasAction
= AddAlias IndexAlias IndexAliasCreate
| RemoveAlias IndexAlias
deriving (Eq, Show)
data IndexAliasCreate = IndexAliasCreate
{ aliasCreateRouting :: Maybe AliasRouting,
aliasCreateFilter :: Maybe Filter
}
deriving (Eq, Show)
data AliasRouting
= AllAliasRouting RoutingValue
| GranularAliasRouting (Maybe SearchAliasRouting) (Maybe IndexAliasRouting)
deriving (Eq, Show)
newtype SearchAliasRouting
= SearchAliasRouting (NonEmpty RoutingValue)
deriving (Eq, Show, Generic)
instance ToJSON SearchAliasRouting where
toJSON (SearchAliasRouting rvs) = toJSON (T.intercalate "," (routingValue <$> toList rvs))
instance FromJSON SearchAliasRouting where
parseJSON = withText "SearchAliasRouting" parse
where
parse t = SearchAliasRouting <$> parseNEJSON (String <$> T.splitOn "," t)
newtype IndexAliasRouting
= IndexAliasRouting RoutingValue
deriving (Eq, Show, Generic, ToJSON, FromJSON)
newtype RoutingValue = RoutingValue {routingValue :: Text}
deriving (Eq, Show, ToJSON, FromJSON)
newtype IndexAliasesSummary = IndexAliasesSummary {indexAliasesSummary :: [IndexAliasSummary]}
deriving (Eq, Show)
instance FromJSON IndexAliasesSummary where
parseJSON = withObject "IndexAliasesSummary" parse
where
parse o = IndexAliasesSummary . mconcat <$> mapM (uncurry go) (X.toList o)
go ixn = withObject "index aliases" $ \ia -> do
aliases <- ia .:? "aliases" .!= mempty
forM (HM.toList aliases) $ \(aName, v) -> do
let indexAlias = IndexAlias (IndexName $ toText ixn) (IndexAliasName (IndexName $ toText aName))
IndexAliasSummary indexAlias <$> parseJSON v
instance ToJSON IndexAliasAction where
toJSON (AddAlias ia opts) = object ["add" .= (iaObj <> optsObj)]
where
Object iaObj = toJSON ia
Object optsObj = toJSON opts
toJSON (RemoveAlias ia) = object ["remove" .= iaObj]
where
Object iaObj = toJSON ia
instance ToJSON IndexAlias where
toJSON IndexAlias {..} =
object
[ "index" .= srcIndex,
"alias" .= indexAlias
]
instance ToJSON IndexAliasCreate where
toJSON IndexAliasCreate {..} = Object (filterObj <> routingObj)
where
filterObj = maybe mempty (X.singleton "filter" . toJSON) aliasCreateFilter
Object routingObj = maybe (Object mempty) toJSON aliasCreateRouting
instance ToJSON AliasRouting where
toJSON (AllAliasRouting v) = object ["routing" .= v]
toJSON (GranularAliasRouting srch idx) = object (catMaybes prs)
where
prs =
[ ("search_routing" .=) <$> srch,
("index_routing" .=) <$> idx
]
instance FromJSON AliasRouting where
parseJSON = withObject "AliasRouting" parse
where
parse o = parseAll o <|> parseGranular o
parseAll o = AllAliasRouting <$> o .: "routing"
parseGranular o = do
sr <- o .:? "search_routing"
ir <- o .:? "index_routing"
if isNothing sr && isNothing ir
then fail "Both search_routing and index_routing can't be blank"
else return (GranularAliasRouting sr ir)
instance FromJSON IndexAliasCreate where
parseJSON v = withObject "IndexAliasCreate" parse v
where
parse o =
IndexAliasCreate <$> optional (parseJSON v)
<*> o .:? "filter"
-- | 'IndexAliasSummary' is a summary of an index alias configured for a server.
data IndexAliasSummary = IndexAliasSummary
{ indexAliasSummaryAlias :: IndexAlias,
indexAliasSummaryCreate :: IndexAliasCreate
}
deriving (Eq, Show)
data JoinRelation
= ParentDocument FieldName RelationName
| ChildDocument FieldName RelationName DocId
deriving (Show, 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
{ idsVersionControl :: VersionControl,
idsJoinRelation :: Maybe JoinRelation
}
deriving (Eq, Show)
-- | Reasonable default settings. Chooses no version control and no parent.
defaultIndexDocumentSettings :: IndexDocumentSettings
defaultIndexDocumentSettings = IndexDocumentSettings NoVersionControl 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 (Eq, Show)
-- | 'NodeSelection' is used for most cluster APIs. See <https://www.elastic.co/guide/en/elasticsearch/reference/current/cluster.html#cluster-nodes here> for more details.
data NodeSelection
= -- | Whatever node receives this request
LocalNode
| NodeList (NonEmpty NodeSelector)
| AllNodes
deriving (Eq, Show)
-- | An exact match or pattern to identify a node. Note that All of
-- these options support wildcarding, so your node name, server, attr
-- name can all contain * characters to be a fuzzy match.
data NodeSelector
= NodeByName NodeName
| NodeByFullNodeId FullNodeId
| -- | e.g. 10.0.0.1 or even 10.0.0.*
NodeByHost Server
| -- | NodeAttrName can be a pattern, e.g. rack*. The value can too.
NodeByAttribute NodeAttrName Text
deriving (Eq, Show)
-- | 'TemplateName' is used to describe which template to query/create/delete
newtype TemplateName = TemplateName Text deriving (Eq, Show, Generic, ToJSON, FromJSON)
-- | 'IndexPattern' represents a pattern which is matched against index names
newtype IndexPattern = IndexPattern Text deriving (Eq, Show, Generic, ToJSON, FromJSON)
-- | Username type used for HTTP Basic authentication. See 'basicAuthHook'.
newtype EsUsername = EsUsername {esUsername :: Text} deriving (Read, Show, Eq)
-- | Password type used for HTTP Basic authentication. See 'basicAuthHook'.
newtype EsPassword = EsPassword {esPassword :: Text} deriving (Read, Show, Eq)
data SnapshotRepoSelection
= SnapshotRepoList (NonEmpty SnapshotRepoPattern)
| AllSnapshotRepos
deriving (Eq, 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 (Eq, Show)
-- | The unique name of a snapshot repository.
newtype SnapshotRepoName = SnapshotRepoName {snapshotRepoName :: Text}
deriving (Eq, Ord, Show, Generic, ToJSON, 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
{ gSnapshotRepoName :: SnapshotRepoName,
gSnapshotRepoType :: SnapshotRepoType,
gSnapshotRepoSettings :: GenericSnapshotRepoSettings
}
deriving (Eq, Show)
instance SnapshotRepo GenericSnapshotRepo where
toGSnapshotRepo = id
fromGSnapshotRepo = Right
newtype SnapshotRepoType = SnapshotRepoType {snapshotRepoType :: Text}
deriving (Eq, Ord, Show, ToJSON, FromJSON)
-- | Opaque representation of snapshot repo settings. Instances of
-- 'SnapshotRepo' will produce this.
newtype GenericSnapshotRepoSettings = GenericSnapshotRepoSettings {gSnapshotRepoSettingsObject :: Object}
deriving (Eq, Show, 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 = fmap (GenericSnapshotRepoSettings . fmap unStringlyTypeJSON) . parseJSON
-- | The result of running 'verifySnapshotRepo'.
newtype SnapshotVerification = SnapshotVerification
{ snapshotNodeVerifications :: [SnapshotNodeVerification]
}
deriving (Eq, Show)
instance FromJSON SnapshotVerification where
parseJSON = withObject "SnapshotVerification" parse
where
parse o = do
o2 <- o .: "nodes"
SnapshotVerification <$> mapM (uncurry parse') (HM.toList o2)
parse' rawFullId = withObject "SnapshotNodeVerification" $ \o ->
SnapshotNodeVerification (FullNodeId rawFullId) <$> o .: "name"
-- | A node that has verified a snapshot
data SnapshotNodeVerification = SnapshotNodeVerification
{ snvFullId :: FullNodeId,
snvNodeName :: NodeName
}
deriving (Eq, Show)
-- | Unique, automatically-generated name assigned to nodes that are
-- usually returned in node-oriented APIs.
newtype FullNodeId = FullNodeId {fullNodeId :: Text}
deriving (Eq, Ord, Show, 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}
deriving (Eq, Ord, Show, FromJSON)
newtype ClusterName = ClusterName {clusterName :: Text}
deriving (Eq, Ord, Show, FromJSON)
data NodesInfo = NodesInfo
{ nodesInfo :: [NodeInfo],
nodesClusterName :: ClusterName
}
deriving (Eq, Show)
data NodesStats = NodesStats
{ nodesStats :: [NodeStats],
nodesStatsClusterName :: ClusterName
}
deriving (Eq, Show)
data NodeStats = NodeStats
{ nodeStatsName :: NodeName,
nodeStatsFullId :: FullNodeId,
nodeStatsBreakersStats :: Maybe NodeBreakersStats,
nodeStatsHTTP :: NodeHTTPStats,
nodeStatsTransport :: NodeTransportStats,
nodeStatsFS :: NodeFSStats,
nodeStatsNetwork :: Maybe NodeNetworkStats,
nodeStatsThreadPool :: Map Text NodeThreadPoolStats,
nodeStatsJVM :: NodeJVMStats,
nodeStatsProcess :: NodeProcessStats,
nodeStatsOS :: NodeOSStats,
nodeStatsIndices :: NodeIndicesStats
}
deriving (Eq, Show)
data NodeBreakersStats = NodeBreakersStats
{ nodeStatsParentBreaker :: NodeBreakerStats,
nodeStatsRequestBreaker :: NodeBreakerStats,
nodeStatsFieldDataBreaker :: NodeBreakerStats
}
deriving (Eq, Show)
data NodeBreakerStats = NodeBreakerStats
{ nodeBreakersTripped :: Int,
nodeBreakersOverhead :: Double,
nodeBreakersEstSize :: Bytes,
nodeBreakersLimitSize :: Bytes
}
deriving (Eq, Show)
data NodeHTTPStats = NodeHTTPStats
{ nodeHTTPTotalOpened :: Int,
nodeHTTPCurrentOpen :: Int
}
deriving (Eq, Show)
data NodeTransportStats = NodeTransportStats
{ nodeTransportTXSize :: Bytes,
nodeTransportCount :: Int,
nodeTransportRXSize :: Bytes,
nodeTransportRXCount :: Int,
nodeTransportServerOpen :: Int
}
deriving (Eq, Show)
data NodeFSStats = NodeFSStats
{ nodeFSDataPaths :: [NodeDataPathStats],
nodeFSTotal :: NodeFSTotalStats,
nodeFSTimestamp :: UTCTime
}
deriving (Eq, Show)
data NodeDataPathStats = NodeDataPathStats
{ nodeDataPathDiskServiceTime :: Maybe Double,
nodeDataPathDiskQueue :: Maybe Double,
nodeDataPathIOSize :: Maybe Bytes,
nodeDataPathWriteSize :: Maybe Bytes,
nodeDataPathReadSize :: Maybe Bytes,
nodeDataPathIOOps :: Maybe Int,
nodeDataPathWrites :: Maybe Int,
nodeDataPathReads :: Maybe Int,
nodeDataPathAvailable :: Bytes,
nodeDataPathFree :: Bytes,
nodeDataPathTotal :: Bytes,
nodeDataPathType :: Maybe Text,
nodeDataPathDevice :: Maybe Text,
nodeDataPathMount :: Text,
nodeDataPathPath :: Text
}
deriving (Eq, Show)
data NodeFSTotalStats = NodeFSTotalStats
{ nodeFSTotalDiskServiceTime :: Maybe Double,
nodeFSTotalDiskQueue :: Maybe Double,
nodeFSTotalIOSize :: Maybe Bytes,
nodeFSTotalWriteSize :: Maybe Bytes,
nodeFSTotalReadSize :: Maybe Bytes,
nodeFSTotalIOOps :: Maybe Int,
nodeFSTotalWrites :: Maybe Int,
nodeFSTotalReads :: Maybe Int,
nodeFSTotalAvailable :: Bytes,
nodeFSTotalFree :: Bytes,
nodeFSTotalTotal :: Bytes
}
deriving (Eq, Show)
data NodeNetworkStats = NodeNetworkStats
{ nodeNetTCPOutRSTs :: Int,
nodeNetTCPInErrs :: Int,
nodeNetTCPAttemptFails :: Int,
nodeNetTCPEstabResets :: Int,
nodeNetTCPRetransSegs :: Int,
nodeNetTCPOutSegs :: Int,
nodeNetTCPInSegs :: Int,
nodeNetTCPCurrEstab :: Int,
nodeNetTCPPassiveOpens :: Int,
nodeNetTCPActiveOpens :: Int
}
deriving (Eq, Show)
data NodeThreadPoolStats = NodeThreadPoolStats
{ nodeThreadPoolCompleted :: Int,
nodeThreadPoolLargest :: Int,
nodeThreadPoolRejected :: Int,
nodeThreadPoolActive :: Int,
nodeThreadPoolQueue :: Int,
nodeThreadPoolThreads :: Int
}
deriving (Eq, Show)
data NodeJVMStats = NodeJVMStats
{ nodeJVMStatsMappedBufferPool :: JVMBufferPoolStats,
nodeJVMStatsDirectBufferPool :: JVMBufferPoolStats,
nodeJVMStatsGCOldCollector :: JVMGCStats,
nodeJVMStatsGCYoungCollector :: JVMGCStats,
nodeJVMStatsPeakThreadsCount :: Int,
nodeJVMStatsThreadsCount :: Int,
nodeJVMStatsOldPool :: JVMPoolStats,
nodeJVMStatsSurvivorPool :: JVMPoolStats,
nodeJVMStatsYoungPool :: JVMPoolStats,
nodeJVMStatsNonHeapCommitted :: Bytes,
nodeJVMStatsNonHeapUsed :: Bytes,
nodeJVMStatsHeapMax :: Bytes,
nodeJVMStatsHeapCommitted :: Bytes,
nodeJVMStatsHeapUsedPercent :: Int,
nodeJVMStatsHeapUsed :: Bytes,
nodeJVMStatsUptime :: NominalDiffTime,
nodeJVMStatsTimestamp :: UTCTime
}
deriving (Eq, Show)
data JVMBufferPoolStats = JVMBufferPoolStats
{ jvmBufferPoolStatsTotalCapacity :: Bytes,
jvmBufferPoolStatsUsed :: Bytes,
jvmBufferPoolStatsCount :: Int
}
deriving (Eq, Show)
data JVMGCStats = JVMGCStats
{ jvmGCStatsCollectionTime :: NominalDiffTime,
jvmGCStatsCollectionCount :: Int
}
deriving (Eq, Show)
data JVMPoolStats = JVMPoolStats
{ jvmPoolStatsPeakMax :: Bytes,
jvmPoolStatsPeakUsed :: Bytes,
jvmPoolStatsMax :: Bytes,
jvmPoolStatsUsed :: Bytes
}
deriving (Eq, Show)
data NodeProcessStats = NodeProcessStats
{ nodeProcessTimestamp :: UTCTime,
nodeProcessOpenFDs :: Int,
nodeProcessMaxFDs :: Int,
nodeProcessCPUPercent :: Int,
nodeProcessCPUTotal :: NominalDiffTime,
nodeProcessMemTotalVirtual :: Bytes
}
deriving (Eq, Show)
data NodeOSStats = NodeOSStats
{ nodeOSTimestamp :: UTCTime,
nodeOSCPUPercent :: Int,
nodeOSLoad :: Maybe LoadAvgs,
nodeOSMemTotal :: Bytes,
nodeOSMemFree :: Bytes,
nodeOSMemFreePercent :: Int,
nodeOSMemUsed :: Bytes,
nodeOSMemUsedPercent :: Int,
nodeOSSwapTotal :: Bytes,
nodeOSSwapFree :: Bytes,
nodeOSSwapUsed :: Bytes
}
deriving (Eq, Show)
data LoadAvgs = LoadAvgs
{ loadAvg1Min :: Double,
loadAvg5Min :: Double,
loadAvg15Min :: Double
}
deriving (Eq, Show)
data NodeIndicesStats = NodeIndicesStats
{ nodeIndicesStatsRecoveryThrottleTime :: Maybe NominalDiffTime,
nodeIndicesStatsRecoveryCurrentAsTarget :: Maybe Int,
nodeIndicesStatsRecoveryCurrentAsSource :: Maybe Int,
nodeIndicesStatsQueryCacheMisses :: Maybe Int,
nodeIndicesStatsQueryCacheHits :: Maybe Int,
nodeIndicesStatsQueryCacheEvictions :: Maybe Int,
nodeIndicesStatsQueryCacheSize :: Maybe Bytes,
nodeIndicesStatsSuggestCurrent :: Maybe Int,
nodeIndicesStatsSuggestTime :: Maybe NominalDiffTime,
nodeIndicesStatsSuggestTotal :: Maybe Int,
nodeIndicesStatsTranslogSize :: Bytes,
nodeIndicesStatsTranslogOps :: Int,
nodeIndicesStatsSegFixedBitSetMemory :: Maybe Bytes,
nodeIndicesStatsSegVersionMapMemory :: Bytes,
nodeIndicesStatsSegIndexWriterMaxMemory :: Maybe Bytes,
nodeIndicesStatsSegIndexWriterMemory :: Bytes,
nodeIndicesStatsSegMemory :: Bytes,
nodeIndicesStatsSegCount :: Int,
nodeIndicesStatsCompletionSize :: Bytes,
nodeIndicesStatsPercolateQueries :: Maybe Int,
nodeIndicesStatsPercolateMemory :: Maybe Bytes,
nodeIndicesStatsPercolateCurrent :: Maybe Int,
nodeIndicesStatsPercolateTime :: Maybe NominalDiffTime,
nodeIndicesStatsPercolateTotal :: Maybe Int,
nodeIndicesStatsFieldDataEvictions :: Int,
nodeIndicesStatsFieldDataMemory :: Bytes,
nodeIndicesStatsWarmerTotalTime :: NominalDiffTime,
nodeIndicesStatsWarmerTotal :: Int,
nodeIndicesStatsWarmerCurrent :: Int,
nodeIndicesStatsFlushTotalTime :: NominalDiffTime,
nodeIndicesStatsFlushTotal :: Int,
nodeIndicesStatsRefreshTotalTime :: NominalDiffTime,
nodeIndicesStatsRefreshTotal :: Int,
nodeIndicesStatsMergesTotalSize :: Bytes,
nodeIndicesStatsMergesTotalDocs :: Int,
nodeIndicesStatsMergesTotalTime :: NominalDiffTime,
nodeIndicesStatsMergesTotal :: Int,
nodeIndicesStatsMergesCurrentSize :: Bytes,
nodeIndicesStatsMergesCurrentDocs :: Int,
nodeIndicesStatsMergesCurrent :: Int,
nodeIndicesStatsSearchFetchCurrent :: Int,
nodeIndicesStatsSearchFetchTime :: NominalDiffTime,
nodeIndicesStatsSearchFetchTotal :: Int,
nodeIndicesStatsSearchQueryCurrent :: Int,
nodeIndicesStatsSearchQueryTime :: NominalDiffTime,
nodeIndicesStatsSearchQueryTotal :: Int,
nodeIndicesStatsSearchOpenContexts :: Int,
nodeIndicesStatsGetCurrent :: Int,
nodeIndicesStatsGetMissingTime :: NominalDiffTime,
nodeIndicesStatsGetMissingTotal :: Int,
nodeIndicesStatsGetExistsTime :: NominalDiffTime,
nodeIndicesStatsGetExistsTotal :: Int,
nodeIndicesStatsGetTime :: NominalDiffTime,
nodeIndicesStatsGetTotal :: Int,
nodeIndicesStatsIndexingThrottleTime :: Maybe NominalDiffTime,
nodeIndicesStatsIndexingIsThrottled :: Maybe Bool,
nodeIndicesStatsIndexingNoopUpdateTotal :: Maybe Int,
nodeIndicesStatsIndexingDeleteCurrent :: Int,
nodeIndicesStatsIndexingDeleteTime :: NominalDiffTime,
nodeIndicesStatsIndexingDeleteTotal :: Int,
nodeIndicesStatsIndexingIndexCurrent :: Int,
nodeIndicesStatsIndexingIndexTime :: NominalDiffTime,
nodeIndicesStatsIndexingTotal :: Int,
nodeIndicesStatsStoreThrottleTime :: Maybe NominalDiffTime,
nodeIndicesStatsStoreSize :: Bytes,
nodeIndicesStatsDocsDeleted :: Int,
nodeIndicesStatsDocsCount :: Int
}
deriving (Eq, 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}
deriving (Eq, Ord, Show, FromJSON)
-- | Typically a 7 character hex string.
newtype BuildHash = BuildHash {buildHash :: Text}
deriving (Eq, Ord, Show, Generic, FromJSON, ToJSON)
newtype PluginName = PluginName {pluginName :: Text}
deriving (Eq, Ord, Show, FromJSON)
data NodeInfo = NodeInfo
{ nodeInfoHTTPAddress :: Maybe EsAddress,
nodeInfoBuild :: BuildHash,
nodeInfoESVersion :: VersionNumber,
nodeInfoIP :: Server,
nodeInfoHost :: Server,
nodeInfoTransportAddress :: EsAddress,
nodeInfoName :: NodeName,
nodeInfoFullId :: FullNodeId,
nodeInfoPlugins :: [NodePluginInfo],
nodeInfoHTTP :: NodeHTTPInfo,
nodeInfoTransport :: NodeTransportInfo,
nodeInfoNetwork :: Maybe NodeNetworkInfo,
nodeInfoThreadPool :: Map Text NodeThreadPoolInfo,
nodeInfoJVM :: NodeJVMInfo,
nodeInfoProcess :: NodeProcessInfo,
nodeInfoOS :: NodeOSInfo,
-- | The members of the settings objects are not consistent,
-- dependent on plugins, etc.
nodeInfoSettings :: Object
}
deriving (Eq, Show)
data NodePluginInfo = NodePluginInfo
{ -- | Is this a site plugin?
nodePluginSite :: Maybe Bool,
-- | Is this plugin running on the JVM
nodePluginJVM :: Maybe Bool,
nodePluginDescription :: Text,
nodePluginVersion :: MaybeNA VersionNumber,
nodePluginName :: PluginName
}
deriving (Eq, Show)
data NodeHTTPInfo = NodeHTTPInfo
{ nodeHTTPMaxContentLength :: Bytes,
nodeHTTPpublishAddress :: EsAddress,
nodeHTTPbound_address :: [EsAddress]
}
deriving (Eq, Show)
data NodeTransportInfo = NodeTransportInfo
{ nodeTransportProfiles :: [BoundTransportAddress],
nodeTransportPublishAddress :: EsAddress,
nodeTransportBoundAddress :: [EsAddress]
}
deriving (Eq, Show)
data BoundTransportAddress = BoundTransportAddress
{ publishAddress :: EsAddress,
boundAddress :: [EsAddress]
}
deriving (Eq, Show)
data NodeNetworkInfo = NodeNetworkInfo
{ nodeNetworkPrimaryInterface :: NodeNetworkInterface,
nodeNetworkRefreshInterval :: NominalDiffTime
}
deriving (Eq, Show)
newtype MacAddress = MacAddress {macAddress :: Text}
deriving (Eq, Ord, Show, FromJSON)
newtype NetworkInterfaceName = NetworkInterfaceName {networkInterfaceName :: Text}
deriving (Eq, Ord, Show, FromJSON)
data NodeNetworkInterface = NodeNetworkInterface
{ nodeNetIfaceMacAddress :: MacAddress,
nodeNetIfaceName :: NetworkInterfaceName,
nodeNetIfaceAddress :: Server
}
deriving (Eq, Show)
data ThreadPool = ThreadPool
{ nodeThreadPoolName :: Text,
nodeThreadPoolInfo :: NodeThreadPoolInfo
}
deriving (Eq, Show)
data NodeThreadPoolInfo = NodeThreadPoolInfo
{ nodeThreadPoolQueueSize :: ThreadPoolSize,
nodeThreadPoolKeepalive :: Maybe NominalDiffTime,
nodeThreadPoolMin :: Maybe Int,
nodeThreadPoolMax :: Maybe Int,
nodeThreadPoolType :: ThreadPoolType
}
deriving (Eq, Show)
data ThreadPoolSize
= ThreadPoolBounded Int
| ThreadPoolUnbounded
deriving (Eq, Show)
data ThreadPoolType
= ThreadPoolScaling
| ThreadPoolFixed
| ThreadPoolCached
| ThreadPoolFixedAutoQueueSize
deriving (Eq, Show)
data NodeJVMInfo = NodeJVMInfo
{ nodeJVMInfoMemoryPools :: [JVMMemoryPool],
nodeJVMInfoMemoryPoolsGCCollectors :: [JVMGCCollector],
nodeJVMInfoMemoryInfo :: JVMMemoryInfo,
nodeJVMInfoStartTime :: UTCTime,
nodeJVMInfoVMVendor :: Text,
-- | JVM doesn't seme to follow normal version conventions
nodeJVMVMVersion :: VMVersion,
nodeJVMVMName :: Text,
nodeJVMVersion :: JVMVersion,
nodeJVMPID :: PID
}
deriving (Eq, Show)
-- | We cannot parse JVM version numbers and we're not going to try.
newtype JVMVersion = JVMVersion {unJVMVersion :: Text}
deriving (Eq, Show)
instance FromJSON JVMVersion where
parseJSON = withText "JVMVersion" (pure . JVMVersion)
data JVMMemoryInfo = JVMMemoryInfo
{ jvmMemoryInfoDirectMax :: Bytes,
jvmMemoryInfoNonHeapMax :: Bytes,
jvmMemoryInfoNonHeapInit :: Bytes,
jvmMemoryInfoHeapMax :: Bytes,
jvmMemoryInfoHeapInit :: Bytes
}
deriving (Eq, Show)
-- VM version numbers don't appear to be SemVer
-- so we're special casing this jawn.
newtype VMVersion = VMVersion {unVMVersion :: Text}
deriving (Eq, Show)
instance ToJSON VMVersion where
toJSON = toJSON . unVMVersion
instance FromJSON VMVersion where
parseJSON = withText "VMVersion" (pure . VMVersion)
newtype JVMMemoryPool = JVMMemoryPool
{ jvmMemoryPool :: Text
}
deriving (Eq, Show, FromJSON)
newtype JVMGCCollector = JVMGCCollector
{ jvmGCCollector :: Text
}
deriving (Eq, Show, FromJSON)
newtype PID = PID
{ pid :: Int
}
deriving (Eq, Show, FromJSON)
data NodeOSInfo = NodeOSInfo
{ nodeOSRefreshInterval :: NominalDiffTime,
nodeOSName :: Text,
nodeOSArch :: Text,
nodeOSVersion :: Text, -- semver breaks on "5.10.60.1-microsoft-standard-WSL2"
nodeOSAvailableProcessors :: Int,
nodeOSAllocatedProcessors :: Int
}
deriving (Eq, Show)
data CPUInfo = CPUInfo
{ cpuCacheSize :: Bytes,
cpuCoresPerSocket :: Int,
cpuTotalSockets :: Int,
cpuTotalCores :: Int,
cpuMHZ :: Int,
cpuModel :: Text,
cpuVendor :: Text
}
deriving (Eq, Show)
data NodeProcessInfo = NodeProcessInfo
{ -- | See <https://www.elastic.co/guide/en/elasticsearch/reference/current/setup-configuration.html>
nodeProcessMLockAll :: Bool,
nodeProcessMaxFileDescriptors :: Maybe Int,
nodeProcessId :: PID,
nodeProcessRefreshInterval :: NominalDiffTime
}
deriving (Eq, Show)
data ShardResult = ShardResult
{ shardTotal :: Int,
shardsSuccessful :: Int,
shardsSkipped :: Int,
shardsFailed :: Int
}
deriving (Eq, Show)
instance FromJSON ShardResult where
parseJSON =
withObject "ShardResult" $ \v ->
ShardResult
<$> v .:? "total" .!= 0
<*> v .:? "successful" .!= 0
<*> v .:? "skipped" .!= 0
<*> v .:? "failed" .!= 0
data SnapshotState
= SnapshotInit
| SnapshotStarted
| SnapshotSuccess
| SnapshotFailed
| SnapshotAborted
| SnapshotMissing
| SnapshotWaiting
deriving (Eq, Show)
instance FromJSON SnapshotState where
parseJSON = withText "SnapshotState" parse
where
parse "INIT" = return SnapshotInit
parse "STARTED" = return SnapshotStarted
parse "SUCCESS" = return SnapshotSuccess
parse "FAILED" = return SnapshotFailed
parse "ABORTED" = return SnapshotAborted
parse "MISSING" = return SnapshotMissing
parse "WAITING" = return SnapshotWaiting
parse t = fail ("Invalid snapshot state " <> T.unpack t)
data SnapshotRestoreSettings = SnapshotRestoreSettings
{ -- | Should the API call return immediately after initializing
-- the restore or wait until completed? Note that if this is
-- enabled, it could wait a long time, so you should adjust your
-- 'ManagerSettings' accordingly to set long timeouts or
-- explicitly handle timeouts.
snapRestoreWaitForCompletion :: Bool,
-- | Nothing will restore all indices in the snapshot. Just [] is
-- permissable and will essentially be a no-op restore.
snapRestoreIndices :: Maybe IndexSelection,
-- | If set to True, any indices that do not exist will be ignored
-- during snapshot rather than failing the restore.
snapRestoreIgnoreUnavailable :: Bool,
-- | If set to false, will ignore any global state in the snapshot
-- and will not restore it.
snapRestoreIncludeGlobalState :: Bool,
-- | A regex pattern for matching indices. Used with
-- 'snapRestoreRenameReplacement', the restore can reference the
-- matched index and create a new index name upon restore.
snapRestoreRenamePattern :: Maybe RestoreRenamePattern,
-- | Expression of how index renames should be constructed.
snapRestoreRenameReplacement :: Maybe (NonEmpty RestoreRenameToken),
-- | If some indices fail to restore, should the process proceed?
snapRestorePartial :: Bool,
-- | Should the restore also restore the aliases captured in the
-- snapshot.
snapRestoreIncludeAliases :: Bool,
-- | Settings to apply during the restore process. __NOTE:__ This
-- option is not supported in ES < 1.5 and should be set to
-- Nothing in that case.
snapRestoreIndexSettingsOverrides :: Maybe RestoreIndexSettings,
-- | This type could be more rich but it isn't clear which
-- settings are allowed to be ignored during restore, so we're
-- going with including this feature in a basic form rather than
-- omitting it. One example here would be
-- "index.refresh_interval". Any setting specified here will
-- revert back to the server default during the restore process.
snapRestoreIgnoreIndexSettings :: Maybe (NonEmpty Text)
}
deriving (Eq, Show)
newtype SnapshotRepoUpdateSettings = SnapshotRepoUpdateSettings
{ -- | After creation/update, synchronously check that nodes can
-- write to this repo. Defaults to True. You may use False if you
-- need a faster response and plan on verifying manually later
-- with 'verifySnapshotRepo'.
repoUpdateVerify :: Bool
}
deriving (Eq, Show)
-- | Reasonable defaults for repo creation/update
--
-- * repoUpdateVerify True
defaultSnapshotRepoUpdateSettings :: SnapshotRepoUpdateSettings
defaultSnapshotRepoUpdateSettings = SnapshotRepoUpdateSettings True
-- | A filesystem-based snapshot repo that ships with
-- Elasticsearch. This is an instance of 'SnapshotRepo' so it can be
-- used with 'updateSnapshotRepo'
data FsSnapshotRepo = FsSnapshotRepo
{ fsrName :: SnapshotRepoName,
fsrLocation :: FilePath,
fsrCompressMetadata :: Bool,
-- | Size by which to split large files during snapshotting.
fsrChunkSize :: Maybe Bytes,
-- | Throttle node restore rate. If not supplied, defaults to 40mb/sec
fsrMaxRestoreBytesPerSec :: Maybe Bytes,
-- | Throttle node snapshot rate. If not supplied, defaults to 40mb/sec
fsrMaxSnapshotBytesPerSec :: Maybe Bytes
}
deriving (Eq, Show, Generic)
instance SnapshotRepo FsSnapshotRepo where
toGSnapshotRepo FsSnapshotRepo {..} =
GenericSnapshotRepo fsrName fsRepoType (GenericSnapshotRepoSettings settings)
where
Object settings =
object $
[ "location" .= fsrLocation,
"compress" .= fsrCompressMetadata
]
++ optionalPairs
optionalPairs =
catMaybes
[ ("chunk_size" .=) <$> fsrChunkSize,
("max_restore_bytes_per_sec" .=) <$> fsrMaxRestoreBytesPerSec,
("max_snapshot_bytes_per_sec" .=) <$> fsrMaxSnapshotBytesPerSec
]
fromGSnapshotRepo GenericSnapshotRepo {..}
| gSnapshotRepoType == fsRepoType = do
let o = gSnapshotRepoSettingsObject gSnapshotRepoSettings
parseRepo $
FsSnapshotRepo gSnapshotRepoName <$> o .: "location"
<*> o .:? "compress" .!= False
<*> o .:? "chunk_size"
<*> o .:? "max_restore_bytes_per_sec"
<*> o .:? "max_snapshot_bytes_per_sec"
| otherwise = Left (RepoTypeMismatch fsRepoType gSnapshotRepoType)
parseRepo :: Parser a -> Either SnapshotRepoConversionError a
parseRepo parser = case parseEither (const parser) () of
Left e -> Left (OtherRepoConversionError (T.pack e))
Right a -> Right a
fsRepoType :: SnapshotRepoType
fsRepoType = SnapshotRepoType "fs"
-- | Law: fromGSnapshotRepo (toGSnapshotRepo r) == Right r
class SnapshotRepo r where
toGSnapshotRepo :: r -> GenericSnapshotRepo
fromGSnapshotRepo :: GenericSnapshotRepo -> Either SnapshotRepoConversionError r
data SnapshotRepoConversionError
= -- | Expected type and actual type
RepoTypeMismatch SnapshotRepoType SnapshotRepoType
| OtherRepoConversionError Text
deriving (Show, Eq)
instance Exception SnapshotRepoConversionError
data SnapshotCreateSettings = SnapshotCreateSettings
{ -- | Should the API call return immediately after initializing
-- the snapshot or wait until completed? Note that if this is
-- enabled it could wait a long time, so you should adjust your
-- 'ManagerSettings' accordingly to set long timeouts or
-- explicitly handle timeouts.
snapWaitForCompletion :: Bool,
-- | Nothing will snapshot all indices. Just [] is permissable and
-- will essentially be a no-op snapshot.
snapIndices :: Maybe IndexSelection,
-- | If set to True, any matched indices that don't exist will be
-- ignored. Otherwise it will be an error and fail.
snapIgnoreUnavailable :: Bool,
snapIncludeGlobalState :: Bool,
-- | If some indices failed to snapshot (e.g. if not all primary
-- shards are available), should the process proceed?
snapPartial :: Bool
}
deriving (Eq, Show)
-- | Reasonable defaults for snapshot creation
--
-- * snapWaitForCompletion False
-- * snapIndices Nothing
-- * snapIgnoreUnavailable False
-- * snapIncludeGlobalState True
-- * snapPartial False
defaultSnapshotCreateSettings :: SnapshotCreateSettings
defaultSnapshotCreateSettings =
SnapshotCreateSettings
{ snapWaitForCompletion = False,
snapIndices = Nothing,
snapIgnoreUnavailable = False,
snapIncludeGlobalState = True,
snapPartial = False
}
data SnapshotSelection
= SnapshotList (NonEmpty SnapshotPattern)
| AllSnapshots
deriving (Eq, Show)
-- | Either specifies an exact snapshot name or one with globs in it,
-- e.g. @SnapPattern "foo*"@ __NOTE__: Patterns are not supported on
-- ES < 1.7
data SnapshotPattern
= ExactSnap SnapshotName
| SnapPattern Text
deriving (Eq, Show)
-- | General information about the state of a snapshot. Has some
-- redundancies with 'SnapshotStatus'
data SnapshotInfo = SnapshotInfo
{ snapInfoShards :: ShardResult,
snapInfoFailures :: [SnapshotShardFailure],
snapInfoDuration :: NominalDiffTime,
snapInfoEndTime :: UTCTime,
snapInfoStartTime :: UTCTime,
snapInfoState :: SnapshotState,
snapInfoIndices :: [IndexName],
snapInfoName :: SnapshotName
}
deriving (Eq, Show)
instance FromJSON SnapshotInfo where
parseJSON = withObject "SnapshotInfo" parse
where
parse o =
SnapshotInfo <$> o .: "shards"
<*> o .: "failures"
<*> (unMS <$> o .: "duration_in_millis")
<*> (posixMS <$> o .: "end_time_in_millis")
<*> (posixMS <$> o .: "start_time_in_millis")
<*> o .: "state"
<*> o .: "indices"
<*> o .: "snapshot"
data SnapshotShardFailure = SnapshotShardFailure
{ snapShardFailureIndex :: IndexName,
snapShardFailureNodeId :: Maybe NodeName, -- I'm not 100% sure this isn't actually 'FullNodeId'
snapShardFailureReason :: Text,
snapShardFailureShardId :: ShardId
}
deriving (Eq, Show)
instance FromJSON SnapshotShardFailure where
parseJSON = withObject "SnapshotShardFailure" parse
where
parse o =
SnapshotShardFailure <$> o .: "index"
<*> o .:? "node_id"
<*> o .: "reason"
<*> o .: "shard_id"
-- | Regex-stype pattern, e.g. "index_(.+)" to match index names
newtype RestoreRenamePattern = RestoreRenamePattern {rrPattern :: Text}
deriving (Eq, Show, Ord, ToJSON)
-- | A single token in a index renaming scheme for a restore. These
-- are concatenated into a string before being sent to
-- Elasticsearch. Check out these Java
-- <https://docs.oracle.com/javase/7/docs/api/java/util/regex/Matcher.html docs> to find out more if you're into that sort of thing.
data RestoreRenameToken
= -- | Just a literal string of characters
RRTLit Text
| -- | Equivalent to $0. The entire matched pattern, not any subgroup
RRSubWholeMatch
| -- | A specific reference to a group number
RRSubGroup RRGroupRefNum
deriving (Eq, Show)
-- | A group number for regex matching. Only values from 1-9 are
-- supported. Construct with 'mkRRGroupRefNum'
newtype RRGroupRefNum = RRGroupRefNum {rrGroupRefNum :: Int}
deriving (Eq, Ord, Show)
instance Bounded RRGroupRefNum where
minBound = RRGroupRefNum 1
maxBound = RRGroupRefNum 9
-- | Only allows valid group number references (1-9).
mkRRGroupRefNum :: Int -> Maybe RRGroupRefNum
mkRRGroupRefNum i
| i >= rrGroupRefNum minBound
&& i <= rrGroupRefNum maxBound =
Just $ RRGroupRefNum i
| otherwise = Nothing
-- | Reasonable defaults for snapshot restores
--
-- * snapRestoreWaitForCompletion False
-- * snapRestoreIndices Nothing
-- * snapRestoreIgnoreUnavailable False
-- * snapRestoreIncludeGlobalState True
-- * snapRestoreRenamePattern Nothing
-- * snapRestoreRenameReplacement Nothing
-- * snapRestorePartial False
-- * snapRestoreIncludeAliases True
-- * snapRestoreIndexSettingsOverrides Nothing
-- * snapRestoreIgnoreIndexSettings Nothing
defaultSnapshotRestoreSettings :: SnapshotRestoreSettings
defaultSnapshotRestoreSettings =
SnapshotRestoreSettings
{ snapRestoreWaitForCompletion = False,
snapRestoreIndices = Nothing,
snapRestoreIgnoreUnavailable = False,
snapRestoreIncludeGlobalState = True,
snapRestoreRenamePattern = Nothing,
snapRestoreRenameReplacement = Nothing,
snapRestorePartial = False,
snapRestoreIncludeAliases = True,
snapRestoreIndexSettingsOverrides = Nothing,
snapRestoreIgnoreIndexSettings = Nothing
}
-- | Index settings that can be overridden. The docs only mention you
-- can update number of replicas, but there may be more. You
-- definitely cannot override shard count.
newtype RestoreIndexSettings = RestoreIndexSettings
{ restoreOverrideReplicas :: Maybe ReplicaCount
}
deriving (Eq, Show)
instance ToJSON RestoreIndexSettings where
toJSON RestoreIndexSettings {..} = object prs
where
prs = catMaybes [("index.number_of_replicas" .=) <$> restoreOverrideReplicas]
instance FromJSON NodesInfo where
parseJSON = withObject "NodesInfo" parse
where
parse o = do
nodes <- o .: "nodes"
infos <- forM (HM.toList nodes) $ \(fullNID, v) -> do
node <- parseJSON v
parseNodeInfo (FullNodeId fullNID) node
cn <- o .: "cluster_name"
return (NodesInfo infos cn)
instance FromJSON NodesStats where
parseJSON = withObject "NodesStats" parse
where
parse o = do
nodes <- o .: "nodes"
stats <- forM (HM.toList nodes) $ \(fullNID, v) -> do
node <- parseJSON v
parseNodeStats (FullNodeId fullNID) node
cn <- o .: "cluster_name"
return (NodesStats stats cn)
instance FromJSON NodeBreakerStats where
parseJSON = withObject "NodeBreakerStats" parse
where
parse o =
NodeBreakerStats <$> o .: "tripped"
<*> o .: "overhead"
<*> o .: "estimated_size_in_bytes"
<*> o .: "limit_size_in_bytes"
instance FromJSON NodeHTTPStats where
parseJSON = withObject "NodeHTTPStats" parse
where
parse o =
NodeHTTPStats <$> o .: "total_opened"
<*> o .: "current_open"
instance FromJSON NodeTransportStats where
parseJSON = withObject "NodeTransportStats" parse
where
parse o =
NodeTransportStats <$> o .: "tx_size_in_bytes"
<*> o .: "tx_count"
<*> o .: "rx_size_in_bytes"
<*> o .: "rx_count"
<*> o .: "server_open"
instance FromJSON NodeFSStats where
parseJSON = withObject "NodeFSStats" parse
where
parse o =
NodeFSStats <$> o .: "data"
<*> o .: "total"
<*> (posixMS <$> o .: "timestamp")
instance FromJSON NodeDataPathStats where
parseJSON = withObject "NodeDataPathStats" parse
where
parse o =
NodeDataPathStats <$> (fmap unStringlyTypedDouble <$> o .:? "disk_service_time")
<*> (fmap unStringlyTypedDouble <$> o .:? "disk_queue")
<*> o .:? "disk_io_size_in_bytes"
<*> o .:? "disk_write_size_in_bytes"
<*> o .:? "disk_read_size_in_bytes"
<*> o .:? "disk_io_op"
<*> o .:? "disk_writes"
<*> o .:? "disk_reads"
<*> o .: "available_in_bytes"
<*> o .: "free_in_bytes"
<*> o .: "total_in_bytes"
<*> o .:? "type"
<*> o .:? "dev"
<*> o .: "mount"
<*> o .: "path"
instance FromJSON NodeFSTotalStats where
parseJSON = withObject "NodeFSTotalStats" parse
where
parse o =
NodeFSTotalStats <$> (fmap unStringlyTypedDouble <$> o .:? "disk_service_time")
<*> (fmap unStringlyTypedDouble <$> o .:? "disk_queue")
<*> o .:? "disk_io_size_in_bytes"
<*> o .:? "disk_write_size_in_bytes"
<*> o .:? "disk_read_size_in_bytes"
<*> o .:? "disk_io_op"
<*> o .:? "disk_writes"
<*> o .:? "disk_reads"
<*> o .: "available_in_bytes"
<*> o .: "free_in_bytes"
<*> o .: "total_in_bytes"
instance FromJSON NodeNetworkStats where
parseJSON = withObject "NodeNetworkStats" parse
where
parse o = do
tcp <- o .: "tcp"
NodeNetworkStats <$> tcp .: "out_rsts"
<*> tcp .: "in_errs"
<*> tcp .: "attempt_fails"
<*> tcp .: "estab_resets"
<*> tcp .: "retrans_segs"
<*> tcp .: "out_segs"
<*> tcp .: "in_segs"
<*> tcp .: "curr_estab"
<*> tcp .: "passive_opens"
<*> tcp .: "active_opens"
instance FromJSON NodeThreadPoolStats where
parseJSON = withObject "NodeThreadPoolStats" parse
where
parse o =
NodeThreadPoolStats <$> o .: "completed"
<*> o .: "largest"
<*> o .: "rejected"
<*> o .: "active"
<*> o .: "queue"
<*> o .: "threads"
instance FromJSON NodeJVMStats where
parseJSON = withObject "NodeJVMStats" parse
where
parse o = do
bufferPools <- o .: "buffer_pools"
mapped <- bufferPools .: "mapped"
direct <- bufferPools .: "direct"
gc <- o .: "gc"
collectors <- gc .: "collectors"
oldC <- collectors .: "old"
youngC <- collectors .: "young"
threads <- o .: "threads"
mem <- o .: "mem"
pools <- mem .: "pools"
oldM <- pools .: "old"
survivorM <- pools .: "survivor"
youngM <- pools .: "young"
NodeJVMStats <$> pure mapped
<*> pure direct
<*> pure oldC
<*> pure youngC
<*> threads .: "peak_count"
<*> threads .: "count"
<*> pure oldM
<*> pure survivorM
<*> pure youngM
<*> mem .: "non_heap_committed_in_bytes"
<*> mem .: "non_heap_used_in_bytes"
<*> mem .: "heap_max_in_bytes"
<*> mem .: "heap_committed_in_bytes"
<*> mem .: "heap_used_percent"
<*> mem .: "heap_used_in_bytes"
<*> (unMS <$> o .: "uptime_in_millis")
<*> (posixMS <$> o .: "timestamp")
instance FromJSON JVMBufferPoolStats where
parseJSON = withObject "JVMBufferPoolStats" parse
where
parse o =
JVMBufferPoolStats <$> o .: "total_capacity_in_bytes"
<*> o .: "used_in_bytes"
<*> o .: "count"
instance FromJSON JVMGCStats where
parseJSON = withObject "JVMGCStats" parse
where
parse o =
JVMGCStats <$> (unMS <$> o .: "collection_time_in_millis")
<*> o .: "collection_count"
instance FromJSON JVMPoolStats where
parseJSON = withObject "JVMPoolStats" parse
where
parse o =
JVMPoolStats <$> o .: "peak_max_in_bytes"
<*> o .: "peak_used_in_bytes"
<*> o .: "max_in_bytes"
<*> o .: "used_in_bytes"
instance FromJSON NodeProcessStats where
parseJSON = withObject "NodeProcessStats" parse
where
parse o = do
mem <- o .: "mem"
cpu <- o .: "cpu"
NodeProcessStats <$> (posixMS <$> o .: "timestamp")
<*> o .: "open_file_descriptors"
<*> o .: "max_file_descriptors"
<*> cpu .: "percent"
<*> (unMS <$> cpu .: "total_in_millis")
<*> mem .: "total_virtual_in_bytes"
instance FromJSON NodeOSStats where
parseJSON = withObject "NodeOSStats" parse
where
parse o = do
swap <- o .: "swap"
mem <- o .: "mem"
cpu <- o .: "cpu"
load <- o .:? "load_average"
NodeOSStats <$> (posixMS <$> o .: "timestamp")
<*> cpu .: "percent"
<*> pure load
<*> mem .: "total_in_bytes"
<*> mem .: "free_in_bytes"
<*> mem .: "free_percent"
<*> mem .: "used_in_bytes"
<*> mem .: "used_percent"
<*> swap .: "total_in_bytes"
<*> swap .: "free_in_bytes"
<*> swap .: "used_in_bytes"
instance FromJSON LoadAvgs where
parseJSON = withArray "LoadAvgs" parse
where
parse v = case V.toList v of
[one, five, fifteen] ->
LoadAvgs <$> parseJSON one
<*> parseJSON five
<*> parseJSON fifteen
_ -> fail "Expecting a triple of Doubles"
instance FromJSON NodeIndicesStats where
parseJSON = withObject "NodeIndicesStats" parse
where
parse o = do
let (.::) mv k = case mv of
Just v -> Just <$> v .: k
Nothing -> pure Nothing
mRecovery <- o .:? "recovery"
mQueryCache <- o .:? "query_cache"
mSuggest <- o .:? "suggest"
translog <- o .: "translog"
segments <- o .: "segments"
completion <- o .: "completion"
mPercolate <- o .:? "percolate"
fielddata <- o .: "fielddata"
warmer <- o .: "warmer"
flush <- o .: "flush"
refresh <- o .: "refresh"
merges <- o .: "merges"
search <- o .: "search"
getStats <- o .: "get"
indexing <- o .: "indexing"
store <- o .: "store"
docs <- o .: "docs"
NodeIndicesStats <$> (fmap unMS <$> mRecovery .:: "throttle_time_in_millis")
<*> mRecovery .:: "current_as_target"
<*> mRecovery .:: "current_as_source"
<*> mQueryCache .:: "miss_count"
<*> mQueryCache .:: "hit_count"
<*> mQueryCache .:: "evictions"
<*> mQueryCache .:: "memory_size_in_bytes"
<*> mSuggest .:: "current"
<*> (fmap unMS <$> mSuggest .:: "time_in_millis")
<*> mSuggest .:: "total"
<*> translog .: "size_in_bytes"
<*> translog .: "operations"
<*> segments .:? "fixed_bit_set_memory_in_bytes"
<*> segments .: "version_map_memory_in_bytes"
<*> segments .:? "index_writer_max_memory_in_bytes"
<*> segments .: "index_writer_memory_in_bytes"
<*> segments .: "memory_in_bytes"
<*> segments .: "count"
<*> completion .: "size_in_bytes"
<*> mPercolate .:: "queries"
<*> mPercolate .:: "memory_size_in_bytes"
<*> mPercolate .:: "current"
<*> (fmap unMS <$> mPercolate .:: "time_in_millis")
<*> mPercolate .:: "total"
<*> fielddata .: "evictions"
<*> fielddata .: "memory_size_in_bytes"
<*> (unMS <$> warmer .: "total_time_in_millis")
<*> warmer .: "total"
<*> warmer .: "current"
<*> (unMS <$> flush .: "total_time_in_millis")
<*> flush .: "total"
<*> (unMS <$> refresh .: "total_time_in_millis")
<*> refresh .: "total"
<*> merges .: "total_size_in_bytes"
<*> merges .: "total_docs"
<*> (unMS <$> merges .: "total_time_in_millis")
<*> merges .: "total"
<*> merges .: "current_size_in_bytes"
<*> merges .: "current_docs"
<*> merges .: "current"
<*> search .: "fetch_current"
<*> (unMS <$> search .: "fetch_time_in_millis")
<*> search .: "fetch_total"
<*> search .: "query_current"
<*> (unMS <$> search .: "query_time_in_millis")
<*> search .: "query_total"
<*> search .: "open_contexts"
<*> getStats .: "current"
<*> (unMS <$> getStats .: "missing_time_in_millis")
<*> getStats .: "missing_total"
<*> (unMS <$> getStats .: "exists_time_in_millis")
<*> getStats .: "exists_total"
<*> (unMS <$> getStats .: "time_in_millis")
<*> getStats .: "total"
<*> (fmap unMS <$> indexing .:? "throttle_time_in_millis")
<*> indexing .:? "is_throttled"
<*> indexing .:? "noop_update_total"
<*> indexing .: "delete_current"
<*> (unMS <$> indexing .: "delete_time_in_millis")
<*> indexing .: "delete_total"
<*> indexing .: "index_current"
<*> (unMS <$> indexing .: "index_time_in_millis")
<*> indexing .: "index_total"
<*> (fmap unMS <$> store .:? "throttle_time_in_millis")
<*> store .: "size_in_bytes"
<*> docs .: "deleted"
<*> docs .: "count"
instance FromJSON NodeBreakersStats where
parseJSON = withObject "NodeBreakersStats" parse
where
parse o =
NodeBreakersStats <$> o .: "parent"
<*> o .: "request"
<*> o .: "fielddata"
parseNodeStats :: FullNodeId -> Object -> Parser NodeStats
parseNodeStats fnid o =
NodeStats <$> o .: "name"
<*> pure fnid
<*> o .:? "breakers"
<*> o .: "http"
<*> o .: "transport"
<*> o .: "fs"
<*> o .:? "network"
<*> o .: "thread_pool"
<*> o .: "jvm"
<*> o .: "process"
<*> o .: "os"
<*> o .: "indices"
parseNodeInfo :: FullNodeId -> Object -> Parser NodeInfo
parseNodeInfo nid o =
NodeInfo <$> o .:? "http_address"
<*> o .: "build_hash"
<*> o .: "version"
<*> o .: "ip"
<*> o .: "host"
<*> o .: "transport_address"
<*> o .: "name"
<*> pure nid
<*> o .: "plugins"
<*> o .: "http"
<*> o .: "transport"
<*> o .:? "network"
<*> o .: "thread_pool"
<*> o .: "jvm"
<*> o .: "process"
<*> o .: "os"
<*> o .: "settings"
instance FromJSON NodePluginInfo where
parseJSON = withObject "NodePluginInfo" parse
where
parse o =
NodePluginInfo <$> o .:? "site"
<*> o .:? "jvm"
<*> o .: "description"
<*> o .: "version"
<*> o .: "name"
instance FromJSON NodeHTTPInfo where
parseJSON = withObject "NodeHTTPInfo" parse
where
parse o =
NodeHTTPInfo <$> o .: "max_content_length_in_bytes"
<*> o .: "publish_address"
<*> o .: "bound_address"
instance FromJSON BoundTransportAddress where
parseJSON = withObject "BoundTransportAddress" parse
where
parse o =
BoundTransportAddress <$> o .: "publish_address"
<*> o .: "bound_address"
instance FromJSON NodeOSInfo where
parseJSON = withObject "NodeOSInfo" parse
where
parse o =
NodeOSInfo <$> (unMS <$> o .: "refresh_interval_in_millis")
<*> o .: "name"
<*> o .: "arch"
<*> o .: "version"
<*> o .: "available_processors"
<*> o .: "allocated_processors"
instance FromJSON CPUInfo where
parseJSON = withObject "CPUInfo" parse
where
parse o =
CPUInfo <$> o .: "cache_size_in_bytes"
<*> o .: "cores_per_socket"
<*> o .: "total_sockets"
<*> o .: "total_cores"
<*> o .: "mhz"
<*> o .: "model"
<*> o .: "vendor"
instance FromJSON NodeProcessInfo where
parseJSON = withObject "NodeProcessInfo" parse
where
parse o =
NodeProcessInfo <$> o .: "mlockall"
<*> o .:? "max_file_descriptors"
<*> o .: "id"
<*> (unMS <$> o .: "refresh_interval_in_millis")
instance FromJSON NodeJVMInfo where
parseJSON = withObject "NodeJVMInfo" parse
where
parse o =
NodeJVMInfo <$> o .: "memory_pools"
<*> o .: "gc_collectors"
<*> o .: "mem"
<*> (posixMS <$> o .: "start_time_in_millis")
<*> o .: "vm_vendor"
<*> o .: "vm_version"
<*> o .: "vm_name"
<*> o .: "version"
<*> o .: "pid"
instance FromJSON JVMMemoryInfo where
parseJSON = withObject "JVMMemoryInfo" parse
where
parse o =
JVMMemoryInfo <$> o .: "direct_max_in_bytes"
<*> o .: "non_heap_max_in_bytes"
<*> o .: "non_heap_init_in_bytes"
<*> o .: "heap_max_in_bytes"
<*> o .: "heap_init_in_bytes"
instance FromJSON NodeThreadPoolInfo where
parseJSON = withObject "NodeThreadPoolInfo" parse
where
parse o = do
ka <- maybe (return Nothing) (fmap Just . parseStringInterval) =<< o .:? "keep_alive"
NodeThreadPoolInfo <$> (parseJSON . unStringlyTypeJSON =<< o .: "queue_size")
<*> pure ka
<*> o .:? "min"
<*> o .:? "max"
<*> o .: "type"
data TimeInterval
= Weeks
| Days
| Hours
| Minutes
| Seconds
deriving (Eq)
instance Show TimeInterval where
show Weeks = "w"
show Days = "d"
show Hours = "h"
show Minutes = "m"
show Seconds = "s"
instance Read TimeInterval where
readPrec = f =<< TR.get
where
f 'w' = return Weeks
f 'd' = return Days
f 'h' = return Hours
f 'm' = return Minutes
f 's' = return Seconds
f _ = fail "TimeInterval expected one of w, d, h, m, s"
data Interval
= Year
| Quarter
| Month
| Week
| Day
| Hour
| Minute
| Second
deriving (Eq, Show)
instance ToJSON Interval where
toJSON Year = "year"
toJSON Quarter = "quarter"
toJSON Month = "month"
toJSON Week = "week"
toJSON Day = "day"
toJSON Hour = "hour"
toJSON Minute = "minute"
toJSON Second = "second"
parseStringInterval :: (Monad m, MonadFail m) => String -> m NominalDiffTime
parseStringInterval s = case span isNumber s of
("", _) -> fail "Invalid interval"
(nS, unitS) -> case (readMay nS, readMay unitS) of
(Just n, Just unit) -> return (fromInteger (n * unitNDT unit))
(Nothing, _) -> fail "Invalid interval number"
(_, Nothing) -> fail "Invalid interval unit"
where
unitNDT Seconds = 1
unitNDT Minutes = 60
unitNDT Hours = 60 * 60
unitNDT Days = 24 * 60 * 60
unitNDT Weeks = 7 * 24 * 60 * 60
instance FromJSON ThreadPoolSize where
parseJSON v = parseAsNumber v <|> parseAsString v
where
parseAsNumber = parseAsInt <=< parseJSON
parseAsInt (-1) = return ThreadPoolUnbounded
parseAsInt n
| n >= 0 = return (ThreadPoolBounded n)
| otherwise = fail "Thread pool size must be >= -1."
parseAsString = withText "ThreadPoolSize" $ \t ->
case first (readMay . T.unpack) (T.span isNumber t) of
(Just n, "k") -> return (ThreadPoolBounded (n * 1000))
(Just n, "") -> return (ThreadPoolBounded n)
_ -> fail ("Invalid thread pool size " <> T.unpack t)
instance FromJSON ThreadPoolType where
parseJSON = withText "ThreadPoolType" parse
where
parse "scaling" = return ThreadPoolScaling
parse "fixed" = return ThreadPoolFixed
parse "cached" = return ThreadPoolCached
parse "fixed_auto_queue_size" = return ThreadPoolFixedAutoQueueSize
parse e = fail ("Unexpected thread pool type" <> T.unpack e)
instance FromJSON NodeTransportInfo where
parseJSON = withObject "NodeTransportInfo" parse
where
parse o =
NodeTransportInfo <$> (maybe (return mempty) parseProfiles =<< o .:? "profiles")
<*> o .: "publish_address"
<*> o .: "bound_address"
parseProfiles (Object o) | X.null o = return []
parseProfiles v@(Array _) = parseJSON v
parseProfiles Null = return []
parseProfiles _ = fail "Could not parse profiles"
instance FromJSON NodeNetworkInfo where
parseJSON = withObject "NodeNetworkInfo" parse
where
parse o =
NodeNetworkInfo <$> o .: "primary_interface"
<*> (unMS <$> o .: "refresh_interval_in_millis")
instance FromJSON NodeNetworkInterface where
parseJSON = withObject "NodeNetworkInterface" parse
where
parse o =
NodeNetworkInterface <$> o .: "mac_address"
<*> o .: "name"
<*> o .: "address"
instance ToJSON Version where
toJSON Version {..} =
object
[ "number" .= number,
"build_hash" .= build_hash,
"build_date" .= build_date,
"build_snapshot" .= build_snapshot,
"lucene_version" .= lucene_version
]
instance FromJSON Version where
parseJSON = withObject "Version" parse
where
parse o =
Version
<$> o .: "number"
<*> o .: "build_hash"
<*> o .: "build_date"
<*> o .: "build_snapshot"
<*> o .: "lucene_version"
instance ToJSON VersionNumber where
toJSON = toJSON . SemVer.toText . versionNumber
instance FromJSON VersionNumber where
parseJSON = withText "VersionNumber" parse
where
parse t =
case SemVer.fromText t of
(Left err) -> fail err
(Right v) -> return (VersionNumber v)