@@ -0,0 +1,5057 @@
1+{-# LANGUAGE DeriveDataTypeable #-}
2+{-# LANGUAGE DeriveGeneric #-}
3+{-# LANGUAGE FlexibleContexts #-}
4+{-# LANGUAGE FlexibleInstances #-}
5+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
6+{-# LANGUAGE MultiParamTypeClasses #-}
7+-- {-# LANGUAGE NoMonomorphismRestriction #-}
8+{-# LANGUAGE NamedFieldPuns #-}
9+{-# LANGUAGE OverloadedStrings #-}
10+{-# LANGUAGE RecordWildCards #-}
11+{-# LANGUAGE UndecidableInstances #-}
12+
13+-------------------------------------------------------------------------------
14+-- |
15+-- Module : Database.Bloodhound.Types
16+-- Copyright : (C) 2014, 2015, 2016 Chris Allen
17+-- License : BSD-style (see the file LICENSE)
18+-- Maintainer : Chris Allen <cma@bitemyapp.com
19+-- Stability : provisional
20+-- Portability : DeriveGeneric, RecordWildCards
21+--
22+-- Data types for describing actions and data structures performed to interact
23+-- with Elasticsearch. The two main buckets your queries against Elasticsearch
24+-- will fall into are 'Query's and 'Filter's. 'Filter's are more like
25+-- traditional database constraints and often have preferable performance
26+-- properties. 'Query's support human-written textual queries, such as fuzzy
27+-- queries.
28+-------------------------------------------------------------------------------
29+
30+
31+
32+module Database.V5.Bloodhound.Types
33+ ( defaultCache
34+ , defaultIndexSettings
35+ , defaultIndexDocumentSettings
36+ , mkSort
37+ , showText
38+ , unpackId
39+ , mkMatchQuery
40+ , mkMultiMatchQuery
41+ , mkBoolQuery
42+ , mkRangeQuery
43+ , mkQueryStringQuery
44+ , mkAggregations
45+ , mkTermsAggregation
46+ , mkTermsScriptAggregation
47+ , mkDateHistogram
48+ , mkCardinalityAggregation
49+ , mkDocVersion
50+ , mkStatsAggregation
51+ , mkExtendedStatsAggregation
52+ , docVersionNumber
53+ , toMissing
54+ , toTerms
55+ , toDateHistogram
56+ , toTopHits
57+ , omitNulls
58+ , BH(..)
59+ , runBH
60+ , BHEnv
61+ , bhServer
62+ , bhManager
63+ , bhRequestHook
64+ , mkBHEnv
65+ , MonadBH(..)
66+ , Version(..)
67+ , VersionNumber(..)
68+ , MaybeNA(..)
69+ , BuildHash(..)
70+ , Status(..)
71+ , Existence(..)
72+ , NullValue(..)
73+ , IndexSettings(..)
74+ , UpdatableIndexSetting(..)
75+ , IndexSettingsSummary(..)
76+ , AllocationPolicy(..)
77+ , ReplicaBounds(..)
78+ , Bytes(..)
79+ , gigabytes
80+ , megabytes
81+ , kilobytes
82+ , FSType(..)
83+ , InitialShardCount(..)
84+ , NodeAttrFilter(..)
85+ , NodeAttrName(..)
86+ , CompoundFormat(..)
87+ , IndexTemplate(..)
88+ , Server(..)
89+ , Reply
90+ , EsResult(..)
91+ , EsResultFound(..)
92+ , EsError(..)
93+ , EsProtocolException(..)
94+ , IndexAlias(..)
95+ , IndexAliasName(..)
96+ , IndexAliasAction(..)
97+ , IndexAliasCreate(..)
98+ , IndexAliasSummary(..)
99+ , IndexAliasesSummary(..)
100+ , AliasRouting(..)
101+ , SearchAliasRouting(..)
102+ , IndexAliasRouting(..)
103+ , RoutingValue(..)
104+ , DocVersion
105+ , ExternalDocVersion(..)
106+ , VersionControl(..)
107+ , DocumentParent(..)
108+ , IndexDocumentSettings(..)
109+ , Query(..)
110+ , Search(..)
111+ , SearchType(..)
112+ , SearchResult(..)
113+ , ScrollId(..)
114+ , SearchHits(..)
115+ , TrackSortScores
116+ , From(..)
117+ , Size(..)
118+ , Source(..)
119+ , PatternOrPatterns(..)
120+ , Include(..)
121+ , Exclude(..)
122+ , Pattern(..)
123+ , ShardResult(..)
124+ , Hit(..)
125+ , Filter(..)
126+ , Seminearring(..)
127+ , BoolMatch(..)
128+ , Term(..)
129+ , GeoPoint(..)
130+ , GeoBoundingBoxConstraint(..)
131+ , GeoBoundingBox(..)
132+ , GeoFilterType(..)
133+ , Distance(..)
134+ , DistanceUnit(..)
135+ , DistanceType(..)
136+ , DistanceRange(..)
137+ , OptimizeBbox(..)
138+ , LatLon(..)
139+ , RangeValue(..)
140+ , RangeExecution(..)
141+ , LessThan(..)
142+ , LessThanEq(..)
143+ , GreaterThan(..)
144+ , GreaterThanEq(..)
145+ , LessThanD(..)
146+ , LessThanEqD(..)
147+ , GreaterThanD(..)
148+ , GreaterThanEqD(..)
149+ , Regexp(..)
150+ , RegexpFlags(..)
151+ , RegexpFlag(..)
152+ , FieldName(..)
153+ , Script(..)
154+ , IndexName(..)
155+ , IndexSelection(..)
156+ , NodeSelection(..)
157+ , NodeSelector(..)
158+ , ForceMergeIndexSettings(..)
159+ , defaultForceMergeIndexSettings
160+ , TemplateName(..)
161+ , TemplatePattern(..)
162+ , MappingName(..)
163+ , DocId(..)
164+ , CacheName(..)
165+ , CacheKey(..)
166+ , BulkOperation(..)
167+ , ReplicaCount(..)
168+ , ShardCount(..)
169+ , Sort
170+ , SortMode(..)
171+ , SortOrder(..)
172+ , SortSpec(..)
173+ , DefaultSort(..)
174+ , Missing(..)
175+ , OpenCloseIndex(..)
176+ , Method
177+ , Boost(..)
178+ , MatchQuery(..)
179+ , MultiMatchQuery(..)
180+ , BoolQuery(..)
181+ , BoostingQuery(..)
182+ , CommonTermsQuery(..)
183+ , DisMaxQuery(..)
184+ , FuzzyLikeThisQuery(..)
185+ , FuzzyLikeFieldQuery(..)
186+ , FuzzyQuery(..)
187+ , HasChildQuery(..)
188+ , HasParentQuery(..)
189+ , IndicesQuery(..)
190+ , MoreLikeThisQuery(..)
191+ , MoreLikeThisFieldQuery(..)
192+ , NestedQuery(..)
193+ , PrefixQuery(..)
194+ , QueryStringQuery(..)
195+ , SimpleQueryStringQuery(..)
196+ , RangeQuery(..)
197+ , RegexpQuery(..)
198+ , QueryString(..)
199+ , BooleanOperator(..)
200+ , ZeroTermsQuery(..)
201+ , CutoffFrequency(..)
202+ , Analyzer(..)
203+ , MaxExpansions(..)
204+ , Lenient(..)
205+ , MatchQueryType(..)
206+ , MultiMatchQueryType(..)
207+ , Tiebreaker(..)
208+ , MinimumMatch(..)
209+ , DisableCoord(..)
210+ , CommonMinimumMatch(..)
211+ , MinimumMatchHighLow(..)
212+ , PrefixLength(..)
213+ , Fuzziness(..)
214+ , IgnoreTermFrequency(..)
215+ , MaxQueryTerms(..)
216+ , ScoreType(..)
217+ , Score
218+ , Cache
219+ , TypeName(..)
220+ , BoostTerms(..)
221+ , MaxWordLength(..)
222+ , MinWordLength(..)
223+ , MaxDocFrequency(..)
224+ , MinDocFrequency(..)
225+ , PhraseSlop(..)
226+ , StopWord(..)
227+ , QueryPath(..)
228+ , MinimumTermFrequency(..)
229+ , PercentMatch(..)
230+ , FieldDefinition(..)
231+ , MappingField(..)
232+ , Mapping(..)
233+ , AllowLeadingWildcard(..)
234+ , LowercaseExpanded(..)
235+ , GeneratePhraseQueries(..)
236+ , Locale(..)
237+ , AnalyzeWildcard(..)
238+ , EnablePositionIncrements(..)
239+ , SimpleQueryFlag(..)
240+ , FieldOrFields(..)
241+ , Monoid(..)
242+ , ToJSON(..)
243+ , Interval(..)
244+ , TimeInterval(..)
245+ , ExecutionHint(..)
246+ , CollectionMode(..)
247+ , TermOrder(..)
248+ , TermInclusion(..)
249+ , SnapshotRepoSelection(..)
250+ , GenericSnapshotRepo(..)
251+ , SnapshotRepo(..)
252+ , SnapshotRepoConversionError(..)
253+ , SnapshotRepoType(..)
254+ , GenericSnapshotRepoSettings(..)
255+ , SnapshotRepoUpdateSettings(..)
256+ , defaultSnapshotRepoUpdateSettings
257+ , SnapshotRepoName(..)
258+ , SnapshotRepoPattern(..)
259+ , SnapshotVerification(..)
260+ , SnapshotNodeVerification(..)
261+ , FullNodeId(..)
262+ , NodeName(..)
263+ , ClusterName(..)
264+ , NodesInfo(..)
265+ , NodesStats(..)
266+ , NodeStats(..)
267+ , NodeBreakersStats(..)
268+ , NodeBreakerStats(..)
269+ , NodeHTTPStats(..)
270+ , NodeTransportStats(..)
271+ , NodeFSStats(..)
272+ , NodeDataPathStats(..)
273+ , NodeFSTotalStats(..)
274+ , NodeNetworkStats(..)
275+ , NodeThreadPoolsStats(..)
276+ , NodeThreadPoolStats(..)
277+ , NodeJVMStats(..)
278+ , JVMBufferPoolStats(..)
279+ , JVMGCStats(..)
280+ , JVMPoolStats(..)
281+ , NodeProcessStats(..)
282+ , NodeOSStats(..)
283+ , LoadAvgs(..)
284+ , NodeIndicesStats(..)
285+ , EsAddress(..)
286+ , PluginName(..)
287+ , NodeInfo(..)
288+ , NodePluginInfo(..)
289+ , NodeHTTPInfo(..)
290+ , NodeTransportInfo(..)
291+ , BoundTransportAddress(..)
292+ , NodeNetworkInfo(..)
293+ , MacAddress(..)
294+ , NetworkInterfaceName(..)
295+ , NodeNetworkInterface(..)
296+ , NodeThreadPoolsInfo(..)
297+ , NodeThreadPoolInfo(..)
298+ , ThreadPoolSize(..)
299+ , ThreadPoolType(..)
300+ , NodeJVMInfo(..)
301+ , JVMMemoryPool(..)
302+ , JVMGCCollector(..)
303+ , JVMMemoryInfo(..)
304+ , PID(..)
305+ , NodeOSInfo(..)
306+ , CPUInfo(..)
307+ , NodeProcessInfo(..)
308+ , FsSnapshotRepo(..)
309+ , SnapshotCreateSettings(..)
310+ , defaultSnapshotCreateSettings
311+ , SnapshotSelection(..)
312+ , SnapshotPattern(..)
313+ , SnapshotInfo(..)
314+ , SnapshotShardFailure(..)
315+ , ShardId(..)
316+ , SnapshotName(..)
317+ , SnapshotState(..)
318+ , SnapshotRestoreSettings(..)
319+ , defaultSnapshotRestoreSettings
320+ , RestoreRenamePattern(..)
321+ , RestoreRenameToken(..)
322+ , RRGroupRefNum
323+ , rrGroupRefNum
324+ , mkRRGroupRefNum
325+ , RestoreIndexSettings(..)
326+
327+ , Aggregation(..)
328+ , Aggregations
329+ , AggregationResults
330+ , BucketValue(..)
331+ , Bucket(..)
332+ , BucketAggregation(..)
333+ , TermsAggregation(..)
334+ , MissingAggregation(..)
335+ , ValueCountAggregation(..)
336+ , FilterAggregation(..)
337+ , CardinalityAggregation(..)
338+ , DateHistogramAggregation(..)
339+ , DateRangeAggregation(..)
340+ , DateRangeAggRange(..)
341+ , DateMathExpr(..)
342+ , DateMathAnchor(..)
343+ , DateMathModifier(..)
344+ , DateMathUnit(..)
345+ , TopHitsAggregation(..)
346+ , StatisticsAggregation(..)
347+
348+ , Highlights(..)
349+ , FieldHighlight(..)
350+ , HighlightSettings(..)
351+ , PlainHighlight(..)
352+ , PostingsHighlight(..)
353+ , FastVectorHighlight(..)
354+ , CommonHighlight(..)
355+ , NonPostings(..)
356+ , HighlightEncoder(..)
357+ , HighlightTag(..)
358+ , HitHighlight
359+
360+ , MissingResult(..)
361+ , TermsResult(..)
362+ , DateHistogramResult(..)
363+ , DateRangeResult(..)
364+ , TopHitResult(..)
365+
366+ , EsUsername(..)
367+ , EsPassword(..)
368+ ) where
369+
370+import Control.Applicative as A
371+import Control.Arrow (first)
372+import Control.Monad.Catch
373+import Control.Monad.Except
374+import Control.Monad.Reader (MonadReader (..),
375+ ReaderT (..))
376+import Control.Monad.State (MonadState)
377+import Control.Monad.Writer (MonadWriter)
378+import Data.Aeson
379+import Data.Aeson.Types (Pair, Parser,
380+ emptyObject,
381+ parseEither, parseMaybe)
382+import qualified Data.ByteString.Lazy.Char8 as L
383+import Data.Char
384+import Data.Hashable (Hashable)
385+import qualified Data.HashMap.Strict as HM
386+import Data.List (foldl', intercalate,
387+ nub)
388+import Data.List.NonEmpty (NonEmpty (..), toList)
389+import qualified Data.Map.Strict as M
390+import Data.Maybe
391+import Data.Scientific (Scientific)
392+import Data.Semigroup
393+import Data.Text (Text)
394+import qualified Data.Text as T
395+import Data.Time.Calendar
396+import Data.Time.Clock (NominalDiffTime,
397+ UTCTime)
398+import Data.Time.Clock.POSIX
399+import qualified Data.Traversable as DT
400+import Data.Typeable (Typeable)
401+import qualified Data.Vector as V
402+import qualified Data.Version as Vers
403+import GHC.Enum
404+import GHC.Generics (Generic)
405+import Network.HTTP.Client
406+import qualified Network.HTTP.Types.Method as NHTM
407+import qualified Text.ParserCombinators.ReadP as RP
408+import qualified Text.Read as TR
409+
410+import Database.V5.Bloodhound.Types.Class
411+import Database.V5.Bloodhound.Types.Internal
412+
413+-- $setup
414+-- >>> :set -XOverloadedStrings
415+-- >>> import Data.Aeson
416+-- >>> import Database.V5.Bloodhound
417+-- >>> let testServer = (Server "http://localhost:9200")
418+-- >>> let testIndex = IndexName "twitter"
419+-- >>> let testMapping = MappingName "tweet"
420+-- >>> let defaultIndexSettings = IndexSettings (ShardCount 3) (ReplicaCount 2)
421+
422+-- defaultIndexSettings is exported by Database.Bloodhound as well
423+-- no trailing slashes in servers, library handles building the path.
424+
425+-- | Create a 'BHEnv' with all optional fields defaulted. HTTP hook
426+-- will be a noop. You can use the exported fields to customize it further, e.g.:
427+--
428+-- >> (mkBHEnv myServer myManager) { bhRequestHook = customHook }
429+mkBHEnv :: Server -> Manager -> BHEnv
430+mkBHEnv s m = BHEnv s m return
431+
432+newtype BH m a = BH {
433+ unBH :: ReaderT BHEnv m a
434+ } deriving ( Functor
435+ , A.Applicative
436+ , Monad
437+ , MonadIO
438+ , MonadState s
439+ , MonadWriter w
440+ , MonadError e
441+ , Alternative
442+ , MonadPlus
443+ , MonadFix
444+ , MonadThrow
445+ , MonadCatch
446+ , MonadMask)
447+
448+instance MonadTrans BH where
449+ lift = BH . lift
450+
451+instance (MonadReader r m) => MonadReader r (BH m) where
452+ ask = lift ask
453+ local f (BH (ReaderT m)) = BH $ ReaderT $ \r ->
454+ local f (m r)
455+
456+instance (Functor m, Applicative m, MonadIO m) => MonadBH (BH m) where
457+ getBHEnv = BH getBHEnv
458+
459+runBH :: BHEnv -> BH m a -> m a
460+runBH e f = runReaderT (unBH f) e
461+
462+{-| 'Version' is embedded in 'Status' -}
463+data Version = Version { number :: VersionNumber
464+ , build_hash :: BuildHash
465+ , build_date :: UTCTime
466+ , build_snapshot :: Bool
467+ , lucene_version :: VersionNumber } deriving (Eq, Read, Show, Generic, Typeable)
468+
469+-- | Traditional software versioning number
470+newtype VersionNumber = VersionNumber { versionNumber :: Vers.Version
471+ } deriving (Eq, Read, Show, Generic, Typeable, Ord)
472+
473+{-| 'Status' is a data type for describing the JSON body returned by
474+ Elasticsearch when you query its status. This was deprecated in 1.2.0.
475+
476+ <http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/indices-status.html#indices-status>
477+-}
478+
479+data Status = Status { name :: Text
480+ , cluster_name :: Text
481+ , cluster_uuid :: Text
482+ , version :: Version
483+ , tagline :: Text } deriving (Eq, Read, Show, Generic)
484+
485+{-| 'IndexSettings' is used to configure the shards and replicas when you create
486+ an Elasticsearch Index.
487+
488+ <http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/indices-create-index.html>
489+-}
490+
491+data IndexSettings =
492+ IndexSettings { indexShards :: ShardCount
493+ , indexReplicas :: ReplicaCount } deriving (Eq, Read, Show, Generic, Typeable)
494+
495+{-| 'defaultIndexSettings' is an 'IndexSettings' with 3 shards and 2 replicas. -}
496+defaultIndexSettings :: IndexSettings
497+defaultIndexSettings = IndexSettings (ShardCount 3) (ReplicaCount 2)
498+
499+
500+{-| 'ForceMergeIndexSettings' is used to configure index optimization. See
501+ <https://www.elastic.co/guide/en/elasticsearch/reference/current/indices-forcemerge.html>
502+ for more info.
503+-}
504+data ForceMergeIndexSettings =
505+ ForceMergeIndexSettings { maxNumSegments :: Maybe Int
506+ -- ^ 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.
507+ , onlyExpungeDeletes :: Bool
508+ -- ^ 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.
509+ , flushAfterOptimize :: Bool
510+ -- ^ Should a flush be performed after the optimize.
511+ } deriving (Eq, Show, Generic, Typeable)
512+
513+
514+{-| 'defaultForceMergeIndexSettings' implements the default settings that
515+ ElasticSearch uses for index optimization. 'maxNumSegments' is Nothing,
516+ 'onlyExpungeDeletes' is False, and flushAfterOptimize is True.
517+-}
518+defaultForceMergeIndexSettings :: ForceMergeIndexSettings
519+defaultForceMergeIndexSettings = ForceMergeIndexSettings Nothing False True
520+
521+{-| 'UpdatableIndexSetting' are settings which may be updated after an index is created.
522+
523+ <https://www.elastic.co/guide/en/elasticsearch/reference/current/indices-update-settings.html>
524+-}
525+data UpdatableIndexSetting = NumberOfReplicas ReplicaCount
526+ -- ^ The number of replicas each shard has.
527+ | AutoExpandReplicas ReplicaBounds
528+ | BlocksReadOnly Bool
529+ -- ^ Set to True to have the index read only. False to allow writes and metadata changes.
530+ | BlocksRead Bool
531+ -- ^ Set to True to disable read operations against the index.
532+ | BlocksWrite Bool
533+ -- ^ Set to True to disable write operations against the index.
534+ | BlocksMetaData Bool
535+ -- ^ Set to True to disable metadata operations against the index.
536+ | RefreshInterval NominalDiffTime
537+ -- ^ The async refresh interval of a shard
538+ | IndexConcurrency Int
539+ | FailOnMergeFailure Bool
540+ | TranslogFlushThresholdOps Int
541+ -- ^ When to flush on operations.
542+ | TranslogFlushThresholdSize Bytes
543+ -- ^ When to flush based on translog (bytes) size.
544+ | TranslogFlushThresholdPeriod NominalDiffTime
545+ -- ^ When to flush based on a period of not flushing.
546+ | TranslogDisableFlush Bool
547+ -- ^ Disables flushing. Note, should be set for a short interval and then enabled.
548+ | CacheFilterMaxSize (Maybe Bytes)
549+ -- ^ The maximum size of filter cache (per segment in shard).
550+ | CacheFilterExpire (Maybe NominalDiffTime)
551+ -- ^ The expire after access time for filter cache.
552+ | GatewaySnapshotInterval NominalDiffTime
553+ -- ^ The gateway snapshot interval (only applies to shared gateways).
554+ | RoutingAllocationInclude (NonEmpty NodeAttrFilter)
555+ -- ^ A node matching any rule will be allowed to host shards from the index.
556+ | RoutingAllocationExclude (NonEmpty NodeAttrFilter)
557+ -- ^ A node matching any rule will NOT be allowed to host shards from the index.
558+ | RoutingAllocationRequire (NonEmpty NodeAttrFilter)
559+ -- ^ Only nodes matching all rules will be allowed to host shards from the index.
560+ | RoutingAllocationEnable AllocationPolicy
561+ -- ^ Enables shard allocation for a specific index.
562+ | RoutingAllocationShardsPerNode ShardCount
563+ -- ^ Controls the total number of shards (replicas and primaries) allowed to be allocated on a single node.
564+ | RecoveryInitialShards InitialShardCount
565+ -- ^ When using local gateway a particular shard is recovered only if there can be allocated quorum shards in the cluster.
566+ | GCDeletes NominalDiffTime
567+ | TTLDisablePurge Bool
568+ -- ^ Disables temporarily the purge of expired docs.
569+ | TranslogFSType FSType
570+ | IndexCompoundFormat CompoundFormat
571+ | IndexCompoundOnFlush Bool
572+ | WarmerEnabled Bool
573+ deriving (Eq, Show, Generic, Typeable)
574+
575+data AllocationPolicy = AllocAll
576+ -- ^ Allows shard allocation for all shards.
577+ | AllocPrimaries
578+ -- ^ Allows shard allocation only for primary shards.
579+ | AllocNewPrimaries
580+ -- ^ Allows shard allocation only for primary shards for new indices.
581+ | AllocNone
582+ -- ^ No shard allocation is allowed
583+ deriving (Eq, Read, Show, Generic, Typeable)
584+
585+data ReplicaBounds = ReplicasBounded Int Int
586+ | ReplicasLowerBounded Int
587+ | ReplicasUnbounded
588+ deriving (Eq, Read, Show, Generic, Typeable)
589+
590+-- | A measure of bytes used for various configurations. You may want
591+-- to use smart constructors like 'gigabytes' for larger values.
592+--
593+-- >>> gigabytes 9
594+-- Bytes 9000000000
595+--
596+-- >>> megabytes 9
597+-- Bytes 9000000
598+--
599+-- >>> kilobytes 9
600+-- Bytes 9000
601+newtype Bytes = Bytes Int deriving (Eq, Read, Show, Generic, Typeable, Ord, ToJSON, FromJSON)
602+
603+gigabytes :: Int -> Bytes
604+gigabytes n = megabytes (1000 * n)
605+
606+
607+megabytes :: Int -> Bytes
608+megabytes n = kilobytes (1000 * n)
609+
610+
611+kilobytes :: Int -> Bytes
612+kilobytes n = Bytes (1000 * n)
613+
614+
615+data FSType = FSSimple
616+ | FSBuffered deriving (Eq, Read, Show, Generic, Typeable, Ord)
617+
618+data InitialShardCount = QuorumShards
619+ | QuorumMinus1Shards
620+ | FullShards
621+ | FullMinus1Shards
622+ | ExplicitShards Int
623+ deriving (Eq, Read, Show, Generic, Typeable)
624+
625+data NodeAttrFilter = NodeAttrFilter { nodeAttrFilterName :: NodeAttrName
626+ , nodeAttrFilterValues :: NonEmpty Text}
627+ deriving (Eq, Read, Show, Generic, Ord, Typeable)
628+
629+newtype NodeAttrName = NodeAttrName Text deriving (Eq, Read, Show, Ord, Generic, Typeable)
630+
631+data CompoundFormat = CompoundFileFormat Bool
632+ | MergeSegmentVsTotalIndex Double
633+ -- ^ percentage between 0 and 1 where 0 is false, 1 is true
634+ deriving (Eq, Read, Show, Generic, Typeable)
635+
636+newtype NominalDiffTimeJSON = NominalDiffTimeJSON { ndtJSON :: NominalDiffTime }
637+
638+data IndexSettingsSummary = IndexSettingsSummary { sSummaryIndexName :: IndexName
639+ , sSummaryFixedSettings :: IndexSettings
640+ , sSummaryUpdateable :: [UpdatableIndexSetting]}
641+ deriving (Eq, Show, Generic, Typeable)
642+
643+{-| 'Reply' and 'Method' are type synonyms from 'Network.HTTP.Types.Method.Method' -}
644+type Reply = Network.HTTP.Client.Response L.ByteString
645+type Method = NHTM.Method
646+
647+{-| 'OpenCloseIndex' is a sum type for opening and closing indices.
648+
649+ <http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/indices-open-close.html>
650+-}
651+data OpenCloseIndex = OpenIndex | CloseIndex deriving (Eq, Read, Show, Generic, Typeable)
652+
653+data FieldType = GeoPointType
654+ | GeoShapeType
655+ | FloatType
656+ | IntegerType
657+ | LongType
658+ | ShortType
659+ | ByteType deriving (Eq, Read, Show, Generic, Typeable)
660+
661+data FieldDefinition =
662+ FieldDefinition { fieldType :: FieldType } deriving (Eq, Read, Show, Generic, Typeable)
663+
664+{-| An 'IndexTemplate' defines a template that will automatically be
665+ applied to new indices created. The templates include both
666+ 'IndexSettings' and mappings, and a simple 'TemplatePattern' that
667+ controls if the template will be applied to the index created.
668+ Specify mappings as follows: @[toJSON TweetMapping, ...]@
669+
670+ https://www.elastic.co/guide/en/elasticsearch/reference/1.7/indices-templates.html
671+-}
672+data IndexTemplate =
673+ IndexTemplate { templatePattern :: TemplatePattern
674+ , templateSettings :: Maybe IndexSettings
675+ , templateMappings :: [Value]
676+ }
677+
678+data MappingField =
679+ MappingField { mappingFieldName :: FieldName
680+ , fieldDefinition :: FieldDefinition } deriving (Eq, Read, Show, Generic, Typeable)
681+
682+{-| Support for type reification of 'Mapping's is currently incomplete, for
683+ now the mapping API verbiage expects a 'ToJSON'able blob.
684+
685+ Indexes have mappings, mappings are schemas for the documents contained in the
686+ index. I'd recommend having only one mapping per index, always having a mapping,
687+ and keeping different kinds of documents separated if possible.
688+-}
689+data Mapping = Mapping { typeName :: TypeName
690+ , mappingFields :: [MappingField] } deriving (Eq, Read, Show, Generic, Typeable)
691+
692+{-| 'BulkOperation' is a sum type for expressing the four kinds of bulk
693+ operation index, create, delete, and update. 'BulkIndex' behaves like an
694+ "upsert", 'BulkCreate' will fail if a document already exists at the DocId.
695+
696+ <http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/docs-bulk.html#docs-bulk>
697+-}
698+data BulkOperation =
699+ BulkIndex IndexName MappingName DocId Value
700+ | BulkCreate IndexName MappingName DocId Value
701+ | BulkDelete IndexName MappingName DocId
702+ | BulkUpdate IndexName MappingName DocId Value deriving (Eq, Read, Show, Generic, Typeable)
703+
704+{-| 'EsResult' describes the standard wrapper JSON document that you see in
705+ successful Elasticsearch lookups or lookups that couldn't find the document.
706+-}
707+data EsResult a = EsResult { _index :: Text
708+ , _type :: Text
709+ , _id :: Text
710+ , foundResult :: Maybe (EsResultFound a)} deriving (Eq, Read, Show, Generic, Typeable)
711+
712+{-| 'EsResultFound' contains the document and its metadata inside of an
713+ 'EsResult' when the document was successfully found.
714+-}
715+data EsResultFound a = EsResultFound { _version :: DocVersion
716+ , _source :: a } deriving (Eq, Read, Show, Generic, Typeable)
717+
718+{-| 'EsError' is the generic type that will be returned when there was a
719+ problem. If you can't parse the expected response, its a good idea to
720+ try parsing this.
721+-}
722+data EsError = EsError { errorStatus :: Int
723+ , errorMessage :: Text } deriving (Eq, Read, Show, Generic, Typeable)
724+
725+{-| 'EsProtocolException' will be thrown if Bloodhound cannot parse a response
726+returned by the ElasticSearch server. If you encounter this error, please
727+verify that your domain data types and FromJSON instances are working properly
728+(for example, the 'a' of '[Hit a]' in 'SearchResult.searchHits.hits'). If you're
729+sure that your mappings are correct, then this error may be an indication of an
730+incompatibility between Bloodhound and ElasticSearch. Please open a bug report
731+and be sure to include the exception body.
732+-}
733+data EsProtocolException = EsProtocolException { esProtoExBody :: L.ByteString }
734+ deriving (Eq, Read, Show, Generic, Typeable)
735+
736+instance Exception EsProtocolException
737+
738+data IndexAlias = IndexAlias { srcIndex :: IndexName
739+ , indexAlias :: IndexAliasName } deriving (Eq, Read, Show, Generic, Typeable)
740+
741+newtype IndexAliasName = IndexAliasName { indexAliasName :: IndexName } deriving (Eq, Read, Show, Generic, ToJSON)
742+
743+data IndexAliasAction = AddAlias IndexAlias IndexAliasCreate
744+ | RemoveAlias IndexAlias deriving (Read, Show, Eq, Generic, Typeable)
745+
746+data IndexAliasCreate = IndexAliasCreate { aliasCreateRouting :: Maybe AliasRouting
747+ , aliasCreateFilter :: Maybe Filter}
748+ deriving (Read, Show, Eq, Generic, Typeable)
749+
750+data AliasRouting = AllAliasRouting RoutingValue
751+ | GranularAliasRouting (Maybe SearchAliasRouting) (Maybe IndexAliasRouting)
752+ deriving (Read, Show, Eq, Generic, Typeable)
753+
754+newtype SearchAliasRouting = SearchAliasRouting (NonEmpty RoutingValue) deriving (Read, Show, Eq, Generic, Typeable)
755+
756+newtype IndexAliasRouting = IndexAliasRouting RoutingValue deriving (Read, Show, Eq, Generic, ToJSON, FromJSON, Typeable)
757+
758+newtype RoutingValue = RoutingValue { routingValue :: Text } deriving (Read, Show, Eq, Generic, ToJSON, FromJSON, Typeable)
759+
760+newtype IndexAliasesSummary = IndexAliasesSummary { indexAliasesSummary :: [IndexAliasSummary] } deriving (Read, Show, Eq, Generic, Typeable)
761+
762+{-| 'IndexAliasSummary' is a summary of an index alias configured for a server. -}
763+data IndexAliasSummary = IndexAliasSummary { indexAliasSummaryAlias :: IndexAlias
764+ , indexAliasSummaryCreate :: IndexAliasCreate} deriving (Read, Show, Eq, Generic, Typeable)
765+
766+{-| 'DocVersion' is an integer version number for a document between 1
767+and 9.2e+18 used for <<https://www.elastic.co/guide/en/elasticsearch/guide/current/optimistic-concurrency-control.html optimistic concurrency control>>.
768+-}
769+newtype DocVersion = DocVersion {
770+ docVersionNumber :: Int
771+ } deriving (Eq, Read, Show, Generic, Ord, ToJSON)
772+
773+-- | Smart constructor for in-range doc version
774+mkDocVersion :: Int -> Maybe DocVersion
775+mkDocVersion i
776+ | i >= (docVersionNumber minBound) && i <= (docVersionNumber maxBound) =
777+ Just $ DocVersion i
778+ | otherwise = Nothing
779+
780+
781+{-| 'ExternalDocVersion' is a convenience wrapper if your code uses its
782+own version numbers instead of ones from ES.
783+-}
784+newtype ExternalDocVersion = ExternalDocVersion DocVersion
785+ deriving (Eq, Read, Show, Generic, Ord, Bounded, Enum, ToJSON)
786+
787+{-| 'VersionControl' is specified when indexing documents as a
788+optimistic concurrency control.
789+-}
790+data VersionControl = NoVersionControl
791+ -- ^ Don't send a version. This is a pure overwrite.
792+ | InternalVersion DocVersion
793+ -- ^ Use the default ES versioning scheme. Only
794+ -- index the document if the version is the same
795+ -- as the one specified. Only applicable to
796+ -- updates, as you should be getting Version from
797+ -- a search result.
798+ | ExternalGT ExternalDocVersion
799+ -- ^ Use your own version numbering. Only index
800+ -- the document if the version is strictly higher
801+ -- OR the document doesn't exist. The given
802+ -- version will be used as the new version number
803+ -- for the stored document. N.B. All updates must
804+ -- increment this number, meaning there is some
805+ -- global, external ordering of updates.
806+ | ExternalGTE ExternalDocVersion
807+ -- ^ Use your own version numbering. Only index
808+ -- the document if the version is equal or higher
809+ -- than the stored version. Will succeed if there
810+ -- is no existing document. The given version will
811+ -- be used as the new version number for the
812+ -- stored document. Use with care, as this could
813+ -- result in data loss.
814+ | ForceVersion ExternalDocVersion
815+ -- ^ The document will always be indexed and the
816+ -- given version will be the new version. This is
817+ -- typically used for correcting errors. Use with
818+ -- care, as this could result in data loss.
819+ deriving (Read, Show, Eq, Generic, Ord)
820+
821+{-| 'DocumentParent' is used to specify a parent document.
822+-}
823+newtype DocumentParent = DocumentParent DocId
824+ deriving (Eq, Read, Show, Generic, Typeable)
825+
826+{-| 'IndexDocumentSettings' are special settings supplied when indexing
827+a document. For the best backwards compatiblity when new fields are
828+added, you should probably prefer to start with 'defaultIndexDocumentSettings'
829+-}
830+data IndexDocumentSettings =
831+ IndexDocumentSettings { idsVersionControl :: VersionControl
832+ , idsParent :: Maybe DocumentParent
833+ } deriving (Eq, Read, Show, Generic, Typeable)
834+
835+{-| Reasonable default settings. Chooses no version control and no parent.
836+-}
837+defaultIndexDocumentSettings :: IndexDocumentSettings
838+defaultIndexDocumentSettings = IndexDocumentSettings NoVersionControl Nothing
839+
840+{-| 'Sort' is a synonym for a list of 'SortSpec's. Sort behavior is order
841+ dependent with later sorts acting as tie-breakers for earlier sorts.
842+-}
843+type Sort = [SortSpec]
844+
845+{-| The two main kinds of 'SortSpec' are 'DefaultSortSpec' and
846+ 'GeoDistanceSortSpec'. The latter takes a 'SortOrder', 'GeoPoint', and
847+ 'DistanceUnit' to express "nearness" to a single geographical point as a
848+ sort specification.
849+
850+<http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/search-request-sort.html#search-request-sort>
851+-}
852+data SortSpec = DefaultSortSpec DefaultSort
853+ | GeoDistanceSortSpec SortOrder GeoPoint DistanceUnit deriving (Eq, Read, Show, Generic, Typeable)
854+
855+{-| 'DefaultSort' is usually the kind of 'SortSpec' you'll want. There's a
856+ 'mkSort' convenience function for when you want to specify only the most
857+ common parameters.
858+
859+ The `ignoreUnmapped`, when `Just` field is used to set the elastic 'unmapped_type'
860+
861+<http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/search-request-sort.html#search-request-sort>
862+-}
863+data DefaultSort =
864+ DefaultSort { sortFieldName :: FieldName
865+ , sortOrder :: SortOrder
866+ -- default False
867+ , ignoreUnmapped :: Maybe Text
868+ , sortMode :: Maybe SortMode
869+ , missingSort :: Maybe Missing
870+ , nestedFilter :: Maybe Filter } deriving (Eq, Read, Show, Generic, Typeable)
871+
872+{-| 'SortOrder' is 'Ascending' or 'Descending', as you might expect. These get
873+ encoded into "asc" or "desc" when turned into JSON.
874+
875+<http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/search-request-sort.html#search-request-sort>
876+-}
877+data SortOrder = Ascending
878+ | Descending deriving (Eq, Read, Show, Generic, Typeable)
879+
880+{-| 'Missing' prescribes how to handle missing fields. A missing field can be
881+ sorted last, first, or using a custom value as a substitute.
882+
883+<http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/search-request-sort.html#_missing_values>
884+-}
885+data Missing = LastMissing
886+ | FirstMissing
887+ | CustomMissing Text deriving (Eq, Read, Show, Generic, Typeable)
888+
889+{-| 'SortMode' prescribes how to handle sorting array/multi-valued fields.
890+
891+http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/search-request-sort.html#_sort_mode_option
892+-}
893+data SortMode = SortMin
894+ | SortMax
895+ | SortSum
896+ | SortAvg deriving (Eq, Read, Show, Generic, Typeable)
897+
898+{-| 'mkSort' defaults everything but the 'FieldName' and the 'SortOrder' so
899+ that you can concisely describe the usual kind of 'SortSpec's you want.
900+-}
901+mkSort :: FieldName -> SortOrder -> DefaultSort
902+mkSort fieldName sOrder = DefaultSort fieldName sOrder Nothing Nothing Nothing Nothing
903+
904+{-| 'Cache' is for telling ES whether it should cache a 'Filter' not.
905+ 'Query's cannot be cached.
906+-}
907+type Cache = Bool -- caching on/off
908+defaultCache :: Cache
909+defaultCache = False
910+
911+{-| 'PrefixValue' is used in 'PrefixQuery' as the main query component.
912+-}
913+-- type PrefixValue = Text
914+
915+{-| 'BooleanOperator' is the usual And/Or operators with an ES compatible
916+ JSON encoding baked in. Used all over the place.
917+-}
918+data BooleanOperator = And | Or deriving (Eq, Read, Show, Generic, Typeable)
919+
920+{-| 'ShardCount' is part of 'IndexSettings'
921+-}
922+newtype ShardCount = ShardCount Int deriving (Eq, Read, Show, Generic, ToJSON, Typeable)
923+
924+{-| 'ReplicaCount' is part of 'IndexSettings'
925+-}
926+newtype ReplicaCount = ReplicaCount Int deriving (Eq, Read, Show, Generic, ToJSON, Typeable)
927+
928+{-| 'IndexName' is used to describe which index to query/create/delete
929+-}
930+newtype IndexName = IndexName Text deriving (Eq, Generic, Read, Show, ToJSON, FromJSON, Typeable)
931+
932+{-| 'IndexSelection' is used for APIs which take a single index, a list of
933+ indexes, or the special @_all@ index.
934+-}
935+--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.
936+data IndexSelection = IndexList (NonEmpty IndexName)
937+ | AllIndexes deriving (Eq, Generic, Show, Typeable)
938+
939+{-| '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.
940+-}
941+data NodeSelection = LocalNode
942+ -- ^ Whatever node receives this request
943+ | NodeList (NonEmpty NodeSelector)
944+ | AllNodes deriving (Eq, Generic, Show, Typeable)
945+
946+
947+-- | An exact match or pattern to identify a node. Note that All of
948+-- these options support wildcarding, so your node name, server, attr
949+-- name can all contain * characters to be a fuzzy match.
950+data NodeSelector = NodeByName NodeName
951+ | NodeByFullNodeId FullNodeId
952+ | NodeByHost Server
953+ -- ^ e.g. 10.0.0.1 or even 10.0.0.*
954+ | NodeByAttribute NodeAttrName Text
955+ -- ^ NodeAttrName can be a pattern, e.g. rack*. The value can too.
956+ deriving (Eq, Generic, Show, Typeable)
957+
958+{-| 'TemplateName' is used to describe which template to query/create/delete
959+-}
960+newtype TemplateName = TemplateName Text deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
961+
962+{-| 'TemplatePattern' represents a pattern which is matched against index names
963+-}
964+newtype TemplatePattern = TemplatePattern Text deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
965+
966+{-| 'MappingName' is part of mappings which are how ES describes and schematizes
967+ the data in the indices.
968+-}
969+newtype MappingName = MappingName Text deriving (Eq, Generic, Read, Show, ToJSON, FromJSON, Typeable)
970+
971+{-| 'DocId' is a generic wrapper value for expressing unique Document IDs.
972+ Can be set by the user or created by ES itself. Often used in client
973+ functions for poking at specific documents.
974+-}
975+newtype DocId = DocId Text deriving (Eq, Generic, Read, Show, ToJSON, FromJSON, Typeable)
976+
977+{-| 'QueryString' is used to wrap query text bodies, be they human written or not.
978+-}
979+newtype QueryString = QueryString Text deriving (Eq, Generic, Read, Show, ToJSON, FromJSON, Typeable)
980+
981+{-| 'FieldName' is used all over the place wherever a specific field within
982+ a document needs to be specified, usually in 'Query's or 'Filter's.
983+-}
984+newtype FieldName = FieldName Text deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
985+
986+
987+{-| 'Script' is often used in place of 'FieldName' to specify more
988+complex ways of extracting a value from a document.
989+-}
990+newtype Script = Script { scriptText :: Text } deriving (Eq, Read, Show, Generic, Typeable)
991+
992+{-| 'CacheName' is used in 'RegexpFilter' for describing the
993+ 'CacheKey' keyed caching behavior.
994+-}
995+newtype CacheName = CacheName Text deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
996+
997+{-| 'CacheKey' is used in 'RegexpFilter' to key regex caching.
998+-}
999+newtype CacheKey =
1000+ CacheKey Text deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1001+newtype Existence =
1002+ Existence Bool deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1003+newtype NullValue =
1004+ NullValue Bool deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1005+newtype CutoffFrequency =
1006+ CutoffFrequency Double deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1007+newtype Analyzer =
1008+ Analyzer Text deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1009+newtype MaxExpansions =
1010+ MaxExpansions Int deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1011+
1012+{-| 'Lenient', if set to true, will cause format based failures to be
1013+ ignored. I don't know what the bloody default is, Elasticsearch
1014+ documentation didn't say what it was. Let me know if you figure it out.
1015+-}
1016+newtype Lenient =
1017+ Lenient Bool deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1018+newtype Tiebreaker =
1019+ Tiebreaker Double deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1020+newtype Boost =
1021+ Boost Double deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1022+newtype BoostTerms =
1023+ BoostTerms Double deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1024+
1025+{-| 'MinimumMatch' controls how many should clauses in the bool query should
1026+ match. Can be an absolute value (2) or a percentage (30%) or a
1027+ combination of both.
1028+-}
1029+newtype MinimumMatch =
1030+ MinimumMatch Int deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1031+newtype DisableCoord =
1032+ DisableCoord Bool deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1033+newtype IgnoreTermFrequency =
1034+ IgnoreTermFrequency Bool deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1035+newtype MinimumTermFrequency =
1036+ MinimumTermFrequency Int deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1037+newtype MaxQueryTerms =
1038+ MaxQueryTerms Int deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1039+newtype Fuzziness =
1040+ Fuzziness Double deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1041+
1042+{-| 'PrefixLength' is the prefix length used in queries, defaults to 0. -}
1043+newtype PrefixLength =
1044+ PrefixLength Int deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1045+newtype TypeName =
1046+ TypeName Text deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1047+newtype PercentMatch =
1048+ PercentMatch Double deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1049+newtype StopWord =
1050+ StopWord Text deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1051+newtype QueryPath =
1052+ QueryPath Text deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1053+
1054+{-| Allowing a wildcard at the beginning of a word (eg "*ing") is particularly
1055+ heavy, because all terms in the index need to be examined, just in case
1056+ they match. Leading wildcards can be disabled by setting
1057+ 'AllowLeadingWildcard' to false. -}
1058+newtype AllowLeadingWildcard =
1059+ AllowLeadingWildcard Bool deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1060+newtype LowercaseExpanded =
1061+ LowercaseExpanded Bool deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1062+newtype EnablePositionIncrements =
1063+ EnablePositionIncrements Bool deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1064+
1065+{-| By default, wildcard terms in a query are not analyzed.
1066+ Setting 'AnalyzeWildcard' to true enables best-effort analysis.
1067+-}
1068+newtype AnalyzeWildcard = AnalyzeWildcard Bool deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1069+
1070+{-| 'GeneratePhraseQueries' defaults to false.
1071+-}
1072+newtype GeneratePhraseQueries =
1073+ GeneratePhraseQueries Bool deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1074+
1075+{-| 'Locale' is used for string conversions - defaults to ROOT.
1076+-}
1077+newtype Locale = Locale Text deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1078+newtype MaxWordLength = MaxWordLength Int deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1079+newtype MinWordLength = MinWordLength Int deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1080+
1081+{-| 'PhraseSlop' sets the default slop for phrases, 0 means exact
1082+ phrase matches. Default is 0.
1083+-}
1084+newtype PhraseSlop = PhraseSlop Int deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1085+newtype MinDocFrequency = MinDocFrequency Int deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1086+newtype MaxDocFrequency = MaxDocFrequency Int deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1087+
1088+-- | Newtype wrapper to parse ES's concerning tendency to in some APIs return a floating point number of milliseconds since epoch ಠ_ಠ
1089+newtype POSIXMS = POSIXMS { posixMS :: UTCTime }
1090+
1091+{-| 'unpackId' is a silly convenience function that gets used once.
1092+-}
1093+unpackId :: DocId -> Text
1094+unpackId (DocId docId) = docId
1095+
1096+type TrackSortScores = Bool
1097+newtype From = From Int deriving (Eq, Read, Show, Generic, ToJSON)
1098+newtype Size = Size Int deriving (Eq, Read, Show, Generic, ToJSON)
1099+
1100+data Search = Search { queryBody :: Maybe Query
1101+ , filterBody :: Maybe Filter
1102+ , sortBody :: Maybe Sort
1103+ , aggBody :: Maybe Aggregations
1104+ , highlight :: Maybe Highlights
1105+ -- default False
1106+ , trackSortScores :: TrackSortScores
1107+ , from :: From
1108+ , size :: Size
1109+ , searchType :: SearchType
1110+ , fields :: Maybe [FieldName]
1111+ , source :: Maybe Source } deriving (Eq, Read, Show, Generic, Typeable)
1112+
1113+data SearchType = SearchTypeQueryThenFetch
1114+ | SearchTypeDfsQueryThenFetch
1115+ deriving (Eq, Read, Show, Generic, Typeable)
1116+
1117+data Source =
1118+ NoSource
1119+ | SourcePatterns PatternOrPatterns
1120+ | SourceIncludeExclude Include Exclude
1121+ deriving (Read, Show, Eq, Generic, Typeable)
1122+
1123+data PatternOrPatterns = PopPattern Pattern
1124+ | PopPatterns [Pattern] deriving (Eq, Read, Show, Generic, Typeable)
1125+
1126+data Include = Include [Pattern] deriving (Eq, Read, Show, Generic, Typeable)
1127+data Exclude = Exclude [Pattern] deriving (Eq, Read, Show, Generic, Typeable)
1128+
1129+newtype Pattern = Pattern Text deriving (Eq, Read, Show, Generic, Typeable)
1130+
1131+data Highlights = Highlights { globalsettings :: Maybe HighlightSettings
1132+ , highlightFields :: [FieldHighlight]
1133+ } deriving (Read, Show, Eq, Generic, Typeable)
1134+
1135+data FieldHighlight = FieldHighlight FieldName (Maybe HighlightSettings)
1136+ deriving (Read, Show, Eq, Generic, Typeable)
1137+
1138+
1139+data HighlightSettings = Plain PlainHighlight
1140+ | Postings PostingsHighlight
1141+ | FastVector FastVectorHighlight
1142+ deriving (Read, Show, Eq, Generic, Typeable)
1143+data PlainHighlight =
1144+ PlainHighlight { plainCommon :: Maybe CommonHighlight
1145+ , plainNonPost :: Maybe NonPostings } deriving (Read, Show, Eq, Generic, Typeable)
1146+
1147+ -- This requires that index_options are set to 'offset' in the mapping.
1148+data PostingsHighlight = PostingsHighlight (Maybe CommonHighlight) deriving (Read, Show, Eq, Generic, Typeable)
1149+
1150+-- This requires that term_vector is set to 'with_positions_offsets' in the mapping.
1151+data FastVectorHighlight =
1152+ FastVectorHighlight { fvCommon :: Maybe CommonHighlight
1153+ , fvNonPostSettings :: Maybe NonPostings
1154+ , boundaryChars :: Maybe Text
1155+ , boundaryMaxScan :: Maybe Int
1156+ , fragmentOffset :: Maybe Int
1157+ , matchedFields :: [Text]
1158+ , phraseLimit :: Maybe Int
1159+ } deriving (Read, Show, Eq, Generic, Typeable)
1160+
1161+data CommonHighlight =
1162+ CommonHighlight { order :: Maybe Text
1163+ , forceSource :: Maybe Bool
1164+ , tag :: Maybe HighlightTag
1165+ , encoder :: Maybe HighlightEncoder
1166+ , noMatchSize :: Maybe Int
1167+ , highlightQuery :: Maybe Query
1168+ , requireFieldMatch :: Maybe Bool
1169+ } deriving (Read, Show, Eq, Generic, Typeable)
1170+
1171+-- Settings that are only applicable to FastVector and Plain highlighters.
1172+data NonPostings =
1173+ NonPostings { fragmentSize :: Maybe Int
1174+ , numberOfFragments :: Maybe Int} deriving (Read, Show, Eq, Generic, Typeable)
1175+
1176+data HighlightEncoder = DefaultEncoder
1177+ | HTMLEncoder
1178+ deriving (Read, Show, Eq, Generic, Typeable)
1179+
1180+-- NOTE: Should the tags use some kind of HTML type, rather than Text?
1181+data HighlightTag = TagSchema Text
1182+ | CustomTags ([Text], [Text]) -- Only uses more than the first value in the lists if fvh
1183+ deriving (Read, Show, Eq, Generic, Typeable)
1184+
1185+
1186+data Query =
1187+ TermQuery Term (Maybe Boost)
1188+ | TermsQuery Text (NonEmpty Text)
1189+ | QueryMatchQuery MatchQuery
1190+ | QueryMultiMatchQuery MultiMatchQuery
1191+ | QueryBoolQuery BoolQuery
1192+ | QueryBoostingQuery BoostingQuery
1193+ | QueryCommonTermsQuery CommonTermsQuery
1194+ | ConstantScoreQuery Query Boost
1195+ | QueryDisMaxQuery DisMaxQuery
1196+ | QueryFuzzyLikeThisQuery FuzzyLikeThisQuery
1197+ | QueryFuzzyLikeFieldQuery FuzzyLikeFieldQuery
1198+ | QueryFuzzyQuery FuzzyQuery
1199+ | QueryHasChildQuery HasChildQuery
1200+ | QueryHasParentQuery HasParentQuery
1201+ | IdsQuery MappingName [DocId]
1202+ | QueryIndicesQuery IndicesQuery
1203+ | MatchAllQuery (Maybe Boost)
1204+ | QueryMoreLikeThisQuery MoreLikeThisQuery
1205+ | QueryMoreLikeThisFieldQuery MoreLikeThisFieldQuery
1206+ | QueryNestedQuery NestedQuery
1207+ | QueryPrefixQuery PrefixQuery
1208+ | QueryQueryStringQuery QueryStringQuery
1209+ | QuerySimpleQueryStringQuery SimpleQueryStringQuery
1210+ | QueryRangeQuery RangeQuery
1211+ | QueryRegexpQuery RegexpQuery
1212+ | QueryExistsQuery FieldName
1213+ | QueryMatchNoneQuery
1214+ deriving (Eq, Read, Show, Generic, Typeable)
1215+
1216+-- | As of Elastic 2.0, 'Filters' are just 'Queries' housed in a Bool Query, and
1217+-- flagged in a different context.
1218+newtype Filter = Filter { unFilter :: Query }
1219+ deriving (Eq, Read, Show, Generic, Typeable)
1220+
1221+instance ToJSON Filter where
1222+ toJSON = toJSON . unFilter
1223+
1224+instance FromJSON Filter where
1225+ parseJSON v = Filter <$> parseJSON v
1226+
1227+data RegexpQuery =
1228+ RegexpQuery { regexpQueryField :: FieldName
1229+ , regexpQuery :: Regexp
1230+ , regexpQueryFlags :: RegexpFlags
1231+ , regexpQueryBoost :: Maybe Boost
1232+ } deriving (Eq, Read, Show, Generic, Typeable)
1233+
1234+data RangeQuery =
1235+ RangeQuery { rangeQueryField :: FieldName
1236+ , rangeQueryRange :: RangeValue
1237+ , rangeQueryBoost :: Boost } deriving (Eq, Read, Show, Generic, Typeable)
1238+
1239+mkRangeQuery :: FieldName -> RangeValue -> RangeQuery
1240+mkRangeQuery f r = RangeQuery f r (Boost 1.0)
1241+
1242+data SimpleQueryStringQuery =
1243+ SimpleQueryStringQuery
1244+ { simpleQueryStringQuery :: QueryString
1245+ , simpleQueryStringField :: Maybe FieldOrFields
1246+ , simpleQueryStringOperator :: Maybe BooleanOperator
1247+ , simpleQueryStringAnalyzer :: Maybe Analyzer
1248+ , simpleQueryStringFlags :: Maybe (NonEmpty SimpleQueryFlag)
1249+ , simpleQueryStringLowercaseExpanded :: Maybe LowercaseExpanded
1250+ , simpleQueryStringLocale :: Maybe Locale
1251+ } deriving (Eq, Read, Show, Generic, Typeable)
1252+
1253+data SimpleQueryFlag =
1254+ SimpleQueryAll
1255+ | SimpleQueryNone
1256+ | SimpleQueryAnd
1257+ | SimpleQueryOr
1258+ | SimpleQueryPrefix
1259+ | SimpleQueryPhrase
1260+ | SimpleQueryPrecedence
1261+ | SimpleQueryEscape
1262+ | SimpleQueryWhitespace
1263+ | SimpleQueryFuzzy
1264+ | SimpleQueryNear
1265+ | SimpleQuerySlop deriving (Eq, Read, Show, Generic, Typeable)
1266+
1267+-- use_dis_max and tie_breaker when fields are plural?
1268+data QueryStringQuery =
1269+ QueryStringQuery
1270+ { queryStringQuery :: QueryString
1271+ , queryStringDefaultField :: Maybe FieldName
1272+ , queryStringOperator :: Maybe BooleanOperator
1273+ , queryStringAnalyzer :: Maybe Analyzer
1274+ , queryStringAllowLeadingWildcard :: Maybe AllowLeadingWildcard
1275+ , queryStringLowercaseExpanded :: Maybe LowercaseExpanded
1276+ , queryStringEnablePositionIncrements :: Maybe EnablePositionIncrements
1277+ , queryStringFuzzyMaxExpansions :: Maybe MaxExpansions
1278+ , queryStringFuzziness :: Maybe Fuzziness
1279+ , queryStringFuzzyPrefixLength :: Maybe PrefixLength
1280+ , queryStringPhraseSlop :: Maybe PhraseSlop
1281+ , queryStringBoost :: Maybe Boost
1282+ , queryStringAnalyzeWildcard :: Maybe AnalyzeWildcard
1283+ , queryStringGeneratePhraseQueries :: Maybe GeneratePhraseQueries
1284+ , queryStringMinimumShouldMatch :: Maybe MinimumMatch
1285+ , queryStringLenient :: Maybe Lenient
1286+ , queryStringLocale :: Maybe Locale
1287+ } deriving (Eq, Read, Show, Generic, Typeable)
1288+
1289+mkQueryStringQuery :: QueryString -> QueryStringQuery
1290+mkQueryStringQuery qs =
1291+ QueryStringQuery qs Nothing Nothing
1292+ Nothing Nothing Nothing Nothing
1293+ Nothing Nothing Nothing Nothing
1294+ Nothing Nothing Nothing Nothing
1295+ Nothing Nothing
1296+
1297+data FieldOrFields = FofField FieldName
1298+ | FofFields (NonEmpty FieldName) deriving (Eq, Read, Show, Generic, Typeable)
1299+
1300+data PrefixQuery =
1301+ PrefixQuery
1302+ { prefixQueryField :: FieldName
1303+ , prefixQueryPrefixValue :: Text
1304+ , prefixQueryBoost :: Maybe Boost } deriving (Eq, Read, Show, Generic, Typeable)
1305+
1306+data NestedQuery =
1307+ NestedQuery
1308+ { nestedQueryPath :: QueryPath
1309+ , nestedQueryScoreType :: ScoreType
1310+ , nestedQuery :: Query } deriving (Eq, Read, Show, Generic, Typeable)
1311+
1312+data MoreLikeThisFieldQuery =
1313+ MoreLikeThisFieldQuery
1314+ { moreLikeThisFieldText :: Text
1315+ , moreLikeThisFieldFields :: FieldName
1316+ -- default 0.3 (30%)
1317+ , moreLikeThisFieldPercentMatch :: Maybe PercentMatch
1318+ , moreLikeThisFieldMinimumTermFreq :: Maybe MinimumTermFrequency
1319+ , moreLikeThisFieldMaxQueryTerms :: Maybe MaxQueryTerms
1320+ , moreLikeThisFieldStopWords :: Maybe (NonEmpty StopWord)
1321+ , moreLikeThisFieldMinDocFrequency :: Maybe MinDocFrequency
1322+ , moreLikeThisFieldMaxDocFrequency :: Maybe MaxDocFrequency
1323+ , moreLikeThisFieldMinWordLength :: Maybe MinWordLength
1324+ , moreLikeThisFieldMaxWordLength :: Maybe MaxWordLength
1325+ , moreLikeThisFieldBoostTerms :: Maybe BoostTerms
1326+ , moreLikeThisFieldBoost :: Maybe Boost
1327+ , moreLikeThisFieldAnalyzer :: Maybe Analyzer
1328+ } deriving (Eq, Read, Show, Generic, Typeable)
1329+
1330+data MoreLikeThisQuery =
1331+ MoreLikeThisQuery
1332+ { moreLikeThisText :: Text
1333+ , moreLikeThisFields :: Maybe (NonEmpty FieldName)
1334+ -- default 0.3 (30%)
1335+ , moreLikeThisPercentMatch :: Maybe PercentMatch
1336+ , moreLikeThisMinimumTermFreq :: Maybe MinimumTermFrequency
1337+ , moreLikeThisMaxQueryTerms :: Maybe MaxQueryTerms
1338+ , moreLikeThisStopWords :: Maybe (NonEmpty StopWord)
1339+ , moreLikeThisMinDocFrequency :: Maybe MinDocFrequency
1340+ , moreLikeThisMaxDocFrequency :: Maybe MaxDocFrequency
1341+ , moreLikeThisMinWordLength :: Maybe MinWordLength
1342+ , moreLikeThisMaxWordLength :: Maybe MaxWordLength
1343+ , moreLikeThisBoostTerms :: Maybe BoostTerms
1344+ , moreLikeThisBoost :: Maybe Boost
1345+ , moreLikeThisAnalyzer :: Maybe Analyzer
1346+ } deriving (Eq, Read, Show, Generic, Typeable)
1347+
1348+data IndicesQuery =
1349+ IndicesQuery
1350+ { indicesQueryIndices :: [IndexName]
1351+ , indicesQuery :: Query
1352+ -- default "all"
1353+ , indicesQueryNoMatch :: Maybe Query } deriving (Eq, Read, Show, Generic, Typeable)
1354+
1355+data HasParentQuery =
1356+ HasParentQuery
1357+ { hasParentQueryType :: TypeName
1358+ , hasParentQuery :: Query
1359+ , hasParentQueryScoreType :: Maybe ScoreType } deriving (Eq, Read, Show, Generic, Typeable)
1360+
1361+data HasChildQuery =
1362+ HasChildQuery
1363+ { hasChildQueryType :: TypeName
1364+ , hasChildQuery :: Query
1365+ , hasChildQueryScoreType :: Maybe ScoreType } deriving (Eq, Read, Show, Generic, Typeable)
1366+
1367+data ScoreType =
1368+ ScoreTypeMax
1369+ | ScoreTypeSum
1370+ | ScoreTypeAvg
1371+ | ScoreTypeNone deriving (Eq, Read, Show, Generic, Typeable)
1372+
1373+data FuzzyQuery =
1374+ FuzzyQuery { fuzzyQueryField :: FieldName
1375+ , fuzzyQueryValue :: Text
1376+ , fuzzyQueryPrefixLength :: PrefixLength
1377+ , fuzzyQueryMaxExpansions :: MaxExpansions
1378+ , fuzzyQueryFuzziness :: Fuzziness
1379+ , fuzzyQueryBoost :: Maybe Boost
1380+ } deriving (Eq, Read, Show, Generic, Typeable)
1381+
1382+data FuzzyLikeFieldQuery =
1383+ FuzzyLikeFieldQuery
1384+ { fuzzyLikeField :: FieldName
1385+ -- anaphora is good for the soul.
1386+ , fuzzyLikeFieldText :: Text
1387+ , fuzzyLikeFieldMaxQueryTerms :: MaxQueryTerms
1388+ , fuzzyLikeFieldIgnoreTermFrequency :: IgnoreTermFrequency
1389+ , fuzzyLikeFieldFuzziness :: Fuzziness
1390+ , fuzzyLikeFieldPrefixLength :: PrefixLength
1391+ , fuzzyLikeFieldBoost :: Boost
1392+ , fuzzyLikeFieldAnalyzer :: Maybe Analyzer
1393+ } deriving (Eq, Read, Show, Generic, Typeable)
1394+
1395+data FuzzyLikeThisQuery =
1396+ FuzzyLikeThisQuery
1397+ { fuzzyLikeFields :: [FieldName]
1398+ , fuzzyLikeText :: Text
1399+ , fuzzyLikeMaxQueryTerms :: MaxQueryTerms
1400+ , fuzzyLikeIgnoreTermFrequency :: IgnoreTermFrequency
1401+ , fuzzyLikeFuzziness :: Fuzziness
1402+ , fuzzyLikePrefixLength :: PrefixLength
1403+ , fuzzyLikeBoost :: Boost
1404+ , fuzzyLikeAnalyzer :: Maybe Analyzer
1405+ } deriving (Eq, Read, Show, Generic, Typeable)
1406+
1407+data DisMaxQuery =
1408+ DisMaxQuery { disMaxQueries :: [Query]
1409+ -- default 0.0
1410+ , disMaxTiebreaker :: Tiebreaker
1411+ , disMaxBoost :: Maybe Boost
1412+ } deriving (Eq, Read, Show, Generic, Typeable)
1413+
1414+data MatchQuery =
1415+ MatchQuery { matchQueryField :: FieldName
1416+ , matchQueryQueryString :: QueryString
1417+ , matchQueryOperator :: BooleanOperator
1418+ , matchQueryZeroTerms :: ZeroTermsQuery
1419+ , matchQueryCutoffFrequency :: Maybe CutoffFrequency
1420+ , matchQueryMatchType :: Maybe MatchQueryType
1421+ , matchQueryAnalyzer :: Maybe Analyzer
1422+ , matchQueryMaxExpansions :: Maybe MaxExpansions
1423+ , matchQueryLenient :: Maybe Lenient
1424+ , matchQueryBoost :: Maybe Boost } deriving (Eq, Read, Show, Generic, Typeable)
1425+
1426+{-| 'mkMatchQuery' is a convenience function that defaults the less common parameters,
1427+ enabling you to provide only the 'FieldName' and 'QueryString' to make a 'MatchQuery'
1428+-}
1429+mkMatchQuery :: FieldName -> QueryString -> MatchQuery
1430+mkMatchQuery field query = MatchQuery field query Or ZeroTermsNone Nothing Nothing Nothing Nothing Nothing Nothing
1431+
1432+data MatchQueryType =
1433+ MatchPhrase
1434+ | MatchPhrasePrefix deriving (Eq, Read, Show, Generic, Typeable)
1435+
1436+data MultiMatchQuery =
1437+ MultiMatchQuery { multiMatchQueryFields :: [FieldName]
1438+ , multiMatchQueryString :: QueryString
1439+ , multiMatchQueryOperator :: BooleanOperator
1440+ , multiMatchQueryZeroTerms :: ZeroTermsQuery
1441+ , multiMatchQueryTiebreaker :: Maybe Tiebreaker
1442+ , multiMatchQueryType :: Maybe MultiMatchQueryType
1443+ , multiMatchQueryCutoffFrequency :: Maybe CutoffFrequency
1444+ , multiMatchQueryAnalyzer :: Maybe Analyzer
1445+ , multiMatchQueryMaxExpansions :: Maybe MaxExpansions
1446+ , multiMatchQueryLenient :: Maybe Lenient } deriving (Eq, Read, Show, Generic, Typeable)
1447+
1448+{-| 'mkMultiMatchQuery' is a convenience function that defaults the less common parameters,
1449+ enabling you to provide only the list of 'FieldName's and 'QueryString' to
1450+ make a 'MultiMatchQuery'.
1451+-}
1452+
1453+mkMultiMatchQuery :: [FieldName] -> QueryString -> MultiMatchQuery
1454+mkMultiMatchQuery matchFields query =
1455+ MultiMatchQuery matchFields query
1456+ Or ZeroTermsNone Nothing Nothing Nothing Nothing Nothing Nothing
1457+
1458+data MultiMatchQueryType =
1459+ MultiMatchBestFields
1460+ | MultiMatchMostFields
1461+ | MultiMatchCrossFields
1462+ | MultiMatchPhrase
1463+ | MultiMatchPhrasePrefix deriving (Eq, Read, Show, Generic, Typeable)
1464+
1465+data BoolQuery =
1466+ BoolQuery { boolQueryMustMatch :: [Query]
1467+ , boolQueryFilter :: [Filter]
1468+ , boolQueryMustNotMatch :: [Query]
1469+ , boolQueryShouldMatch :: [Query]
1470+ , boolQueryMinimumShouldMatch :: Maybe MinimumMatch
1471+ , boolQueryBoost :: Maybe Boost
1472+ , boolQueryDisableCoord :: Maybe DisableCoord
1473+ } deriving (Eq, Read, Show, Generic, Typeable)
1474+
1475+mkBoolQuery :: [Query] -> [Filter] -> [Query] -> [Query] -> BoolQuery
1476+mkBoolQuery must filt mustNot should =
1477+ BoolQuery must filt mustNot should Nothing Nothing Nothing
1478+
1479+data BoostingQuery =
1480+ BoostingQuery { positiveQuery :: Query
1481+ , negativeQuery :: Query
1482+ , negativeBoost :: Boost } deriving (Eq, Read, Show, Generic, Typeable)
1483+
1484+data CommonTermsQuery =
1485+ CommonTermsQuery { commonField :: FieldName
1486+ , commonQuery :: QueryString
1487+ , commonCutoffFrequency :: CutoffFrequency
1488+ , commonLowFreqOperator :: BooleanOperator
1489+ , commonHighFreqOperator :: BooleanOperator
1490+ , commonMinimumShouldMatch :: Maybe CommonMinimumMatch
1491+ , commonBoost :: Maybe Boost
1492+ , commonAnalyzer :: Maybe Analyzer
1493+ , commonDisableCoord :: Maybe DisableCoord
1494+ } deriving (Eq, Read, Show, Generic, Typeable)
1495+
1496+data CommonMinimumMatch =
1497+ CommonMinimumMatchHighLow MinimumMatchHighLow
1498+ | CommonMinimumMatch MinimumMatch
1499+ deriving (Eq, Read, Show, Generic, Typeable)
1500+
1501+data MinimumMatchHighLow =
1502+ MinimumMatchHighLow { lowFreq :: MinimumMatch
1503+ , highFreq :: MinimumMatch } deriving (Eq, Read, Show, Generic, Typeable)
1504+
1505+data ZeroTermsQuery = ZeroTermsNone
1506+ | ZeroTermsAll deriving (Eq, Read, Show, Generic, Typeable)
1507+
1508+data RangeExecution = RangeExecutionIndex
1509+ | RangeExecutionFielddata deriving (Eq, Read, Show, Generic, Typeable)
1510+
1511+newtype Regexp = Regexp Text deriving (Eq, Read, Show, Generic, Typeable, FromJSON)
1512+
1513+data RegexpFlags = AllRegexpFlags
1514+ | NoRegexpFlags
1515+ | SomeRegexpFlags (NonEmpty RegexpFlag) deriving (Eq, Read, Show, Generic, Typeable)
1516+
1517+data RegexpFlag = AnyString
1518+ | Automaton
1519+ | Complement
1520+ | Empty
1521+ | Intersection
1522+ | Interval deriving (Eq, Read, Show, Generic, Typeable)
1523+
1524+newtype LessThan = LessThan Double deriving (Eq, Read, Show, Generic, Typeable)
1525+newtype LessThanEq = LessThanEq Double deriving (Eq, Read, Show, Generic, Typeable)
1526+newtype GreaterThan = GreaterThan Double deriving (Eq, Read, Show, Generic, Typeable)
1527+newtype GreaterThanEq = GreaterThanEq Double deriving (Eq, Read, Show, Generic, Typeable)
1528+
1529+newtype LessThanD = LessThanD UTCTime deriving (Eq, Read, Show, Generic, Typeable)
1530+newtype LessThanEqD = LessThanEqD UTCTime deriving (Eq, Read, Show, Generic, Typeable)
1531+newtype GreaterThanD = GreaterThanD UTCTime deriving (Eq, Read, Show, Generic, Typeable)
1532+newtype GreaterThanEqD = GreaterThanEqD UTCTime deriving (Eq, Read, Show, Generic, Typeable)
1533+
1534+data RangeValue = RangeDateLte LessThanEqD
1535+ | RangeDateLt LessThanD
1536+ | RangeDateGte GreaterThanEqD
1537+ | RangeDateGt GreaterThanD
1538+ | RangeDateGtLt GreaterThanD LessThanD
1539+ | RangeDateGteLte GreaterThanEqD LessThanEqD
1540+ | RangeDateGteLt GreaterThanEqD LessThanD
1541+ | RangeDateGtLte GreaterThanD LessThanEqD
1542+ | RangeDoubleLte LessThanEq
1543+ | RangeDoubleLt LessThan
1544+ | RangeDoubleGte GreaterThanEq
1545+ | RangeDoubleGt GreaterThan
1546+ | RangeDoubleGtLt GreaterThan LessThan
1547+ | RangeDoubleGteLte GreaterThanEq LessThanEq
1548+ | RangeDoubleGteLt GreaterThanEq LessThan
1549+ | RangeDoubleGtLte GreaterThan LessThanEq
1550+ deriving (Eq, Read, Show, Generic, Typeable)
1551+
1552+rangeValueToPair :: RangeValue -> [Pair]
1553+rangeValueToPair rv = case rv of
1554+ RangeDateLte (LessThanEqD t) -> ["lte" .= t]
1555+ RangeDateGte (GreaterThanEqD t) -> ["gte" .= t]
1556+ RangeDateLt (LessThanD t) -> ["lt" .= t]
1557+ RangeDateGt (GreaterThanD t) -> ["gt" .= t]
1558+ RangeDateGteLte (GreaterThanEqD l) (LessThanEqD g) -> ["gte" .= l, "lte" .= g]
1559+ RangeDateGtLte (GreaterThanD l) (LessThanEqD g) -> ["gt" .= l, "lte" .= g]
1560+ RangeDateGteLt (GreaterThanEqD l) (LessThanD g) -> ["gte" .= l, "lt" .= g]
1561+ RangeDateGtLt (GreaterThanD l) (LessThanD g) -> ["gt" .= l, "lt" .= g]
1562+ RangeDoubleLte (LessThanEq t) -> ["lte" .= t]
1563+ RangeDoubleGte (GreaterThanEq t) -> ["gte" .= t]
1564+ RangeDoubleLt (LessThan t) -> ["lt" .= t]
1565+ RangeDoubleGt (GreaterThan t) -> ["gt" .= t]
1566+ RangeDoubleGteLte (GreaterThanEq l) (LessThanEq g) -> ["gte" .= l, "lte" .= g]
1567+ RangeDoubleGtLte (GreaterThan l) (LessThanEq g) -> ["gt" .= l, "lte" .= g]
1568+ RangeDoubleGteLt (GreaterThanEq l) (LessThan g) -> ["gte" .= l, "lt" .= g]
1569+ RangeDoubleGtLt (GreaterThan l) (LessThan g) -> ["gt" .= l, "lt" .= g]
1570+
1571+data Term = Term { termField :: Text
1572+ , termValue :: Text } deriving (Eq, Read, Show, Generic, Typeable)
1573+
1574+data BoolMatch = MustMatch Term Cache
1575+ | MustNotMatch Term Cache
1576+ | ShouldMatch [Term] Cache deriving (Eq, Read, Show, Generic, Typeable)
1577+
1578+-- "memory" or "indexed"
1579+data GeoFilterType = GeoFilterMemory
1580+ | GeoFilterIndexed deriving (Eq, Read, Show, Generic, Typeable)
1581+
1582+data LatLon = LatLon { lat :: Double
1583+ , lon :: Double } deriving (Eq, Read, Show, Generic, Typeable)
1584+
1585+data GeoBoundingBox =
1586+ GeoBoundingBox { topLeft :: LatLon
1587+ , bottomRight :: LatLon } deriving (Eq, Read, Show, Generic, Typeable)
1588+
1589+data GeoBoundingBoxConstraint =
1590+ GeoBoundingBoxConstraint { geoBBField :: FieldName
1591+ , constraintBox :: GeoBoundingBox
1592+ , bbConstraintcache :: Cache
1593+ , geoType :: GeoFilterType
1594+ } deriving (Eq, Read, Show, Generic, Typeable)
1595+
1596+data GeoPoint =
1597+ GeoPoint { geoField :: FieldName
1598+ , latLon :: LatLon} deriving (Eq, Read, Show, Generic, Typeable)
1599+
1600+data DistanceUnit = Miles
1601+ | Yards
1602+ | Feet
1603+ | Inches
1604+ | Kilometers
1605+ | Meters
1606+ | Centimeters
1607+ | Millimeters
1608+ | NauticalMiles deriving (Eq, Read, Show, Generic, Typeable)
1609+
1610+data DistanceType = Arc
1611+ | SloppyArc -- doesn't exist <1.0
1612+ | Plane deriving (Eq, Read, Show, Generic, Typeable)
1613+
1614+data OptimizeBbox = OptimizeGeoFilterType GeoFilterType
1615+ | NoOptimizeBbox deriving (Eq, Read, Show, Generic, Typeable)
1616+
1617+data Distance =
1618+ Distance { coefficient :: Double
1619+ , unit :: DistanceUnit } deriving (Eq, Read, Show, Generic, Typeable)
1620+
1621+data DistanceRange =
1622+ DistanceRange { distanceFrom :: Distance
1623+ , distanceTo :: Distance } deriving (Eq, Read, Show, Generic, Typeable)
1624+
1625+data SearchResult a =
1626+ SearchResult { took :: Int
1627+ , timedOut :: Bool
1628+ , shards :: ShardResult
1629+ , searchHits :: SearchHits a
1630+ , aggregations :: Maybe AggregationResults
1631+ , scrollId :: Maybe ScrollId } deriving (Eq, Read, Show, Generic, Typeable)
1632+
1633+newtype ScrollId = ScrollId Text deriving (Eq, Read, Show, Generic, Ord, ToJSON, FromJSON)
1634+
1635+type Score = Maybe Double
1636+
1637+data SearchHits a =
1638+ SearchHits { hitsTotal :: Int
1639+ , maxScore :: Score
1640+ , hits :: [Hit a] } deriving (Eq, Read, Show, Generic, Typeable)
1641+
1642+instance Semigroup (SearchHits a) where
1643+ (SearchHits ta ma ha) <> (SearchHits tb mb hb) = SearchHits (ta + tb) (max ma mb) (ha <> hb)
1644+
1645+instance Monoid (SearchHits a) where
1646+ mempty = SearchHits 0 Nothing mempty
1647+ mappend = (<>)
1648+
1649+data Hit a =
1650+ Hit { hitIndex :: IndexName
1651+ , hitType :: MappingName
1652+ , hitDocId :: DocId
1653+ , hitScore :: Score
1654+ , hitSource :: Maybe a
1655+ , hitHighlight :: Maybe HitHighlight } deriving (Eq, Read, Show, Generic, Typeable)
1656+
1657+data ShardResult =
1658+ ShardResult { shardTotal :: Int
1659+ , shardsSuccessful :: Int
1660+ , shardsFailed :: Int } deriving (Eq, Read, Show, Generic, Typeable)
1661+
1662+type HitHighlight = M.Map Text [Text]
1663+
1664+showText :: Show a => a -> Text
1665+showText = T.pack . show
1666+
1667+readMay :: Read a => String -> Maybe a
1668+readMay s = case reads s of
1669+ (a, ""):_ -> Just a
1670+ _ -> Nothing
1671+
1672+parseReadText :: Read a => Text -> Parser a
1673+parseReadText = maybe mzero return . readMay . T.unpack
1674+
1675+type Aggregations = M.Map Text Aggregation
1676+
1677+emptyAggregations :: Aggregations
1678+emptyAggregations = M.empty
1679+
1680+mkAggregations :: Text -> Aggregation -> Aggregations
1681+mkAggregations name aggregation = M.insert name aggregation emptyAggregations
1682+
1683+data TermOrder = TermOrder{ termSortField :: Text
1684+ , termSortOrder :: SortOrder } deriving (Eq, Read, Show, Generic, Typeable)
1685+
1686+data TermInclusion = TermInclusion Text
1687+ | TermPattern Text Text deriving (Eq, Read, Show, Generic, Typeable)
1688+
1689+data CollectionMode = BreadthFirst
1690+ | DepthFirst deriving (Eq, Read, Show, Generic, Typeable)
1691+
1692+data ExecutionHint = Ordinals
1693+ | GlobalOrdinals
1694+ | GlobalOrdinalsHash
1695+ | GlobalOrdinalsLowCardinality
1696+ | Map deriving (Eq, Read, Show, Generic, Typeable)
1697+
1698+data TimeInterval = Weeks
1699+ | Days
1700+ | Hours
1701+ | Minutes
1702+ | Seconds deriving Eq
1703+
1704+data Interval = Year
1705+ | Quarter
1706+ | Month
1707+ | Week
1708+ | Day
1709+ | Hour
1710+ | Minute
1711+ | Second deriving (Eq, Read, Show, Generic, Typeable)
1712+
1713+data Aggregation = TermsAgg TermsAggregation
1714+ | CardinalityAgg CardinalityAggregation
1715+ | DateHistogramAgg DateHistogramAggregation
1716+ | ValueCountAgg ValueCountAggregation
1717+ | FilterAgg FilterAggregation
1718+ | DateRangeAgg DateRangeAggregation
1719+ | MissingAgg MissingAggregation
1720+ | TopHitsAgg TopHitsAggregation
1721+ | StatsAgg StatisticsAggregation
1722+ deriving (Eq, Read, Show, Generic, Typeable)
1723+
1724+data TopHitsAggregation = TopHitsAggregation
1725+ { taFrom :: Maybe From
1726+ , taSize :: Maybe Size
1727+ , taSort :: Maybe Sort
1728+ } deriving (Eq, Read, Show)
1729+
1730+data MissingAggregation = MissingAggregation
1731+ { maField :: Text
1732+ } deriving (Eq, Read, Show, Generic, Typeable)
1733+
1734+data TermsAggregation = TermsAggregation { term :: Either Text Text
1735+ , termInclude :: Maybe TermInclusion
1736+ , termExclude :: Maybe TermInclusion
1737+ , termOrder :: Maybe TermOrder
1738+ , termMinDocCount :: Maybe Int
1739+ , termSize :: Maybe Int
1740+ , termShardSize :: Maybe Int
1741+ , termCollectMode :: Maybe CollectionMode
1742+ , termExecutionHint :: Maybe ExecutionHint
1743+ , termAggs :: Maybe Aggregations
1744+ } deriving (Eq, Read, Show, Generic, Typeable)
1745+
1746+data CardinalityAggregation = CardinalityAggregation { cardinalityField :: FieldName,
1747+ precisionThreshold :: Maybe Int
1748+ } deriving (Eq, Read, Show, Generic, Typeable)
1749+
1750+data DateHistogramAggregation = DateHistogramAggregation { dateField :: FieldName
1751+ , dateInterval :: Interval
1752+ , dateFormat :: Maybe Text
1753+ -- pre and post deprecated in 1.5
1754+ , datePreZone :: Maybe Text
1755+ , datePostZone :: Maybe Text
1756+ , datePreOffset :: Maybe Text
1757+ , datePostOffset :: Maybe Text
1758+ , dateAggs :: Maybe Aggregations
1759+ } deriving (Eq, Read, Show, Generic, Typeable)
1760+
1761+
1762+data DateRangeAggregation = DateRangeAggregation { draField :: FieldName
1763+ , draFormat :: Maybe Text
1764+ , draRanges :: NonEmpty DateRangeAggRange
1765+ } deriving (Eq, Read, Show, Generic, Typeable)
1766+
1767+data DateRangeAggRange = DateRangeFrom DateMathExpr
1768+ | DateRangeTo DateMathExpr
1769+ | DateRangeFromAndTo DateMathExpr DateMathExpr deriving (Eq, Read, Show, Generic, Typeable)
1770+
1771+-- | See <https://www.elastic.co/guide/en/elasticsearch/reference/current/common-options.html#date-math> for more information.
1772+data DateMathExpr = DateMathExpr DateMathAnchor [DateMathModifier] deriving (Eq, Read, Show, Generic, Typeable)
1773+
1774+
1775+-- | Starting point for a date range. This along with the 'DateMathModifiers' gets you the date ES will start from.
1776+data DateMathAnchor = DMNow
1777+ | DMDate Day deriving (Eq, Read, Show, Generic, Typeable)
1778+
1779+data DateMathModifier = AddTime Int DateMathUnit
1780+ | SubtractTime Int DateMathUnit
1781+ | RoundDownTo DateMathUnit deriving (Eq, Read, Show, Generic, Typeable)
1782+
1783+data DateMathUnit = DMYear
1784+ | DMMonth
1785+ | DMWeek
1786+ | DMDay
1787+ | DMHour
1788+ | DMMinute
1789+ | DMSecond deriving (Eq, Read, Show, Generic, Typeable)
1790+
1791+-- | See <https://www.elastic.co/guide/en/elasticsearch/reference/current/search-aggregations-metrics-valuecount-aggregation.html> for more information.
1792+data ValueCountAggregation = FieldValueCount FieldName
1793+ | ScriptValueCount Script deriving (Eq, Read, Show, Generic, Typeable)
1794+
1795+-- | Single-bucket filter aggregations. See <https://www.elastic.co/guide/en/elasticsearch/reference/current/search-aggregations-bucket-filter-aggregation.html#search-aggregations-bucket-filter-aggregation> for more information.
1796+data FilterAggregation = FilterAggregation { faFilter :: Filter
1797+ , faAggs :: Maybe Aggregations} deriving (Eq, Read, Show, Generic, Typeable)
1798+
1799+data StatisticsAggregation = StatisticsAggregation { statsType :: StatsType
1800+ , statsField :: FieldName } deriving (Eq, Read, Show, Generic, Typeable)
1801+
1802+data StatsType
1803+ = Basic
1804+ | Extended
1805+ deriving (Eq, Read, Show, Generic, Typeable)
1806+
1807+mkTermsAggregation :: Text -> TermsAggregation
1808+mkTermsAggregation t = TermsAggregation (Left t) Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing
1809+
1810+mkTermsScriptAggregation :: Text -> TermsAggregation
1811+mkTermsScriptAggregation t = TermsAggregation (Right t) Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing
1812+
1813+mkDateHistogram :: FieldName -> Interval -> DateHistogramAggregation
1814+mkDateHistogram t i = DateHistogramAggregation t i Nothing Nothing Nothing Nothing Nothing Nothing
1815+
1816+mkCardinalityAggregation :: FieldName -> CardinalityAggregation
1817+mkCardinalityAggregation t = CardinalityAggregation t Nothing
1818+
1819+mkStatsAggregation :: FieldName -> StatisticsAggregation
1820+mkStatsAggregation = StatisticsAggregation Basic
1821+
1822+mkExtendedStatsAggregation :: FieldName -> StatisticsAggregation
1823+mkExtendedStatsAggregation = StatisticsAggregation Extended
1824+
1825+instance ToJSON Version where
1826+ toJSON Version {..} = object ["number" .= number
1827+ ,"build_hash" .= build_hash
1828+ ,"build_date" .= build_date
1829+ ,"build_snapshot" .= build_snapshot
1830+ ,"lucene_version" .= lucene_version]
1831+
1832+instance FromJSON Version where
1833+ parseJSON = withObject "Version" parse
1834+ where parse o = Version
1835+ <$> o .: "number"
1836+ <*> o .: "build_hash"
1837+ <*> o .: "build_date"
1838+ <*> o .: "build_snapshot"
1839+ <*> o .: "lucene_version"
1840+
1841+instance ToJSON VersionNumber where
1842+ toJSON = toJSON . Vers.showVersion . versionNumber
1843+
1844+instance FromJSON VersionNumber where
1845+ parseJSON = withText "VersionNumber" (parse . T.unpack)
1846+ where
1847+ parse s = case filter (null . snd)(RP.readP_to_S Vers.parseVersion s) of
1848+ [(v, _)] -> pure (VersionNumber v)
1849+ [] -> fail ("Invalid version string " ++ s)
1850+ xs -> fail ("Ambiguous version string " ++ s ++ " (" ++ intercalate ", " (Vers.showVersion . fst <$> xs) ++ ")")
1851+
1852+instance ToJSON TermOrder where
1853+ toJSON (TermOrder termSortField termSortOrder) = object [termSortField .= termSortOrder]
1854+
1855+instance ToJSON TermInclusion where
1856+ toJSON (TermInclusion x) = toJSON x
1857+ toJSON (TermPattern pattern flags) = omitNulls [ "pattern" .= pattern,
1858+ "flags" .= flags]
1859+
1860+instance ToJSON CollectionMode where
1861+ toJSON BreadthFirst = "breadth_first"
1862+ toJSON DepthFirst = "depth_first"
1863+
1864+instance ToJSON ExecutionHint where
1865+ toJSON Ordinals = "ordinals"
1866+ toJSON GlobalOrdinals = "global_ordinals"
1867+ toJSON GlobalOrdinalsHash = "global_ordinals_hash"
1868+ toJSON GlobalOrdinalsLowCardinality = "global_ordinals_low_cardinality"
1869+ toJSON Map = "map"
1870+
1871+instance ToJSON Interval where
1872+ toJSON Year = "year"
1873+ toJSON Quarter = "quarter"
1874+ toJSON Month = "month"
1875+ toJSON Week = "week"
1876+ toJSON Day = "day"
1877+ toJSON Hour = "hour"
1878+ toJSON Minute = "minute"
1879+ toJSON Second = "second"
1880+
1881+instance Show TimeInterval where
1882+ show Weeks = "w"
1883+ show Days = "d"
1884+ show Hours = "h"
1885+ show Minutes = "m"
1886+ show Seconds = "s"
1887+
1888+instance Read TimeInterval where
1889+ readPrec = f =<< TR.get
1890+ where
1891+ f 'w' = return Weeks
1892+ f 'd' = return Days
1893+ f 'h' = return Hours
1894+ f 'm' = return Minutes
1895+ f 's' = return Seconds
1896+ f _ = fail "TimeInterval expected one of w, d, h, m, s"
1897+
1898+instance ToJSON Aggregation where
1899+ toJSON (TermsAgg (TermsAggregation term include exclude order minDocCount size shardSize collectMode executionHint termAggs)) =
1900+ omitNulls ["terms" .= omitNulls [ toJSON' term,
1901+ "include" .= include,
1902+ "exclude" .= exclude,
1903+ "order" .= order,
1904+ "min_doc_count" .= minDocCount,
1905+ "size" .= size,
1906+ "shard_size" .= shardSize,
1907+ "collect_mode" .= collectMode,
1908+ "execution_hint" .= executionHint
1909+ ],
1910+ "aggs" .= termAggs ]
1911+ where
1912+ toJSON' x = case x of { Left y -> "field" .= y; Right y -> "script" .= y }
1913+
1914+ toJSON (CardinalityAgg (CardinalityAggregation field precisionThreshold)) =
1915+ object ["cardinality" .= omitNulls [ "field" .= field,
1916+ "precisionThreshold" .= precisionThreshold
1917+ ]
1918+ ]
1919+
1920+ toJSON (DateHistogramAgg (DateHistogramAggregation field interval format preZone postZone preOffset postOffset dateHistoAggs)) =
1921+ omitNulls ["date_histogram" .= omitNulls [ "field" .= field,
1922+ "interval" .= interval,
1923+ "format" .= format,
1924+ "pre_zone" .= preZone,
1925+ "post_zone" .= postZone,
1926+ "pre_offset" .= preOffset,
1927+ "post_offset" .= postOffset
1928+ ],
1929+ "aggs" .= dateHistoAggs ]
1930+ toJSON (ValueCountAgg a) = object ["value_count" .= v]
1931+ where v = case a of
1932+ (FieldValueCount (FieldName n)) -> object ["field" .= n]
1933+ (ScriptValueCount (Script s)) -> object ["script" .= s]
1934+ toJSON (FilterAgg (FilterAggregation filt ags)) =
1935+ omitNulls [ "filter" .= filt
1936+ , "aggs" .= ags]
1937+ toJSON (DateRangeAgg a) = object [ "date_range" .= a
1938+ ]
1939+ toJSON (MissingAgg (MissingAggregation{..})) =
1940+ object ["missing" .= object ["field" .= maField]]
1941+
1942+ toJSON (TopHitsAgg (TopHitsAggregation mfrom msize msort)) =
1943+ omitNulls ["top_hits" .= omitNulls [ "size" .= msize
1944+ , "from" .= mfrom
1945+ , "sort" .= msort
1946+ ]
1947+ ]
1948+
1949+ toJSON (StatsAgg (StatisticsAggregation typ field)) =
1950+ object [stType .= omitNulls [ "field" .= field ]]
1951+ where
1952+ stType | typ == Basic = "stats"
1953+ | otherwise = "extended_stats"
1954+
1955+instance ToJSON DateRangeAggregation where
1956+ toJSON DateRangeAggregation {..} =
1957+ omitNulls [ "field" .= draField
1958+ , "format" .= draFormat
1959+ , "ranges" .= toList draRanges
1960+ ]
1961+
1962+instance ToJSON DateRangeAggRange where
1963+ toJSON (DateRangeFrom e) = object [ "from" .= e ]
1964+ toJSON (DateRangeTo e) = object [ "to" .= e ]
1965+ toJSON (DateRangeFromAndTo f t) = object [ "from" .= f, "to" .= t ]
1966+
1967+instance ToJSON DateMathExpr where
1968+ toJSON (DateMathExpr a mods) = String (fmtA a <> mconcat (fmtMod <$> mods))
1969+ where fmtA DMNow = "now"
1970+ fmtA (DMDate date) = (T.pack $ showGregorian date) <> "||"
1971+ fmtMod (AddTime n u) = "+" <> showText n <> fmtU u
1972+ fmtMod (SubtractTime n u) = "-" <> showText n <> fmtU u
1973+ fmtMod (RoundDownTo u) = "/" <> fmtU u
1974+ fmtU DMYear = "y"
1975+ fmtU DMMonth = "M"
1976+ fmtU DMWeek = "w"
1977+ fmtU DMDay = "d"
1978+ fmtU DMHour = "h"
1979+ fmtU DMMinute = "m"
1980+ fmtU DMSecond = "s"
1981+
1982+
1983+type AggregationResults = M.Map Text Value
1984+
1985+class BucketAggregation a where
1986+ key :: a -> BucketValue
1987+ docCount :: a -> Int
1988+ aggs :: a -> Maybe AggregationResults
1989+
1990+
1991+data Bucket a = Bucket { buckets :: [a]} deriving (Read, Show)
1992+
1993+data BucketValue = TextValue Text
1994+ | ScientificValue Scientific
1995+ | BoolValue Bool deriving (Read, Show)
1996+
1997+data MissingResult = MissingResult { missingDocCount :: Int } deriving (Show)
1998+
1999+data TopHitResult a = TopHitResult { tarHits :: (SearchHits a)
2000+ } deriving Show
2001+
2002+data TermsResult = TermsResult { termKey :: BucketValue
2003+ , termsDocCount :: Int
2004+ , termsAggs :: Maybe AggregationResults } deriving (Read, Show)
2005+
2006+data DateHistogramResult = DateHistogramResult { dateKey :: Int
2007+ , dateKeyStr :: Maybe Text
2008+ , dateDocCount :: Int
2009+ , dateHistogramAggs :: Maybe AggregationResults } deriving (Read, Show)
2010+
2011+data DateRangeResult = DateRangeResult { dateRangeKey :: Text
2012+ , dateRangeFrom :: Maybe UTCTime
2013+ , dateRangeFromAsString :: Maybe Text
2014+ , dateRangeTo :: Maybe UTCTime
2015+ , dateRangeToAsString :: Maybe Text
2016+ , dateRangeDocCount :: Int
2017+ , dateRangeAggs :: Maybe AggregationResults } deriving (Read, Show, Eq, Generic, Typeable)
2018+
2019+toTerms :: Text -> AggregationResults -> Maybe (Bucket TermsResult)
2020+toTerms = toAggResult
2021+
2022+toDateHistogram :: Text -> AggregationResults -> Maybe (Bucket DateHistogramResult)
2023+toDateHistogram = toAggResult
2024+
2025+toMissing :: Text -> AggregationResults -> Maybe MissingResult
2026+toMissing = toAggResult
2027+
2028+toTopHits :: (FromJSON a) => Text -> AggregationResults -> Maybe (TopHitResult a)
2029+toTopHits = toAggResult
2030+
2031+toAggResult :: (FromJSON a) => Text -> AggregationResults -> Maybe a
2032+toAggResult t a = M.lookup t a >>= deserialize
2033+ where deserialize = parseMaybe parseJSON
2034+
2035+instance BucketAggregation TermsResult where
2036+ key = termKey
2037+ docCount = termsDocCount
2038+ aggs = termsAggs
2039+
2040+instance BucketAggregation DateHistogramResult where
2041+ key = TextValue . showText . dateKey
2042+ docCount = dateDocCount
2043+ aggs = dateHistogramAggs
2044+
2045+instance BucketAggregation DateRangeResult where
2046+ key = TextValue . dateRangeKey
2047+ docCount = dateRangeDocCount
2048+ aggs = dateRangeAggs
2049+
2050+instance (FromJSON a, BucketAggregation a) => FromJSON (Bucket a) where
2051+ parseJSON (Object v) = Bucket <$>
2052+ v .: "buckets"
2053+ parseJSON _ = mempty
2054+
2055+instance FromJSON BucketValue where
2056+ parseJSON (String t) = return $ TextValue t
2057+ parseJSON (Number s) = return $ ScientificValue s
2058+ parseJSON (Bool b) = return $ BoolValue b
2059+ parseJSON _ = mempty
2060+
2061+instance FromJSON MissingResult where
2062+ parseJSON = withObject "MissingResult" parse
2063+ where parse v = MissingResult <$> v .: "doc_count"
2064+
2065+instance FromJSON TermsResult where
2066+ parseJSON (Object v) = TermsResult <$>
2067+ v .: "key" <*>
2068+ v .: "doc_count" <*>
2069+ (pure $ getNamedSubAgg v ["key", "doc_count"])
2070+ parseJSON _ = mempty
2071+
2072+instance FromJSON DateHistogramResult where
2073+ parseJSON (Object v) = DateHistogramResult <$>
2074+ v .: "key" <*>
2075+ v .:? "key_as_string" <*>
2076+ v .: "doc_count" <*>
2077+ (pure $ getNamedSubAgg v [ "key"
2078+ , "doc_count"
2079+ , "key_as_string"
2080+ ]
2081+ )
2082+ parseJSON _ = mempty
2083+
2084+instance FromJSON DateRangeResult where
2085+ parseJSON = withObject "DateRangeResult" parse
2086+ where parse v = DateRangeResult <$>
2087+ v .: "key" <*>
2088+ (fmap posixMS <$> v .:? "from") <*>
2089+ v .:? "from_as_string" <*>
2090+ (fmap posixMS <$> v .:? "to") <*>
2091+ v .:? "to_as_string" <*>
2092+ v .: "doc_count" <*>
2093+ (pure $ getNamedSubAgg v [ "key"
2094+ , "from"
2095+ , "from_as_string"
2096+ , "to"
2097+ , "to_as_string"
2098+ , "doc_count"
2099+ ]
2100+ )
2101+
2102+instance FromJSON POSIXMS where
2103+ parseJSON = withScientific "POSIXMS" (return . parse)
2104+ where parse n = let n' = truncate n :: Integer
2105+ in POSIXMS (posixSecondsToUTCTime (fromInteger (n' `div` 1000)))
2106+
2107+instance (FromJSON a) => FromJSON (TopHitResult a) where
2108+ parseJSON (Object v) = TopHitResult <$>
2109+ v .: "hits"
2110+ parseJSON _ = fail "Failure in FromJSON (TopHitResult a)"
2111+
2112+fieldTagged :: Monad m => (FieldName -> Object -> m a) -> Object -> m a
2113+fieldTagged f o = case HM.toList o of
2114+ [(k, Object o')] -> f (FieldName k) o'
2115+ _ -> fail "Expected object with 1 field-named key"
2116+
2117+-- Try to get an AggregationResults when we don't know the
2118+-- field name. We filter out the known keys to try to minimize the noise.
2119+getNamedSubAgg :: Object -> [Text] -> Maybe AggregationResults
2120+getNamedSubAgg o knownKeys = maggRes
2121+ where unknownKeys = HM.filterWithKey (\k _ -> k `notElem` knownKeys) o
2122+ maggRes
2123+ | HM.null unknownKeys = Nothing
2124+ | otherwise = Just . M.fromList $ HM.toList unknownKeys
2125+
2126+instance ToJSON GeoPoint where
2127+ toJSON (GeoPoint (FieldName geoPointField) geoPointLatLon) =
2128+ object [ geoPointField .= geoPointLatLon ]
2129+
2130+
2131+instance ToJSON Query where
2132+ toJSON (TermQuery (Term termQueryField termQueryValue) boost) =
2133+ object [ "term" .=
2134+ object [termQueryField .= object merged]]
2135+ where
2136+ base = [ "value" .= termQueryValue ]
2137+ boosted = maybe [] (return . ("boost" .=)) boost
2138+ merged = mappend base boosted
2139+
2140+ toJSON (TermsQuery fieldName terms) =
2141+ object [ "terms" .= object conjoined ]
2142+ where conjoined = [fieldName .= terms]
2143+
2144+ toJSON (IdsQuery idsQueryMappingName docIds) =
2145+ object [ "ids" .= object conjoined ]
2146+ where conjoined = [ "type" .= idsQueryMappingName
2147+ , "values" .= fmap toJSON docIds ]
2148+
2149+ toJSON (QueryQueryStringQuery qQueryStringQuery) =
2150+ object [ "query_string" .= qQueryStringQuery ]
2151+
2152+ toJSON (QueryMatchQuery matchQuery) =
2153+ object [ "match" .= matchQuery ]
2154+
2155+ toJSON (QueryMultiMatchQuery multiMatchQuery) =
2156+ toJSON multiMatchQuery
2157+
2158+ toJSON (QueryBoolQuery boolQuery) =
2159+ object [ "bool" .= boolQuery ]
2160+
2161+ toJSON (QueryBoostingQuery boostingQuery) =
2162+ object [ "boosting" .= boostingQuery ]
2163+
2164+ toJSON (QueryCommonTermsQuery commonTermsQuery) =
2165+ object [ "common" .= commonTermsQuery ]
2166+
2167+ toJSON (ConstantScoreQuery query boost) =
2168+ object ["constant_score" .= object ["query" .= query
2169+ , "boost" .= boost]]
2170+
2171+ toJSON (QueryDisMaxQuery disMaxQuery) =
2172+ object [ "dis_max" .= disMaxQuery ]
2173+
2174+ toJSON (QueryFuzzyLikeThisQuery fuzzyQuery) =
2175+ object [ "fuzzy_like_this" .= fuzzyQuery ]
2176+
2177+ toJSON (QueryFuzzyLikeFieldQuery fuzzyFieldQuery) =
2178+ object [ "fuzzy_like_this_field" .= fuzzyFieldQuery ]
2179+
2180+ toJSON (QueryFuzzyQuery fuzzyQuery) =
2181+ object [ "fuzzy" .= fuzzyQuery ]
2182+
2183+ toJSON (QueryHasChildQuery childQuery) =
2184+ object [ "has_child" .= childQuery ]
2185+
2186+ toJSON (QueryHasParentQuery parentQuery) =
2187+ object [ "has_parent" .= parentQuery ]
2188+
2189+ toJSON (QueryIndicesQuery qIndicesQuery) =
2190+ object [ "indices" .= qIndicesQuery ]
2191+
2192+ toJSON (MatchAllQuery boost) =
2193+ object [ "match_all" .= omitNulls [ "boost" .= boost ] ]
2194+
2195+ toJSON (QueryMoreLikeThisQuery query) =
2196+ object [ "more_like_this" .= query ]
2197+
2198+ toJSON (QueryMoreLikeThisFieldQuery query) =
2199+ object [ "more_like_this_field" .= query ]
2200+
2201+ toJSON (QueryNestedQuery query) =
2202+ object [ "nested" .= query ]
2203+
2204+ toJSON (QueryPrefixQuery query) =
2205+ object [ "prefix" .= query ]
2206+
2207+ toJSON (QueryRangeQuery query) =
2208+ object [ "range" .= query ]
2209+
2210+ toJSON (QueryRegexpQuery query) =
2211+ object [ "regexp" .= query ]
2212+
2213+ toJSON (QuerySimpleQueryStringQuery query) =
2214+ object [ "simple_query_string" .= query ]
2215+
2216+ toJSON (QueryExistsQuery (FieldName fieldName)) =
2217+ object ["exists" .= object
2218+ ["field" .= fieldName]
2219+ ]
2220+ toJSON QueryMatchNoneQuery =
2221+ object ["match_none" .= object []]
2222+
2223+instance FromJSON Query where
2224+ parseJSON v = withObject "Query" parse v
2225+ where parse o = termQuery `taggedWith` "term"
2226+ <|> termsQuery `taggedWith` "terms"
2227+ <|> idsQuery `taggedWith` "ids"
2228+ <|> queryQueryStringQuery `taggedWith` "query_string"
2229+ <|> queryMatchQuery `taggedWith` "match"
2230+ <|> queryMultiMatchQuery
2231+ <|> queryBoolQuery `taggedWith` "bool"
2232+ <|> queryBoostingQuery `taggedWith` "boosting"
2233+ <|> queryCommonTermsQuery `taggedWith` "common"
2234+ <|> constantScoreQuery `taggedWith` "constant_score"
2235+ <|> queryDisMaxQuery `taggedWith` "dis_max"
2236+ <|> queryFuzzyLikeThisQuery `taggedWith` "fuzzy_like_this"
2237+ <|> queryFuzzyLikeFieldQuery `taggedWith` "fuzzy_like_this_field"
2238+ <|> queryFuzzyQuery `taggedWith` "fuzzy"
2239+ <|> queryHasChildQuery `taggedWith` "has_child"
2240+ <|> queryHasParentQuery `taggedWith` "has_parent"
2241+ <|> queryIndicesQuery `taggedWith` "indices"
2242+ <|> matchAllQuery `taggedWith` "match_all"
2243+ <|> queryMoreLikeThisQuery `taggedWith` "more_like_this"
2244+ <|> queryMoreLikeThisFieldQuery `taggedWith` "more_like_this_field"
2245+ <|> queryNestedQuery `taggedWith` "nested"
2246+ <|> queryPrefixQuery `taggedWith` "prefix"
2247+ <|> queryRangeQuery `taggedWith` "range"
2248+ <|> queryRegexpQuery `taggedWith` "regexp"
2249+ <|> querySimpleQueryStringQuery `taggedWith` "simple_query_string"
2250+ where taggedWith parser k = parser =<< o .: k
2251+ termQuery = fieldTagged $ \(FieldName fn) o ->
2252+ TermQuery <$> (Term fn <$> o .: "value") <*> o .:? "boost"
2253+ termsQuery o = case HM.toList o of
2254+ [(fn, vs)] -> do vals <- parseJSON vs
2255+ case vals of
2256+ x:xs -> return (TermsQuery fn (x :| xs))
2257+ _ -> fail "Expected non empty list of values"
2258+ _ -> fail "Expected object with 1 field-named key"
2259+ idsQuery o = IdsQuery <$> o .: "type"
2260+ <*> o .: "values"
2261+ queryQueryStringQuery = pure . QueryQueryStringQuery
2262+ queryMatchQuery = pure . QueryMatchQuery
2263+ queryMultiMatchQuery = QueryMultiMatchQuery <$> parseJSON v
2264+ queryBoolQuery = pure . QueryBoolQuery
2265+ queryBoostingQuery = pure . QueryBoostingQuery
2266+ queryCommonTermsQuery = pure . QueryCommonTermsQuery
2267+ constantScoreQuery o = case HM.lookup "query" o of
2268+ Just x -> ConstantScoreQuery <$> parseJSON x
2269+ <*> o .: "boost"
2270+ _ -> fail "Does not appear to be a ConstantScoreQuery"
2271+ queryDisMaxQuery = pure . QueryDisMaxQuery
2272+ queryFuzzyLikeThisQuery = pure . QueryFuzzyLikeThisQuery
2273+ queryFuzzyLikeFieldQuery = pure . QueryFuzzyLikeFieldQuery
2274+ queryFuzzyQuery = pure . QueryFuzzyQuery
2275+ queryHasChildQuery = pure . QueryHasChildQuery
2276+ queryHasParentQuery = pure . QueryHasParentQuery
2277+ queryIndicesQuery = pure . QueryIndicesQuery
2278+ matchAllQuery o = MatchAllQuery <$> o .:? "boost"
2279+ queryMoreLikeThisQuery = pure . QueryMoreLikeThisQuery
2280+ queryMoreLikeThisFieldQuery = pure . QueryMoreLikeThisFieldQuery
2281+ queryNestedQuery = pure . QueryNestedQuery
2282+ queryPrefixQuery = pure . QueryPrefixQuery
2283+ queryRangeQuery = pure . QueryRangeQuery
2284+ queryRegexpQuery = pure . QueryRegexpQuery
2285+ querySimpleQueryStringQuery = pure . QuerySimpleQueryStringQuery
2286+ -- queryExistsQuery o = QueryExistsQuery <$> o .: "field"
2287+
2288+
2289+omitNulls :: [(Text, Value)] -> Value
2290+omitNulls = object . filter notNull where
2291+ notNull (_, Null) = False
2292+ notNull (_, Array a) = (not . V.null) a
2293+ notNull _ = True
2294+
2295+instance ToJSON SimpleQueryStringQuery where
2296+ toJSON SimpleQueryStringQuery {..} =
2297+ omitNulls (base ++ maybeAdd)
2298+ where base = [ "query" .= simpleQueryStringQuery ]
2299+ maybeAdd = [ "fields" .= simpleQueryStringField
2300+ , "default_operator" .= simpleQueryStringOperator
2301+ , "analyzer" .= simpleQueryStringAnalyzer
2302+ , "flags" .= simpleQueryStringFlags
2303+ , "lowercase_expanded_terms" .= simpleQueryStringLowercaseExpanded
2304+ , "locale" .= simpleQueryStringLocale ]
2305+
2306+instance FromJSON SimpleQueryStringQuery where
2307+ parseJSON = withObject "SimpleQueryStringQuery" parse
2308+ where parse o = SimpleQueryStringQuery <$> o .: "query"
2309+ <*> o .:? "fields"
2310+ <*> o .:? "default_operator"
2311+ <*> o .:? "analyzer"
2312+ <*> (parseFlags <$> o .:? "flags")
2313+ <*> o .:? "lowercase_expanded_terms"
2314+ <*> o .:? "locale"
2315+ parseFlags (Just (x:xs)) = Just (x :| xs)
2316+ parseFlags _ = Nothing
2317+
2318+instance ToJSON FieldOrFields where
2319+ toJSON (FofField fieldName) =
2320+ toJSON fieldName
2321+ toJSON (FofFields fieldNames) =
2322+ toJSON fieldNames
2323+
2324+instance FromJSON FieldOrFields where
2325+ parseJSON v = FofField <$> parseJSON v
2326+ <|> FofFields <$> (parseNEJSON =<< parseJSON v)
2327+
2328+instance ToJSON SimpleQueryFlag where
2329+ toJSON SimpleQueryAll = "ALL"
2330+ toJSON SimpleQueryNone = "NONE"
2331+ toJSON SimpleQueryAnd = "AND"
2332+ toJSON SimpleQueryOr = "OR"
2333+ toJSON SimpleQueryPrefix = "PREFIX"
2334+ toJSON SimpleQueryPhrase = "PHRASE"
2335+ toJSON SimpleQueryPrecedence = "PRECEDENCE"
2336+ toJSON SimpleQueryEscape = "ESCAPE"
2337+ toJSON SimpleQueryWhitespace = "WHITESPACE"
2338+ toJSON SimpleQueryFuzzy = "FUZZY"
2339+ toJSON SimpleQueryNear = "NEAR"
2340+ toJSON SimpleQuerySlop = "SLOP"
2341+
2342+instance FromJSON SimpleQueryFlag where
2343+ parseJSON = withText "SimpleQueryFlag" parse
2344+ where parse "ALL" = pure SimpleQueryAll
2345+ parse "NONE" = pure SimpleQueryNone
2346+ parse "AND" = pure SimpleQueryAnd
2347+ parse "OR" = pure SimpleQueryOr
2348+ parse "PREFIX" = pure SimpleQueryPrefix
2349+ parse "PHRASE" = pure SimpleQueryPhrase
2350+ parse "PRECEDENCE" = pure SimpleQueryPrecedence
2351+ parse "ESCAPE" = pure SimpleQueryEscape
2352+ parse "WHITESPACE" = pure SimpleQueryWhitespace
2353+ parse "FUZZY" = pure SimpleQueryFuzzy
2354+ parse "NEAR" = pure SimpleQueryNear
2355+ parse "SLOP" = pure SimpleQuerySlop
2356+ parse f = fail ("Unexpected SimpleQueryFlag: " <> show f)
2357+
2358+instance ToJSON RegexpQuery where
2359+ toJSON (RegexpQuery (FieldName rqQueryField)
2360+ (Regexp regexpQueryQuery) rqQueryFlags
2361+ rqQueryBoost) =
2362+ object [ rqQueryField .= omitNulls base ]
2363+ where base = [ "value" .= regexpQueryQuery
2364+ , "flags" .= rqQueryFlags
2365+ , "boost" .= rqQueryBoost ]
2366+
2367+instance FromJSON RegexpQuery where
2368+ parseJSON = withObject "RegexpQuery" parse
2369+ where parse = fieldTagged $ \fn o ->
2370+ RegexpQuery fn
2371+ <$> o .: "value"
2372+ <*> o .: "flags"
2373+ <*> o .:? "boost"
2374+
2375+instance ToJSON QueryStringQuery where
2376+ toJSON (QueryStringQuery qsQueryString
2377+ qsDefaultField qsOperator
2378+ qsAnalyzer qsAllowWildcard
2379+ qsLowercaseExpanded qsEnablePositionIncrements
2380+ qsFuzzyMaxExpansions qsFuzziness
2381+ qsFuzzyPrefixLength qsPhraseSlop
2382+ qsBoost qsAnalyzeWildcard
2383+ qsGeneratePhraseQueries qsMinimumShouldMatch
2384+ qsLenient qsLocale) =
2385+ omitNulls base
2386+ where
2387+ base = [ "query" .= qsQueryString
2388+ , "default_field" .= qsDefaultField
2389+ , "default_operator" .= qsOperator
2390+ , "analyzer" .= qsAnalyzer
2391+ , "allow_leading_wildcard" .= qsAllowWildcard
2392+ , "lowercase_expanded_terms" .= qsLowercaseExpanded
2393+ , "enable_position_increments" .= qsEnablePositionIncrements
2394+ , "fuzzy_max_expansions" .= qsFuzzyMaxExpansions
2395+ , "fuzziness" .= qsFuzziness
2396+ , "fuzzy_prefix_length" .= qsFuzzyPrefixLength
2397+ , "phrase_slop" .= qsPhraseSlop
2398+ , "boost" .= qsBoost
2399+ , "analyze_wildcard" .= qsAnalyzeWildcard
2400+ , "auto_generate_phrase_queries" .= qsGeneratePhraseQueries
2401+ , "minimum_should_match" .= qsMinimumShouldMatch
2402+ , "lenient" .= qsLenient
2403+ , "locale" .= qsLocale ]
2404+
2405+instance FromJSON QueryStringQuery where
2406+ parseJSON = withObject "QueryStringQuery" parse
2407+ where parse o = QueryStringQuery
2408+ <$> o .: "query"
2409+ <*> o .:? "default_field"
2410+ <*> o .:? "default_operator"
2411+ <*> o .:? "analyzer"
2412+ <*> o .:? "allow_leading_wildcard"
2413+ <*> o .:? "lowercase_expanded_terms"
2414+ <*> o .:? "enable_position_increments"
2415+ <*> o .:? "fuzzy_max_expansions"
2416+ <*> o .:? "fuzziness"
2417+ <*> o .:? "fuzzy_prefix_length"
2418+ <*> o .:? "phrase_slop"
2419+ <*> o .:? "boost"
2420+ <*> o .:? "analyze_wildcard"
2421+ <*> o .:? "auto_generate_phrase_queries"
2422+ <*> o .:? "minimum_should_match"
2423+ <*> o .:? "lenient"
2424+ <*> o .:? "locale"
2425+
2426+instance ToJSON RangeQuery where
2427+ toJSON (RangeQuery (FieldName fieldName) range boost) =
2428+ object [ fieldName .= object conjoined ]
2429+ where conjoined = [ "boost" .= boost ] ++ (rangeValueToPair range)
2430+
2431+instance FromJSON RangeQuery where
2432+ parseJSON = withObject "RangeQuery" parse
2433+ where parse = fieldTagged $ \fn o ->
2434+ RangeQuery fn
2435+ <$> parseJSON (Object o)
2436+ <*> o .: "boost"
2437+
2438+instance FromJSON RangeValue where
2439+ parseJSON = withObject "RangeValue" parse
2440+ where parse o = parseDate o
2441+ <|> parseDouble o
2442+ parseDate o = do lt <- o .:? "lt"
2443+ lte <- o .:? "lte"
2444+ gt <- o .:? "gt"
2445+ gte <- o .:? "gte"
2446+ case (lt, lte, gt, gte) of
2447+ (Just a, _, Just b, _) -> return (RangeDateGtLt (GreaterThanD b) (LessThanD a))
2448+ (Just a, _, _, Just b)-> return (RangeDateGteLt (GreaterThanEqD b) (LessThanD a))
2449+ (_, Just a, Just b, _)-> return (RangeDateGtLte (GreaterThanD b) (LessThanEqD a))
2450+ (_, Just a, _, Just b)-> return (RangeDateGteLte (GreaterThanEqD b) (LessThanEqD a))
2451+ (_, _, Just a, _)-> return (RangeDateGt (GreaterThanD a))
2452+ (Just a, _, _, _)-> return (RangeDateLt (LessThanD a))
2453+ (_, _, _, Just a)-> return (RangeDateGte (GreaterThanEqD a))
2454+ (_, Just a, _, _)-> return (RangeDateLte (LessThanEqD a))
2455+ (Nothing, Nothing, Nothing, Nothing) -> mzero
2456+ parseDouble o = do lt <- o .:? "lt"
2457+ lte <- o .:? "lte"
2458+ gt <- o .:? "gt"
2459+ gte <- o .:? "gte"
2460+ case (lt, lte, gt, gte) of
2461+ (Just a, _, Just b, _) -> return (RangeDoubleGtLt (GreaterThan b) (LessThan a))
2462+ (Just a, _, _, Just b)-> return (RangeDoubleGteLt (GreaterThanEq b) (LessThan a))
2463+ (_, Just a, Just b, _)-> return (RangeDoubleGtLte (GreaterThan b) (LessThanEq a))
2464+ (_, Just a, _, Just b)-> return (RangeDoubleGteLte (GreaterThanEq b) (LessThanEq a))
2465+ (_, _, Just a, _)-> return (RangeDoubleGt (GreaterThan a))
2466+ (Just a, _, _, _)-> return (RangeDoubleLt (LessThan a))
2467+ (_, _, _, Just a)-> return (RangeDoubleGte (GreaterThanEq a))
2468+ (_, Just a, _, _)-> return (RangeDoubleLte (LessThanEq a))
2469+ (Nothing, Nothing, Nothing, Nothing) -> mzero
2470+
2471+instance ToJSON PrefixQuery where
2472+ toJSON (PrefixQuery (FieldName fieldName) queryValue boost) =
2473+ object [ fieldName .= omitNulls base ]
2474+ where base = [ "value" .= queryValue
2475+ , "boost" .= boost ]
2476+
2477+instance FromJSON PrefixQuery where
2478+ parseJSON = withObject "PrefixQuery" parse
2479+ where parse = fieldTagged $ \fn o ->
2480+ PrefixQuery fn
2481+ <$> o .: "value"
2482+ <*> o .:? "boost"
2483+
2484+instance ToJSON NestedQuery where
2485+ toJSON (NestedQuery nqPath nqScoreType nqQuery) =
2486+ object [ "path" .= nqPath
2487+ , "score_mode" .= nqScoreType
2488+ , "query" .= nqQuery ]
2489+
2490+instance FromJSON NestedQuery where
2491+ parseJSON = withObject "NestedQuery" parse
2492+ where parse o = NestedQuery
2493+ <$> o .: "path"
2494+ <*> o .: "score_mode"
2495+ <*> o .: "query"
2496+
2497+instance ToJSON MoreLikeThisFieldQuery where
2498+ toJSON (MoreLikeThisFieldQuery text (FieldName fieldName)
2499+ percent mtf mqt stopwords mindf maxdf
2500+ minwl maxwl boostTerms boost analyzer) =
2501+ object [ fieldName .= omitNulls base ]
2502+ where base = [ "like_text" .= text
2503+ , "percent_terms_to_match" .= percent
2504+ , "min_term_freq" .= mtf
2505+ , "max_query_terms" .= mqt
2506+ , "stop_words" .= stopwords
2507+ , "min_doc_freq" .= mindf
2508+ , "max_doc_freq" .= maxdf
2509+ , "min_word_length" .= minwl
2510+ , "max_word_length" .= maxwl
2511+ , "boost_terms" .= boostTerms
2512+ , "boost" .= boost
2513+ , "analyzer" .= analyzer ]
2514+
2515+instance FromJSON MoreLikeThisFieldQuery where
2516+ parseJSON = withObject "MoreLikeThisFieldQuery" parse
2517+ where parse = fieldTagged $ \fn o ->
2518+ MoreLikeThisFieldQuery
2519+ <$> o .: "like_text"
2520+ <*> pure fn
2521+ <*> o .:? "percent_terms_to_match"
2522+ <*> o .:? "min_term_freq"
2523+ <*> o .:? "max_query_terms"
2524+ -- <*> (optionalNE =<< o .:? "stop_words")
2525+ <*> o .:? "stop_words"
2526+ <*> o .:? "min_doc_freq"
2527+ <*> o .:? "max_doc_freq"
2528+ <*> o .:? "min_word_length"
2529+ <*> o .:? "max_word_length"
2530+ <*> o .:? "boost_terms"
2531+ <*> o .:? "boost"
2532+ <*> o .:? "analyzer"
2533+ -- optionalNE = maybe (pure Nothing) (fmap Just . parseNEJSON)
2534+
2535+instance ToJSON MoreLikeThisQuery where
2536+ toJSON (MoreLikeThisQuery text fields percent
2537+ mtf mqt stopwords mindf maxdf
2538+ minwl maxwl boostTerms boost analyzer) =
2539+ omitNulls base
2540+ where base = [ "like_text" .= text
2541+ , "fields" .= fields
2542+ , "percent_terms_to_match" .= percent
2543+ , "min_term_freq" .= mtf
2544+ , "max_query_terms" .= mqt
2545+ , "stop_words" .= stopwords
2546+ , "min_doc_freq" .= mindf
2547+ , "max_doc_freq" .= maxdf
2548+ , "min_word_length" .= minwl
2549+ , "max_word_length" .= maxwl
2550+ , "boost_terms" .= boostTerms
2551+ , "boost" .= boost
2552+ , "analyzer" .= analyzer ]
2553+
2554+instance FromJSON MoreLikeThisQuery where
2555+ parseJSON = withObject "MoreLikeThisQuery" parse
2556+ where parse o = MoreLikeThisQuery
2557+ <$> o .: "like_text"
2558+ -- <*> (optionalNE =<< o .:? "fields")
2559+ <*> o .:? "fields"
2560+ <*> o .:? "percent_terms_to_match"
2561+ <*> o .:? "min_term_freq"
2562+ <*> o .:? "max_query_terms"
2563+ -- <*> (optionalNE =<< o .:? "stop_words")
2564+ <*> o .:? "stop_words"
2565+ <*> o .:? "min_doc_freq"
2566+ <*> o .:? "max_doc_freq"
2567+ <*> o .:? "min_word_length"
2568+ <*> o .:? "max_word_length"
2569+ <*> o .:? "boost_terms"
2570+ <*> o .:? "boost"
2571+ <*> o .:? "analyzer"
2572+ -- optionalNE = maybe (pure Nothing) (fmap Just . parseNEJSON)
2573+
2574+instance ToJSON IndicesQuery where
2575+ toJSON (IndicesQuery indices query noMatch) =
2576+ omitNulls [ "indices" .= indices
2577+ , "no_match_query" .= noMatch
2578+ , "query" .= query ]
2579+
2580+instance FromJSON IndicesQuery where
2581+ parseJSON = withObject "IndicesQuery" parse
2582+ where parse o = IndicesQuery
2583+ <$> o .:? "indices" .!= []
2584+ <*> o .: "query"
2585+ <*> o .:? "no_match_query"
2586+
2587+instance ToJSON HasParentQuery where
2588+ toJSON (HasParentQuery queryType query scoreType) =
2589+ omitNulls [ "parent_type" .= queryType
2590+ , "score_type" .= scoreType
2591+ , "query" .= query ]
2592+
2593+instance FromJSON HasParentQuery where
2594+ parseJSON = withObject "HasParentQuery" parse
2595+ where parse o = HasParentQuery
2596+ <$> o .: "parent_type"
2597+ <*> o .: "query"
2598+ <*> o .:? "score_type"
2599+
2600+instance ToJSON HasChildQuery where
2601+ toJSON (HasChildQuery queryType query scoreType) =
2602+ omitNulls [ "query" .= query
2603+ , "score_type" .= scoreType
2604+ , "type" .= queryType ]
2605+
2606+instance FromJSON HasChildQuery where
2607+ parseJSON = withObject "HasChildQuery" parse
2608+ where parse o = HasChildQuery
2609+ <$> o .: "type"
2610+ <*> o .: "query"
2611+ <*> o .:? "score_type"
2612+
2613+instance ToJSON FuzzyQuery where
2614+ toJSON (FuzzyQuery (FieldName fieldName) queryText
2615+ prefixLength maxEx fuzziness boost) =
2616+ object [ fieldName .= omitNulls base ]
2617+ where base = [ "value" .= queryText
2618+ , "fuzziness" .= fuzziness
2619+ , "prefix_length" .= prefixLength
2620+ , "boost" .= boost
2621+ , "max_expansions" .= maxEx ]
2622+
2623+instance FromJSON FuzzyQuery where
2624+ parseJSON = withObject "FuzzyQuery" parse
2625+ where parse = fieldTagged $ \fn o ->
2626+ FuzzyQuery fn
2627+ <$> o .: "value"
2628+ <*> o .: "prefix_length"
2629+ <*> o .: "max_expansions"
2630+ <*> o .: "fuzziness"
2631+ <*> o .:? "boost"
2632+
2633+instance ToJSON FuzzyLikeFieldQuery where
2634+ toJSON (FuzzyLikeFieldQuery (FieldName fieldName)
2635+ fieldText maxTerms ignoreFreq fuzziness prefixLength
2636+ boost analyzer) =
2637+ object [ fieldName .=
2638+ omitNulls [ "like_text" .= fieldText
2639+ , "max_query_terms" .= maxTerms
2640+ , "ignore_tf" .= ignoreFreq
2641+ , "fuzziness" .= fuzziness
2642+ , "prefix_length" .= prefixLength
2643+ , "analyzer" .= analyzer
2644+ , "boost" .= boost ]]
2645+
2646+instance FromJSON FuzzyLikeFieldQuery where
2647+ parseJSON = withObject "FuzzyLikeFieldQuery" parse
2648+ where parse = fieldTagged $ \fn o ->
2649+ FuzzyLikeFieldQuery fn
2650+ <$> o .: "like_text"
2651+ <*> o .: "max_query_terms"
2652+ <*> o .: "ignore_tf"
2653+ <*> o .: "fuzziness"
2654+ <*> o .: "prefix_length"
2655+ <*> o .: "boost"
2656+ <*> o .:? "analyzer"
2657+
2658+instance ToJSON FuzzyLikeThisQuery where
2659+ toJSON (FuzzyLikeThisQuery fields text maxTerms
2660+ ignoreFreq fuzziness prefixLength boost analyzer) =
2661+ omitNulls base
2662+ where base = [ "fields" .= fields
2663+ , "like_text" .= text
2664+ , "max_query_terms" .= maxTerms
2665+ , "ignore_tf" .= ignoreFreq
2666+ , "fuzziness" .= fuzziness
2667+ , "prefix_length" .= prefixLength
2668+ , "analyzer" .= analyzer
2669+ , "boost" .= boost ]
2670+
2671+instance FromJSON FuzzyLikeThisQuery where
2672+ parseJSON = withObject "FuzzyLikeThisQuery" parse
2673+ where parse o = FuzzyLikeThisQuery
2674+ <$> o .:? "fields" .!= []
2675+ <*> o .: "like_text"
2676+ <*> o .: "max_query_terms"
2677+ <*> o .: "ignore_tf"
2678+ <*> o .: "fuzziness"
2679+ <*> o .: "prefix_length"
2680+ <*> o .: "boost"
2681+ <*> o .:? "analyzer"
2682+
2683+instance ToJSON DisMaxQuery where
2684+ toJSON (DisMaxQuery queries tiebreaker boost) =
2685+ omitNulls base
2686+ where base = [ "queries" .= queries
2687+ , "boost" .= boost
2688+ , "tie_breaker" .= tiebreaker ]
2689+
2690+instance FromJSON DisMaxQuery where
2691+ parseJSON = withObject "DisMaxQuery" parse
2692+ where parse o = DisMaxQuery
2693+ <$> o .:? "queries" .!= []
2694+ <*> o .: "tie_breaker"
2695+ <*> o .:? "boost"
2696+
2697+instance ToJSON CommonTermsQuery where
2698+ toJSON (CommonTermsQuery (FieldName fieldName)
2699+ (QueryString query) cf lfo hfo msm
2700+ boost analyzer disableCoord) =
2701+ object [fieldName .= omitNulls base ]
2702+ where base = [ "query" .= query
2703+ , "cutoff_frequency" .= cf
2704+ , "low_freq_operator" .= lfo
2705+ , "minimum_should_match" .= msm
2706+ , "boost" .= boost
2707+ , "analyzer" .= analyzer
2708+ , "disable_coord" .= disableCoord
2709+ , "high_freq_operator" .= hfo ]
2710+
2711+instance FromJSON CommonTermsQuery where
2712+ parseJSON = withObject "CommonTermsQuery" parse
2713+ where parse = fieldTagged $ \fn o ->
2714+ CommonTermsQuery fn
2715+ <$> o .: "query"
2716+ <*> o .: "cutoff_frequency"
2717+ <*> o .: "low_freq_operator"
2718+ <*> o .: "high_freq_operator"
2719+ <*> o .:? "minimum_should_match"
2720+ <*> o .:? "boost"
2721+ <*> o .:? "analyzer"
2722+ <*> o .:? "disable_coord"
2723+
2724+instance ToJSON CommonMinimumMatch where
2725+ toJSON (CommonMinimumMatch mm) = toJSON mm
2726+ toJSON (CommonMinimumMatchHighLow (MinimumMatchHighLow lowF highF)) =
2727+ object [ "low_freq" .= lowF
2728+ , "high_freq" .= highF ]
2729+
2730+instance FromJSON CommonMinimumMatch where
2731+ parseJSON v = parseMinimum v
2732+ <|> parseMinimumHighLow v
2733+ where parseMinimum = fmap CommonMinimumMatch . parseJSON
2734+ parseMinimumHighLow = fmap CommonMinimumMatchHighLow . withObject "CommonMinimumMatchHighLow" (\o ->
2735+ MinimumMatchHighLow
2736+ <$> o .: "low_freq"
2737+ <*> o .: "high_freq")
2738+
2739+
2740+instance ToJSON BoostingQuery where
2741+ toJSON (BoostingQuery bqPositiveQuery bqNegativeQuery bqNegativeBoost) =
2742+ object [ "positive" .= bqPositiveQuery
2743+ , "negative" .= bqNegativeQuery
2744+ , "negative_boost" .= bqNegativeBoost ]
2745+
2746+instance FromJSON BoostingQuery where
2747+ parseJSON = withObject "BoostingQuery" parse
2748+ where parse o = BoostingQuery
2749+ <$> o .: "positive"
2750+ <*> o .: "negative"
2751+ <*> o .: "negative_boost"
2752+
2753+instance ToJSON BoolQuery where
2754+ toJSON (BoolQuery mustM filterM' notM shouldM bqMin boost disableCoord) =
2755+ omitNulls base
2756+ where base = [ "must" .= mustM
2757+ , "filter" .= filterM'
2758+ , "must_not" .= notM
2759+ , "should" .= shouldM
2760+ , "minimum_should_match" .= bqMin
2761+ , "boost" .= boost
2762+ , "disable_coord" .= disableCoord ]
2763+
2764+instance FromJSON BoolQuery where
2765+ parseJSON = withObject "BoolQuery" parse
2766+ where parse o = BoolQuery
2767+ <$> o .:? "must" .!= []
2768+ <*> o .:? "filter" .!= []
2769+ <*> o .:? "must_not" .!= []
2770+ <*> o .:? "should" .!= []
2771+ <*> o .:? "minimum_should_match"
2772+ <*> o .:? "boost"
2773+ <*> o .:? "disable_coord"
2774+
2775+instance ToJSON MatchQuery where
2776+ toJSON (MatchQuery (FieldName fieldName)
2777+ (QueryString mqQueryString) booleanOperator
2778+ zeroTermsQuery cutoffFrequency matchQueryType
2779+ analyzer maxExpansions lenient boost) =
2780+ object [ fieldName .= omitNulls base ]
2781+ where base = [ "query" .= mqQueryString
2782+ , "operator" .= booleanOperator
2783+ , "zero_terms_query" .= zeroTermsQuery
2784+ , "cutoff_frequency" .= cutoffFrequency
2785+ , "type" .= matchQueryType
2786+ , "analyzer" .= analyzer
2787+ , "max_expansions" .= maxExpansions
2788+ , "lenient" .= lenient
2789+ , "boost" .= boost ]
2790+
2791+instance FromJSON MatchQuery where
2792+ parseJSON = withObject "MatchQuery" parse
2793+ where parse = fieldTagged $ \fn o ->
2794+ MatchQuery fn
2795+ <$> o .: "query"
2796+ <*> o .: "operator"
2797+ <*> o .: "zero_terms_query"
2798+ <*> o .:? "cutoff_frequency"
2799+ <*> o .:? "type"
2800+ <*> o .:? "analyzer"
2801+ <*> o .:? "max_expansions"
2802+ <*> o .:? "lenient"
2803+ <*> o .:? "boost"
2804+
2805+instance ToJSON MultiMatchQuery where
2806+ toJSON (MultiMatchQuery fields (QueryString query) boolOp
2807+ ztQ tb mmqt cf analyzer maxEx lenient) =
2808+ object ["multi_match" .= omitNulls base]
2809+ where base = [ "fields" .= fmap toJSON fields
2810+ , "query" .= query
2811+ , "operator" .= boolOp
2812+ , "zero_terms_query" .= ztQ
2813+ , "tiebreaker" .= tb
2814+ , "type" .= mmqt
2815+ , "cutoff_frequency" .= cf
2816+ , "analyzer" .= analyzer
2817+ , "max_expansions" .= maxEx
2818+ , "lenient" .= lenient ]
2819+
2820+instance FromJSON MultiMatchQuery where
2821+ parseJSON = withObject "MultiMatchQuery" parse
2822+ where parse raw = do o <- raw .: "multi_match"
2823+ MultiMatchQuery
2824+ <$> o .:? "fields" .!= []
2825+ <*> o .: "query"
2826+ <*> o .: "operator"
2827+ <*> o .: "zero_terms_query"
2828+ <*> o .:? "tiebreaker"
2829+ <*> o .:? "type"
2830+ <*> o .:? "cutoff_frequency"
2831+ <*> o .:? "analyzer"
2832+ <*> o .:? "max_expansions"
2833+ <*> o .:? "lenient"
2834+
2835+instance ToJSON MultiMatchQueryType where
2836+ toJSON MultiMatchBestFields = "best_fields"
2837+ toJSON MultiMatchMostFields = "most_fields"
2838+ toJSON MultiMatchCrossFields = "cross_fields"
2839+ toJSON MultiMatchPhrase = "phrase"
2840+ toJSON MultiMatchPhrasePrefix = "phrase_prefix"
2841+
2842+instance FromJSON MultiMatchQueryType where
2843+ parseJSON = withText "MultiMatchPhrasePrefix" parse
2844+ where parse "best_fields" = pure MultiMatchBestFields
2845+ parse "most_fields" = pure MultiMatchMostFields
2846+ parse "cross_fields" = pure MultiMatchCrossFields
2847+ parse "phrase" = pure MultiMatchPhrase
2848+ parse "phrase_prefix" = pure MultiMatchPhrasePrefix
2849+ parse t = fail ("Unexpected MultiMatchPhrasePrefix: " <> show t)
2850+
2851+instance ToJSON BooleanOperator where
2852+ toJSON And = String "and"
2853+ toJSON Or = String "or"
2854+
2855+instance FromJSON BooleanOperator where
2856+ parseJSON = withText "BooleanOperator" parse
2857+ where parse "and" = pure And
2858+ parse "or" = pure Or
2859+ parse o = fail ("Unexpected BooleanOperator: " <> show o)
2860+
2861+instance ToJSON ZeroTermsQuery where
2862+ toJSON ZeroTermsNone = String "none"
2863+ toJSON ZeroTermsAll = String "all"
2864+
2865+instance FromJSON ZeroTermsQuery where
2866+ parseJSON = withText "ZeroTermsQuery" parse
2867+ where parse "none" = pure ZeroTermsNone
2868+ parse "all" = pure ZeroTermsAll
2869+ parse q = fail ("Unexpected ZeroTermsQuery: " <> show q)
2870+
2871+instance ToJSON MatchQueryType where
2872+ toJSON MatchPhrase = "phrase"
2873+ toJSON MatchPhrasePrefix = "phrase_prefix"
2874+
2875+instance FromJSON MatchQueryType where
2876+ parseJSON = withText "MatchQueryType" parse
2877+ where parse "phrase" = pure MatchPhrase
2878+ parse "phrase_prefix" = pure MatchPhrasePrefix
2879+ parse t = fail ("Unexpected MatchQueryType: " <> show t)
2880+
2881+instance FromJSON Status where
2882+ parseJSON (Object v) = Status <$>
2883+ v .: "name" <*>
2884+ v .: "cluster_name" <*>
2885+ v .: "cluster_uuid" <*>
2886+ v .: "version" <*>
2887+ v .: "tagline"
2888+ parseJSON _ = empty
2889+
2890+
2891+instance ToJSON IndexSettings where
2892+ toJSON (IndexSettings s r) = object ["settings" .=
2893+ object ["index" .=
2894+ object ["number_of_shards" .= s, "number_of_replicas" .= r]
2895+ ]
2896+ ]
2897+
2898+instance FromJSON IndexSettings where
2899+ parseJSON = withObject "IndexSettings" parse
2900+ where parse o = do s <- o .: "settings"
2901+ i <- s .: "index"
2902+ IndexSettings <$> i .: "number_of_shards"
2903+ <*> i .: "number_of_replicas"
2904+
2905+instance ToJSON UpdatableIndexSetting where
2906+ toJSON (NumberOfReplicas x) = oPath ("index" :| ["number_of_replicas"]) x
2907+ toJSON (AutoExpandReplicas x) = oPath ("index" :| ["auto_expand_replicas"]) x
2908+ toJSON (RefreshInterval x) = oPath ("index" :| ["refresh_interval"]) (NominalDiffTimeJSON x)
2909+ toJSON (IndexConcurrency x) = oPath ("index" :| ["concurrency"]) x
2910+ toJSON (FailOnMergeFailure x) = oPath ("index" :| ["fail_on_merge_failure"]) x
2911+ toJSON (TranslogFlushThresholdOps x) = oPath ("index" :| ["translog", "flush_threshold_ops"]) x
2912+ toJSON (TranslogFlushThresholdSize x) = oPath ("index" :| ["translog", "flush_threshold_size"]) x
2913+ toJSON (TranslogFlushThresholdPeriod x) = oPath ("index" :| ["translog", "flush_threshold_period"]) (NominalDiffTimeJSON x)
2914+ toJSON (TranslogDisableFlush x) = oPath ("index" :| ["translog", "disable_flush"]) x
2915+ toJSON (CacheFilterMaxSize x) = oPath ("index" :| ["cache", "filter", "max_size"]) x
2916+ toJSON (CacheFilterExpire x) = oPath ("index" :| ["cache", "filter", "expire"]) (NominalDiffTimeJSON <$> x)
2917+ toJSON (GatewaySnapshotInterval x) = oPath ("index" :| ["gateway", "snapshot_interval"]) (NominalDiffTimeJSON x)
2918+ toJSON (RoutingAllocationInclude fs) = oPath ("index" :| ["routing", "allocation", "include"]) (attrFilterJSON fs)
2919+ toJSON (RoutingAllocationExclude fs) = oPath ("index" :| ["routing", "allocation", "exclude"]) (attrFilterJSON fs)
2920+ toJSON (RoutingAllocationRequire fs) = oPath ("index" :| ["routing", "allocation", "require"]) (attrFilterJSON fs)
2921+ toJSON (RoutingAllocationEnable x) = oPath ("index" :| ["routing", "allocation", "enable"]) x
2922+ toJSON (RoutingAllocationShardsPerNode x) = oPath ("index" :| ["routing", "allocation", "total_shards_per_node"]) x
2923+ toJSON (RecoveryInitialShards x) = oPath ("index" :| ["recovery", "initial_shards"]) x
2924+ toJSON (GCDeletes x) = oPath ("index" :| ["gc_deletes"]) (NominalDiffTimeJSON x)
2925+ toJSON (TTLDisablePurge x) = oPath ("index" :| ["ttl", "disable_purge"]) x
2926+ toJSON (TranslogFSType x) = oPath ("index" :| ["translog", "fs", "type"]) x
2927+ toJSON (IndexCompoundFormat x) = oPath ("index" :| ["compound_format"]) x
2928+ toJSON (IndexCompoundOnFlush x) = oPath ("index" :| ["compound_on_flush"]) x
2929+ toJSON (WarmerEnabled x) = oPath ("index" :| ["warmer", "enabled"]) x
2930+ toJSON (BlocksReadOnly x) = oPath ("blocks" :| ["read_only"]) x
2931+ toJSON (BlocksRead x) = oPath ("blocks" :| ["read"]) x
2932+ toJSON (BlocksWrite x) = oPath ("blocks" :| ["write"]) x
2933+ toJSON (BlocksMetaData x) = oPath ("blocks" :| ["metadata"]) x
2934+
2935+instance FromJSON UpdatableIndexSetting where
2936+ parseJSON = withObject "UpdatableIndexSetting" parse
2937+ where parse o = numberOfReplicas `taggedAt` ["index", "number_of_replicas"]
2938+ <|> autoExpandReplicas `taggedAt` ["index", "auto_expand_replicas"]
2939+ <|> refreshInterval `taggedAt` ["index", "refresh_interval"]
2940+ <|> indexConcurrency `taggedAt` ["index", "concurrency"]
2941+ <|> failOnMergeFailure `taggedAt` ["index", "fail_on_merge_failure"]
2942+ <|> translogFlushThresholdOps `taggedAt` ["index", "translog", "flush_threshold_ops"]
2943+ <|> translogFlushThresholdSize `taggedAt` ["index", "translog", "flush_threshold_size"]
2944+ <|> translogFlushThresholdPeriod `taggedAt` ["index", "translog", "flush_threshold_period"]
2945+ <|> translogDisableFlush `taggedAt` ["index", "translog", "disable_flush"]
2946+ <|> cacheFilterMaxSize `taggedAt` ["index", "cache", "filter", "max_size"]
2947+ <|> cacheFilterExpire `taggedAt` ["index", "cache", "filter", "expire"]
2948+ <|> gatewaySnapshotInterval `taggedAt` ["index", "gateway", "snapshot_interval"]
2949+ <|> routingAllocationInclude `taggedAt` ["index", "routing", "allocation", "include"]
2950+ <|> routingAllocationExclude `taggedAt` ["index", "routing", "allocation", "exclude"]
2951+ <|> routingAllocationRequire `taggedAt` ["index", "routing", "allocation", "require"]
2952+ <|> routingAllocationEnable `taggedAt` ["index", "routing", "allocation", "enable"]
2953+ <|> routingAllocationShardsPerNode `taggedAt` ["index", "routing", "allocation", "total_shards_per_node"]
2954+ <|> recoveryInitialShards `taggedAt` ["index", "recovery", "initial_shards"]
2955+ <|> gcDeletes `taggedAt` ["index", "gc_deletes"]
2956+ <|> ttlDisablePurge `taggedAt` ["index", "ttl", "disable_purge"]
2957+ <|> translogFSType `taggedAt` ["index", "translog", "fs", "type"]
2958+ <|> compoundFormat `taggedAt` ["index", "compound_format"]
2959+ <|> compoundOnFlush `taggedAt` ["index", "compound_on_flush"]
2960+ <|> warmerEnabled `taggedAt` ["index", "warmer", "enabled"]
2961+ <|> blocksReadOnly `taggedAt` ["blocks", "read_only"]
2962+ <|> blocksRead `taggedAt` ["blocks", "read"]
2963+ <|> blocksWrite `taggedAt` ["blocks", "write"]
2964+ <|> blocksMetaData `taggedAt` ["blocks", "metadata"]
2965+ where taggedAt f ks = taggedAt' f (Object o) ks
2966+ taggedAt' f v [] = f =<< (parseJSON v <|> (parseJSON (unStringlyTypeJSON v)))
2967+ taggedAt' f v (k:ks) = withObject "Object" (\o -> do v' <- o .: k
2968+ taggedAt' f v' ks) v
2969+ numberOfReplicas = pure . NumberOfReplicas
2970+ autoExpandReplicas = pure . AutoExpandReplicas
2971+ refreshInterval = pure . RefreshInterval . ndtJSON
2972+ indexConcurrency = pure . IndexConcurrency
2973+ failOnMergeFailure = pure . FailOnMergeFailure
2974+ translogFlushThresholdOps = pure . TranslogFlushThresholdOps
2975+ translogFlushThresholdSize = pure . TranslogFlushThresholdSize
2976+ translogFlushThresholdPeriod = pure . TranslogFlushThresholdPeriod . ndtJSON
2977+ translogDisableFlush = pure . TranslogDisableFlush
2978+ cacheFilterMaxSize = pure . CacheFilterMaxSize
2979+ cacheFilterExpire = pure . CacheFilterExpire . fmap ndtJSON
2980+ gatewaySnapshotInterval = pure . GatewaySnapshotInterval . ndtJSON
2981+ routingAllocationInclude = fmap RoutingAllocationInclude . parseAttrFilter
2982+ routingAllocationExclude = fmap RoutingAllocationExclude . parseAttrFilter
2983+ routingAllocationRequire = fmap RoutingAllocationRequire . parseAttrFilter
2984+ routingAllocationEnable = pure . RoutingAllocationEnable
2985+ routingAllocationShardsPerNode = pure . RoutingAllocationShardsPerNode
2986+ recoveryInitialShards = pure . RecoveryInitialShards
2987+ gcDeletes = pure . GCDeletes . ndtJSON
2988+ ttlDisablePurge = pure . TTLDisablePurge
2989+ translogFSType = pure . TranslogFSType
2990+ compoundFormat = pure . IndexCompoundFormat
2991+ compoundOnFlush = pure . IndexCompoundOnFlush
2992+ warmerEnabled = pure . WarmerEnabled
2993+ blocksReadOnly = pure . BlocksReadOnly
2994+ blocksRead = pure . BlocksRead
2995+ blocksWrite = pure . BlocksWrite
2996+ blocksMetaData = pure . BlocksMetaData
2997+
2998+instance FromJSON IndexSettingsSummary where
2999+ parseJSON = withObject "IndexSettingsSummary" parse
3000+ where parse o = case HM.toList o of
3001+ [(ixn, v@(Object o'))] -> IndexSettingsSummary (IndexName ixn)
3002+ <$> parseJSON v
3003+ <*> (fmap (filter (not . redundant)) . parseSettings =<< o' .: "settings")
3004+ _ -> fail "Expected single-key object with index name"
3005+ redundant (NumberOfReplicas _) = True
3006+ redundant _ = False
3007+
3008+-- | For some reason in several settings APIs, all leaf values get returned
3009+-- as strings. This function attepmts to recover from this for all
3010+-- non-recursive JSON types. If nothing can be done, the value is left alone.
3011+unStringlyTypeJSON :: Value -> Value
3012+unStringlyTypeJSON (String "true") = Bool True
3013+unStringlyTypeJSON (String "false") = Bool False
3014+unStringlyTypeJSON (String "null") = Null
3015+unStringlyTypeJSON v@(String t) = case readMay (T.unpack t) of
3016+ Just n -> Number n
3017+ Nothing -> v
3018+unStringlyTypeJSON v = v
3019+
3020+
3021+parseSettings :: Object -> Parser [UpdatableIndexSetting]
3022+parseSettings o = do
3023+ o' <- o .: "index"
3024+ -- slice the index object into singleton hashmaps and try to parse each
3025+ parses <- forM (HM.toList o') $ \(k, v) -> do
3026+ -- blocks are now nested into the "index" key, which is not how they're serialized
3027+ let atRoot = Object (HM.singleton k v)
3028+ let atIndex = Object (HM.singleton "index" atRoot)
3029+ optional (parseJSON atRoot <|> parseJSON atIndex)
3030+ return (catMaybes parses)
3031+
3032+oPath :: ToJSON a => NonEmpty Text -> a -> Value
3033+oPath (k :| []) v = object [k .= v]
3034+oPath (k:| (h:t)) v = object [k .= oPath (h :| t) v]
3035+
3036+attrFilterJSON :: NonEmpty NodeAttrFilter -> Value
3037+attrFilterJSON fs = object [ n .= T.intercalate "," (toList vs)
3038+ | NodeAttrFilter (NodeAttrName n) vs <- toList fs]
3039+
3040+parseAttrFilter :: Value -> Parser (NonEmpty NodeAttrFilter)
3041+parseAttrFilter = withObject "NonEmpty NodeAttrFilter" parse
3042+ where parse o = case HM.toList o of
3043+ [] -> fail "Expected non-empty list of NodeAttrFilters"
3044+ x:xs -> DT.mapM (uncurry parse') (x :| xs)
3045+ parse' n = withText "Text" $ \t ->
3046+ case T.splitOn "," t of
3047+ fv:fvs -> return (NodeAttrFilter (NodeAttrName n) (fv :| fvs))
3048+ [] -> fail "Expected non-empty list of filter values"
3049+
3050+instance ToJSON ReplicaBounds where
3051+ toJSON (ReplicasBounded a b) = String (showText a <> "-" <> showText b)
3052+ toJSON (ReplicasLowerBounded a) = String (showText a <> "-all")
3053+ toJSON ReplicasUnbounded = Bool False
3054+
3055+instance FromJSON ReplicaBounds where
3056+ parseJSON v = withText "ReplicaBounds" parseText v
3057+ <|> withBool "ReplicaBounds" parseBool v
3058+ where parseText t = case T.splitOn "-" t of
3059+ [a, "all"] -> ReplicasLowerBounded <$> parseReadText a
3060+ [a, b] -> ReplicasBounded <$> parseReadText a
3061+ <*> parseReadText b
3062+ _ -> fail ("Could not parse ReplicaBounds: " <> show t)
3063+ parseBool False = pure ReplicasUnbounded
3064+ parseBool _ = fail "ReplicasUnbounded cannot be represented with True"
3065+
3066+instance ToJSON AllocationPolicy where
3067+ toJSON AllocAll = String "all"
3068+ toJSON AllocPrimaries = String "primaries"
3069+ toJSON AllocNewPrimaries = String "new_primaries"
3070+ toJSON AllocNone = String "none"
3071+
3072+instance FromJSON AllocationPolicy where
3073+ parseJSON = withText "AllocationPolicy" parse
3074+ where parse "all" = pure AllocAll
3075+ parse "primaries" = pure AllocPrimaries
3076+ parse "new_primaries" = pure AllocNewPrimaries
3077+ parse "none" = pure AllocNone
3078+ parse t = fail ("Invlaid AllocationPolicy: " <> show t)
3079+
3080+instance ToJSON InitialShardCount where
3081+ toJSON QuorumShards = String "quorum"
3082+ toJSON QuorumMinus1Shards = String "quorum-1"
3083+ toJSON FullShards = String "full"
3084+ toJSON FullMinus1Shards = String "full-1"
3085+ toJSON (ExplicitShards x) = toJSON x
3086+
3087+instance FromJSON InitialShardCount where
3088+ parseJSON v = withText "InitialShardCount" parseText v
3089+ <|> ExplicitShards <$> parseJSON v
3090+ where parseText "quorum" = pure QuorumShards
3091+ parseText "quorum-1" = pure QuorumMinus1Shards
3092+ parseText "full" = pure FullShards
3093+ parseText "full-1" = pure FullMinus1Shards
3094+ parseText _ = mzero
3095+
3096+instance ToJSON FSType where
3097+ toJSON FSSimple = "simple"
3098+ toJSON FSBuffered = "buffered"
3099+
3100+instance FromJSON FSType where
3101+ parseJSON = withText "FSType" parse
3102+ where parse "simple" = pure FSSimple
3103+ parse "buffered" = pure FSBuffered
3104+ parse t = fail ("Invalid FSType: " <> show t)
3105+
3106+instance ToJSON CompoundFormat where
3107+ toJSON (CompoundFileFormat x) = Bool x
3108+ toJSON (MergeSegmentVsTotalIndex x) = toJSON x
3109+
3110+instance FromJSON CompoundFormat where
3111+ parseJSON v = CompoundFileFormat <$> parseJSON v
3112+ <|> MergeSegmentVsTotalIndex <$> parseJSON v
3113+
3114+instance ToJSON NominalDiffTimeJSON where
3115+ toJSON (NominalDiffTimeJSON t) = String (showText (round t :: Integer) <> "s")
3116+
3117+instance FromJSON NominalDiffTimeJSON where
3118+ parseJSON = withText "NominalDiffTime" parse
3119+ where parse t = case T.takeEnd 1 t of
3120+ "s" -> NominalDiffTimeJSON . fromInteger <$> parseReadText (T.dropEnd 1 t)
3121+ _ -> fail "Invalid or missing NominalDiffTime unit (expected s)"
3122+
3123+instance ToJSON IndexTemplate where
3124+ toJSON (IndexTemplate p s m) = merge
3125+ (object [ "template" .= p
3126+ , "mappings" .= foldl' merge (object []) m
3127+ ])
3128+ (toJSON s)
3129+ where
3130+ merge (Object o1) (Object o2) = toJSON $ HM.union o1 o2
3131+ merge o Null = o
3132+ merge _ _ = undefined
3133+
3134+instance (FromJSON a) => FromJSON (EsResult a) where
3135+ parseJSON jsonVal@(Object v) = do
3136+ found <- v .:? "found" .!= False
3137+ fr <- if found
3138+ then parseJSON jsonVal
3139+ else return Nothing
3140+ EsResult <$> v .: "_index" <*>
3141+ v .: "_type" <*>
3142+ v .: "_id" <*>
3143+ pure fr
3144+ parseJSON _ = empty
3145+
3146+instance (FromJSON a) => FromJSON (EsResultFound a) where
3147+ parseJSON (Object v) = EsResultFound <$>
3148+ v .: "_version" <*>
3149+ v .: "_source"
3150+ parseJSON _ = empty
3151+
3152+instance FromJSON EsError where
3153+ parseJSON (Object v) = EsError <$>
3154+ v .: "status" <*>
3155+ (v .: "error" <|> (v .: "error" >>= (.: "reason")))
3156+ parseJSON _ = empty
3157+
3158+instance FromJSON IndexAliasesSummary where
3159+ parseJSON = withObject "IndexAliasesSummary" parse
3160+ where parse o = IndexAliasesSummary . mconcat <$> mapM (uncurry go) (HM.toList o)
3161+ go ixn = withObject "index aliases" $ \ia -> do
3162+ aliases <- ia .:? "aliases" .!= mempty
3163+ forM (HM.toList aliases) $ \(aName, v) -> do
3164+ let indexAlias = IndexAlias (IndexName ixn) (IndexAliasName (IndexName aName))
3165+ IndexAliasSummary indexAlias <$> parseJSON v
3166+
3167+
3168+instance ToJSON IndexAliasAction where
3169+ toJSON (AddAlias ia opts) = object ["add" .= (iaObj <> optsObj)]
3170+ where Object iaObj = toJSON ia
3171+ Object optsObj = toJSON opts
3172+ toJSON (RemoveAlias ia) = object ["remove" .= iaObj]
3173+ where Object iaObj = toJSON ia
3174+
3175+instance ToJSON IndexAlias where
3176+ toJSON IndexAlias {..} = object ["index" .= srcIndex
3177+ , "alias" .= indexAlias
3178+ ]
3179+
3180+instance ToJSON IndexAliasCreate where
3181+ toJSON IndexAliasCreate {..} = Object (filterObj <> routingObj)
3182+ where filterObj = maybe mempty (HM.singleton "filter" . toJSON) aliasCreateFilter
3183+ Object routingObj = maybe (Object mempty) toJSON aliasCreateRouting
3184+
3185+instance ToJSON AliasRouting where
3186+ toJSON (AllAliasRouting v) = object ["routing" .= v]
3187+ toJSON (GranularAliasRouting srch idx) = object (catMaybes prs)
3188+ where prs = [("search_routing" .=) <$> srch
3189+ ,("index_routing" .=) <$> idx]
3190+
3191+instance FromJSON AliasRouting where
3192+ parseJSON = withObject "AliasRouting" parse
3193+ where parse o = parseAll o <|> parseGranular o
3194+ parseAll o = AllAliasRouting <$> o .: "routing"
3195+ parseGranular o = do
3196+ sr <- o .:? "search_routing"
3197+ ir <- o .:? "index_routing"
3198+ if isNothing sr && isNothing ir
3199+ then fail "Both search_routing and index_routing can't be blank"
3200+ else return (GranularAliasRouting sr ir)
3201+
3202+instance FromJSON IndexAliasCreate where
3203+ parseJSON v = withObject "IndexAliasCreate" parse v
3204+ where parse o = IndexAliasCreate <$> optional (parseJSON v)
3205+ <*> o .:? "filter"
3206+
3207+instance ToJSON SearchAliasRouting where
3208+ toJSON (SearchAliasRouting rvs) = toJSON (T.intercalate "," (routingValue <$> toList rvs))
3209+
3210+instance FromJSON SearchAliasRouting where
3211+ parseJSON = withText "SearchAliasRouting" parse
3212+ where parse t = SearchAliasRouting <$> parseNEJSON (String <$> T.splitOn "," t)
3213+
3214+instance ToJSON Search where
3215+ toJSON (Search mquery sFilter sort searchAggs highlight sTrackSortScores sFrom sSize _ sFields sSource) =
3216+ omitNulls [ "query" .= query'
3217+ , "sort" .= sort
3218+ , "aggregations" .= searchAggs
3219+ , "highlight" .= highlight
3220+ , "from" .= sFrom
3221+ , "size" .= sSize
3222+ , "track_scores" .= sTrackSortScores
3223+ , "fields" .= sFields
3224+ , "_source" .= sSource]
3225+
3226+ where query' = case sFilter of
3227+ Nothing -> mquery
3228+ Just x -> Just . QueryBoolQuery $ mkBoolQuery (maybeToList mquery) [x] [] []
3229+
3230+instance ToJSON Source where
3231+ toJSON NoSource = toJSON False
3232+ toJSON (SourcePatterns patterns) = toJSON patterns
3233+ toJSON (SourceIncludeExclude incl excl) = object [ "includes" .= incl, "excludes" .= excl ]
3234+
3235+instance ToJSON PatternOrPatterns where
3236+ toJSON (PopPattern pattern) = toJSON pattern
3237+ toJSON (PopPatterns patterns) = toJSON patterns
3238+
3239+instance ToJSON Include where
3240+ toJSON (Include patterns) = toJSON patterns
3241+
3242+instance ToJSON Exclude where
3243+ toJSON (Exclude patterns) = toJSON patterns
3244+
3245+instance ToJSON Pattern where
3246+ toJSON (Pattern pattern) = toJSON pattern
3247+
3248+
3249+instance ToJSON FieldHighlight where
3250+ toJSON (FieldHighlight (FieldName fName) (Just fSettings)) =
3251+ object [ fName .= fSettings ]
3252+ toJSON (FieldHighlight (FieldName fName) Nothing) =
3253+ object [ fName .= emptyObject ]
3254+
3255+instance ToJSON Highlights where
3256+ toJSON (Highlights global fields) =
3257+ omitNulls (("fields" .= fields)
3258+ : highlightSettingsPairs global)
3259+
3260+instance ToJSON HighlightSettings where
3261+ toJSON hs = omitNulls (highlightSettingsPairs (Just hs))
3262+
3263+highlightSettingsPairs :: Maybe HighlightSettings -> [Pair]
3264+highlightSettingsPairs Nothing = []
3265+highlightSettingsPairs (Just (Plain plh)) = plainHighPairs (Just plh)
3266+highlightSettingsPairs (Just (Postings ph)) = postHighPairs (Just ph)
3267+highlightSettingsPairs (Just (FastVector fvh)) = fastVectorHighPairs (Just fvh)
3268+
3269+
3270+plainHighPairs :: Maybe PlainHighlight -> [Pair]
3271+plainHighPairs Nothing = []
3272+plainHighPairs (Just (PlainHighlight plCom plNonPost)) =
3273+ [ "type" .= String "plain"]
3274+ ++ commonHighlightPairs plCom
3275+ ++ nonPostingsToPairs plNonPost
3276+
3277+postHighPairs :: Maybe PostingsHighlight -> [Pair]
3278+postHighPairs Nothing = []
3279+postHighPairs (Just (PostingsHighlight pCom)) =
3280+ ("type" .= String "postings")
3281+ : commonHighlightPairs pCom
3282+
3283+fastVectorHighPairs :: Maybe FastVectorHighlight -> [Pair]
3284+fastVectorHighPairs Nothing = []
3285+fastVectorHighPairs (Just
3286+ (FastVectorHighlight fvCom fvNonPostSettings fvBoundChars
3287+ fvBoundMaxScan fvFragOff fvMatchedFields
3288+ fvPhraseLim)) =
3289+ [ "type" .= String "fvh"
3290+ , "boundary_chars" .= fvBoundChars
3291+ , "boundary_max_scan" .= fvBoundMaxScan
3292+ , "fragment_offset" .= fvFragOff
3293+ , "matched_fields" .= fvMatchedFields
3294+ , "phraseLimit" .= fvPhraseLim]
3295+ ++ commonHighlightPairs fvCom
3296+ ++ nonPostingsToPairs fvNonPostSettings
3297+
3298+deleteSeveral :: (Eq k, Hashable k) => [k] -> HM.HashMap k v -> HM.HashMap k v
3299+deleteSeveral ks hm = foldr HM.delete hm ks
3300+
3301+commonHighlightPairs :: Maybe CommonHighlight -> [Pair]
3302+commonHighlightPairs Nothing = []
3303+commonHighlightPairs (Just (CommonHighlight chScore chForceSource chTag chEncoder
3304+ chNoMatchSize chHighlightQuery
3305+ chRequireFieldMatch)) =
3306+ [ "order" .= chScore
3307+ , "force_source" .= chForceSource
3308+ , "encoder" .= chEncoder
3309+ , "no_match_size" .= chNoMatchSize
3310+ , "highlight_query" .= chHighlightQuery
3311+ , "require_fieldMatch" .= chRequireFieldMatch]
3312+ ++ highlightTagToPairs chTag
3313+
3314+
3315+nonPostingsToPairs :: Maybe NonPostings -> [Pair]
3316+nonPostingsToPairs Nothing = []
3317+nonPostingsToPairs (Just (NonPostings npFragSize npNumOfFrags)) =
3318+ [ "fragment_size" .= npFragSize
3319+ , "number_of_fragments" .= npNumOfFrags]
3320+
3321+parseNEJSON :: (FromJSON a) => [Value] -> Parser (NonEmpty a)
3322+parseNEJSON [] = fail "Expected non-empty list"
3323+parseNEJSON (x:xs) = DT.mapM parseJSON (x :| xs)
3324+
3325+
3326+instance ToJSON HighlightEncoder where
3327+ toJSON DefaultEncoder = String "default"
3328+ toJSON HTMLEncoder = String "html"
3329+
3330+highlightTagToPairs :: Maybe HighlightTag -> [Pair]
3331+highlightTagToPairs (Just (TagSchema _)) = [ "scheme" .= String "default"]
3332+highlightTagToPairs (Just (CustomTags (pre, post))) = [ "pre_tags" .= pre
3333+ , "post_tags" .= post]
3334+highlightTagToPairs Nothing = []
3335+
3336+instance ToJSON SortSpec where
3337+ toJSON (DefaultSortSpec
3338+ (DefaultSort (FieldName dsSortFieldName) dsSortOrder dsIgnoreUnmapped
3339+ dsSortMode dsMissingSort dsNestedFilter)) =
3340+ object [dsSortFieldName .= omitNulls base] where
3341+ base = [ "order" .= dsSortOrder
3342+ , "unmapped_type" .= dsIgnoreUnmapped
3343+ , "mode" .= dsSortMode
3344+ , "missing" .= dsMissingSort
3345+ , "nested_filter" .= dsNestedFilter ]
3346+
3347+ toJSON (GeoDistanceSortSpec gdsSortOrder (GeoPoint (FieldName field) gdsLatLon) units) =
3348+ object [ "unit" .= units
3349+ , field .= gdsLatLon
3350+ , "order" .= gdsSortOrder ]
3351+
3352+
3353+instance ToJSON SortOrder where
3354+ toJSON Ascending = String "asc"
3355+ toJSON Descending = String "desc"
3356+
3357+
3358+instance ToJSON SortMode where
3359+ toJSON SortMin = String "min"
3360+ toJSON SortMax = String "max"
3361+ toJSON SortSum = String "sum"
3362+ toJSON SortAvg = String "avg"
3363+
3364+
3365+instance ToJSON Missing where
3366+ toJSON LastMissing = String "_last"
3367+ toJSON FirstMissing = String "_first"
3368+ toJSON (CustomMissing txt) = String txt
3369+
3370+
3371+instance ToJSON ScoreType where
3372+ toJSON ScoreTypeMax = "max"
3373+ toJSON ScoreTypeAvg = "avg"
3374+ toJSON ScoreTypeSum = "sum"
3375+ toJSON ScoreTypeNone = "none"
3376+
3377+instance FromJSON ScoreType where
3378+ parseJSON = withText "ScoreType" parse
3379+ where parse "max" = pure ScoreTypeMax
3380+ parse "avg" = pure ScoreTypeAvg
3381+ parse "sum" = pure ScoreTypeSum
3382+ parse "none" = pure ScoreTypeNone
3383+ parse t = fail ("Unexpected ScoreType: " <> show t)
3384+
3385+instance ToJSON Distance where
3386+ toJSON (Distance dCoefficient dUnit) =
3387+ String boltedTogether where
3388+ coefText = showText dCoefficient
3389+ (String unitText) = toJSON dUnit
3390+ boltedTogether = mappend coefText unitText
3391+
3392+instance FromJSON Distance where
3393+ parseJSON = withText "Distance" parse
3394+ where parse t = Distance <$> parseCoeff nT
3395+ <*> parseJSON (String unitT)
3396+ where (nT, unitT) = T.span validForNumber t
3397+ -- may be a better way to do this
3398+ validForNumber '-' = True
3399+ validForNumber '.' = True
3400+ validForNumber 'e' = True
3401+ validForNumber c = isNumber c
3402+ parseCoeff "" = fail "Empty string cannot be parsed as number"
3403+ parseCoeff s = return (read (T.unpack s))
3404+
3405+instance ToJSON DistanceUnit where
3406+ toJSON Miles = String "mi"
3407+ toJSON Yards = String "yd"
3408+ toJSON Feet = String "ft"
3409+ toJSON Inches = String "in"
3410+ toJSON Kilometers = String "km"
3411+ toJSON Meters = String "m"
3412+ toJSON Centimeters = String "cm"
3413+ toJSON Millimeters = String "mm"
3414+ toJSON NauticalMiles = String "nmi"
3415+
3416+
3417+instance FromJSON DistanceUnit where
3418+ parseJSON = withText "DistanceUnit" parse
3419+ where parse "mi" = pure Miles
3420+ parse "yd" = pure Yards
3421+ parse "ft" = pure Feet
3422+ parse "in" = pure Inches
3423+ parse "km" = pure Kilometers
3424+ parse "m" = pure Meters
3425+ parse "cm" = pure Centimeters
3426+ parse "mm" = pure Millimeters
3427+ parse "nmi" = pure NauticalMiles
3428+ parse u = fail ("Unrecognized DistanceUnit: " <> show u)
3429+
3430+instance ToJSON DistanceType where
3431+ toJSON Arc = String "arc"
3432+ toJSON SloppyArc = String "sloppy_arc"
3433+ toJSON Plane = String "plane"
3434+
3435+instance FromJSON DistanceType where
3436+ parseJSON = withText "DistanceType" parse
3437+ where parse "arc" = pure Arc
3438+ parse "sloppy_arc" = pure SloppyArc
3439+ parse "plane" = pure Plane
3440+ parse t = fail ("Unrecognized DistanceType: " <> show t)
3441+
3442+
3443+instance ToJSON OptimizeBbox where
3444+ toJSON NoOptimizeBbox = String "none"
3445+ toJSON (OptimizeGeoFilterType gft) = toJSON gft
3446+
3447+instance FromJSON OptimizeBbox where
3448+ parseJSON v = withText "NoOptimizeBbox" parseNoOptimize v
3449+ <|> parseOptimize v
3450+ where parseNoOptimize "none" = pure NoOptimizeBbox
3451+ parseNoOptimize _ = mzero
3452+ parseOptimize = fmap OptimizeGeoFilterType . parseJSON
3453+
3454+instance ToJSON GeoBoundingBoxConstraint where
3455+ toJSON (GeoBoundingBoxConstraint
3456+ (FieldName gbbcGeoBBField) gbbcConstraintBox cache type') =
3457+ object [gbbcGeoBBField .= gbbcConstraintBox
3458+ , "_cache" .= cache
3459+ , "type" .= type']
3460+
3461+instance FromJSON GeoBoundingBoxConstraint where
3462+ parseJSON = withObject "GeoBoundingBoxConstraint" parse
3463+ where parse o = case HM.toList (deleteSeveral ["type", "_cache"] o) of
3464+ [(fn, v)] -> GeoBoundingBoxConstraint (FieldName fn)
3465+ <$> parseJSON v
3466+ <*> o .:? "_cache" .!= defaultCache
3467+ <*> o .: "type"
3468+ _ -> fail "Could not find field name for GeoBoundingBoxConstraint"
3469+
3470+instance ToJSON GeoFilterType where
3471+ toJSON GeoFilterMemory = String "memory"
3472+ toJSON GeoFilterIndexed = String "indexed"
3473+
3474+instance FromJSON GeoFilterType where
3475+ parseJSON = withText "GeoFilterType" parse
3476+ where parse "memory" = pure GeoFilterMemory
3477+ parse "indexed" = pure GeoFilterIndexed
3478+ parse t = fail ("Unrecognized GeoFilterType: " <> show t)
3479+
3480+instance ToJSON GeoBoundingBox where
3481+ toJSON (GeoBoundingBox gbbTopLeft gbbBottomRight) =
3482+ object ["top_left" .= gbbTopLeft
3483+ , "bottom_right" .= gbbBottomRight]
3484+
3485+instance FromJSON GeoBoundingBox where
3486+ parseJSON = withObject "GeoBoundingBox" parse
3487+ where parse o = GeoBoundingBox
3488+ <$> o .: "top_left"
3489+ <*> o .: "bottom_right"
3490+
3491+instance ToJSON LatLon where
3492+ toJSON (LatLon lLat lLon) =
3493+ object ["lat" .= lLat
3494+ , "lon" .= lLon]
3495+
3496+instance FromJSON LatLon where
3497+ parseJSON = withObject "LatLon" parse
3498+ where parse o = LatLon <$> o .: "lat"
3499+ <*> o .: "lon"
3500+
3501+-- index for smaller ranges, fielddata for longer ranges
3502+instance ToJSON RangeExecution where
3503+ toJSON RangeExecutionIndex = "index"
3504+ toJSON RangeExecutionFielddata = "fielddata"
3505+
3506+
3507+instance FromJSON RangeExecution where
3508+ parseJSON = withText "RangeExecution" parse
3509+ where parse "index" = pure RangeExecutionIndex
3510+ parse "fielddata" = pure RangeExecutionFielddata
3511+ parse t = error ("Unrecognized RangeExecution " <> show t)
3512+
3513+instance ToJSON RegexpFlags where
3514+ toJSON AllRegexpFlags = String "ALL"
3515+ toJSON NoRegexpFlags = String "NONE"
3516+ toJSON (SomeRegexpFlags (h :| fs)) = String $ T.intercalate "|" flagStrs
3517+ where flagStrs = map flagStr . nub $ h:fs
3518+ flagStr AnyString = "ANYSTRING"
3519+ flagStr Automaton = "AUTOMATON"
3520+ flagStr Complement = "COMPLEMENT"
3521+ flagStr Empty = "EMPTY"
3522+ flagStr Intersection = "INTERSECTION"
3523+ flagStr Interval = "INTERVAL"
3524+
3525+instance FromJSON RegexpFlags where
3526+ parseJSON = withText "RegexpFlags" parse
3527+ where parse "ALL" = pure AllRegexpFlags
3528+ parse "NONE" = pure NoRegexpFlags
3529+ parse t = SomeRegexpFlags <$> parseNEJSON (String <$> T.splitOn "|" t)
3530+
3531+instance FromJSON RegexpFlag where
3532+ parseJSON = withText "RegexpFlag" parse
3533+ where parse "ANYSTRING" = pure AnyString
3534+ parse "AUTOMATON" = pure Automaton
3535+ parse "COMPLEMENT" = pure Complement
3536+ parse "EMPTY" = pure Empty
3537+ parse "INTERSECTION" = pure Intersection
3538+ parse "INTERVAL" = pure Interval
3539+ parse f = fail ("Unknown RegexpFlag: " <> show f)
3540+
3541+instance ToJSON Term where
3542+ toJSON (Term field value) = object ["term" .= object
3543+ [field .= value]]
3544+
3545+instance FromJSON Term where
3546+ parseJSON = withObject "Term" parse
3547+ where parse o = do termObj <- o .: "term"
3548+ case HM.toList termObj of
3549+ [(fn, v)] -> Term fn <$> parseJSON v
3550+ _ -> fail "Expected object with 1 field-named key"
3551+
3552+instance ToJSON BoolMatch where
3553+ toJSON (MustMatch term cache) = object ["must" .= term,
3554+ "_cache" .= cache]
3555+ toJSON (MustNotMatch term cache) = object ["must_not" .= term,
3556+ "_cache" .= cache]
3557+ toJSON (ShouldMatch terms cache) = object ["should" .= fmap toJSON terms,
3558+ "_cache" .= cache]
3559+
3560+instance FromJSON BoolMatch where
3561+ parseJSON = withObject "BoolMatch" parse
3562+ where parse o = mustMatch `taggedWith` "must"
3563+ <|> mustNotMatch `taggedWith` "must_not"
3564+ <|> shouldMatch `taggedWith` "should"
3565+ where taggedWith parser k = parser =<< o .: k
3566+ mustMatch t = MustMatch t <$> o .:? "_cache" .!= defaultCache
3567+ mustNotMatch t = MustNotMatch t <$> o .:? "_cache" .!= defaultCache
3568+ shouldMatch t = ShouldMatch t <$> o .:? "_cache" .!= defaultCache
3569+
3570+instance (FromJSON a) => FromJSON (SearchResult a) where
3571+ parseJSON (Object v) = SearchResult <$>
3572+ v .: "took" <*>
3573+ v .: "timed_out" <*>
3574+ v .: "_shards" <*>
3575+ v .: "hits" <*>
3576+ v .:? "aggregations" <*>
3577+ v .:? "_scroll_id"
3578+ parseJSON _ = empty
3579+
3580+instance (FromJSON a) => FromJSON (SearchHits a) where
3581+ parseJSON (Object v) = SearchHits <$>
3582+ v .: "total" <*>
3583+ v .: "max_score" <*>
3584+ v .: "hits"
3585+ parseJSON _ = empty
3586+
3587+instance (FromJSON a) => FromJSON (Hit a) where
3588+ parseJSON (Object v) = Hit <$>
3589+ v .: "_index" <*>
3590+ v .: "_type" <*>
3591+ v .: "_id" <*>
3592+ v .: "_score" <*>
3593+ v .:? "_source" <*>
3594+ v .:? "highlight"
3595+ parseJSON _ = empty
3596+
3597+instance FromJSON ShardResult where
3598+ parseJSON (Object v) = ShardResult <$>
3599+ v .: "total" <*>
3600+ v .: "successful" <*>
3601+ v .: "failed"
3602+ parseJSON _ = empty
3603+
3604+
3605+instance FromJSON DocVersion where
3606+ parseJSON v = do
3607+ i <- parseJSON v
3608+ maybe (fail "DocVersion out of range") return $ mkDocVersion i
3609+
3610+-- This insanity is because ES *sometimes* returns Replica/Shard counts as strings
3611+instance FromJSON ReplicaCount where
3612+ parseJSON v = parseAsInt v
3613+ <|> parseAsString v
3614+ where parseAsInt = fmap ReplicaCount . parseJSON
3615+ parseAsString = withText "ReplicaCount" (fmap ReplicaCount . parseReadText)
3616+
3617+instance FromJSON ShardCount where
3618+ parseJSON v = parseAsInt v
3619+ <|> parseAsString v
3620+ where parseAsInt = fmap ShardCount . parseJSON
3621+ parseAsString = withText "ShardCount" (fmap ShardCount . parseReadText)
3622+
3623+instance Bounded DocVersion where
3624+ minBound = DocVersion 1
3625+ maxBound = DocVersion 9200000000000000000 -- 9.2e+18
3626+
3627+instance Enum DocVersion where
3628+ succ x
3629+ | x /= maxBound = DocVersion (succ $ docVersionNumber x)
3630+ | otherwise = succError "DocVersion"
3631+ pred x
3632+ | x /= minBound = DocVersion (pred $ docVersionNumber x)
3633+ | otherwise = predError "DocVersion"
3634+ toEnum i =
3635+ fromMaybe (error $ show i ++ " out of DocVersion range") $ mkDocVersion i
3636+ fromEnum = docVersionNumber
3637+ enumFrom = boundedEnumFrom
3638+ enumFromThen = boundedEnumFromThen
3639+
3640+-- | Username type used for HTTP Basic authentication. See 'basicAuthHook'.
3641+newtype EsUsername = EsUsername { esUsername :: Text } deriving (Read, Show, Eq)
3642+
3643+-- | Password type used for HTTP Basic authentication. See 'basicAuthHook'.
3644+newtype EsPassword = EsPassword { esPassword :: Text } deriving (Read, Show, Eq)
3645+
3646+
3647+data SnapshotRepoSelection = SnapshotRepoList (NonEmpty SnapshotRepoPattern)
3648+ | AllSnapshotRepos deriving (Eq, Generic, Show, Typeable)
3649+
3650+
3651+-- | Either specifies an exact repo name or one with globs in it,
3652+-- e.g. @RepoPattern "foo*"@ __NOTE__: Patterns are not supported on ES < 1.7
3653+data SnapshotRepoPattern = ExactRepo SnapshotRepoName
3654+ | RepoPattern Text
3655+ deriving (Eq, Generic, Show, Typeable)
3656+
3657+-- | The unique name of a snapshot repository.
3658+newtype SnapshotRepoName = SnapshotRepoName { snapshotRepoName :: Text }
3659+ deriving (Eq, Ord, Generic, Show, Typeable, ToJSON, FromJSON)
3660+
3661+
3662+-- | A generic representation of a snapshot repo. This is what gets
3663+-- sent to and parsed from the server. For repo types enabled by
3664+-- plugins that aren't exported by this library, consider making a
3665+-- custom type which implements 'SnapshotRepo'. If it is a common repo
3666+-- type, consider submitting a pull request to have it included in the
3667+-- library proper
3668+data GenericSnapshotRepo = GenericSnapshotRepo {
3669+ gSnapshotRepoName :: SnapshotRepoName
3670+ , gSnapshotRepoType :: SnapshotRepoType
3671+ , gSnapshotRepoSettings :: GenericSnapshotRepoSettings
3672+ } deriving (Eq, Generic, Show, Typeable)
3673+
3674+
3675+instance SnapshotRepo GenericSnapshotRepo where
3676+ toGSnapshotRepo = id
3677+ fromGSnapshotRepo = Right
3678+
3679+
3680+newtype SnapshotRepoType = SnapshotRepoType { snapshotRepoType :: Text }
3681+ deriving (Eq, Ord, Generic, Show, Typeable, ToJSON, FromJSON)
3682+
3683+
3684+-- | Opaque representation of snapshot repo settings. Instances of
3685+-- 'SnapshotRepo' will produce this.
3686+newtype GenericSnapshotRepoSettings = GenericSnapshotRepoSettings { gSnapshotRepoSettingsObject :: Object }
3687+ deriving (Eq, Generic, Show, Typeable, ToJSON)
3688+
3689+
3690+ -- Regardless of whether you send strongly typed json, my version of
3691+ -- ES sends back stringly typed json in the settings, e.g. booleans
3692+ -- as strings, so we'll try to convert them.
3693+instance FromJSON GenericSnapshotRepoSettings where
3694+ parseJSON = fmap (GenericSnapshotRepoSettings . fmap unStringlyTypeJSON). parseJSON
3695+
3696+-- | The result of running 'verifySnapshotRepo'.
3697+newtype SnapshotVerification = SnapshotVerification { snapshotNodeVerifications :: [SnapshotNodeVerification] }
3698+ deriving (Eq, Generic, Show, Typeable)
3699+
3700+
3701+instance FromJSON SnapshotVerification where
3702+ parseJSON = withObject "SnapshotVerification" parse
3703+ where
3704+ parse o = do
3705+ o2 <- o .: "nodes"
3706+ SnapshotVerification <$> mapM (uncurry parse') (HM.toList o2)
3707+ parse' rawFullId = withObject "SnapshotNodeVerification" $ \o ->
3708+ SnapshotNodeVerification (FullNodeId rawFullId) <$> o .: "name"
3709+
3710+
3711+-- | A node that has verified a snapshot
3712+data SnapshotNodeVerification = SnapshotNodeVerification {
3713+ snvFullId :: FullNodeId
3714+ , snvNodeName :: NodeName
3715+ } deriving (Eq, Generic, Show, Typeable)
3716+
3717+
3718+-- | Unique, automatically-generated name assigned to nodes that are
3719+-- usually returned in node-oriented APIs.
3720+newtype FullNodeId = FullNodeId { fullNodeId :: Text }
3721+ deriving (Eq, Ord, Generic, Show, Typeable, FromJSON)
3722+
3723+
3724+-- | A human-readable node name that is supplied by the user in the
3725+-- node config or automatically generated by ElasticSearch.
3726+newtype NodeName = NodeName { nodeName :: Text }
3727+ deriving (Eq, Ord, Generic, Show, Typeable, FromJSON)
3728+
3729+newtype ClusterName = ClusterName { clusterName :: Text }
3730+ deriving (Eq, Ord, Generic, Show, Typeable, FromJSON)
3731+
3732+data NodesInfo = NodesInfo {
3733+ nodesInfo :: [NodeInfo]
3734+ , nodesClusterName :: ClusterName
3735+ } deriving (Eq, Show, Generic, Typeable)
3736+
3737+data NodesStats = NodesStats {
3738+ nodesStats :: [NodeStats]
3739+ , nodesStatsClusterName :: ClusterName
3740+ } deriving (Eq, Show, Generic, Typeable)
3741+
3742+data NodeStats = NodeStats {
3743+ nodeStatsName :: NodeName
3744+ , nodeStatsFullId :: FullNodeId
3745+ , nodeStatsBreakersStats :: Maybe NodeBreakersStats
3746+ , nodeStatsHTTP :: NodeHTTPStats
3747+ , nodeStatsTransport :: NodeTransportStats
3748+ , nodeStatsFS :: NodeFSStats
3749+ , nodeStatsNetwork :: Maybe NodeNetworkStats
3750+ , nodeStatsThreadPool :: NodeThreadPoolsStats
3751+ , nodeStatsJVM :: NodeJVMStats
3752+ , nodeStatsProcess :: NodeProcessStats
3753+ , nodeStatsOS :: NodeOSStats
3754+ , nodeStatsIndices :: NodeIndicesStats
3755+ } deriving (Eq, Show, Generic, Typeable)
3756+
3757+data NodeBreakersStats = NodeBreakersStats {
3758+ nodeStatsParentBreaker :: NodeBreakerStats
3759+ , nodeStatsRequestBreaker :: NodeBreakerStats
3760+ , nodeStatsFieldDataBreaker :: NodeBreakerStats
3761+ } deriving (Eq, Show, Generic, Typeable)
3762+
3763+data NodeBreakerStats = NodeBreakerStats {
3764+ nodeBreakersTripped :: Int
3765+ , nodeBreakersOverhead :: Double
3766+ , nodeBreakersEstSize :: Bytes
3767+ , nodeBreakersLimitSize :: Bytes
3768+ } deriving (Eq, Show, Generic, Typeable)
3769+
3770+data NodeHTTPStats = NodeHTTPStats {
3771+ nodeHTTPTotalOpened :: Int
3772+ , nodeHTTPCurrentOpen :: Int
3773+ } deriving (Eq, Show, Generic, Typeable)
3774+
3775+data NodeTransportStats = NodeTransportStats {
3776+ nodeTransportTXSize :: Bytes
3777+ , nodeTransportCount :: Int
3778+ , nodeTransportRXSize :: Bytes
3779+ , nodeTransportRXCount :: Int
3780+ , nodeTransportServerOpen :: Int
3781+ } deriving (Eq, Show, Generic, Typeable)
3782+
3783+data NodeFSStats = NodeFSStats {
3784+ nodeFSDataPaths :: [NodeDataPathStats]
3785+ , nodeFSTotal :: NodeFSTotalStats
3786+ , nodeFSTimestamp :: UTCTime
3787+ } deriving (Eq, Show, Generic, Typeable)
3788+
3789+data NodeDataPathStats = NodeDataPathStats {
3790+ nodeDataPathDiskServiceTime :: Maybe Double
3791+ , nodeDataPathDiskQueue :: Maybe Double
3792+ , nodeDataPathIOSize :: Maybe Bytes
3793+ , nodeDataPathWriteSize :: Maybe Bytes
3794+ , nodeDataPathReadSize :: Maybe Bytes
3795+ , nodeDataPathIOOps :: Maybe Int
3796+ , nodeDataPathWrites :: Maybe Int
3797+ , nodeDataPathReads :: Maybe Int
3798+ , nodeDataPathAvailable :: Bytes
3799+ , nodeDataPathFree :: Bytes
3800+ , nodeDataPathTotal :: Bytes
3801+ , nodeDataPathType :: Maybe Text
3802+ , nodeDataPathDevice :: Maybe Text
3803+ , nodeDataPathMount :: Text
3804+ , nodeDataPathPath :: Text
3805+ } deriving (Eq, Show, Generic, Typeable)
3806+
3807+data NodeFSTotalStats = NodeFSTotalStats {
3808+ nodeFSTotalDiskServiceTime :: Maybe Double
3809+ , nodeFSTotalDiskQueue :: Maybe Double
3810+ , nodeFSTotalIOSize :: Maybe Bytes
3811+ , nodeFSTotalWriteSize :: Maybe Bytes
3812+ , nodeFSTotalReadSize :: Maybe Bytes
3813+ , nodeFSTotalIOOps :: Maybe Int
3814+ , nodeFSTotalWrites :: Maybe Int
3815+ , nodeFSTotalReads :: Maybe Int
3816+ , nodeFSTotalAvailable :: Bytes
3817+ , nodeFSTotalFree :: Bytes
3818+ , nodeFSTotalTotal :: Bytes
3819+ } deriving (Eq, Show, Generic, Typeable)
3820+
3821+data NodeNetworkStats = NodeNetworkStats {
3822+ nodeNetTCPOutRSTs :: Int
3823+ , nodeNetTCPInErrs :: Int
3824+ , nodeNetTCPAttemptFails :: Int
3825+ , nodeNetTCPEstabResets :: Int
3826+ , nodeNetTCPRetransSegs :: Int
3827+ , nodeNetTCPOutSegs :: Int
3828+ , nodeNetTCPInSegs :: Int
3829+ , nodeNetTCPCurrEstab :: Int
3830+ , nodeNetTCPPassiveOpens :: Int
3831+ , nodeNetTCPActiveOpens :: Int
3832+ } deriving (Eq, Show, Generic, Typeable)
3833+
3834+data NodeThreadPoolsStats = NodeThreadPoolsStats {
3835+ nodeThreadPoolsStatsSnapshot :: NodeThreadPoolStats
3836+ , nodeThreadPoolsStatsBulk :: NodeThreadPoolStats
3837+ , nodeThreadPoolsStatsMerge :: NodeThreadPoolStats
3838+ , nodeThreadPoolsStatsGet :: NodeThreadPoolStats
3839+ , nodeThreadPoolsStatsManagement :: NodeThreadPoolStats
3840+ , nodeThreadPoolsStatsFetchShardStore :: Maybe NodeThreadPoolStats
3841+ , nodeThreadPoolsStatsOptimize :: Maybe NodeThreadPoolStats
3842+ , nodeThreadPoolsStatsFlush :: NodeThreadPoolStats
3843+ , nodeThreadPoolsStatsSearch :: NodeThreadPoolStats
3844+ , nodeThreadPoolsStatsWarmer :: NodeThreadPoolStats
3845+ , nodeThreadPoolsStatsGeneric :: NodeThreadPoolStats
3846+ , nodeThreadPoolsStatsSuggest :: Maybe NodeThreadPoolStats
3847+ , nodeThreadPoolsStatsRefresh :: NodeThreadPoolStats
3848+ , nodeThreadPoolsStatsIndex :: NodeThreadPoolStats
3849+ , nodeThreadPoolsStatsListener :: Maybe NodeThreadPoolStats
3850+ , nodeThreadPoolsStatsFetchShardStarted :: Maybe NodeThreadPoolStats
3851+ , nodeThreadPoolsStatsPercolate :: Maybe NodeThreadPoolStats
3852+ } deriving (Eq, Show, Generic, Typeable)
3853+
3854+data NodeThreadPoolStats = NodeThreadPoolStats {
3855+ nodeThreadPoolCompleted :: Int
3856+ , nodeThreadPoolLargest :: Int
3857+ , nodeThreadPoolRejected :: Int
3858+ , nodeThreadPoolActive :: Int
3859+ , nodeThreadPoolQueue :: Int
3860+ , nodeThreadPoolThreads :: Int
3861+ } deriving (Eq, Show, Generic, Typeable)
3862+
3863+data NodeJVMStats = NodeJVMStats {
3864+ nodeJVMStatsMappedBufferPool :: JVMBufferPoolStats
3865+ , nodeJVMStatsDirectBufferPool :: JVMBufferPoolStats
3866+ , nodeJVMStatsGCOldCollector :: JVMGCStats
3867+ , nodeJVMStatsGCYoungCollector :: JVMGCStats
3868+ , nodeJVMStatsPeakThreadsCount :: Int
3869+ , nodeJVMStatsThreadsCount :: Int
3870+ , nodeJVMStatsOldPool :: JVMPoolStats
3871+ , nodeJVMStatsSurvivorPool :: JVMPoolStats
3872+ , nodeJVMStatsYoungPool :: JVMPoolStats
3873+ , nodeJVMStatsNonHeapCommitted :: Bytes
3874+ , nodeJVMStatsNonHeapUsed :: Bytes
3875+ , nodeJVMStatsHeapMax :: Bytes
3876+ , nodeJVMStatsHeapCommitted :: Bytes
3877+ , nodeJVMStatsHeapUsedPercent :: Int
3878+ , nodeJVMStatsHeapUsed :: Bytes
3879+ , nodeJVMStatsUptime :: NominalDiffTime
3880+ , nodeJVMStatsTimestamp :: UTCTime
3881+ } deriving (Eq, Show, Generic, Typeable)
3882+
3883+data JVMBufferPoolStats = JVMBufferPoolStats {
3884+ jvmBufferPoolStatsTotalCapacity :: Bytes
3885+ , jvmBufferPoolStatsUsed :: Bytes
3886+ , jvmBufferPoolStatsCount :: Int
3887+ } deriving (Eq, Show, Generic, Typeable)
3888+
3889+data JVMGCStats = JVMGCStats {
3890+ jvmGCStatsCollectionTime :: NominalDiffTime
3891+ , jvmGCStatsCollectionCount :: Int
3892+ } deriving (Eq, Show, Generic, Typeable)
3893+
3894+data JVMPoolStats = JVMPoolStats {
3895+ jvmPoolStatsPeakMax :: Bytes
3896+ , jvmPoolStatsPeakUsed :: Bytes
3897+ , jvmPoolStatsMax :: Bytes
3898+ , jvmPoolStatsUsed :: Bytes
3899+ } deriving (Eq, Show, Generic, Typeable)
3900+
3901+data NodeProcessStats = NodeProcessStats {
3902+ nodeProcessTimestamp :: UTCTime
3903+ , nodeProcessOpenFDs :: Int
3904+ , nodeProcessMaxFDs :: Int
3905+ , nodeProcessCPUPercent :: Int
3906+ , nodeProcessCPUTotal :: NominalDiffTime
3907+ , nodeProcessMemTotalVirtual :: Bytes
3908+ } deriving (Eq, Show, Generic, Typeable)
3909+
3910+data NodeOSStats = NodeOSStats {
3911+ nodeOSTimestamp :: UTCTime
3912+ , nodeOSCPUPercent :: Int
3913+ , nodeOSLoad :: Maybe LoadAvgs
3914+ , nodeOSMemTotal :: Bytes
3915+ , nodeOSMemFree :: Bytes
3916+ , nodeOSMemFreePercent :: Int
3917+ , nodeOSMemUsed :: Bytes
3918+ , nodeOSMemUsedPercent :: Int
3919+ , nodeOSSwapTotal :: Bytes
3920+ , nodeOSSwapFree :: Bytes
3921+ , nodeOSSwapUsed :: Bytes
3922+ } deriving (Eq, Show, Generic, Typeable)
3923+
3924+data LoadAvgs = LoadAvgs {
3925+ loadAvg1Min :: Double
3926+ , loadAvg5Min :: Double
3927+ , loadAvg15Min :: Double
3928+ } deriving (Eq, Show, Generic, Typeable)
3929+
3930+data NodeIndicesStats = NodeIndicesStats {
3931+ nodeIndicesStatsRecoveryThrottleTime :: Maybe NominalDiffTime
3932+ , nodeIndicesStatsRecoveryCurrentAsTarget :: Maybe Int
3933+ , nodeIndicesStatsRecoveryCurrentAsSource :: Maybe Int
3934+ , nodeIndicesStatsQueryCacheMisses :: Maybe Int
3935+ , nodeIndicesStatsQueryCacheHits :: Maybe Int
3936+ , nodeIndicesStatsQueryCacheEvictions :: Maybe Int
3937+ , nodeIndicesStatsQueryCacheSize :: Maybe Bytes
3938+ , nodeIndicesStatsSuggestCurrent :: Maybe Int
3939+ , nodeIndicesStatsSuggestTime :: Maybe NominalDiffTime
3940+ , nodeIndicesStatsSuggestTotal :: Maybe Int
3941+ , nodeIndicesStatsTranslogSize :: Bytes
3942+ , nodeIndicesStatsTranslogOps :: Int
3943+ , nodeIndicesStatsSegFixedBitSetMemory :: Maybe Bytes
3944+ , nodeIndicesStatsSegVersionMapMemory :: Bytes
3945+ , nodeIndicesStatsSegIndexWriterMaxMemory :: Maybe Bytes
3946+ , nodeIndicesStatsSegIndexWriterMemory :: Bytes
3947+ , nodeIndicesStatsSegMemory :: Bytes
3948+ , nodeIndicesStatsSegCount :: Int
3949+ , nodeIndicesStatsCompletionSize :: Bytes
3950+ , nodeIndicesStatsPercolateQueries :: Maybe Int
3951+ , nodeIndicesStatsPercolateMemory :: Maybe Bytes
3952+ , nodeIndicesStatsPercolateCurrent :: Maybe Int
3953+ , nodeIndicesStatsPercolateTime :: Maybe NominalDiffTime
3954+ , nodeIndicesStatsPercolateTotal :: Maybe Int
3955+ , nodeIndicesStatsFieldDataEvictions :: Int
3956+ , nodeIndicesStatsFieldDataMemory :: Bytes
3957+ , nodeIndicesStatsWarmerTotalTime :: NominalDiffTime
3958+ , nodeIndicesStatsWarmerTotal :: Int
3959+ , nodeIndicesStatsWarmerCurrent :: Int
3960+ , nodeIndicesStatsFlushTotalTime :: NominalDiffTime
3961+ , nodeIndicesStatsFlushTotal :: Int
3962+ , nodeIndicesStatsRefreshTotalTime :: NominalDiffTime
3963+ , nodeIndicesStatsRefreshTotal :: Int
3964+ , nodeIndicesStatsMergesTotalSize :: Bytes
3965+ , nodeIndicesStatsMergesTotalDocs :: Int
3966+ , nodeIndicesStatsMergesTotalTime :: NominalDiffTime
3967+ , nodeIndicesStatsMergesTotal :: Int
3968+ , nodeIndicesStatsMergesCurrentSize :: Bytes
3969+ , nodeIndicesStatsMergesCurrentDocs :: Int
3970+ , nodeIndicesStatsMergesCurrent :: Int
3971+ , nodeIndicesStatsSearchFetchCurrent :: Int
3972+ , nodeIndicesStatsSearchFetchTime :: NominalDiffTime
3973+ , nodeIndicesStatsSearchFetchTotal :: Int
3974+ , nodeIndicesStatsSearchQueryCurrent :: Int
3975+ , nodeIndicesStatsSearchQueryTime :: NominalDiffTime
3976+ , nodeIndicesStatsSearchQueryTotal :: Int
3977+ , nodeIndicesStatsSearchOpenContexts :: Int
3978+ , nodeIndicesStatsGetCurrent :: Int
3979+ , nodeIndicesStatsGetMissingTime :: NominalDiffTime
3980+ , nodeIndicesStatsGetMissingTotal :: Int
3981+ , nodeIndicesStatsGetExistsTime :: NominalDiffTime
3982+ , nodeIndicesStatsGetExistsTotal :: Int
3983+ , nodeIndicesStatsGetTime :: NominalDiffTime
3984+ , nodeIndicesStatsGetTotal :: Int
3985+ , nodeIndicesStatsIndexingThrottleTime :: Maybe NominalDiffTime
3986+ , nodeIndicesStatsIndexingIsThrottled :: Maybe Bool
3987+ , nodeIndicesStatsIndexingNoopUpdateTotal :: Maybe Int
3988+ , nodeIndicesStatsIndexingDeleteCurrent :: Int
3989+ , nodeIndicesStatsIndexingDeleteTime :: NominalDiffTime
3990+ , nodeIndicesStatsIndexingDeleteTotal :: Int
3991+ , nodeIndicesStatsIndexingIndexCurrent :: Int
3992+ , nodeIndicesStatsIndexingIndexTime :: NominalDiffTime
3993+ , nodeIndicesStatsIndexingTotal :: Int
3994+ , nodeIndicesStatsStoreThrottleTime :: NominalDiffTime
3995+ , nodeIndicesStatsStoreSize :: Bytes
3996+ , nodeIndicesStatsDocsDeleted :: Int
3997+ , nodeIndicesStatsDocsCount :: Int
3998+ } deriving (Eq, Show, Generic, Typeable)
3999+
4000+-- | A quirky address format used throughout ElasticSearch. An example
4001+-- would be inet[/1.1.1.1:9200]. inet may be a placeholder for a
4002+-- <https://en.wikipedia.org/wiki/Fully_qualified_domain_name FQDN>.
4003+newtype EsAddress = EsAddress { esAddress :: Text }
4004+ deriving (Eq, Ord, Generic, Show, Typeable, FromJSON)
4005+
4006+-- | Typically a 7 character hex string.
4007+newtype BuildHash = BuildHash { buildHash :: Text }
4008+ deriving (Eq, Ord, Generic, Read, Show, Typeable, FromJSON, ToJSON)
4009+
4010+newtype PluginName = PluginName { pluginName :: Text }
4011+ deriving (Eq, Ord, Generic, Show, Typeable, FromJSON)
4012+
4013+data NodeInfo = NodeInfo {
4014+ nodeInfoHTTPAddress :: Maybe EsAddress
4015+ , nodeInfoBuild :: BuildHash
4016+ , nodeInfoESVersion :: VersionNumber
4017+ , nodeInfoIP :: Server
4018+ , nodeInfoHost :: Server
4019+ , nodeInfoTransportAddress :: EsAddress
4020+ , nodeInfoName :: NodeName
4021+ , nodeInfoFullId :: FullNodeId
4022+ , nodeInfoPlugins :: [NodePluginInfo]
4023+ , nodeInfoHTTP :: NodeHTTPInfo
4024+ , nodeInfoTransport :: NodeTransportInfo
4025+ , nodeInfoNetwork :: Maybe NodeNetworkInfo
4026+ , nodeInfoThreadPool :: NodeThreadPoolsInfo
4027+ , nodeInfoJVM :: NodeJVMInfo
4028+ , nodeInfoProcess :: NodeProcessInfo
4029+ , nodeInfoOS :: NodeOSInfo
4030+ , nodeInfoSettings :: Object
4031+ -- ^ The members of the settings objects are not consistent,
4032+ -- dependent on plugins, etc.
4033+ } deriving (Eq, Show, Generic, Typeable)
4034+
4035+data NodePluginInfo = NodePluginInfo {
4036+ nodePluginSite :: Maybe Bool
4037+ -- ^ Is this a site plugin?
4038+ , nodePluginJVM :: Maybe Bool
4039+ -- ^ Is this plugin running on the JVM
4040+ , nodePluginDescription :: Text
4041+ , nodePluginVersion :: MaybeNA VersionNumber
4042+ , nodePluginName :: PluginName
4043+ } deriving (Eq, Show, Generic, Typeable)
4044+
4045+data NodeHTTPInfo = NodeHTTPInfo {
4046+ nodeHTTPMaxContentLength :: Bytes
4047+ , nodeHTTPTransportAddress :: BoundTransportAddress
4048+ } deriving (Eq, Show, Generic, Typeable)
4049+
4050+data NodeTransportInfo = NodeTransportInfo {
4051+ nodeTransportProfiles :: [BoundTransportAddress]
4052+ , nodeTransportAddress :: BoundTransportAddress
4053+ } deriving (Eq, Show, Generic, Typeable)
4054+
4055+data BoundTransportAddress = BoundTransportAddress {
4056+ publishAddress :: EsAddress
4057+ , boundAddress :: [EsAddress]
4058+ } deriving (Eq, Show, Generic, Typeable)
4059+
4060+data NodeNetworkInfo = NodeNetworkInfo {
4061+ nodeNetworkPrimaryInterface :: NodeNetworkInterface
4062+ , nodeNetworkRefreshInterval :: NominalDiffTime
4063+ } deriving (Eq, Show, Generic, Typeable)
4064+
4065+newtype MacAddress = MacAddress { macAddress :: Text }
4066+ deriving (Eq, Ord, Generic, Show, Typeable, FromJSON)
4067+
4068+newtype NetworkInterfaceName = NetworkInterfaceName { networkInterfaceName :: Text }
4069+ deriving (Eq, Ord, Generic, Show, Typeable, FromJSON)
4070+
4071+data NodeNetworkInterface = NodeNetworkInterface {
4072+ nodeNetIfaceMacAddress :: MacAddress
4073+ , nodeNetIfaceName :: NetworkInterfaceName
4074+ , nodeNetIfaceAddress :: Server
4075+ } deriving (Eq, Show, Generic, Typeable)
4076+
4077+data NodeThreadPoolsInfo = NodeThreadPoolsInfo {
4078+ nodeThreadPoolsRefresh :: NodeThreadPoolInfo
4079+ , nodeThreadPoolsManagement :: NodeThreadPoolInfo
4080+ , nodeThreadPoolsPercolate :: Maybe NodeThreadPoolInfo
4081+ , nodeThreadPoolsListener :: Maybe NodeThreadPoolInfo
4082+ , nodeThreadPoolsFetchShardStarted :: Maybe NodeThreadPoolInfo
4083+ , nodeThreadPoolsSearch :: NodeThreadPoolInfo
4084+ , nodeThreadPoolsFlush :: NodeThreadPoolInfo
4085+ , nodeThreadPoolsWarmer :: NodeThreadPoolInfo
4086+ , nodeThreadPoolsOptimize :: Maybe NodeThreadPoolInfo
4087+ , nodeThreadPoolsBulk :: NodeThreadPoolInfo
4088+ , nodeThreadPoolsSuggest :: Maybe NodeThreadPoolInfo
4089+ , nodeThreadPoolsMerge :: NodeThreadPoolInfo
4090+ , nodeThreadPoolsSnapshot :: NodeThreadPoolInfo
4091+ , nodeThreadPoolsGet :: NodeThreadPoolInfo
4092+ , nodeThreadPoolsFetchShardStore :: Maybe NodeThreadPoolInfo
4093+ , nodeThreadPoolsIndex :: NodeThreadPoolInfo
4094+ , nodeThreadPoolsGeneric :: NodeThreadPoolInfo
4095+ } deriving (Eq, Show, Generic, Typeable)
4096+
4097+data NodeThreadPoolInfo = NodeThreadPoolInfo {
4098+ nodeThreadPoolQueueSize :: ThreadPoolSize
4099+ , nodeThreadPoolKeepalive :: Maybe NominalDiffTime
4100+ , nodeThreadPoolMin :: Maybe Int
4101+ , nodeThreadPoolMax :: Maybe Int
4102+ , nodeThreadPoolType :: ThreadPoolType
4103+ } deriving (Eq, Show, Generic, Typeable)
4104+
4105+data ThreadPoolSize = ThreadPoolBounded Int
4106+ | ThreadPoolUnbounded
4107+ deriving (Eq, Show, Generic, Typeable)
4108+
4109+data ThreadPoolType = ThreadPoolScaling
4110+ | ThreadPoolFixed
4111+ | ThreadPoolCached
4112+ deriving (Eq, Show, Generic, Typeable)
4113+
4114+data NodeJVMInfo = NodeJVMInfo {
4115+ nodeJVMInfoMemoryPools :: [JVMMemoryPool]
4116+ , nodeJVMInfoMemoryPoolsGCCollectors :: [JVMGCCollector]
4117+ , nodeJVMInfoMemoryInfo :: JVMMemoryInfo
4118+ , nodeJVMInfoStartTime :: UTCTime
4119+ , nodeJVMInfoVMVendor :: Text
4120+ , nodeJVMVMVersion :: VersionNumber
4121+ -- ^ JVM doesn't seme to follow normal version conventions
4122+ , nodeJVMVMName :: Text
4123+ , nodeJVMVersion :: VersionNumber
4124+ , nodeJVMPID :: PID
4125+ } deriving (Eq, Show, Generic, Typeable)
4126+
4127+-- | Handles quirks in the way JVM versions are rendered (1.7.0_101 -> 1.7.0.101)
4128+newtype JVMVersion = JVMVersion { unJVMVersion :: VersionNumber }
4129+
4130+data JVMMemoryInfo = JVMMemoryInfo {
4131+ jvmMemoryInfoDirectMax :: Bytes
4132+ , jvmMemoryInfoNonHeapMax :: Bytes
4133+ , jvmMemoryInfoNonHeapInit :: Bytes
4134+ , jvmMemoryInfoHeapMax :: Bytes
4135+ , jvmMemoryInfoHeapInit :: Bytes
4136+ } deriving (Eq, Show, Generic, Typeable)
4137+
4138+newtype JVMMemoryPool = JVMMemoryPool {
4139+ jvmMemoryPool :: Text
4140+ } deriving (Eq, Show, Generic, Typeable, FromJSON)
4141+
4142+newtype JVMGCCollector = JVMGCCollector {
4143+ jvmGCCollector :: Text
4144+ } deriving (Eq, Show, Generic, Typeable, FromJSON)
4145+
4146+newtype PID = PID {
4147+ pid :: Int
4148+ } deriving (Eq, Show, Generic, Typeable, FromJSON)
4149+
4150+data NodeOSInfo = NodeOSInfo {
4151+ nodeOSRefreshInterval :: NominalDiffTime
4152+ , nodeOSName :: Text
4153+ , nodeOSArch :: Text
4154+ , nodeOSVersion :: VersionNumber
4155+ , nodeOSAvailableProcessors :: Int
4156+ , nodeOSAllocatedProcessors :: Int
4157+ } deriving (Eq, Show, Generic, Typeable)
4158+
4159+data CPUInfo = CPUInfo {
4160+ cpuCacheSize :: Bytes
4161+ , cpuCoresPerSocket :: Int
4162+ , cpuTotalSockets :: Int
4163+ , cpuTotalCores :: Int
4164+ , cpuMHZ :: Int
4165+ , cpuModel :: Text
4166+ , cpuVendor :: Text
4167+ } deriving (Eq, Show, Generic, Typeable)
4168+
4169+data NodeProcessInfo = NodeProcessInfo {
4170+ nodeProcessMLockAll :: Bool
4171+ -- ^ See <https://www.elastic.co/guide/en/elasticsearch/reference/current/setup-configuration.html>
4172+ , nodeProcessMaxFileDescriptors :: Maybe Int
4173+ , nodeProcessId :: PID
4174+ , nodeProcessRefreshInterval :: NominalDiffTime
4175+ } deriving (Eq, Show, Generic, Typeable)
4176+
4177+data SnapshotRepoUpdateSettings = SnapshotRepoUpdateSettings {
4178+ repoUpdateVerify :: Bool
4179+ -- ^ After creation/update, synchronously check that nodes can
4180+ -- write to this repo. Defaults to True. You may use False if you
4181+ -- need a faster response and plan on verifying manually later
4182+ -- with 'verifySnapshotRepo'.
4183+ } deriving (Eq, Show, Generic, Typeable)
4184+
4185+
4186+-- | Reasonable defaults for repo creation/update
4187+--
4188+-- * repoUpdateVerify True
4189+defaultSnapshotRepoUpdateSettings :: SnapshotRepoUpdateSettings
4190+defaultSnapshotRepoUpdateSettings = SnapshotRepoUpdateSettings True
4191+
4192+
4193+-- | A filesystem-based snapshot repo that ships with
4194+-- ElasticSearch. This is an instance of 'SnapshotRepo' so it can be
4195+-- used with 'updateSnapshotRepo'
4196+data FsSnapshotRepo = FsSnapshotRepo {
4197+ fsrName :: SnapshotRepoName
4198+ , fsrLocation :: FilePath
4199+ , fsrCompressMetadata :: Bool
4200+ , fsrChunkSize :: Maybe Bytes
4201+ -- ^ Size by which to split large files during snapshotting.
4202+ , fsrMaxRestoreBytesPerSec :: Maybe Bytes
4203+ -- ^ Throttle node restore rate. If not supplied, defaults to 40mb/sec
4204+ , fsrMaxSnapshotBytesPerSec :: Maybe Bytes
4205+ -- ^ Throttle node snapshot rate. If not supplied, defaults to 40mb/sec
4206+ } deriving (Eq, Generic, Show, Typeable)
4207+
4208+
4209+instance SnapshotRepo FsSnapshotRepo where
4210+ toGSnapshotRepo FsSnapshotRepo {..} =
4211+ GenericSnapshotRepo fsrName fsRepoType (GenericSnapshotRepoSettings settings)
4212+ where
4213+ Object settings = object $ [ "location" .= fsrLocation
4214+ , "compress" .= fsrCompressMetadata
4215+ ] ++ optionalPairs
4216+ optionalPairs = catMaybes [ ("chunk_size" .=) <$> fsrChunkSize
4217+ , ("max_restore_bytes_per_sec" .=) <$> fsrMaxRestoreBytesPerSec
4218+ , ("max_snapshot_bytes_per_sec" .=) <$> fsrMaxSnapshotBytesPerSec
4219+ ]
4220+ fromGSnapshotRepo GenericSnapshotRepo {..}
4221+ | gSnapshotRepoType == fsRepoType = do
4222+ let o = gSnapshotRepoSettingsObject gSnapshotRepoSettings
4223+ parseRepo $ do
4224+ FsSnapshotRepo gSnapshotRepoName <$> o .: "location"
4225+ <*> o .:? "compress" .!= False
4226+ <*> o .:? "chunk_size"
4227+ <*> o .:? "max_restore_bytes_per_sec"
4228+ <*> o .:? "max_snapshot_bytes_per_sec"
4229+ | otherwise = Left (RepoTypeMismatch fsRepoType gSnapshotRepoType)
4230+
4231+
4232+parseRepo :: Parser a -> Either SnapshotRepoConversionError a
4233+parseRepo parser = case parseEither (const parser) () of
4234+ Left e -> Left (OtherRepoConversionError (T.pack e))
4235+ Right a -> Right a
4236+
4237+
4238+fsRepoType :: SnapshotRepoType
4239+fsRepoType = SnapshotRepoType "fs"
4240+
4241+-- | Law: fromGSnapshotRepo (toGSnapshotRepo r) == Right r
4242+class SnapshotRepo r where
4243+ toGSnapshotRepo :: r -> GenericSnapshotRepo
4244+ fromGSnapshotRepo :: GenericSnapshotRepo -> Either SnapshotRepoConversionError r
4245+
4246+
4247+data SnapshotRepoConversionError = RepoTypeMismatch SnapshotRepoType SnapshotRepoType
4248+ -- ^ Expected type and actual type
4249+ | OtherRepoConversionError Text
4250+ deriving (Show, Eq, Generic, Typeable)
4251+
4252+
4253+instance Exception SnapshotRepoConversionError
4254+
4255+
4256+data SnapshotCreateSettings = SnapshotCreateSettings {
4257+ snapWaitForCompletion :: Bool
4258+ -- ^ Should the API call return immediately after initializing
4259+ -- the snapshot or wait until completed? Note that if this is
4260+ -- enabled it could wait a long time, so you should adjust your
4261+ -- 'ManagerSettings' accordingly to set long timeouts or
4262+ -- explicitly handle timeouts.
4263+ , snapIndices :: Maybe IndexSelection
4264+ -- ^ Nothing will snapshot all indices. Just [] is permissable and
4265+ -- will essentially be a no-op snapshot.
4266+ , snapIgnoreUnavailable :: Bool
4267+ -- ^ If set to True, any matched indices that don't exist will be
4268+ -- ignored. Otherwise it will be an error and fail.
4269+ , snapIncludeGlobalState :: Bool
4270+ , snapPartial :: Bool
4271+ -- ^ If some indices failed to snapshot (e.g. if not all primary
4272+ -- shards are available), should the process proceed?
4273+ } deriving (Eq, Generic, Show, Typeable)
4274+
4275+
4276+-- | Reasonable defaults for snapshot creation
4277+--
4278+-- * snapWaitForCompletion False
4279+-- * snapIndices Nothing
4280+-- * snapIgnoreUnavailable False
4281+-- * snapIncludeGlobalState True
4282+-- * snapPartial False
4283+defaultSnapshotCreateSettings :: SnapshotCreateSettings
4284+defaultSnapshotCreateSettings = SnapshotCreateSettings {
4285+ snapWaitForCompletion = False
4286+ , snapIndices = Nothing
4287+ , snapIgnoreUnavailable = False
4288+ , snapIncludeGlobalState = True
4289+ , snapPartial = False
4290+ }
4291+
4292+
4293+data SnapshotSelection = SnapshotList (NonEmpty SnapshotPattern)
4294+ | AllSnapshots deriving (Eq, Generic, Show, Typeable)
4295+
4296+
4297+-- | Either specifies an exact snapshot name or one with globs in it,
4298+-- e.g. @SnapPattern "foo*"@ __NOTE__: Patterns are not supported on
4299+-- ES < 1.7
4300+data SnapshotPattern = ExactSnap SnapshotName
4301+ | SnapPattern Text
4302+ deriving (Eq, Generic, Show, Typeable)
4303+
4304+
4305+-- | General information about the state of a snapshot. Has some
4306+-- redundancies with 'SnapshotStatus'
4307+data SnapshotInfo = SnapshotInfo {
4308+ snapInfoShards :: ShardResult
4309+ , snapInfoFailures :: [SnapshotShardFailure]
4310+ , snapInfoDuration :: NominalDiffTime
4311+ , snapInfoEndTime :: UTCTime
4312+ , snapInfoStartTime :: UTCTime
4313+ , snapInfoState :: SnapshotState
4314+ , snapInfoIndices :: [IndexName]
4315+ , snapInfoName :: SnapshotName
4316+ } deriving (Eq, Generic, Show, Typeable)
4317+
4318+
4319+instance FromJSON SnapshotInfo where
4320+ parseJSON = withObject "SnapshotInfo" parse
4321+ where
4322+ parse o = SnapshotInfo <$> o .: "shards"
4323+ <*> o .: "failures"
4324+ <*> (unMS <$> o .: "duration_in_millis")
4325+ <*> (posixMS <$> o .: "end_time_in_millis")
4326+ <*> (posixMS <$> o .: "start_time_in_millis")
4327+ <*> o .: "state"
4328+ <*> o .: "indices"
4329+ <*> o .: "snapshot"
4330+
4331+data SnapshotShardFailure = SnapshotShardFailure {
4332+ snapShardFailureIndex :: IndexName
4333+ , snapShardFailureNodeId :: Maybe NodeName -- I'm not 100% sure this isn't actually 'FullNodeId'
4334+ , snapShardFailureReason :: Text
4335+ , snapShardFailureShardId :: ShardId
4336+ } deriving (Eq, Show, Generic, Typeable)
4337+
4338+
4339+instance FromJSON SnapshotShardFailure where
4340+ parseJSON = withObject "SnapshotShardFailure" parse
4341+ where
4342+ parse o = SnapshotShardFailure <$> o .: "index"
4343+ <*> o .:? "node_id"
4344+ <*> o .: "reason"
4345+ <*> o .: "shard_id"
4346+
4347+
4348+newtype ShardId = ShardId { shardId :: Int }
4349+ deriving (Eq, Show, Generic, Typeable, FromJSON)
4350+
4351+-- | Milliseconds
4352+newtype MS = MS NominalDiffTime
4353+
4354+
4355+-- keeps the unexported constructor warnings at bay
4356+unMS :: MS -> NominalDiffTime
4357+unMS (MS t) = t
4358+
4359+
4360+instance FromJSON MS where
4361+ parseJSON = withScientific "MS" (return . MS . parse)
4362+ where
4363+ parse n = fromInteger ((truncate n) * 1000)
4364+
4365+
4366+data SnapshotState = SnapshotInit
4367+ | SnapshotStarted
4368+ | SnapshotSuccess
4369+ | SnapshotFailed
4370+ | SnapshotAborted
4371+ | SnapshotMissing
4372+ | SnapshotWaiting
4373+ deriving (Show, Eq, Generic, Typeable)
4374+
4375+instance FromJSON SnapshotState where
4376+ parseJSON = withText "SnapshotState" parse
4377+ where
4378+ parse "INIT" = return SnapshotInit
4379+ parse "STARTED" = return SnapshotStarted
4380+ parse "SUCCESS" = return SnapshotSuccess
4381+ parse "FAILED" = return SnapshotFailed
4382+ parse "ABORTED" = return SnapshotAborted
4383+ parse "MISSING" = return SnapshotMissing
4384+ parse "WAITING" = return SnapshotWaiting
4385+ parse t = fail ("Invalid snapshot state " <> T.unpack t)
4386+
4387+
4388+newtype SnapshotName = SnapshotName { snapshotName :: Text }
4389+ deriving (Show, Eq, Ord, Generic, Typeable, ToJSON, FromJSON)
4390+
4391+
4392+data SnapshotRestoreSettings = SnapshotRestoreSettings {
4393+ snapRestoreWaitForCompletion :: Bool
4394+ -- ^ Should the API call return immediately after initializing
4395+ -- the restore or wait until completed? Note that if this is
4396+ -- enabled, it could wait a long time, so you should adjust your
4397+ -- 'ManagerSettings' accordingly to set long timeouts or
4398+ -- explicitly handle timeouts.
4399+ , snapRestoreIndices :: Maybe IndexSelection
4400+ -- ^ Nothing will restore all indices in the snapshot. Just [] is
4401+ -- permissable and will essentially be a no-op restore.
4402+ , snapRestoreIgnoreUnavailable :: Bool
4403+ -- ^ If set to True, any indices that do not exist will be ignored
4404+ -- during snapshot rather than failing the restore.
4405+ , snapRestoreIncludeGlobalState :: Bool
4406+ -- ^ If set to false, will ignore any global state in the snapshot
4407+ -- and will not restore it.
4408+ , snapRestoreRenamePattern :: Maybe RestoreRenamePattern
4409+ -- ^ A regex pattern for matching indices. Used with
4410+ -- 'snapRestoreRenameReplacement', the restore can reference the
4411+ -- matched index and create a new index name upon restore.
4412+ , snapRestoreRenameReplacement :: Maybe (NonEmpty RestoreRenameToken)
4413+ -- ^ Expression of how index renames should be constructed.
4414+ , snapRestorePartial :: Bool
4415+ -- ^ If some indices fail to restore, should the process proceed?
4416+ , snapRestoreIncludeAliases :: Bool
4417+ -- ^ Should the restore also restore the aliases captured in the
4418+ -- snapshot.
4419+ , snapRestoreIndexSettingsOverrides :: Maybe RestoreIndexSettings
4420+ -- ^ Settings to apply during the restore process. __NOTE:__ This
4421+ -- option is not supported in ES < 1.5 and should be set to
4422+ -- Nothing in that case.
4423+ , snapRestoreIgnoreIndexSettings :: Maybe (NonEmpty Text)
4424+ -- ^ This type could be more rich but it isn't clear which
4425+ -- settings are allowed to be ignored during restore, so we're
4426+ -- going with including this feature in a basic form rather than
4427+ -- omitting it. One example here would be
4428+ -- "index.refresh_interval". Any setting specified here will
4429+ -- revert back to the server default during the restore process.
4430+ } deriving (Eq, Generic, Show, Typeable)
4431+
4432+-- | Regex-stype pattern, e.g. "index_(.+)" to match index names
4433+newtype RestoreRenamePattern = RestoreRenamePattern { rrPattern :: Text }
4434+ deriving (Show, Eq, Generic, Typeable, Ord, ToJSON)
4435+
4436+
4437+-- | A single token in a index renaming scheme for a restore. These
4438+-- are concatenated into a string before being sent to
4439+-- ElasticSearch. Check out these Java
4440+-- <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.
4441+data RestoreRenameToken = RRTLit Text
4442+ -- ^ Just a literal string of characters
4443+ | RRSubWholeMatch
4444+ -- ^ Equivalent to $0. The entire matched pattern, not any subgroup
4445+ | RRSubGroup RRGroupRefNum
4446+ -- ^ A specific reference to a group number
4447+ deriving (Show, Eq, Generic, Typeable)
4448+
4449+
4450+-- | A group number for regex matching. Only values from 1-9 are
4451+-- supported. Construct with 'mkRRGroupRefNum'
4452+newtype RRGroupRefNum = RRGroupRefNum { rrGroupRefNum :: Int }
4453+ deriving (Show, Eq, Generic, Typeable, Ord)
4454+
4455+instance Bounded RRGroupRefNum where
4456+ minBound = RRGroupRefNum 1
4457+ maxBound = RRGroupRefNum 9
4458+
4459+
4460+-- | Only allows valid group number references (1-9).
4461+mkRRGroupRefNum :: Int -> Maybe RRGroupRefNum
4462+mkRRGroupRefNum i
4463+ | i >= (rrGroupRefNum minBound) && i <= (rrGroupRefNum maxBound) =
4464+ Just $ RRGroupRefNum i
4465+ | otherwise = Nothing
4466+
4467+
4468+-- | Reasonable defaults for snapshot restores
4469+--
4470+-- * snapRestoreWaitForCompletion False
4471+-- * snapRestoreIndices Nothing
4472+-- * snapRestoreIgnoreUnavailable False
4473+-- * snapRestoreIncludeGlobalState True
4474+-- * snapRestoreRenamePattern Nothing
4475+-- * snapRestoreRenameReplacement Nothing
4476+-- * snapRestorePartial False
4477+-- * snapRestoreIncludeAliases True
4478+-- * snapRestoreIndexSettingsOverrides Nothing
4479+-- * snapRestoreIgnoreIndexSettings Nothing
4480+defaultSnapshotRestoreSettings :: SnapshotRestoreSettings
4481+defaultSnapshotRestoreSettings = SnapshotRestoreSettings {
4482+ snapRestoreWaitForCompletion = False
4483+ , snapRestoreIndices = Nothing
4484+ , snapRestoreIgnoreUnavailable = False
4485+ , snapRestoreIncludeGlobalState = True
4486+ , snapRestoreRenamePattern = Nothing
4487+ , snapRestoreRenameReplacement = Nothing
4488+ , snapRestorePartial = False
4489+ , snapRestoreIncludeAliases = True
4490+ , snapRestoreIndexSettingsOverrides = Nothing
4491+ , snapRestoreIgnoreIndexSettings = Nothing
4492+ }
4493+
4494+
4495+-- | Index settings that can be overridden. The docs only mention you
4496+-- can update number of replicas, but there may be more. You
4497+-- definitely cannot override shard count.
4498+data RestoreIndexSettings = RestoreIndexSettings {
4499+ restoreOverrideReplicas :: Maybe ReplicaCount
4500+ } deriving (Show, Eq, Generic, Typeable)
4501+
4502+
4503+instance ToJSON RestoreIndexSettings where
4504+ toJSON RestoreIndexSettings {..} = object prs
4505+ where
4506+ prs = catMaybes [("index.number_of_replicas" .=) <$> restoreOverrideReplicas]
4507+
4508+
4509+instance FromJSON NodesInfo where
4510+ parseJSON = withObject "NodesInfo" parse
4511+ where
4512+ parse o = do
4513+ nodes <- o .: "nodes"
4514+ infos <- forM (HM.toList nodes) $ \(fullNID, v) -> do
4515+ node <- parseJSON v
4516+ parseNodeInfo (FullNodeId fullNID) node
4517+ cn <- o .: "cluster_name"
4518+ return (NodesInfo infos cn)
4519+
4520+instance FromJSON NodesStats where
4521+ parseJSON = withObject "NodesStats" parse
4522+ where
4523+ parse o = do
4524+ nodes <- o .: "nodes"
4525+ stats <- forM (HM.toList nodes) $ \(fullNID, v) -> do
4526+ node <- parseJSON v
4527+ parseNodeStats (FullNodeId fullNID) node
4528+ cn <- o .: "cluster_name"
4529+ return (NodesStats stats cn)
4530+
4531+instance FromJSON NodeBreakerStats where
4532+ parseJSON = withObject "NodeBreakerStats" parse
4533+ where
4534+ parse o = NodeBreakerStats <$> o .: "tripped"
4535+ <*> o .: "overhead"
4536+ <*> o .: "estimated_size_in_bytes"
4537+ <*> o .: "limit_size_in_bytes"
4538+
4539+instance FromJSON NodeHTTPStats where
4540+ parseJSON = withObject "NodeHTTPStats" parse
4541+ where
4542+ parse o = NodeHTTPStats <$> o .: "total_opened"
4543+ <*> o .: "current_open"
4544+
4545+instance FromJSON NodeTransportStats where
4546+ parseJSON = withObject "NodeTransportStats" parse
4547+ where
4548+ parse o = NodeTransportStats <$> o .: "tx_size_in_bytes"
4549+ <*> o .: "tx_count"
4550+ <*> o .: "rx_size_in_bytes"
4551+ <*> o .: "rx_count"
4552+ <*> o .: "server_open"
4553+
4554+instance FromJSON NodeFSStats where
4555+ parseJSON = withObject "NodeFSStats" parse
4556+ where
4557+ parse o = NodeFSStats <$> o .: "data"
4558+ <*> o .: "total"
4559+ <*> (posixMS <$> o .: "timestamp")
4560+
4561+instance FromJSON NodeDataPathStats where
4562+ parseJSON = withObject "NodeDataPathStats" parse
4563+ where
4564+ parse o =
4565+ NodeDataPathStats <$> (fmap unStringlyTypedDouble <$> o .:? "disk_service_time")
4566+ <*> (fmap unStringlyTypedDouble <$> o .:? "disk_queue")
4567+ <*> o .:? "disk_io_size_in_bytes"
4568+ <*> o .:? "disk_write_size_in_bytes"
4569+ <*> o .:? "disk_read_size_in_bytes"
4570+ <*> o .:? "disk_io_op"
4571+ <*> o .:? "disk_writes"
4572+ <*> o .:? "disk_reads"
4573+ <*> o .: "available_in_bytes"
4574+ <*> o .: "free_in_bytes"
4575+ <*> o .: "total_in_bytes"
4576+ <*> o .:? "type"
4577+ <*> o .:? "dev"
4578+ <*> o .: "mount"
4579+ <*> o .: "path"
4580+
4581+newtype StringlyTypedDouble = StringlyTypedDouble { unStringlyTypedDouble :: Double }
4582+
4583+
4584+instance FromJSON StringlyTypedDouble where
4585+ parseJSON = fmap StringlyTypedDouble . parseJSON . unStringlyTypeJSON
4586+
4587+
4588+instance FromJSON NodeFSTotalStats where
4589+ parseJSON = withObject "NodeFSTotalStats" parse
4590+ where
4591+ parse o = NodeFSTotalStats <$> (fmap unStringlyTypedDouble <$> o .:? "disk_service_time")
4592+ <*> (fmap unStringlyTypedDouble <$> o .:? "disk_queue")
4593+ <*> o .:? "disk_io_size_in_bytes"
4594+ <*> o .:? "disk_write_size_in_bytes"
4595+ <*> o .:? "disk_read_size_in_bytes"
4596+ <*> o .:? "disk_io_op"
4597+ <*> o .:? "disk_writes"
4598+ <*> o .:? "disk_reads"
4599+ <*> o .: "available_in_bytes"
4600+ <*> o .: "free_in_bytes"
4601+ <*> o .: "total_in_bytes"
4602+
4603+instance FromJSON NodeNetworkStats where
4604+ parseJSON = withObject "NodeNetworkStats" parse
4605+ where
4606+ parse o = do
4607+ tcp <- o .: "tcp"
4608+ NodeNetworkStats <$> tcp .: "out_rsts"
4609+ <*> tcp .: "in_errs"
4610+ <*> tcp .: "attempt_fails"
4611+ <*> tcp .: "estab_resets"
4612+ <*> tcp .: "retrans_segs"
4613+ <*> tcp .: "out_segs"
4614+ <*> tcp .: "in_segs"
4615+ <*> tcp .: "curr_estab"
4616+ <*> tcp .: "passive_opens"
4617+ <*> tcp .: "active_opens"
4618+
4619+instance FromJSON NodeThreadPoolsStats where
4620+ parseJSON = withObject "NodeThreadPoolsStats" parse
4621+ where
4622+ parse o = NodeThreadPoolsStats <$> o .: "snapshot"
4623+ <*> o .: "bulk"
4624+ <*> o .: "force_merge"
4625+ <*> o .: "get"
4626+ <*> o .: "management"
4627+ <*> o .:? "fetch_shard_store"
4628+ <*> o .:? "optimize"
4629+ <*> o .: "flush"
4630+ <*> o .: "search"
4631+ <*> o .: "warmer"
4632+ <*> o .: "generic"
4633+ <*> o .:? "suggest"
4634+ <*> o .: "refresh"
4635+ <*> o .: "index"
4636+ <*> o .:? "listener"
4637+ <*> o .:? "fetch_shard_started"
4638+ <*> o .:? "percolate"
4639+instance FromJSON NodeThreadPoolStats where
4640+ parseJSON = withObject "NodeThreadPoolStats" parse
4641+ where
4642+ parse o = NodeThreadPoolStats <$> o .: "completed"
4643+ <*> o .: "largest"
4644+ <*> o .: "rejected"
4645+ <*> o .: "active"
4646+ <*> o .: "queue"
4647+ <*> o .: "threads"
4648+
4649+instance FromJSON NodeJVMStats where
4650+ parseJSON = withObject "NodeJVMStats" parse
4651+ where
4652+ parse o = do
4653+ bufferPools <- o .: "buffer_pools"
4654+ mapped <- bufferPools .: "mapped"
4655+ direct <- bufferPools .: "direct"
4656+ gc <- o .: "gc"
4657+ collectors <- gc .: "collectors"
4658+ oldC <- collectors .: "old"
4659+ youngC <- collectors .: "young"
4660+ threads <- o .: "threads"
4661+ mem <- o .: "mem"
4662+ pools <- mem .: "pools"
4663+ oldM <- pools .: "old"
4664+ survivorM <- pools .: "survivor"
4665+ youngM <- pools .: "young"
4666+ NodeJVMStats <$> pure mapped
4667+ <*> pure direct
4668+ <*> pure oldC
4669+ <*> pure youngC
4670+ <*> threads .: "peak_count"
4671+ <*> threads .: "count"
4672+ <*> pure oldM
4673+ <*> pure survivorM
4674+ <*> pure youngM
4675+ <*> mem .: "non_heap_committed_in_bytes"
4676+ <*> mem .: "non_heap_used_in_bytes"
4677+ <*> mem .: "heap_max_in_bytes"
4678+ <*> mem .: "heap_committed_in_bytes"
4679+ <*> mem .: "heap_used_percent"
4680+ <*> mem .: "heap_used_in_bytes"
4681+ <*> (unMS <$> o .: "uptime_in_millis")
4682+ <*> (posixMS <$> o .: "timestamp")
4683+
4684+instance FromJSON JVMBufferPoolStats where
4685+ parseJSON = withObject "JVMBufferPoolStats" parse
4686+ where
4687+ parse o = JVMBufferPoolStats <$> o .: "total_capacity_in_bytes"
4688+ <*> o .: "used_in_bytes"
4689+ <*> o .: "count"
4690+
4691+instance FromJSON JVMGCStats where
4692+ parseJSON = withObject "JVMGCStats" parse
4693+ where
4694+ parse o = JVMGCStats <$> (unMS <$> o .: "collection_time_in_millis")
4695+ <*> o .: "collection_count"
4696+
4697+instance FromJSON JVMPoolStats where
4698+ parseJSON = withObject "JVMPoolStats" parse
4699+ where
4700+ parse o = JVMPoolStats <$> o .: "peak_max_in_bytes"
4701+ <*> o .: "peak_used_in_bytes"
4702+ <*> o .: "max_in_bytes"
4703+ <*> o .: "used_in_bytes"
4704+
4705+instance FromJSON NodeProcessStats where
4706+ parseJSON = withObject "NodeProcessStats" parse
4707+ where
4708+ parse o = do
4709+ mem <- o .: "mem"
4710+ cpu <- o .: "cpu"
4711+ NodeProcessStats <$> (posixMS <$> o .: "timestamp")
4712+ <*> o .: "open_file_descriptors"
4713+ <*> o .: "max_file_descriptors"
4714+ <*> cpu .: "percent"
4715+ <*> (unMS <$> cpu .: "total_in_millis")
4716+ <*> mem .: "total_virtual_in_bytes"
4717+
4718+instance FromJSON NodeOSStats where
4719+ parseJSON = withObject "NodeOSStats" parse
4720+ where
4721+ parse o = do
4722+ swap <- o .: "swap"
4723+ mem <- o .: "mem"
4724+ cpu <- o .: "cpu"
4725+ load <- o .:? "load_average"
4726+ NodeOSStats <$> (posixMS <$> o .: "timestamp")
4727+ <*> cpu .: "percent"
4728+ <*> pure load
4729+ <*> mem .: "total_in_bytes"
4730+ <*> mem .: "free_in_bytes"
4731+ <*> mem .: "free_percent"
4732+ <*> mem .: "used_in_bytes"
4733+ <*> mem .: "used_percent"
4734+ <*> swap .: "total_in_bytes"
4735+ <*> swap .: "free_in_bytes"
4736+ <*> swap .: "used_in_bytes"
4737+
4738+instance FromJSON LoadAvgs where
4739+ parseJSON = withArray "LoadAvgs" parse
4740+ where
4741+ parse v = case V.toList v of
4742+ [one, five, fifteen] -> LoadAvgs <$> parseJSON one
4743+ <*> parseJSON five
4744+ <*> parseJSON fifteen
4745+ _ -> fail "Expecting a triple of Doubles"
4746+
4747+instance FromJSON NodeIndicesStats where
4748+ parseJSON = withObject "NodeIndicesStats" parse
4749+ where
4750+ parse o = do
4751+ let (.::) mv k = case mv of
4752+ Just v -> Just <$> v .: k
4753+ Nothing -> pure Nothing
4754+ mRecovery <- o .:? "recovery"
4755+ mQueryCache <- o .:? "query_cache"
4756+ mSuggest <- o .:? "suggest"
4757+ translog <- o .: "translog"
4758+ segments <- o .: "segments"
4759+ completion <- o .: "completion"
4760+ mPercolate <- o .:? "percolate"
4761+ fielddata <- o .: "fielddata"
4762+ warmer <- o .: "warmer"
4763+ flush <- o .: "flush"
4764+ refresh <- o .: "refresh"
4765+ merges <- o .: "merges"
4766+ search <- o .: "search"
4767+ getStats <- o .: "get"
4768+ indexing <- o .: "indexing"
4769+ store <- o .: "store"
4770+ docs <- o .: "docs"
4771+ NodeIndicesStats <$> (fmap unMS <$> mRecovery .:: "throttle_time_in_millis")
4772+ <*> mRecovery .:: "current_as_target"
4773+ <*> mRecovery .:: "current_as_source"
4774+ <*> mQueryCache .:: "miss_count"
4775+ <*> mQueryCache .:: "hit_count"
4776+ <*> mQueryCache .:: "evictions"
4777+ <*> mQueryCache .:: "memory_size_in_bytes"
4778+ <*> mSuggest .:: "current"
4779+ <*> (fmap unMS <$> mSuggest .:: "time_in_millis")
4780+ <*> mSuggest .:: "total"
4781+ <*> translog .: "size_in_bytes"
4782+ <*> translog .: "operations"
4783+ <*> segments .:? "fixed_bit_set_memory_in_bytes"
4784+ <*> segments .: "version_map_memory_in_bytes"
4785+ <*> segments .:? "index_writer_max_memory_in_bytes"
4786+ <*> segments .: "index_writer_memory_in_bytes"
4787+ <*> segments .: "memory_in_bytes"
4788+ <*> segments .: "count"
4789+ <*> completion .: "size_in_bytes"
4790+ <*> mPercolate .:: "queries"
4791+ <*> mPercolate .:: "memory_size_in_bytes"
4792+ <*> mPercolate .:: "current"
4793+ <*> (fmap unMS <$> mPercolate .:: "time_in_millis")
4794+ <*> mPercolate .:: "total"
4795+ <*> fielddata .: "evictions"
4796+ <*> fielddata .: "memory_size_in_bytes"
4797+ <*> (unMS <$> warmer .: "total_time_in_millis")
4798+ <*> warmer .: "total"
4799+ <*> warmer .: "current"
4800+ <*> (unMS <$> flush .: "total_time_in_millis")
4801+ <*> flush .: "total"
4802+ <*> (unMS <$> refresh .: "total_time_in_millis")
4803+ <*> refresh .: "total"
4804+ <*> merges .: "total_size_in_bytes"
4805+ <*> merges .: "total_docs"
4806+ <*> (unMS <$> merges .: "total_time_in_millis")
4807+ <*> merges .: "total"
4808+ <*> merges .: "current_size_in_bytes"
4809+ <*> merges .: "current_docs"
4810+ <*> merges .: "current"
4811+ <*> search .: "fetch_current"
4812+ <*> (unMS <$> search .: "fetch_time_in_millis")
4813+ <*> search .: "fetch_total"
4814+ <*> search .: "query_current"
4815+ <*> (unMS <$> search .: "query_time_in_millis")
4816+ <*> search .: "query_total"
4817+ <*> search .: "open_contexts"
4818+ <*> getStats .: "current"
4819+ <*> (unMS <$> getStats .: "missing_time_in_millis")
4820+ <*> getStats .: "missing_total"
4821+ <*> (unMS <$> getStats .: "exists_time_in_millis")
4822+ <*> getStats .: "exists_total"
4823+ <*> (unMS <$> getStats .: "time_in_millis")
4824+ <*> getStats .: "total"
4825+ <*> (fmap unMS <$> indexing .:? "throttle_time_in_millis")
4826+ <*> indexing .:? "is_throttled"
4827+ <*> indexing .:? "noop_update_total"
4828+ <*> indexing .: "delete_current"
4829+ <*> (unMS <$> indexing .: "delete_time_in_millis")
4830+ <*> indexing .: "delete_total"
4831+ <*> indexing .: "index_current"
4832+ <*> (unMS <$> indexing .: "index_time_in_millis")
4833+ <*> indexing .: "index_total"
4834+ <*> (unMS <$> store .: "throttle_time_in_millis")
4835+ <*> store .: "size_in_bytes"
4836+ <*> docs .: "deleted"
4837+ <*> docs .: "count"
4838+
4839+instance FromJSON NodeBreakersStats where
4840+ parseJSON = withObject "NodeBreakersStats" parse
4841+ where
4842+ parse o = NodeBreakersStats <$> o .: "parent"
4843+ <*> o .: "request"
4844+ <*> o .: "fielddata"
4845+
4846+parseNodeStats :: FullNodeId -> Object -> Parser NodeStats
4847+parseNodeStats fnid o = do
4848+ NodeStats <$> o .: "name"
4849+ <*> pure fnid
4850+ <*> o .:? "breakers"
4851+ <*> o .: "http"
4852+ <*> o .: "transport"
4853+ <*> o .: "fs"
4854+ <*> o .:? "network"
4855+ <*> o .: "thread_pool"
4856+ <*> o .: "jvm"
4857+ <*> o .: "process"
4858+ <*> o .: "os"
4859+ <*> o .: "indices"
4860+
4861+parseNodeInfo :: FullNodeId -> Object -> Parser NodeInfo
4862+parseNodeInfo nid o =
4863+ NodeInfo <$> o .:? "http_address"
4864+ <*> o .: "build_hash"
4865+ <*> o .: "version"
4866+ <*> o .: "ip"
4867+ <*> o .: "host"
4868+ <*> o .: "transport_address"
4869+ <*> o .: "name"
4870+ <*> pure nid
4871+ <*> o .: "plugins"
4872+ <*> o .: "http"
4873+ <*> o .: "transport"
4874+ <*> o .:? "network"
4875+ <*> o .: "thread_pool"
4876+ <*> o .: "jvm"
4877+ <*> o .: "process"
4878+ <*> o .: "os"
4879+ <*> o .: "settings"
4880+
4881+instance FromJSON NodePluginInfo where
4882+ parseJSON = withObject "NodePluginInfo" parse
4883+ where
4884+ parse o = NodePluginInfo <$> o .:? "site"
4885+ <*> o .:? "jvm"
4886+ <*> o .: "description"
4887+ <*> o .: "version"
4888+ <*> o .: "name"
4889+
4890+instance FromJSON NodeHTTPInfo where
4891+ parseJSON = withObject "NodeHTTPInfo" parse
4892+ where
4893+ parse o = NodeHTTPInfo <$> o .: "max_content_length_in_bytes"
4894+ <*> parseJSON (Object o)
4895+
4896+instance FromJSON BoundTransportAddress where
4897+ parseJSON = withObject "BoundTransportAddress" parse
4898+ where
4899+ parse o = BoundTransportAddress <$> o .: "publish_address"
4900+ <*> o .: "bound_address"
4901+
4902+instance FromJSON NodeOSInfo where
4903+ parseJSON = withObject "NodeOSInfo" parse
4904+ where
4905+ parse o = do
4906+ NodeOSInfo <$> (unMS <$> o .: "refresh_interval_in_millis")
4907+ <*> o .: "name"
4908+ <*> o .: "arch"
4909+ <*> o .: "version"
4910+ <*> o .: "available_processors"
4911+ <*> o .: "allocated_processors"
4912+
4913+
4914+instance FromJSON CPUInfo where
4915+ parseJSON = withObject "CPUInfo" parse
4916+ where
4917+ parse o = CPUInfo <$> o .: "cache_size_in_bytes"
4918+ <*> o .: "cores_per_socket"
4919+ <*> o .: "total_sockets"
4920+ <*> o .: "total_cores"
4921+ <*> o .: "mhz"
4922+ <*> o .: "model"
4923+ <*> o .: "vendor"
4924+
4925+instance FromJSON NodeProcessInfo where
4926+ parseJSON = withObject "NodeProcessInfo" parse
4927+ where
4928+ parse o = NodeProcessInfo <$> o .: "mlockall"
4929+ <*> o .:? "max_file_descriptors"
4930+ <*> o .: "id"
4931+ <*> (unMS <$> o .: "refresh_interval_in_millis")
4932+
4933+instance FromJSON NodeJVMInfo where
4934+ parseJSON = withObject "NodeJVMInfo" parse
4935+ where
4936+ parse o = NodeJVMInfo <$> o .: "memory_pools"
4937+ <*> o .: "gc_collectors"
4938+ <*> o .: "mem"
4939+ <*> (posixMS <$> o .: "start_time_in_millis")
4940+ <*> o .: "vm_vendor"
4941+ <*> o .: "vm_version"
4942+ <*> o .: "vm_name"
4943+ <*> (unJVMVersion <$> o .: "version")
4944+ <*> o .: "pid"
4945+
4946+instance FromJSON JVMVersion where
4947+ parseJSON (String t) =
4948+ JVMVersion <$> parseJSON (String (T.replace "_" "." t))
4949+ parseJSON v = JVMVersion <$> parseJSON v
4950+
4951+instance FromJSON JVMMemoryInfo where
4952+ parseJSON = withObject "JVMMemoryInfo" parse
4953+ where
4954+ parse o = JVMMemoryInfo <$> o .: "direct_max_in_bytes"
4955+ <*> o .: "non_heap_max_in_bytes"
4956+ <*> o .: "non_heap_init_in_bytes"
4957+ <*> o .: "heap_max_in_bytes"
4958+ <*> o .: "heap_init_in_bytes"
4959+
4960+instance FromJSON NodeThreadPoolsInfo where
4961+ parseJSON = withObject "NodeThreadPoolsInfo" parse
4962+ where
4963+ parse o = NodeThreadPoolsInfo <$> o .: "refresh"
4964+ <*> o .: "management"
4965+ <*> o .:? "percolate"
4966+ <*> o .:? "listener"
4967+ <*> o .:? "fetch_shard_started"
4968+ <*> o .: "search"
4969+ <*> o .: "flush"
4970+ <*> o .: "warmer"
4971+ <*> o .:? "optimize"
4972+ <*> o .: "bulk"
4973+ <*> o .:? "suggest"
4974+ <*> o .: "force_merge"
4975+ <*> o .: "snapshot"
4976+ <*> o .: "get"
4977+ <*> o .:? "fetch_shard_store"
4978+ <*> o .: "index"
4979+ <*> o .: "generic"
4980+
4981+instance FromJSON NodeThreadPoolInfo where
4982+ parseJSON = withObject "NodeThreadPoolInfo" parse
4983+ where
4984+ parse o = do
4985+ ka <- maybe (return Nothing) (fmap Just . parseStringInterval) =<< o .:? "keep_alive"
4986+ NodeThreadPoolInfo <$> (parseJSON . unStringlyTypeJSON =<< o .: "queue_size")
4987+ <*> pure ka
4988+ <*> o .:? "min"
4989+ <*> o .:? "max"
4990+ <*> o .: "type"
4991+
4992+parseStringInterval :: (Monad m) => String -> m NominalDiffTime
4993+parseStringInterval s = case span isNumber s of
4994+ ("", _) -> fail "Invalid interval"
4995+ (nS, unitS) -> case (readMay nS, readMay unitS) of
4996+ (Just n, Just unit) -> return (fromInteger (n * unitNDT unit))
4997+ (Nothing, _) -> fail "Invalid interval number"
4998+ (_, Nothing) -> fail "Invalid interval unit"
4999+ where
5000+ unitNDT Seconds = 1
5001+ unitNDT Minutes = 60
5002+ unitNDT Hours = 60 * 60
5003+ unitNDT Days = 24 * 60 * 60
5004+ unitNDT Weeks = 7 * 24 * 60 * 60
5005+
5006+instance FromJSON ThreadPoolSize where
5007+ parseJSON v = parseAsNumber v <|> parseAsString v
5008+ where
5009+ parseAsNumber = parseAsInt <=< parseJSON
5010+ parseAsInt (-1) = return ThreadPoolUnbounded
5011+ parseAsInt n
5012+ | n >= 0 = return (ThreadPoolBounded n)
5013+ | otherwise = fail "Thread pool size must be >= -1."
5014+ parseAsString = withText "ThreadPoolSize" $ \t ->
5015+ case first (readMay . T.unpack) (T.span isNumber t) of
5016+ (Just n, "k") -> return (ThreadPoolBounded (n * 1000))
5017+ (Just n, "") -> return (ThreadPoolBounded n)
5018+ _ -> fail ("Invalid thread pool size " <> T.unpack t)
5019+
5020+instance FromJSON ThreadPoolType where
5021+ parseJSON = withText "ThreadPoolType" parse
5022+ where
5023+ parse "scaling" = return ThreadPoolScaling
5024+ parse "fixed" = return ThreadPoolFixed
5025+ parse "cached" = return ThreadPoolCached
5026+ parse e = fail ("Unexpected thread pool type" <> T.unpack e)
5027+
5028+instance FromJSON NodeTransportInfo where
5029+ parseJSON = withObject "NodeTransportInfo" parse
5030+ where
5031+ parse o = NodeTransportInfo <$> (maybe (return mempty) parseProfiles =<< o .:? "profiles")
5032+ <*> parseJSON (Object o)
5033+ parseProfiles (Object o) | HM.null o = return []
5034+ parseProfiles v@(Array _) = parseJSON v
5035+ parseProfiles Null = return []
5036+ parseProfiles _ = fail "Could not parse profiles"
5037+
5038+instance FromJSON NodeNetworkInfo where
5039+ parseJSON = withObject "NodeNetworkInfo" parse
5040+ where
5041+ parse o = NodeNetworkInfo <$> o .: "primary_interface"
5042+ <*> (unMS <$> o .: "refresh_interval_in_millis")
5043+
5044+
5045+instance FromJSON NodeNetworkInterface where
5046+ parseJSON = withObject "NodeNetworkInterface" parse
5047+ where
5048+ parse o = NodeNetworkInterface <$> o .: "mac_address"
5049+ <*> o .: "name"
5050+ <*> o .: "address"
5051+
5052+newtype MaybeNA a = MaybeNA { unMaybeNA :: Maybe a }
5053+ deriving (Show, Eq)
5054+
5055+instance FromJSON a => FromJSON (MaybeNA a) where
5056+ parseJSON (String "NA") = pure $ MaybeNA Nothing
5057+ parseJSON o = MaybeNA . Just <$> parseJSON o