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