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