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