git.iko.soy/typeable/bloodhound
on a9e893e help sign in
.gitignore−3
since splitsnapshots
unifiedsplit
@@ -17,6 +17,3 @@ bloodhound.iml
17.hg
17.hg
18.hgignore
18.hgignore
19examples/bloodhound-examples.cabal
19examples/bloodhound-examples.cabal
20−/.ghc.environment.*
21−.hspec-failures
22−bloodhound.cabal
.hlint.yamldeleted−66
@@ -1,66 +0,0 @@
1−# HLint configuration file
2−# https://github.com/ndmitchell/hlint
3−##########################
4−
5−# This file contains a template configuration file, which is typically
6−# placed as .hlint.yaml in the root of your project
7−
8−
9−# Specify additional command line arguments
10−#
11−# - arguments: [--color, --cpp-simple, -XQuasiQuotes]
12−
13−
14−# Control which extensions/flags/modules/functions can be used
15−#
16−# - extensions:
17−# - default: false # all extension are banned by default
18−# - name: [PatternGuards, ViewPatterns] # only these listed extensions can be used
19−# - {name: CPP, within: CrossPlatform} # CPP can only be used in a given module
20−#
21−# - flags:
22−# - {name: -w, within: []} # -w is allowed nowhere
23−#
24−# - modules:
25−# - {name: [Data.Set, Data.HashSet], as: Set} # if you import Data.Set qualified, it must be as 'Set'
26−# - {name: Control.Arrow, within: []} # Certain modules are banned entirely
27−#
28−# - functions:
29−# - {name: unsafePerformIO, within: []} # unsafePerformIO can only appear in no modules
30−
31−
32−# Add custom hints for this project
33−#
34−# Will suggest replacing "wibbleMany [myvar]" with "wibbleOne myvar"
35−# - error: {lhs: "wibbleMany [x]", rhs: wibbleOne x}
36−
37−
38−# Turn on hints that are off by default
39−#
40−# Ban "module X(module X) where", to require a real export list
41−# - warn: {name: Use explicit module export list}
42−#
43−# Replace a $ b $ c with a . b $ c
44−# - group: {name: dollar, enabled: true}
45−#
46−# Generalise map to fmap, ++ to <>
47−# - group: {name: generalise, enabled: true}
48−
49−
50−# Ignore some builtin hints
51−- ignore: {name: "Use <$>"}
52−- ignore: {name: "Use lambda-case"}
53−# When we don't use camelCase it's to match ES.
54−# Possibly this is a mistake.
55−- ignore: {name: "Use camelCase"}
56−- ignore: {name: "Eta reduce"}
57−# - ignore: {name: Use let}
58−# - ignore: {name: Use const, within: SpecialModule} # Only within certain modules
59−
60−
61−# Define some custom infix operators
62−# - fixity: infixr 3 ~^#^~
63−
64−
65−# To generate a suitable file for HLint do:
66−# $ hlint --default > .hlint.yaml
.travis.yml+18−18
@@ -1,24 +1,30 @@
1sudo: false
1sudo: false
2−language: generic
3−
4−jdk:
5− - oraclejdk11
6
2
7addons:
3addons:
8 apt:
4 apt:
9 packages:
5 packages:
10 - libgmp-dev
6 - libgmp-dev
7+ - oracle-java8-installer
11
8
12env:
9env:
10+ global:
11+ - JAVA_HOME=/usr/lib/jvm/java-8-oracle
13− matrix:
12+ matrix:
13+ - GHCVER=7.8 ESVER=1.3.6 STACK_YAML=stack-7.8.yaml ESFLAG=ES1 DLINK=https://download.elastic.co/elasticsearch/elasticsearch/elasticsearch
14+ - GHCVER=7.8 ESVER=1.4.1 STACK_YAML=stack-7.8.yaml ESFLAG=ES1 DLINK=https://download.elastic.co/elasticsearch/elasticsearch/elasticsearch
15+ - GHCVER=7.10 ESVER=1.5.2 STACK_YAML=stack-7.10.yaml ESFLAG=ES1 DLINK=https://download.elastic.co/elasticsearch/elasticsearch/elasticsearch
16+ - GHCVER=7.10 ESVER=1.6.0 STACK_YAML=stack-7.10.yaml ESFLAG=ES1 DLINK=https://download.elastic.co/elasticsearch/elasticsearch/elasticsearch
17+ - GHCVER=7.10 ESVER=1.7.2 STACK_YAML=stack-7.10.yaml ESFLAG=ES1 DLINK=https://download.elastic.co/elasticsearch/elasticsearch/elasticsearch
18+ - GHCVER=8.0 ESVER=1.7.2 STACK_YAML=stack.yaml ESFLAG=ES1 DLINK=https://download.elastic.co/elasticsearch/elasticsearch/elasticsearch
14− - GHCVER=8.6 ESVER=5.6.0 STACK_YAML=stack.yaml DLINK=https://artifacts.elastic.co/downloads/elasticsearch/elasticsearch ES_JAVA_OPTS="-Xms500m -Xmx750m"
19+ - GHCVER=8.0 ESVER=5.0.2 STACK_YAML=stack.yaml ESFLAG=ES5 DLINK=https://artifacts.elastic.co/downloads/elasticsearch/elasticsearch ES_JAVA_OPTS="-Xms500m -Xmx750m"
15
20
16install:
21install:
17 # stack
22 # stack
18 - mkdir -p ~/.local/bin
23 - mkdir -p ~/.local/bin
19− - travis_retry curl -L https://github.com/commercialhaskell/stack/releases/download/v2.1.3/stack-2.1.3-linux-x86_64.tar.gz | tar xz --wildcards --strip-components=1 -C ~/.local/bin '*/stack'
24+ - travis_retry curl -L https://github.com/commercialhaskell/stack/releases/download/v1.2.0/stack-1.2.0-linux-x86_64.tar.gz | tar xz --wildcards --strip-components=1 -C ~/.local/bin '*/stack'
20 - export PATH=~/.local/bin:$PATH
25 - export PATH=~/.local/bin:$PATH
21− - stack --no-terminal --version
26+ - stack --version
27+
22 # elasticsearch
28 # elasticsearch
23 - wget --no-check-certificate $DLINK-$ESVER.tar.gz
29 - wget --no-check-certificate $DLINK-$ESVER.tar.gz
24 - tar xzf elasticsearch-$ESVER.tar.gz
30 - tar xzf elasticsearch-$ESVER.tar.gz
@@ -27,17 +33,11 @@ install:
27 - ./elasticsearch-$ESVER/bin/elasticsearch &
33 - ./elasticsearch-$ESVER/bin/elasticsearch &
28
34
29script:
35script:
30− - stack setup --no-terminal
36+ - stack setup
31− - stack update --no-terminal
37+ - stack update
32− - stack build -j2 --fast --no-terminal
38+ - stack build -j1
33− - travis_wait 60 sleep 1800 &
34− - stack test --fast --no-terminal bloodhound:bloodhound-tests --test-arguments="--qc-max-success 500"
39+ - stack test bloodhound:tests --test-arguments="--qc-max-success 500" --flag bloodhound:$ESFLAG
35
40
36cache:
41cache:
37− timeout: 1500
38 directories:
42 directories:
39− - $HOME/.cabal
40− - $HOME/.ghc
41 - $HOME/.stack
43 - $HOME/.stack
42− - .stack-work/
43− apt: true
DSL.org+1−1
@@ -1,4 +1,4 @@
1−* Elasticsearch DSL
1+* ElasticSearch DSL
2
2
3** Grouping
3** Grouping
4
4
Makefile+14−117
@@ -1,129 +1,26 @@
1−.PHONY : build build-validate ghci test test-rerun test-ghci ghcid ghcid-validate \
2− weeder hlint hlint-watch mod-build
3−
4−.DEFAULT_GOAL = help
5−
6−stack = STACK_YAML='stack.yaml' stack
7−ghc_perf_options = --ghc-options '+RTS -A128M -RTS'
8−build = build $(ghc_perf_options)
9−ghci = ghci $(ghc_perf_options)
10−test = test $(ghc_perf_options)
11−stack-8.0 = STACK_YAML="stack-8.0.yaml" stack
12−stack-8.2 = STACK_YAML="stack-8.2.yaml" stack
13−stack-8.4 = STACK_YAML="stack-8.4.yaml" stack
14−stack-8.6 = STACK_YAML="stack-8.6.yaml" stack
15−elasticsearch_directory = elasticsearch
16−
17−# stack build --ghc-options '+RTS -A128M -RTS'
18−
19−## run build
20build:
1build:
21− $(stack) $(build)
2+ stack build
22−
23−## build with validation options (Wall, Werror)
24−build-validate:
25− $(stack) build --fast --ghc-options '-Wall -Werror +RTS -A128M -RTS'
26−
27−## run ghci
28−ghci:
29− $(stack) $(ghci)
30−
31−## run tests
32−test: echo-warn
33− $(stack) $(test)
34−
35−## run tests with forced re-run via "-r"
36−test-rerun: echo-warn
37− $(stack) $(test) --test-arguments "-r"
38−
39−## run ghci with test stanza
40−test-ghci:
41− $(stack) $(ghci) bloodhound:test:bloodhound-tests
42−
43−## run ghcid
44−ghcid:
45− ghcid -c "$(stack) ghci bloodhound:lib --test --ghci-options='-fobject-code -fno-warn-unused-do-bind' --main-is bloodhound:test:bloodhound-tests"
46−
47−## run ghcid with validate options (Werror, etc.)
48−ghcid-validate:
49− ghcid -c "$(stack) ghci bloodhound:lib --test --ghci-options='-Werror -fobject-code -fno-warn-unused-do-bind' --main-is bloodhound:test:bloodhound-tests"
50−
51−## run weeder
52−weeder:
53− weeder . --build
54−
55−## run hlint
56−hlint:
57− hlint .
58−
59−## hlint watch with `sos`
60−hlint-watch:
61− sos src/ -c "hlint ." -p "src/(.*)\.hs"
62−
63−# mod-build:
64−# stack build --ghc-options '+RTS -A128M -RTS'
65
3
66echo-warn:
4echo-warn:
67− @echo "Make certain you have an elasticsearch instance on localhost:9200 !"
5+ echo "Make certain you have an elasticsearch instance on localhost:9200 !"
68
6
69−## Test with GHC 8.0 and ES 5.x
7+test: echo-warn
70−test-8.0:
8+ stack test
71− STACK_YAML="stack-8.0.yaml" stack test --fast bloodhound:test:bloodhound-tests --test-arguments="--qc-max-success 500"
72
9
73−## Test with GHC 8.2 and ES 5.x
10+7.8-build:
74−test-8.2:
75− STACK_YAML="stack.yaml" stack test --fast bloodhound:test:bloodhound-tests --test-arguments="--qc-max-success 500"
11+ STACK_YAML="stack-7.8.yaml" stack build
76
12
77−## Build with the GHC 8.0 Stack YAML
13+7.8-test: echo-warn
78−build-8.0:
14+ STACK_YAML="stack-7.8.yaml" stack test
79− $(stack-8.0) $(build)
80
15
81−## Build with the GHC 8.2 Stack YAML
82−build-8.2:
16+7.10-build:
83− $(stack-8.2) $(build)
17+ STACK_YAML="stack-8=7.10.yaml" stack build
84
18
85−## Build with the GHC 8.4 Stack YAML
19+7.10-test: echo-warn
86−build-8.4:
20+ STACK_YAML="stack-7.10.yaml" stack test
87− $(stack-8.4) $(build)
88
21
89−## Build with the GHC 8.6 Stack YAML
22+ghci:
90−build-8.6:
91− $(stack-8.6) $(build)
23+ stack ghci
92
24
93−## Upload the package to Hackage
94upload:
25upload:
95 stack upload --no-signature .
26 stack upload --no-signature .
96−
97−# Create ES5 instance
98−
99−## Run test environment
100−compose-ES5:
101− @LOCAL_USER_ID=${LOCAL_USER_ID} docker-compose -f docker-compose.yml --project-directory $(elasticsearch_directory) up
102−
103−## Run test environment in detach mode
104−compose-ES5-detach-up:
105− @LOCAL_USER_ID=${LOCAL_USER_ID} docker-compose -f docker-compose.yml --project-directory $(elasticsearch_directory) up -d
106−
107−## Close test environment if run on detach mode
108−compose-ES5-detach-down:
109− @LOCAL_USER_ID=${LOCAL_USER_ID} docker-compose -f docker-compose.yml --project-directory $(elasticsearch_directory) down
110−
111−## build the docker compose images
112−compose-build:
113− @LOCAL_USER_ID=${LOCAL_USER_ID} docker-compose -f docker-compose.yml --project-directory $(elasticsearch_directory) build
114−
115−## Spawn bash shell in ES5 test container
116−ES5-shell:
117− @LOCAL_USER_ID=${LOCAL_USER_ID} docker-compose -f docker-compose.yml --project-directory $(elasticsearch_directory) exec elasticsearch1 bash
118−
119−help:
120− @echo "Please use \`make <target>' where <target> is one of\n\n"
121− @awk '/^[a-zA-Z\-\_0-9]+:/ { \
122− helpMessage = match(lastLine, /^## (.*)/); \
123− if (helpMessage) { \
124− helpCommand = substr($$1, 0, index($$1, ":")); \
125− helpMessage = substr(lastLine, RSTART + 3, RLENGTH); \
126− printf "%-30s %s\n", helpCommand, helpMessage; \
127− } \
128− } \
129− { lastLine = $$0 }' $(MAKEFILE_LIST)
README.md+7−7
@@ -22,17 +22,17 @@ Version compatibility
22---------------------
22---------------------
23
23
24As of version 0.13.0.0, Bloodhound has 2 separate module trees for
24As of version 0.13.0.0, Bloodhound has 2 separate module trees for
25−Elasticsearch versions 1 and 5. Import the module that is appropriate
25+ElasticSearch versions 1 and 5. Import the module that is appropriate
26for your use case. If you would like to add support for another major
26for your use case. If you would like to add support for another major
27version, open a ticket expressing your intend and follow the pattern
27version, open a ticket expressing your intend and follow the pattern
28used for other versions. We weighed the idea of sharing code between
28used for other versions. We weighed the idea of sharing code between
29versions but it just got too messy, especially considering the
29versions but it just got too messy, especially considering the
30−instability of the Elasticsearch API. We switched to a model which
30+instability of the ElasticSearch API. We switched to a model which
31would allow the persons responsible for a particular protocol version
31would allow the persons responsible for a particular protocol version
32to maintain that version while avoiding conflict with other versions.
32to maintain that version while avoiding conflict with other versions.
33
33
34See our [TravisCI](https://travis-ci.org/bitemyapp/bloodhound) for a
34See our [TravisCI](https://travis-ci.org/bitemyapp/bloodhound) for a
35−listing of Elasticsearch version we test against.
35+listing of ElasticSearch version we test against.
36
36
37
37
38Stability
38Stability
@@ -43,15 +43,15 @@ Bloodhound is stable for production use. I will strive to avoid breaking API com
43Testing
43Testing
44---------
44---------
45
45
46−The TravisCI tests are run using [Stack](http://docs.haskellstack.org/en/stable/README.html). You should use Stack instead of `cabal` to build and test Bloodhound to avoid compatibility problems. You will also need to have an Elasticsearch instance running at `localhost:9200` in order to execute some of the tests. See the "Version compatibility" section above for a list of Elasticsearch versions that are officially validated against in TravisCI.
46+The TravisCI tests are run using [Stack](http://docs.haskellstack.org/en/stable/README.html). You should use Stack instead of `cabal` to build and test Bloodhound to avoid compatibility problems. You will also need to have an ElasticSearch instance running at `localhost:9200` in order to execute some of the tests. See the "Version compatibility" section above for a list of ElasticSearch versions that are officially validated against in TravisCI.
47
47
48Steps to run the tests locally:
48Steps to run the tests locally:
49− 1. Dig through the [past releases] (https://www.elastic.co/downloads/past-releases) section of the Elasticsearch download page and install the desired Elasticsearch versions.
49+ 1. Dig through the [past releases] (https://www.elastic.co/downloads/past-releases) section of the ElasticSearch download page and install the desired ElasticSearch versions.
50 2. Install [Stack] (http://docs.haskellstack.org/en/stable/README.html#how-to-install)
50 2. Install [Stack] (http://docs.haskellstack.org/en/stable/README.html#how-to-install)
51 3. In your local Bloodhound directory, run `stack setup && stack build`
51 3. In your local Bloodhound directory, run `stack setup && stack build`
52− 4. Start the desired version of Elasticsearch at `localhost:9200`, which should be the default.
52+ 4. Start the desired version of ElasticSearch at `localhost:9200`, which should be the default.
53 5. Run `stack test` in your local Bloodhound directory.
53 5. Run `stack test` in your local Bloodhound directory.
54− 6. The unit tests will pass if you re-execute `stack test`. If you want to start with a clean slate, stop your Elasticsearch instance, delete the `data/` folder in the Elasticsearch installation, restart Elasticsearch, and re-run `stack test`.
54+ 6. The unit tests will pass if you re-execute `stack test`. If you want to start with a clean slate, stop your ElasticSearch instance, delete the `data/` folder in the ElasticSearch installation, restart ElasticSearch, and re-run `stack test`.
55
55
56
56
57Hackage page and Haddock documentation
57Hackage page and Haddock documentation
bloodhound.cabalnew file+97
@@ -0,0 +1,97 @@
1+name: bloodhound
2+version: 0.13.0.0
3+synopsis: ElasticSearch client library for Haskell
4+description: ElasticSearch made awesome for Haskell hackers
5+homepage: https://github.com/bitemyapp/bloodhound
6+license: BSD3
7+license-file: LICENSE
8+author: Chris Allen
9+maintainer: cma@bitemyapp.com
10+copyright: 2015, Chris Allen
11+category: Database, Search
12+build-type: Simple
13+cabal-version: >=1.10
14+
15+extra-source-files:
16+ README.md
17+ changelog.md
18+
19+source-repository head
20+ type: git
21+ location: https://github.com/bitemyapp/bloodhound.git
22+
23+Flag ES1
24+ Description: Run the test suite against an Elasticsearch 1.x server
25+ Default: True
26+
27+Flag ES5
28+ Description: Run the test suite against an Elasticsearch 5.x server
29+ Default: False
30+
31+library
32+ ghc-options: -Wall
33+ exposed-modules: Database.V1.Bloodhound
34+ Database.V1.Bloodhound.Client
35+ Database.V1.Bloodhound.Types
36+ Database.V1.Bloodhound.Types.Class
37+ Database.V1.Bloodhound.Types.Internal
38+ Database.V5.Bloodhound
39+ Database.V5.Bloodhound.Client
40+ Database.V5.Bloodhound.Types
41+ Database.V5.Bloodhound.Types.Class
42+ Database.V5.Bloodhound.Types.Internal
43+ hs-source-dirs: src
44+ build-depends: base >= 4.3 && <5,
45+ bytestring >= 0.10.0 && <0.11,
46+ containers >= 0.5.0.0 && <0.6,
47+ aeson >= 0.11.1 && <1.2,
48+ http-client >= 0.4.30 && <0.6,
49+ network-uri >= 2.6 && <2.7,
50+ semigroups >= 0.15 && <0.19,
51+ time >= 1.4 && <1.7,
52+ text >= 0.11 && <1.3,
53+ mtl >= 1.0 && <2.3,
54+ transformers >= 0.2 && <0.6,
55+ http-types >= 0.8 && <0.10,
56+ vector >= 0.10.9 && <0.13,
57+ scientific >= 0.3.0.0 && <0.4.0.0,
58+ exceptions,
59+ data-default-class,
60+ blaze-builder,
61+ unordered-containers,
62+ mtl-compat,
63+ hashable
64+ default-language: Haskell2010
65+
66+test-suite tests
67+ ghc-options: -Wall -fno-warn-orphans
68+ type: exitcode-stdio-1.0
69+ main-is: tests.hs
70+ if flag(ES5)
71+ hs-source-dirs: tests/V5
72+ else
73+ hs-source-dirs: tests/V1
74+
75+ build-depends: base,
76+ bloodhound,
77+ bytestring,
78+ http-client,
79+ http-types,
80+ containers,
81+ hspec >= 1.8,
82+ text,
83+ time,
84+ aeson,
85+ semigroups,
86+ QuickCheck,
87+ vector,
88+ unordered-containers >= 0.2.5.0 && <0.3,
89+ mtl,
90+ quickcheck-properties,
91+ generics-sop >=0.2 && <0.3,
92+ errors,
93+ exceptions,
94+ temporary,
95+ unix-compat,
96+ network-uri
97+ default-language: Haskell2010
changelog.md−107
@@ -1,110 +1,3 @@
1−0.17.0.0
2−========
3−- @bitemyapp
4− - Removed V1 modules and support.
5− - Removed the cabal file, replaced with an Hpack `package.yaml`.
6−- @JoseD92
7− - Removed the disused `Seminearring` class.
8− - Added Docker Compose support.
9−
10−0.16.0.0
11−========
12−- @bitemyapp
13− - Reorganized V5 modules internally, ripped out Generic,
14− rewrote part of the test suite.
15− - Added message field to EsProtocolException
16− - Switch from Data.Version to Data.SemVer to support parsing broader version format.
17− - Drop support for GHC < 8.0
18− - Remove upper bound on aeson.
19−- @mxavier
20− - Reorganized V1 modules, mirroring the work done on V5.
21−- @andrewthad
22− - Added support for autogenerated elasticsearch ids in the bulk API
23− - Added support for token filters
24− - Added action for searching multiple indices
25−- @lunaris
26− - Added support for scripts fields and function score queries
27−- @bermanjosh
28− - Added support for direct generators
29−- @rvl
30− - Add [character filters][] to the `AnalyzerDefinition` type.
31− - Add the "stemmer" and "stop" [token filters][] to `TokenFilterDefinition`.
32−- @ahodgen
33− - Add support for wildcard queries
34−- @ashutoshrishi
35− - Added [fuzziness][] option to a Match Query
36− - Added support for "AUTO" Fuzziness alongside a numeric value.
37−
38−[Character Filters]: https://www.elastic.co/guide/en/elasticsearch/reference/5.6/analysis-charfilters.html
39−[Token Filters]: https://www.elastic.co/guide/en/elasticsearch/reference/5.6/analysis-tokenfilters.html
40−[Fuzziness]: https://www.elastic.co/guide/en/elasticsearch/reference/current/common-options.html#fuzziness
41−
42−0.15.0.2
43−========
44−- @michaelxavier
45− - Allow http-types 0.12
46−
47−0.15.0.1
48−========
49−- @bitemyapp
50− - Allow http-types 0.11
51− - Removed unused `oPath` function
52−
53−0.15.0.0
54−===================
55−
56−- @jagare
57− - #204 Fix bug where Location was used instad of LatLon
58− - #207 Add instructions on how to run example code
59−
60−- @andrewthad
61− - #200 Add function for deleting alias
62− - #201 Add BulkCreateEncoding, which allows use of aeson's Encoding for faster bulk creates
63− - #203 Add support for total fields limit
64−
65−- @chrissound
66− - #196 Add missing import to example
67−
68−- @tmcgilchrist
69− - #186 Fix warnings and drop redundant constraints
70−
71−- @23Skidoo
72− - #183 Bump dependencies to support GHC 8.2
73−
74−- @bermanjosh
75− - #182 Support for Suggesters and Template Queries
76−
77−- @dawei-dev
78− - #181 Fix typo
79−
80−
81−0.14.0.0
82−===================
83−
84−- @bitemyapp
85− - Aeson 1.2
86−
87−- @shmish111
88− - #177 Added stats aggregation
89−
90−- @justinwhite
91− - #176 Fixed typo
92−
93−- @WraithM
94− - #175 Sorted version of getInitialScroll for V5 client
95−
96−0.13.0.0
97−===================
98−
99−- @michaelxavier
100− - #174 doctests are bad
101− - #171 Added Semigroup instances
102− - #165 Aeson 1.1
103−
104−- @bermanjosh
105− - #168 Sub-aggregation support
106− - #167 Limit QuickCheck to 500 checks
107−
1080.12.1.0
10.12.1.0
109===================
2===================
110* @michaelxavier
3* @michaelxavier
docker-compose.ymldeleted−35
@@ -1,35 +0,0 @@
1−version: "2"
2−services:
3− elasticsearch1:
4− build: .
5− container_name: elasticsearch1
6− environment:
7− - cluster.name=docker-cluster
8− - bootstrap.memory_lock=true
9− - "ES_JAVA_OPTS=-Xms512m -Xmx512m"
10− ulimits:
11− memlock:
12− soft: -1
13− hard: -1
14− mem_limit: 1g
15− ports:
16− - 9200:9200
17− networks:
18− - esnet
19− elasticsearch2:
20− build: .
21− environment:
22− - cluster.name=docker-cluster
23− - bootstrap.memory_lock=true
24− - "ES_JAVA_OPTS=-Xms512m -Xmx512m"
25− - "discovery.zen.ping.unicast.hosts=elasticsearch1"
26− ulimits:
27− memlock:
28− soft: -1
29− hard: -1
30− mem_limit: 1g
31− networks:
32− - esnet
33−
34−networks:
35− esnet: {}
elasticsearch/Dockerfiledeleted−3
@@ -1,3 +0,0 @@
1−FROM docker.elastic.co/elasticsearch/elasticsearch:5.6.0
2−
3−COPY config /usr/share/elasticsearch/config/
elasticsearch/config/elasticsearch.ymldeleted−3
@@ -1,3 +0,0 @@
1−xpack.security.enabled: false
2−cluster.name: "docker-cluster"
3−network.host: 0.0.0.0
examples/Makefiledeleted−5
@@ -1,5 +0,0 @@
1−build:
2− stack build
3−
4−ghci:
5− stack ghci
examples/README.md+1−4
@@ -1,6 +1,3 @@
1# Bloodhound Examples
1# Bloodhound Examples
2
2
3−These examples can be built via `stack build`.
3+These examples can be build via `stack build`.
4−To run them start an Elasticsearch 5.x server at `localhost:9200`
5−
6−Run with `stack exec tweet-example`
examples/Tweet.hs+22−5
@@ -5,6 +5,7 @@ module Main
5 ) where
5 ) where
6
6
7
7
8+-------------------------------------------------------------------------------
8import Control.Monad.IO.Class (liftIO)
9import Control.Monad.IO.Class (liftIO)
9import Data.Aeson (FromJSON (..), defaultOptions,
10import Data.Aeson (FromJSON (..), defaultOptions,
10 genericParseJSON, genericToJSON,
11 genericParseJSON, genericToJSON,
@@ -14,9 +15,10 @@ import Data.Text (Text)
14import Data.Time.Calendar (Day (..))
15import Data.Time.Calendar (Day (..))
15import Data.Time.Clock (UTCTime (..), secondsToDiffTime)
16import Data.Time.Clock (UTCTime (..), secondsToDiffTime)
16import qualified Data.Vector as V
17import qualified Data.Vector as V
17−import Database.Bloodhound
18+import Database.V1.Bloodhound
18import GHC.Generics (Generic)
19import GHC.Generics (Generic)
19import Network.HTTP.Client (defaultManagerSettings)
20import Network.HTTP.Client (defaultManagerSettings)
21+-------------------------------------------------------------------------------
20
22
21
23
22data TweetMapping = TweetMapping deriving (Eq, Show)
24data TweetMapping = TweetMapping deriving (Eq, Show)
@@ -28,15 +30,25 @@ instance ToJSON TweetMapping where
28 object ["location" .= object ["type" .= ("geo_point" :: Text)]]
30 object ["location" .= object ["type" .= ("geo_point" :: Text)]]
29 ]
31 ]
30
32
33+
34+-------------------------------------------------------------------------------
35+data Location = Location
36+ { locLat :: Double
37+ , locLon :: Double
38+ } deriving (Eq, Generic, Show)
39+
40+
41+-------------------------------------------------------------------------------
31data Tweet = Tweet
42data Tweet = Tweet
32 { user :: Text
43 { user :: Text
33 , postDate :: UTCTime
44 , postDate :: UTCTime
34 , message :: Text
45 , message :: Text
35 , age :: Int
46 , age :: Int
36− , location :: LatLon
47+ , location :: Location
37 } deriving (Eq, Generic, Show)
48 } deriving (Eq, Generic, Show)
38
49
39
50
51+-------------------------------------------------------------------------------
40exampleTweet :: Tweet
52exampleTweet :: Tweet
41exampleTweet =
53exampleTweet =
42 Tweet
54 Tweet
@@ -47,14 +59,19 @@ exampleTweet =
47 , location = loc
59 , location = loc
48 }
60 }
49 where
61 where
50− loc = LatLon {lat = 40.12, lon = -71.3}
62+ loc = Location {locLat = 40.12, locLon = (-71.34)}
51
63
52instance ToJSON Tweet where
64instance ToJSON Tweet where
53 toJSON = genericToJSON defaultOptions
65 toJSON = genericToJSON defaultOptions
54instance FromJSON Tweet where
66instance FromJSON Tweet where
55 parseJSON = genericParseJSON defaultOptions
67 parseJSON = genericParseJSON defaultOptions
68+instance ToJSON Location where
69+ toJSON = genericToJSON defaultOptions
70+instance FromJSON Location where
71+ parseJSON = genericParseJSON defaultOptions
56
72
57
73
74+-------------------------------------------------------------------------------
58main :: IO ()
75main :: IO ()
59main = runBH' $ do
76main = runBH' $ do
60 -- set up index
77 -- set up index
@@ -83,7 +100,7 @@ main = runBH' $ do
83 True <- indexExists aliasName
100 True <- indexExists aliasName
84
101
85 -- create a template so that if we just write into an index named tweet-2017-01-02, for instance, the index will be automatically created with the given mapping. This is a great idea for any ongoing indices because it makes them much easier to manage and rotate.
102 -- create a template so that if we just write into an index named tweet-2017-01-02, for instance, the index will be automatically created with the given mapping. This is a great idea for any ongoing indices because it makes them much easier to manage and rotate.
86− let idxTpl = IndexTemplate (TemplatePattern "tweet-*") (Just (IndexSettings (ShardCount 1) (ReplicaCount 1))) [object ["tweet" .= toJSON TweetMapping]]
103+ let idxTpl = IndexTemplate (TemplatePattern "tweet-*") (Just (IndexSettings (ShardCount 1) (ReplicaCount 1))) [toJSON TweetMapping]
87 let templateName = TemplateName "tweet-tpl"
104 let templateName = TemplateName "tweet-tpl"
88 _ <- putTemplate idxTpl templateName
105 _ <- putTemplate idxTpl templateName
89 True <- templateExists templateName
106 True <- templateExists templateName
@@ -101,7 +118,7 @@ main = runBH' $ do
101
118
102 return ()
119 return ()
103 where
120 where
104− testServer = Server "http://localhost:9200"
121+ testServer = (Server "http://localhost:9200")
105 runBH' = withBH defaultManagerSettings testServer
122 runBH' = withBH defaultManagerSettings testServer
106 testIndex = IndexName "twitter"
123 testIndex = IndexName "twitter"
107 testMapping = MappingName "tweet"
124 testMapping = MappingName "tweet"
examples/package.yaml+1
@@ -17,6 +17,7 @@ dependencies:
17- http-client
17- http-client
18- vector
18- vector
19- semigroups
19- semigroups
20+- transformers
20ghc-options:
21ghc-options:
21- -Wall
22- -Wall
22- -threaded
23- -threaded
examples/stack.yamldeleted−20
@@ -1,20 +0,0 @@
1−flags:
2− bloodhound-examples:
3− werror: false
4−
5−packages:
6−- '.'
7−- '..'
8−# extra-deps:
9−# - http-client-0.5.0
10−# - aeson-1.2.0.0
11−# - fail-4.9.0.0
12−# - http-types-0.9
13−# - attoparsec-0.13.0.1
14−# - quickcheck-properties-0.1
15−# - semigroups-0.18.3
16−# - uri-bytestring-0.1.9
17−# - temporary-resourcet-0.1.0.0
18−# - transformers-compat-0.5.1.4
19−
20−resolver: lts-8.14
package.yamldeleted−74
@@ -1,74 +0,0 @@
1−name: bloodhound
2−version: '0.17.0.0'
3−synopsis: Elasticsearch client library for Haskell
4−description: Elasticsearch made awesome for Haskell hackers
5−category: Database, Search
6−author: Chris Allen
7−maintainer: cma@bitemyapp.com
8−copyright: 2018 Chris Allen
9−license: BSD3
10−github: bitemyapp/bloodhound.git
11−
12−extra-source-files:
13− - README.md
14− - changelog.md
15− - tests/tests.hs
16−
17−dependencies:
18− - aeson >=0.11.1
19− - base >=4.3 && <5
20− - blaze-builder
21− - bytestring >=0.10.0
22− - containers >=0.5.0.0
23− - exceptions
24− - hashable
25− - http-client >=0.4.30
26− - http-types >=0.8
27− - mtl >=1.0
28− - network-uri >=2.6
29− - scientific >=0.3.0.0
30− - semigroups >=0.15
31− - semver
32− - text >=0.11
33− - time >=1.4
34− - transformers >=0.2
35− - unordered-containers
36− - vector >=0.10.9
37−
38−library:
39− source-dirs: src
40− ghc-options: -Wall
41− exposed-modules:
42− - Database.Bloodhound
43− - Database.Bloodhound.Client
44− - Database.Bloodhound.Types
45− - Database.Bloodhound.Internal.Aggregation
46− - Database.Bloodhound.Internal.Analysis
47− - Database.Bloodhound.Internal.Client
48− - Database.Bloodhound.Internal.Highlight
49− - Database.Bloodhound.Internal.Newtypes
50− - Database.Bloodhound.Internal.Query
51− - Database.Bloodhound.Internal.Sort
52− - Database.Bloodhound.Internal.StringlyTyped
53− - Database.Bloodhound.Internal.Suggest
54−
55−tests:
56− bloodhound-tests:
57− source-dirs: tests
58− main: tests.hs
59− ghc-options:
60− - -Wall
61− - -fno-warn-orphans
62− dependencies:
63− - QuickCheck
64− - base
65− - bloodhound
66− - errors
67− - hspec >=1.8
68− - microlens
69− - microlens-aeson
70− - pretty-simple
71− - quickcheck-arbitrary-template
72− - quickcheck-properties
73− - temporary
74− - unix-compat
src/Bloodhound/Import.hsdeleted−85
@@ -1,85 +0,0 @@
1−module Bloodhound.Import
2− ( module X
3− , LByteString
4− , Method
5− , omitNulls
6− , parseNEJSON
7− , parseReadText
8− , readMay
9− , showText
10− , deleteSeveral
11− , oPath
12− , tshow
13− ) where
14−
15−import Control.Applicative as X (Alternative (..), optional)
16−import Control.Exception as X (Exception)
17−import Control.Monad as X (MonadPlus (..), forM, (<=<))
18−import Control.Monad.Catch as X (MonadCatch, MonadMask,
19− MonadThrow)
20−import Control.Monad.Except as X (MonadError)
21−import Control.Monad.Fix as X (MonadFix)
22−import Control.Monad.IO.Class as X (MonadIO (..))
23−import Control.Monad.Reader as X (MonadReader (..),
24− MonadTrans (..), ReaderT (..))
25−import Control.Monad.State as X (MonadState)
26−import Control.Monad.Writer as X (MonadWriter)
27−import Data.Aeson as X
28−import Data.Aeson.Types as X (Pair, Parser, emptyObject,
29− parseEither, parseMaybe,
30− typeMismatch)
31−import Data.Bifunctor as X (first)
32−import Data.Char as X (isNumber)
33−import Data.Hashable as X (Hashable)
34−import qualified Data.HashMap.Strict as HM
35−import Data.List as X (foldl', intercalate, nub)
36−import Data.List.NonEmpty as X (NonEmpty (..), toList)
37−import Data.Maybe as X (catMaybes, fromMaybe,
38− isNothing, maybeToList)
39−import Data.Scientific as X (Scientific)
40−import Data.Semigroup as X (Semigroup (..))
41−import Data.Text as X (Text)
42−import Data.Time.Calendar as X (Day (..), showGregorian)
43−import Data.Time.Clock as X (NominalDiffTime, UTCTime)
44−import Data.Time.Clock.POSIX as X
45−
46−import qualified Data.ByteString.Lazy as BL
47−import qualified Data.Text as T
48−import qualified Data.Traversable as DT
49−import qualified Data.Vector as V
50−import qualified Network.HTTP.Types.Method as NHTM
51−
52−type LByteString = BL.ByteString
53−
54−type Method = NHTM.Method
55−
56−readMay :: Read a => String -> Maybe a
57−readMay s = case reads s of
58− (a, ""):_ -> Just a
59− _ -> Nothing
60−
61−parseReadText :: Read a => Text -> Parser a
62−parseReadText = maybe mzero return . readMay . T.unpack
63−
64−showText :: Show a => a -> Text
65−showText = T.pack . show
66−
67−omitNulls :: [(Text, Value)] -> Value
68−omitNulls = object . filter notNull where
69− notNull (_, Null) = False
70− notNull (_, Array a) = (not . V.null) a
71− notNull _ = True
72−
73−parseNEJSON :: (FromJSON a) => [Value] -> Parser (NonEmpty a)
74−parseNEJSON [] = fail "Expected non-empty list"
75−parseNEJSON (x:xs) = DT.mapM parseJSON (x :| xs)
76−
77−deleteSeveral :: (Eq k, Hashable k) => [k] -> HM.HashMap k v -> HM.HashMap k v
78−deleteSeveral ks hm = foldr HM.delete hm ks
79−
80−oPath :: ToJSON a => NonEmpty Text -> a -> Value
81−oPath (k :| []) v = object [k .= v]
82−oPath (k:| (h:t)) v = object [k .= oPath (h :| t) v]
83−
84−tshow :: Show a => a -> Text
85−tshow = T.pack . show
src/Database/Bloodhound.hsdeleted−10
@@ -1,10 +0,0 @@
1−module Database.Bloodhound
2− ( -- module Data.Aeson.Types
3− -- ,
4− module Database.Bloodhound.Client
5− , module Database.Bloodhound.Types
6− ) where
7−
8−-- import Data.Aeson.Types
9−import Database.Bloodhound.Client
10−import Database.Bloodhound.Types
src/Database/Bloodhound/Common/Script.hsdeleted−220
@@ -1,220 +0,0 @@
1−{-# LANGUAGE GeneralizedNewtypeDeriving #-}
2−{-# LANGUAGE OverloadedStrings #-}
3−
4−module Database.Bloodhound.Common.Script where
5−
6−import Bloodhound.Import
7−
8−import qualified Data.HashMap.Strict as HM
9−
10−import Database.Bloodhound.Internal.Newtypes
11−
12−newtype ScriptFields =
13− ScriptFields (HM.HashMap ScriptFieldName ScriptFieldValue)
14− deriving (Eq, Show)
15−
16−type ScriptFieldName = Text
17−type ScriptFieldValue = Value
18−
19−data Script =
20− Script { scriptLanguage :: Maybe ScriptLanguage
21− , scriptInline :: Maybe ScriptInline
22− , scriptStored :: Maybe ScriptId
23− , scriptParams :: Maybe ScriptParams
24− } deriving (Eq, Show)
25−
26−newtype ScriptLanguage =
27− ScriptLanguage Text deriving (Eq, Show, FromJSON, ToJSON)
28−
29−newtype ScriptInline =
30− ScriptInline Text deriving (Eq, Show, FromJSON, ToJSON)
31−
32−newtype ScriptId =
33− ScriptId Text deriving (Eq, Show, FromJSON, ToJSON)
34−
35−newtype ScriptParams =
36− ScriptParams (HM.HashMap ScriptParamName ScriptParamValue)
37− deriving (Eq, Show)
38−
39−type ScriptParamName = Text
40−type ScriptParamValue = Value
41−
42−data BoostMode =
43− BoostModeMultiply
44− | BoostModeReplace
45− | BoostModeSum
46− | BoostModeAvg
47− | BoostModeMax
48− | BoostModeMin deriving (Eq, Show)
49−
50−data ScoreMode =
51− ScoreModeMultiply
52− | ScoreModeSum
53− | ScoreModeAvg
54− | ScoreModeFirst
55− | ScoreModeMax
56− | ScoreModeMin deriving (Eq, Show)
57−
58−data FunctionScoreFunction =
59− FunctionScoreFunctionScript Script
60− | FunctionScoreFunctionRandom Seed
61− | FunctionScoreFunctionFieldValueFactor FieldValueFactor
62− deriving (Eq, Show)
63−
64−newtype Weight =
65− Weight Float deriving (Eq, Show, FromJSON, ToJSON)
66−
67−newtype Seed =
68− Seed Float deriving (Eq, Show, FromJSON, ToJSON)
69−
70−data FieldValueFactor =
71− FieldValueFactor { fieldValueFactorField :: FieldName
72− , fieldValueFactor :: Maybe Factor
73− , fieldValueFactorModifier :: Maybe FactorModifier
74− , fieldValueFactorMissing :: Maybe FactorMissingFieldValue
75− } deriving (Eq, Show)
76−
77−newtype Factor =
78− Factor Float deriving (Eq, Show, FromJSON, ToJSON)
79−
80−data FactorModifier =
81− FactorModifierNone
82− | FactorModifierLog
83− | FactorModifierLog1p
84− | FactorModifierLog2p
85− | FactorModifierLn
86− | FactorModifierLn1p
87− | FactorModifierLn2p
88− | FactorModifierSquare
89− | FactorModifierSqrt
90− | FactorModifierReciprocal deriving (Eq, Show)
91−
92−newtype FactorMissingFieldValue =
93− FactorMissingFieldValue Float deriving (Eq, Show, FromJSON, ToJSON)
94−
95−instance ToJSON BoostMode where
96− toJSON BoostModeMultiply = "multiply"
97− toJSON BoostModeReplace = "replace"
98− toJSON BoostModeSum = "sum"
99− toJSON BoostModeAvg = "avg"
100− toJSON BoostModeMax = "max"
101− toJSON BoostModeMin = "min"
102−
103−instance FromJSON BoostMode where
104− parseJSON = withText "BoostMode" parse
105− where parse "multiply" = pure BoostModeMultiply
106− parse "replace" = pure BoostModeReplace
107− parse "sum" = pure BoostModeSum
108− parse "avg" = pure BoostModeAvg
109− parse "max" = pure BoostModeMax
110− parse "min" = pure BoostModeMin
111− parse bm = fail ("Unexpected BoostMode: " <> show bm)
112−
113−instance ToJSON ScoreMode where
114− toJSON ScoreModeMultiply = "multiply"
115− toJSON ScoreModeSum = "sum"
116− toJSON ScoreModeFirst = "first"
117− toJSON ScoreModeAvg = "avg"
118− toJSON ScoreModeMax = "max"
119− toJSON ScoreModeMin = "min"
120−
121−instance FromJSON ScoreMode where
122− parseJSON = withText "ScoreMode" parse
123− where parse "multiply" = pure ScoreModeMultiply
124− parse "sum" = pure ScoreModeSum
125− parse "first" = pure ScoreModeFirst
126− parse "avg" = pure ScoreModeAvg
127− parse "max" = pure ScoreModeMax
128− parse "min" = pure ScoreModeMin
129− parse sm = fail ("Unexpected ScoreMode: " <> show sm)
130−
131−functionScoreFunctionPair :: FunctionScoreFunction -> (Text, Value)
132−functionScoreFunctionPair (FunctionScoreFunctionScript functionScoreScript) =
133− ("script_score", toJSON functionScoreScript)
134−functionScoreFunctionPair (FunctionScoreFunctionRandom seed) =
135− ("random_score", omitNulls [ "seed" .= seed ])
136−functionScoreFunctionPair (FunctionScoreFunctionFieldValueFactor fvf) =
137− ("field_value_factor", toJSON fvf)
138−
139−parseFunctionScoreFunction :: Object -> Parser FunctionScoreFunction
140−parseFunctionScoreFunction o =
141− singleScript `taggedWith` "script_score"
142− <|> singleRandom `taggedWith` "random_score"
143− <|> singleFieldValueFactor `taggedWith` "field_value_factor"
144− where taggedWith parser k = parser =<< o .: k
145− singleScript = pure . FunctionScoreFunctionScript
146− singleRandom o' = FunctionScoreFunctionRandom <$> o' .: "seed"
147− singleFieldValueFactor = pure . FunctionScoreFunctionFieldValueFactor
148−
149−instance ToJSON ScriptFields where
150− toJSON (ScriptFields x) = Object x
151−
152−instance FromJSON ScriptFields where
153− parseJSON (Object o) = pure (ScriptFields o)
154− parseJSON _ = fail "error parsing ScriptFields"
155−
156−instance ToJSON Script where
157− toJSON (Script lang inline stored params) =
158− object [ "script" .= omitNulls base ]
159− where base = [ "lang" .= lang
160− , "inline" .= inline
161− , "stored" .= stored
162− , "params" .= params ]
163−
164−instance FromJSON Script where
165− parseJSON = withObject "Script" parse
166− where parse o = o .: "script" >>= \o' ->
167− Script
168− <$> o' .:? "lang"
169− <*> o' .:? "inline"
170− <*> o' .:? "stored"
171− <*> o' .:? "params"
172−
173−instance ToJSON ScriptParams where
174− toJSON (ScriptParams x) = Object x
175−
176−instance FromJSON ScriptParams where
177− parseJSON (Object o) = pure (ScriptParams o)
178− parseJSON _ = fail "error parsing ScriptParams"
179−
180−instance ToJSON FieldValueFactor where
181− toJSON (FieldValueFactor field factor modifier missing) =
182− omitNulls base
183− where base = [ "field" .= field
184− , "factor" .= factor
185− , "modifier" .= modifier
186− , "missing" .= missing ]
187−
188−instance FromJSON FieldValueFactor where
189− parseJSON = withObject "FieldValueFactor" parse
190− where parse o = FieldValueFactor
191− <$> o .: "field"
192− <*> o .:? "factor"
193− <*> o .:? "modifier"
194− <*> o .:? "missing"
195−
196−instance ToJSON FactorModifier where
197− toJSON FactorModifierNone = "none"
198− toJSON FactorModifierLog = "log"
199− toJSON FactorModifierLog1p = "log1p"
200− toJSON FactorModifierLog2p = "log2p"
201− toJSON FactorModifierLn = "ln"
202− toJSON FactorModifierLn1p = "ln1p"
203− toJSON FactorModifierLn2p = "ln2p"
204− toJSON FactorModifierSquare = "square"
205− toJSON FactorModifierSqrt = "sqrt"
206− toJSON FactorModifierReciprocal = "reciprocal"
207−
208−instance FromJSON FactorModifier where
209− parseJSON = withText "FactorModifier" parse
210− where parse "none" = pure FactorModifierNone
211− parse "log" = pure FactorModifierLog
212− parse "log1p" = pure FactorModifierLog1p
213− parse "log2p" = pure FactorModifierLog2p
214− parse "ln" = pure FactorModifierLn
215− parse "ln1p" = pure FactorModifierLn1p
216− parse "ln2p" = pure FactorModifierLn2p
217− parse "square" = pure FactorModifierSquare
218− parse "sqrt" = pure FactorModifierSqrt
219− parse "reciprocal" = pure FactorModifierReciprocal
220− parse fm = fail ("Unexpected FactorModifier: " <> show fm)
src/Database/Bloodhound/Internal/Aggregation.hsdeleted−479
@@ -1,479 +0,0 @@
1−{-# LANGUAGE GeneralizedNewtypeDeriving #-}
2−{-# LANGUAGE OverloadedStrings #-}
3−{-# LANGUAGE RecordWildCards #-}
4−
5−module Database.Bloodhound.Internal.Aggregation where
6−
7−import Bloodhound.Import
8−
9−import qualified Data.Aeson as Aeson
10−import qualified Data.HashMap.Strict as HM
11−import qualified Data.Map.Strict as M
12−import qualified Data.Text as T
13−
14−import Database.Bloodhound.Internal.Client
15−import Database.Bloodhound.Internal.Highlight (HitHighlight)
16−import Database.Bloodhound.Internal.Newtypes
17−import Database.Bloodhound.Internal.Query
18−import Database.Bloodhound.Internal.Sort
19−
20−type Aggregations = M.Map Text Aggregation
21−
22−emptyAggregations :: Aggregations
23−emptyAggregations = M.empty
24−
25−mkAggregations :: Text -> Aggregation -> Aggregations
26−mkAggregations name aggregation = M.insert name aggregation emptyAggregations
27−
28−data Aggregation = TermsAgg TermsAggregation
29− | CardinalityAgg CardinalityAggregation
30− | MaxAgg MaxAggregation
31− | DateHistogramAgg DateHistogramAggregation
32− | ValueCountAgg ValueCountAggregation
33− | FilterAgg FilterAggregation
34− | DateRangeAgg DateRangeAggregation
35− | MissingAgg MissingAggregation
36− | TopHitsAgg TopHitsAggregation
37− | StatsAgg StatisticsAggregation
38− deriving (Eq, Show)
39−
40−instance ToJSON Aggregation where
41− toJSON (TermsAgg (TermsAggregation term include exclude order minDocCount size shardSize collectMode executionHint termAggs)) =
42− omitNulls ["terms" .= omitNulls [ toJSON' term,
43− "include" .= include,
44− "exclude" .= exclude,
45− "order" .= order,
46− "min_doc_count" .= minDocCount,
47− "size" .= size,
48− "shard_size" .= shardSize,
49− "collect_mode" .= collectMode,
50− "execution_hint" .= executionHint
51− ],
52− "aggs" .= termAggs ]
53− where
54− toJSON' x = case x of { Left y -> "field" .= y; Right y -> "script" .= y }
55−
56− toJSON (CardinalityAgg (CardinalityAggregation field precisionThreshold)) =
57− object ["cardinality" .= omitNulls [ "field" .= field,
58− "precisionThreshold" .= precisionThreshold
59− ]
60− ]
61−
62− toJSON (MaxAgg (MaxAggregation field)) =
63− object ["max" .= omitNulls [ "field" .= field ]]
64−
65− toJSON (DateHistogramAgg
66− (DateHistogramAggregation field interval format
67− preZone postZone preOffset postOffset dateHistoAggs)) =
68− omitNulls ["date_histogram" .= omitNulls [ "field" .= field,
69− "interval" .= interval,
70− "format" .= format,
71− "pre_zone" .= preZone,
72− "post_zone" .= postZone,
73− "pre_offset" .= preOffset,
74− "post_offset" .= postOffset
75− ],
76− "aggs" .= dateHistoAggs ]
77− toJSON (ValueCountAgg a) = object ["value_count" .= v]
78− where v = case a of
79− (FieldValueCount (FieldName n)) ->
80− object ["field" .= n]
81− (ScriptValueCount s) ->
82− object ["script" .= s]
83− toJSON (FilterAgg (FilterAggregation filt ags)) =
84− omitNulls [ "filter" .= filt
85− , "aggs" .= ags]
86− toJSON (DateRangeAgg a) = object [ "date_range" .= a
87− ]
88− toJSON (MissingAgg (MissingAggregation{..})) =
89− object ["missing" .= object ["field" .= maField]]
90−
91− toJSON (TopHitsAgg (TopHitsAggregation mfrom msize msort)) =
92− omitNulls ["top_hits" .= omitNulls [ "size" .= msize
93− , "from" .= mfrom
94− , "sort" .= msort
95− ]
96− ]
97−
98− toJSON (StatsAgg (StatisticsAggregation typ field)) =
99− object [stType .= omitNulls [ "field" .= field ]]
100− where
101− stType | typ == Basic = "stats"
102− | otherwise = "extended_stats"
103−
104−data TopHitsAggregation = TopHitsAggregation
105− { taFrom :: Maybe From
106− , taSize :: Maybe Size
107− , taSort :: Maybe Sort
108− } deriving (Eq, Show)
109−
110−data MissingAggregation = MissingAggregation
111− { maField :: Text
112− } deriving (Eq, Show)
113−
114−data TermsAggregation = TermsAggregation
115− { term :: Either Text Text
116− , termInclude :: Maybe TermInclusion
117− , termExclude :: Maybe TermInclusion
118− , termOrder :: Maybe TermOrder
119− , termMinDocCount :: Maybe Int
120− , termSize :: Maybe Int
121− , termShardSize :: Maybe Int
122− , termCollectMode :: Maybe CollectionMode
123− , termExecutionHint :: Maybe ExecutionHint
124− , termAggs :: Maybe Aggregations
125− } deriving (Eq, Show)
126−
127−data CardinalityAggregation = CardinalityAggregation
128− { cardinalityField :: FieldName,
129− precisionThreshold :: Maybe Int
130− } deriving (Eq, Show)
131−
132−data MaxAggregation = MaxAggregation
133− { maxField :: FieldName
134− } deriving (Eq, Show)
135−
136−data DateHistogramAggregation = DateHistogramAggregation
137− { dateField :: FieldName
138− , dateInterval :: Interval
139− , dateFormat :: Maybe Text
140− -- pre and post deprecated in 1.5
141− , datePreZone :: Maybe Text
142− , datePostZone :: Maybe Text
143− , datePreOffset :: Maybe Text
144− , datePostOffset :: Maybe Text
145− , dateAggs :: Maybe Aggregations
146− } deriving (Eq, Show)
147−
148−data DateRangeAggregation = DateRangeAggregation
149− { draField :: FieldName
150− , draFormat :: Maybe Text
151− , draRanges :: NonEmpty DateRangeAggRange
152− } deriving (Eq, Show)
153−
154−instance ToJSON DateRangeAggregation where
155− toJSON DateRangeAggregation {..} =
156− omitNulls [ "field" .= draField
157− , "format" .= draFormat
158− , "ranges" .= toList draRanges
159− ]
160−
161−data DateRangeAggRange =
162− DateRangeFrom DateMathExpr
163− | DateRangeTo DateMathExpr
164− | DateRangeFromAndTo DateMathExpr DateMathExpr
165− deriving (Eq, Show)
166−
167−instance ToJSON DateRangeAggRange where
168− toJSON (DateRangeFrom e) = object [ "from" .= e ]
169− toJSON (DateRangeTo e) = object [ "to" .= e ]
170− toJSON (DateRangeFromAndTo f t) = object [ "from" .= f, "to" .= t ]
171−
172−-- | See <https://www.elastic.co/guide/en/elasticsearch/reference/current/search-aggregations-metrics-valuecount-aggregation.html> for more information.
173−data ValueCountAggregation =
174− FieldValueCount FieldName
175− | ScriptValueCount Script
176− deriving (Eq, Show)
177−
178−-- | 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.
179−data FilterAggregation = FilterAggregation
180− { faFilter :: Filter
181− , faAggs :: Maybe Aggregations }
182− deriving (Eq, Show)
183−
184−data StatisticsAggregation = StatisticsAggregation
185− { statsType :: StatsType
186− , statsField :: FieldName }
187− deriving (Eq, Show)
188−
189−data StatsType
190− = Basic
191− | Extended
192− deriving (Eq, Show)
193−
194−mkTermsAggregation :: Text -> TermsAggregation
195−mkTermsAggregation t =
196− TermsAggregation (Left t)
197− Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing
198−
199−mkTermsScriptAggregation :: Text -> TermsAggregation
200−mkTermsScriptAggregation t = TermsAggregation (Right t) Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing
201−
202−mkDateHistogram :: FieldName -> Interval -> DateHistogramAggregation
203−mkDateHistogram t i = DateHistogramAggregation t i Nothing Nothing Nothing Nothing Nothing Nothing
204−
205−mkCardinalityAggregation :: FieldName -> CardinalityAggregation
206−mkCardinalityAggregation t = CardinalityAggregation t Nothing
207−
208−mkStatsAggregation :: FieldName -> StatisticsAggregation
209−mkStatsAggregation = StatisticsAggregation Basic
210−
211−mkExtendedStatsAggregation :: FieldName -> StatisticsAggregation
212−mkExtendedStatsAggregation = StatisticsAggregation Extended
213−
214−type AggregationResults = M.Map Text Value
215−
216−class BucketAggregation a where
217− key :: a -> BucketValue
218− docCount :: a -> Int
219− aggs :: a -> Maybe AggregationResults
220−
221−data Bucket a = Bucket
222− { buckets :: [a]
223− } deriving (Read, Show)
224−
225−instance (FromJSON a) => FromJSON (Bucket a) where
226− parseJSON (Object v) = Bucket <$>
227− v .: "buckets"
228− parseJSON _ = mempty
229−
230−data BucketValue = TextValue Text
231− | ScientificValue Scientific
232− | BoolValue Bool deriving (Read, Show)
233−
234−instance FromJSON BucketValue where
235− parseJSON (String t) = return $ TextValue t
236− parseJSON (Number s) = return $ ScientificValue s
237− parseJSON (Bool b) = return $ BoolValue b
238− parseJSON _ = mempty
239−
240−data TermInclusion = TermInclusion Text
241− | TermPattern Text Text deriving (Eq, Show)
242−
243−instance ToJSON TermInclusion where
244− toJSON (TermInclusion x) = toJSON x
245− toJSON (TermPattern pattern flags) =
246− omitNulls [ "pattern" .= pattern
247− , "flags" .= flags]
248−
249−data TermOrder = TermOrder
250− { termSortField :: Text
251− , termSortOrder :: SortOrder } deriving (Eq, Show)
252−
253−instance ToJSON TermOrder where
254− toJSON (TermOrder termSortField termSortOrder) =
255− object [termSortField .= termSortOrder]
256−
257−data CollectionMode = BreadthFirst
258− | DepthFirst deriving (Eq, Show)
259−
260−instance ToJSON CollectionMode where
261− toJSON BreadthFirst = "breadth_first"
262− toJSON DepthFirst = "depth_first"
263−
264−data ExecutionHint = Ordinals
265− | GlobalOrdinals
266− | GlobalOrdinalsHash
267− | GlobalOrdinalsLowCardinality
268− | Map deriving (Eq, Show)
269−
270−instance ToJSON ExecutionHint where
271− toJSON Ordinals = "ordinals"
272− toJSON GlobalOrdinals = "global_ordinals"
273− toJSON GlobalOrdinalsHash = "global_ordinals_hash"
274− toJSON GlobalOrdinalsLowCardinality = "global_ordinals_low_cardinality"
275− toJSON Map = "map"
276−
277−-- | See <https://www.elastic.co/guide/en/elasticsearch/reference/current/common-options.html#date-math> for more information.
278−data DateMathExpr =
279− DateMathExpr DateMathAnchor [DateMathModifier]
280− deriving (Eq, Show)
281−
282−instance ToJSON DateMathExpr where
283− toJSON (DateMathExpr a mods) = String (fmtA a <> mconcat (fmtMod <$> mods))
284− where fmtA DMNow = "now"
285− fmtA (DMDate date) = (T.pack $ showGregorian date) <> "||"
286− fmtMod (AddTime n u) = "+" <> showText n <> fmtU u
287− fmtMod (SubtractTime n u) = "-" <> showText n <> fmtU u
288− fmtMod (RoundDownTo u) = "/" <> fmtU u
289− fmtU DMYear = "y"
290− fmtU DMMonth = "M"
291− fmtU DMWeek = "w"
292− fmtU DMDay = "d"
293− fmtU DMHour = "h"
294− fmtU DMMinute = "m"
295− fmtU DMSecond = "s"
296−
297−-- | Starting point for a date range. This along with the 'DateMathModifiers' gets you the date ES will start from.
298−data DateMathAnchor =
299− DMNow
300− | DMDate Day
301− deriving (Eq, Show)
302−
303−data DateMathModifier =
304− AddTime Int DateMathUnit
305− | SubtractTime Int DateMathUnit
306− | RoundDownTo DateMathUnit
307− deriving (Eq, Show)
308−
309−data DateMathUnit =
310− DMYear
311− | DMMonth
312− | DMWeek
313− | DMDay
314− | DMHour
315− | DMMinute
316− | DMSecond
317− deriving (Eq, Show)
318−
319−data TermsResult = TermsResult
320− { termKey :: BucketValue
321− , termsDocCount :: Int
322− , termsAggs :: Maybe AggregationResults
323− } deriving (Read, Show)
324−
325−instance FromJSON TermsResult where
326− parseJSON (Object v) = TermsResult <$>
327− v .: "key" <*>
328− v .: "doc_count" <*>
329− (pure $ getNamedSubAgg v ["key", "doc_count"])
330− parseJSON _ = mempty
331−
332−instance BucketAggregation TermsResult where
333− key = termKey
334− docCount = termsDocCount
335− aggs = termsAggs
336−
337−data DateHistogramResult = DateHistogramResult
338− { dateKey :: Int
339− , dateKeyStr :: Maybe Text
340− , dateDocCount :: Int
341− , dateHistogramAggs :: Maybe AggregationResults
342− } deriving (Show)
343−
344−instance FromJSON DateHistogramResult where
345− parseJSON (Object v) = DateHistogramResult <$>
346− v .: "key" <*>
347− v .:? "key_as_string" <*>
348− v .: "doc_count" <*>
349− (pure $ getNamedSubAgg v [ "key"
350− , "doc_count"
351− , "key_as_string"
352− ]
353− )
354− parseJSON _ = mempty
355−
356−instance BucketAggregation DateHistogramResult where
357− key = TextValue . showText . dateKey
358− docCount = dateDocCount
359− aggs = dateHistogramAggs
360−
361−data DateRangeResult = DateRangeResult
362− { dateRangeKey :: Text
363− , dateRangeFrom :: Maybe UTCTime
364− , dateRangeFromAsString :: Maybe Text
365− , dateRangeTo :: Maybe UTCTime
366− , dateRangeToAsString :: Maybe Text
367− , dateRangeDocCount :: Int
368− , dateRangeAggs :: Maybe AggregationResults
369− } deriving (Eq, Show)
370−
371−instance FromJSON DateRangeResult where
372− parseJSON = withObject "DateRangeResult" parse
373− where parse v = DateRangeResult <$>
374− v .: "key" <*>
375− (fmap posixMS <$> v .:? "from") <*>
376− v .:? "from_as_string" <*>
377− (fmap posixMS <$> v .:? "to") <*>
378− v .:? "to_as_string" <*>
379− v .: "doc_count" <*>
380− (pure $ getNamedSubAgg v [ "key"
381− , "from"
382− , "from_as_string"
383− , "to"
384− , "to_as_string"
385− , "doc_count"
386− ]
387− )
388−
389−instance BucketAggregation DateRangeResult where
390− key = TextValue . dateRangeKey
391− docCount = dateRangeDocCount
392− aggs = dateRangeAggs
393−
394−toTerms :: Text -> AggregationResults -> Maybe (Bucket TermsResult)
395−toTerms = toAggResult
396−
397−toDateHistogram :: Text -> AggregationResults -> Maybe (Bucket DateHistogramResult)
398−toDateHistogram = toAggResult
399−
400−toMissing :: Text -> AggregationResults -> Maybe MissingResult
401−toMissing = toAggResult
402−
403−toTopHits :: (FromJSON a) => Text -> AggregationResults -> Maybe (TopHitResult a)
404−toTopHits = toAggResult
405−
406−toAggResult :: (FromJSON a) => Text -> AggregationResults -> Maybe a
407−toAggResult t a = M.lookup t a >>= deserialize
408− where deserialize = parseMaybe parseJSON
409−
410−-- Try to get an AggregationResults when we don't know the
411−-- field name. We filter out the known keys to try to minimize the noise.
412−getNamedSubAgg :: Object -> [Text] -> Maybe AggregationResults
413−getNamedSubAgg o knownKeys = maggRes
414− where unknownKeys = HM.filterWithKey (\k _ -> k `notElem` knownKeys) o
415− maggRes
416− | HM.null unknownKeys = Nothing
417− | otherwise = Just . M.fromList $ HM.toList unknownKeys
418−
419−data MissingResult = MissingResult
420− { missingDocCount :: Int
421− } deriving (Show)
422−
423−instance FromJSON MissingResult where
424− parseJSON = withObject "MissingResult" parse
425− where parse v = MissingResult <$> v .: "doc_count"
426−
427−data TopHitResult a = TopHitResult
428− { tarHits :: (SearchHits a)
429− } deriving Show
430−
431−instance (FromJSON a) => FromJSON (TopHitResult a) where
432− parseJSON (Object v) = TopHitResult <$>
433− v .: "hits"
434− parseJSON _ = fail "Failure in FromJSON (TopHitResult a)"
435−
436−data SearchHits a =
437− SearchHits { hitsTotal :: Int
438− , maxScore :: Score
439− , hits :: [Hit a] } deriving (Eq, Show)
440−
441−
442−instance (FromJSON a) => FromJSON (SearchHits a) where
443− parseJSON (Object v) = SearchHits <$>
444− v .: "total" <*>
445− v .: "max_score" <*>
446− v .: "hits"
447− parseJSON _ = empty
448−
449−instance Semigroup (SearchHits a) where
450− (SearchHits ta ma ha) <> (SearchHits tb mb hb) =
451− SearchHits (ta + tb) (max ma mb) (ha <> hb)
452−
453−instance Monoid (SearchHits a) where
454− mempty = SearchHits 0 Nothing mempty
455− mappend = (<>)
456−
457−type SearchAfterKey = [Aeson.Value]
458−
459−data Hit a =
460− Hit { hitIndex :: IndexName
461− , hitType :: MappingName
462− , hitDocId :: DocId
463− , hitScore :: Score
464− , hitSource :: Maybe a
465− , hitSort :: Maybe SearchAfterKey
466− , hitFields :: Maybe HitFields
467− , hitHighlight :: Maybe HitHighlight } deriving (Eq, Show)
468−
469−instance (FromJSON a) => FromJSON (Hit a) where
470− parseJSON (Object v) = Hit <$>
471− v .: "_index" <*>
472− v .: "_type" <*>
473− v .: "_id" <*>
474− v .: "_score" <*>
475− v .:? "_source" <*>
476− v .:? "sort" <*>
477− v .:? "fields" <*>
478− v .:? "highlight"
479− parseJSON _ = empty
src/Database/Bloodhound/Internal/Analysis.hsdeleted−379
@@ -1,379 +0,0 @@
1−{-# LANGUAGE GeneralizedNewtypeDeriving #-}
2−{-# LANGUAGE OverloadedStrings #-}
3−
4−module Database.Bloodhound.Internal.Analysis where
5−
6−import Bloodhound.Import
7−
8−import qualified Data.Map.Strict as M
9−import qualified Data.Text as T
10−
11−import Database.Bloodhound.Internal.Newtypes
12−import Database.Bloodhound.Internal.StringlyTyped
13−
14−data Analysis = Analysis
15− { analysisAnalyzer :: M.Map Text AnalyzerDefinition
16− , analysisTokenizer :: M.Map Text TokenizerDefinition
17− , analysisTokenFilter :: M.Map Text TokenFilterDefinition
18− , analysisCharFilter :: M.Map Text CharFilterDefinition
19− } deriving (Eq, Show)
20−
21−instance ToJSON Analysis where
22− toJSON (Analysis analyzer tokenizer tokenFilter charFilter) = object
23− [ "analyzer" .= analyzer
24− , "tokenizer" .= tokenizer
25− , "filter" .= tokenFilter
26− , "char_filter" .= charFilter
27− ]
28−
29−instance FromJSON Analysis where
30− parseJSON = withObject "Analysis" $ \m -> Analysis
31− <$> m .: "analyzer"
32− <*> m .:? "tokenizer" .!= M.empty
33− <*> m .:? "filter" .!= M.empty
34− <*> m .:? "char_filter" .!= M.empty
35−
36−newtype Tokenizer =
37− Tokenizer Text
38− deriving (Eq, Show, ToJSON, FromJSON)
39−
40−data AnalyzerDefinition = AnalyzerDefinition
41− { analyzerDefinitionTokenizer :: Maybe Tokenizer
42− , analyzerDefinitionFilter :: [TokenFilter]
43− , analyzerDefinitionCharFilter :: [CharFilter]
44− } deriving (Eq,Show)
45−
46−instance ToJSON AnalyzerDefinition where
47− toJSON (AnalyzerDefinition tokenizer tokenFilter charFilter) =
48− object $ catMaybes
49− [ fmap ("tokenizer" .=) tokenizer
50− , Just $ "filter" .= tokenFilter
51− , Just $ "char_filter" .= charFilter
52− ]
53−
54−instance FromJSON AnalyzerDefinition where
55− parseJSON = withObject "AnalyzerDefinition" $ \m -> AnalyzerDefinition
56− <$> m .:? "tokenizer"
57− <*> m .:? "filter" .!= []
58− <*> m .:? "char_filter" .!= []
59−
60−-- | Character filters are used to preprocess the stream of characters
61−-- before it is passed to the tokenizer.
62−data CharFilterDefinition
63− = CharFilterDefinitionMapping (M.Map Text Text)
64− | CharFilterDefinitionPatternReplace
65− { charFilterDefinitionPatternReplacePattern :: Text
66− , charFilterDefinitionPatternReplaceReplacement :: Text
67− , charFilterDefinitionPatternReplaceFlags :: Maybe Text
68− }
69− deriving (Eq, Show)
70−
71−instance ToJSON CharFilterDefinition where
72− toJSON (CharFilterDefinitionMapping ms) = object
73− [ "type" .= ("mapping" :: Text)
74− , "mappings" .= [a <> " => " <> b | (a, b) <- M.toList ms] ]
75− toJSON (CharFilterDefinitionPatternReplace pat repl flags) = object $
76− [ "type" .= ("pattern_replace" :: Text)
77− , "pattern" .= pat
78− , "replacement" .= repl
79− ] ++ maybe [] (\f -> ["flags" .= f]) flags
80−
81−instance FromJSON CharFilterDefinition where
82− parseJSON = withObject "CharFilterDefinition" $ \m -> do
83− t <- m .: "type"
84− case (t :: Text) of
85− "mapping" -> CharFilterDefinitionMapping . M.fromList <$> ms
86− where
87− ms = m .: "mappings" >>= mapM parseMapping
88− parseMapping kv = case T.splitOn "=>" kv of
89− (k:vs) -> pure (T.strip k, T.strip $ T.concat vs)
90− _ -> fail "mapping is not of the format key => value"
91− "pattern_replace" -> CharFilterDefinitionPatternReplace
92− <$> m .: "pattern" <*> m .: "replacement" <*> m .:? "flags"
93− _ -> fail ("unrecognized character filter type: " ++ T.unpack t)
94−
95−newtype TokenizerDefinition =
96− TokenizerDefinitionNgram Ngram
97− deriving (Eq,Show)
98−
99−instance ToJSON TokenizerDefinition where
100− toJSON x = case x of
101− TokenizerDefinitionNgram (Ngram minGram maxGram tokenChars) -> object
102− [ "type" .= ("ngram" :: Text)
103− , "min_gram" .= minGram
104− , "max_gram" .= maxGram
105− , "token_chars" .= tokenChars
106− ]
107−
108−instance FromJSON TokenizerDefinition where
109− parseJSON = withObject "TokenizerDefinition" $ \m -> do
110− typ <- m .: "type" :: Parser Text
111− case typ of
112− "ngram" -> fmap TokenizerDefinitionNgram $ Ngram
113− <$> fmap unStringlyTypedInt (m .: "min_gram")
114− <*> fmap unStringlyTypedInt (m .: "max_gram")
115− <*> m .: "token_chars"
116− _ -> fail "invalid TokenizerDefinition"
117−
118−data Ngram = Ngram
119− { ngramMinGram :: Int
120− , ngramMaxGram :: Int
121− , ngramTokenChars :: [TokenChar]
122− } deriving (Eq,Show)
123−
124−data TokenChar =
125− TokenLetter
126− | TokenDigit
127− | TokenWhitespace
128− | TokenPunctuation
129− | TokenSymbol
130− deriving (Eq,Show)
131−
132−instance ToJSON TokenChar where
133− toJSON t = String $ case t of
134− TokenLetter -> "letter"
135− TokenDigit -> "digit"
136− TokenWhitespace -> "whitespace"
137− TokenPunctuation -> "punctuation"
138− TokenSymbol -> "symbol"
139−
140−instance FromJSON TokenChar where
141− parseJSON = withText "TokenChar" $ \t -> case t of
142− "letter" -> return TokenLetter
143− "digit" -> return TokenDigit
144− "whitespace" -> return TokenWhitespace
145− "punctuation" -> return TokenPunctuation
146− "symbol" -> return TokenSymbol
147− _ -> fail "invalid TokenChar"
148−
149−-- | Token filters are used to create custom analyzers.
150−data TokenFilterDefinition
151− = TokenFilterDefinitionLowercase (Maybe Language)
152− | TokenFilterDefinitionUppercase (Maybe Language)
153− | TokenFilterDefinitionApostrophe
154− | TokenFilterDefinitionReverse
155− | TokenFilterDefinitionSnowball Language
156− | TokenFilterDefinitionShingle Shingle
157− | TokenFilterDefinitionStemmer Language
158− | TokenFilterDefinitionStop (Either Language [StopWord])
159− deriving (Eq, Show)
160−
161−instance ToJSON TokenFilterDefinition where
162− toJSON x = case x of
163− TokenFilterDefinitionLowercase mlang -> object $ catMaybes
164− [ Just $ "type" .= ("lowercase" :: Text)
165− , fmap (\lang -> "language" .= languageToText lang) mlang
166− ]
167− TokenFilterDefinitionUppercase mlang -> object $ catMaybes
168− [ Just $ "type" .= ("uppercase" :: Text)
169− , fmap (\lang -> "language" .= languageToText lang) mlang
170− ]
171− TokenFilterDefinitionApostrophe -> object
172− [ "type" .= ("apostrophe" :: Text)
173− ]
174− TokenFilterDefinitionReverse -> object
175− [ "type" .= ("reverse" :: Text)
176− ]
177− TokenFilterDefinitionSnowball lang -> object
178− [ "type" .= ("snowball" :: Text)
179− , "language" .= languageToText lang
180− ]
181− TokenFilterDefinitionShingle s -> object
182− [ "type" .= ("shingle" :: Text)
183− , "max_shingle_size" .= shingleMaxSize s
184− , "min_shingle_size" .= shingleMinSize s
185− , "output_unigrams" .= shingleOutputUnigrams s
186− , "output_unigrams_if_no_shingles" .= shingleOutputUnigramsIfNoShingles s
187− , "token_separator" .= shingleTokenSeparator s
188− , "filler_token" .= shingleFillerToken s
189− ]
190− TokenFilterDefinitionStemmer lang -> object
191− [ "type" .= ("stemmer" :: Text)
192− , "language" .= languageToText lang
193− ]
194− TokenFilterDefinitionStop stop -> object
195− [ "type" .= ("stop" :: Text)
196− , "stopwords" .= case stop of
197− Left lang -> String $ "_" <> languageToText lang <> "_"
198− Right stops -> toJSON stops
199− ]
200−
201−instance FromJSON TokenFilterDefinition where
202− parseJSON = withObject "TokenFilterDefinition" $ \m -> do
203− t <- m .: "type"
204− case (t :: Text) of
205− "reverse" -> return TokenFilterDefinitionReverse
206− "apostrophe" -> return TokenFilterDefinitionApostrophe
207− "lowercase" -> TokenFilterDefinitionLowercase
208− <$> m .:? "language"
209− "uppercase" -> TokenFilterDefinitionUppercase
210− <$> m .:? "language"
211− "snowball" -> TokenFilterDefinitionSnowball
212− <$> m .: "language"
213− "shingle" -> fmap TokenFilterDefinitionShingle $ Shingle
214− <$> (fmap.fmap) unStringlyTypedInt (m .:? "max_shingle_size") .!= 2
215− <*> (fmap.fmap) unStringlyTypedInt (m .:? "min_shingle_size") .!= 2
216− <*> (fmap.fmap) unStringlyTypedBool (m .:? "output_unigrams") .!= True
217− <*> (fmap.fmap) unStringlyTypedBool (m .:? "output_unigrams_if_no_shingles") .!= False
218− <*> m .:? "token_separator" .!= " "
219− <*> m .:? "filler_token" .!= "_"
220− "stemmer" -> TokenFilterDefinitionStemmer
221− <$> m .: "language"
222− "stop" -> do
223− stop <- m .: "stopwords"
224− stop' <- case stop of
225− String lang ->
226− fmap Left
227− . parseJSON
228− . String
229− . T.drop 1
230− . T.dropEnd 1 $ lang
231− _ -> Right <$> parseJSON stop
232− return (TokenFilterDefinitionStop stop')
233− _ -> fail ("unrecognized token filter type: " ++ T.unpack t)
234−
235−-- | The set of languages that can be passed to various analyzers,
236−-- filters, etc. in Elasticsearch. Most data types in this module
237−-- that have a 'Language' field are actually only actually to
238−-- handle a subset of these languages. Consult the official
239−-- Elasticsearch documentation to see what is actually supported.
240−data Language
241− = Arabic
242− | Armenian
243− | Basque
244− | Bengali
245− | Brazilian
246− | Bulgarian
247− | Catalan
248− | Cjk
249− | Czech
250− | Danish
251− | Dutch
252− | English
253− | Finnish
254− | French
255− | Galician
256− | German
257− | German2
258− | Greek
259− | Hindi
260− | Hungarian
261− | Indonesian
262− | Irish
263− | Italian
264− | Kp
265− | Latvian
266− | Lithuanian
267− | Lovins
268− | Norwegian
269− | Persian
270− | Porter
271− | Portuguese
272− | Romanian
273− | Russian
274− | Sorani
275− | Spanish
276− | Swedish
277− | Thai
278− | Turkish
279− deriving (Eq, Show)
280−
281−instance ToJSON Language where
282− toJSON = String . languageToText
283−
284−instance FromJSON Language where
285− parseJSON = withText "Language" $ \t -> case languageFromText t of
286− Nothing -> fail "not a supported Elasticsearch language"
287− Just lang -> return lang
288−
289−languageToText :: Language -> Text
290−languageToText x = case x of
291− Arabic -> "arabic"
292− Armenian -> "armenian"
293− Basque -> "basque"
294− Bengali -> "bengali"
295− Brazilian -> "brazilian"
296− Bulgarian -> "bulgarian"
297− Catalan -> "catalan"
298− Cjk -> "cjk"
299− Czech -> "czech"
300− Danish -> "danish"
301− Dutch -> "dutch"
302− English -> "english"
303− Finnish -> "finnish"
304− French -> "french"
305− Galician -> "galician"
306− German -> "german"
307− German2 -> "german2"
308− Greek -> "greek"
309− Hindi -> "hindi"
310− Hungarian -> "hungarian"
311− Indonesian -> "indonesian"
312− Irish -> "irish"
313− Italian -> "italian"
314− Kp -> "kp"
315− Latvian -> "latvian"
316− Lithuanian -> "lithuanian"
317− Lovins -> "lovins"
318− Norwegian -> "norwegian"
319− Persian -> "persian"
320− Porter -> "porter"
321− Portuguese -> "portuguese"
322− Romanian -> "romanian"
323− Russian -> "russian"
324− Sorani -> "sorani"
325− Spanish -> "spanish"
326− Swedish -> "swedish"
327− Thai -> "thai"
328− Turkish -> "turkish"
329−
330−languageFromText :: Text -> Maybe Language
331−languageFromText x = case x of
332− "arabic" -> Just Arabic
333− "armenian" -> Just Armenian
334− "basque" -> Just Basque
335− "bengali" -> Just Bengali
336− "brazilian" -> Just Brazilian
337− "bulgarian" -> Just Bulgarian
338− "catalan" -> Just Catalan
339− "cjk" -> Just Cjk
340− "czech" -> Just Czech
341− "danish" -> Just Danish
342− "dutch" -> Just Dutch
343− "english" -> Just English
344− "finnish" -> Just Finnish
345− "french" -> Just French
346− "galician" -> Just Galician
347− "german" -> Just German
348− "german2" -> Just German2
349− "greek" -> Just Greek
350− "hindi" -> Just Hindi
351− "hungarian" -> Just Hungarian
352− "indonesian" -> Just Indonesian
353− "irish" -> Just Irish
354− "italian" -> Just Italian
355− "kp" -> Just Kp
356− "latvian" -> Just Latvian
357− "lithuanian" -> Just Lithuanian
358− "lovins" -> Just Lovins
359− "norwegian" -> Just Norwegian
360− "persian" -> Just Persian
361− "porter" -> Just Porter
362− "portuguese" -> Just Portuguese
363− "romanian" -> Just Romanian
364− "russian" -> Just Russian
365− "sorani" -> Just Sorani
366− "spanish" -> Just Spanish
367− "swedish" -> Just Swedish
368− "thai" -> Just Thai
369− "turkish" -> Just Turkish
370− _ -> Nothing
371−
372−data Shingle = Shingle
373− { shingleMaxSize :: Int
374− , shingleMinSize :: Int
375− , shingleOutputUnigrams :: Bool
376− , shingleOutputUnigramsIfNoShingles :: Bool
377− , shingleTokenSeparator :: Text
378− , shingleFillerToken :: Text
379− } deriving (Eq, Show)
src/Database/Bloodhound/Internal/Client.hsdeleted−2431
@@ -1,2431 +0,0 @@
1−{-# LANGUAGE CPP #-}
2−{-# LANGUAGE FlexibleInstances #-}
3−{-# LANGUAGE GeneralizedNewtypeDeriving #-}
4−{-# LANGUAGE MultiParamTypeClasses #-}
5−{-# LANGUAGE OverloadedStrings #-}
6−{-# LANGUAGE RecordWildCards #-}
7−{-# LANGUAGE UndecidableInstances #-}
8−
9−module Database.Bloodhound.Internal.Client where
10−
11−import Bloodhound.Import
12−
13−#if defined(MIN_VERSION_GLASGOW_HASKELL)
14−#if MIN_VERSION_GLASGOW_HASKELL(8,6,0,0)
15−import Control.Monad.Fail (MonadFail)
16−#endif
17−#endif
18−import qualified Data.Text as T
19−import qualified Data.Traversable as DT
20−import qualified Data.HashMap.Strict as HM
21−import qualified Data.SemVer as SemVer
22−import qualified Data.Vector as V
23−import GHC.Enum
24−import Network.HTTP.Client
25−import Text.Read (Read(..))
26−import qualified Text.Read as TR
27−
28−import Database.Bloodhound.Internal.Analysis
29−import Database.Bloodhound.Internal.Newtypes
30−import Database.Bloodhound.Internal.Query
31−import Database.Bloodhound.Internal.StringlyTyped
32−
33−{-| Common environment for Elasticsearch calls. Connections will be
34− pipelined according to the provided HTTP connection manager.
35−-}
36−data BHEnv = BHEnv { bhServer :: Server
37− , bhManager :: Manager
38− , bhRequestHook :: Request -> IO Request
39− -- ^ Low-level hook that is run before every request is sent. Used to implement custom authentication strategies. Defaults to 'return' with 'mkBHEnv'.
40− }
41−
42−instance (Functor m, Applicative m, MonadIO m) => MonadBH (ReaderT BHEnv m) where
43− getBHEnv = ask
44−
45−{-| 'Server' is used with the client functions to point at the ES instance
46−-}
47−newtype Server = Server Text deriving (Eq, Show, FromJSON)
48−
49−{-| All API calls to Elasticsearch operate within
50− MonadBH
51− . The idea is that it can be easily embedded in your
52− own monad transformer stack. A default instance for a ReaderT and
53− alias 'BH' is provided for the simple case.
54−-}
55−class (Functor m, Applicative m, MonadIO m) => MonadBH m where
56− getBHEnv :: m BHEnv
57−
58−-- | Create a 'BHEnv' with all optional fields defaulted. HTTP hook
59−-- will be a noop. You can use the exported fields to customize
60−-- it further, e.g.:
61−--
62−-- >> (mkBHEnv myServer myManager) { bhRequestHook = customHook }
63−mkBHEnv :: Server -> Manager -> BHEnv
64−mkBHEnv s m = BHEnv s m return
65−
66−newtype BH m a = BH {
67− unBH :: ReaderT BHEnv m a
68− } deriving ( Functor
69− , Applicative
70− , Monad
71− , MonadIO
72− , MonadState s
73− , MonadWriter w
74− , MonadError e
75− , Alternative
76− , MonadPlus
77− , MonadFix
78− , MonadThrow
79− , MonadCatch
80−#if defined(MIN_VERSION_GLASGOW_HASKELL)
81−#if MIN_VERSION_GLASGOW_HASKELL(8,6,0,0)
82− , MonadFail
83−#endif
84−#endif
85− , MonadMask)
86−
87−instance MonadTrans BH where
88− lift = BH . lift
89−
90−instance (MonadReader r m) => MonadReader r (BH m) where
91− ask = lift ask
92− local f (BH (ReaderT m)) = BH $ ReaderT $ \r ->
93− local f (m r)
94−
95−instance (Functor m, Applicative m, MonadIO m) => MonadBH (BH m) where
96− getBHEnv = BH getBHEnv
97−
98−runBH :: BHEnv -> BH m a -> m a
99−runBH e f = runReaderT (unBH f) e
100−
101−{-| 'Version' is embedded in 'Status' -}
102−data Version = Version { number :: VersionNumber
103− , build_hash :: BuildHash
104− , build_date :: UTCTime
105− , build_snapshot :: Bool
106− , lucene_version :: VersionNumber }
107− deriving (Eq, Show)
108−
109−-- | Traditional software versioning number
110−newtype VersionNumber = VersionNumber
111− { versionNumber :: SemVer.Version }
112− deriving (Eq, Ord, Show)
113−
114−{-| 'Status' is a data type for describing the JSON body returned by
115− Elasticsearch when you query its status. This was deprecated in 1.2.0.
116−
117− <http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/indices-status.html#indices-status>
118−-}
119−
120−data Status = Status
121− { name :: Text
122− , cluster_name :: Text
123− , cluster_uuid :: Text
124− , version :: Version
125− , tagline :: Text }
126− deriving (Eq, Show)
127−
128−instance FromJSON Status where
129− parseJSON (Object v) = Status <$>
130− v .: "name" <*>
131− v .: "cluster_name" <*>
132− v .: "cluster_uuid" <*>
133− v .: "version" <*>
134− v .: "tagline"
135− parseJSON _ = empty
136−
137−{-| 'IndexSettings' is used to configure the shards and replicas when
138− you create an Elasticsearch Index.
139−
140− <http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/indices-create-index.html>
141−-}
142−
143−data IndexSettings = IndexSettings
144− { indexShards :: ShardCount
145− , indexReplicas :: ReplicaCount }
146− deriving (Eq, Show)
147−
148−instance ToJSON IndexSettings where
149− toJSON (IndexSettings s r) = object ["settings" .=
150− object ["index" .=
151− object ["number_of_shards" .= s, "number_of_replicas" .= r]
152− ]
153− ]
154−
155−instance FromJSON IndexSettings where
156− parseJSON = withObject "IndexSettings" parse
157− where parse o = do s <- o .: "settings"
158− i <- s .: "index"
159− IndexSettings <$> i .: "number_of_shards"
160− <*> i .: "number_of_replicas"
161−
162−{-| 'defaultIndexSettings' is an 'IndexSettings' with 3 shards and
163− 2 replicas. -}
164−defaultIndexSettings :: IndexSettings
165−defaultIndexSettings = IndexSettings (ShardCount 3) (ReplicaCount 2)
166−-- defaultIndexSettings is exported by Database.Bloodhound as well
167−-- no trailing slashes in servers, library handles building the path.
168−
169−
170−{-| 'ForceMergeIndexSettings' is used to configure index optimization. See
171− <https://www.elastic.co/guide/en/elasticsearch/reference/current/indices-forcemerge.html>
172− for more info.
173−-}
174−data ForceMergeIndexSettings =
175− ForceMergeIndexSettings { maxNumSegments :: Maybe Int
176− -- ^ 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.
177− , onlyExpungeDeletes :: Bool
178− -- ^ 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.
179− , flushAfterOptimize :: Bool
180− -- ^ Should a flush be performed after the optimize.
181− } deriving (Eq, Show)
182−
183−
184−{-| 'defaultForceMergeIndexSettings' implements the default settings that
185− Elasticsearch uses for index optimization. 'maxNumSegments' is Nothing,
186− 'onlyExpungeDeletes' is False, and flushAfterOptimize is True.
187−-}
188−defaultForceMergeIndexSettings :: ForceMergeIndexSettings
189−defaultForceMergeIndexSettings = ForceMergeIndexSettings Nothing False True
190−
191−{-| 'UpdatableIndexSetting' are settings which may be updated after an index is created.
192−
193− <https://www.elastic.co/guide/en/elasticsearch/reference/current/indices-update-settings.html>
194−-}
195−data UpdatableIndexSetting = NumberOfReplicas ReplicaCount
196− -- ^ The number of replicas each shard has.
197− | AutoExpandReplicas ReplicaBounds
198− | BlocksReadOnly Bool
199− -- ^ Set to True to have the index read only. False to allow writes and metadata changes.
200− | BlocksRead Bool
201− -- ^ Set to True to disable read operations against the index.
202− | BlocksWrite Bool
203− -- ^ Set to True to disable write operations against the index.
204− | BlocksMetaData Bool
205− -- ^ Set to True to disable metadata operations against the index.
206− | RefreshInterval NominalDiffTime
207− -- ^ The async refresh interval of a shard
208− | IndexConcurrency Int
209− | FailOnMergeFailure Bool
210− | TranslogFlushThresholdOps Int
211− -- ^ When to flush on operations.
212− | TranslogFlushThresholdSize Bytes
213− -- ^ When to flush based on translog (bytes) size.
214− | TranslogFlushThresholdPeriod NominalDiffTime
215− -- ^ When to flush based on a period of not flushing.
216− | TranslogDisableFlush Bool
217− -- ^ Disables flushing. Note, should be set for a short interval and then enabled.
218− | CacheFilterMaxSize (Maybe Bytes)
219− -- ^ The maximum size of filter cache (per segment in shard).
220− | CacheFilterExpire (Maybe NominalDiffTime)
221− -- ^ The expire after access time for filter cache.
222− | GatewaySnapshotInterval NominalDiffTime
223− -- ^ The gateway snapshot interval (only applies to shared gateways).
224− | RoutingAllocationInclude (NonEmpty NodeAttrFilter)
225− -- ^ A node matching any rule will be allowed to host shards from the index.
226− | RoutingAllocationExclude (NonEmpty NodeAttrFilter)
227− -- ^ A node matching any rule will NOT be allowed to host shards from the index.
228− | RoutingAllocationRequire (NonEmpty NodeAttrFilter)
229− -- ^ Only nodes matching all rules will be allowed to host shards from the index.
230− | RoutingAllocationEnable AllocationPolicy
231− -- ^ Enables shard allocation for a specific index.
232− | RoutingAllocationShardsPerNode ShardCount
233− -- ^ Controls the total number of shards (replicas and primaries) allowed to be allocated on a single node.
234− | RecoveryInitialShards InitialShardCount
235− -- ^ When using local gateway a particular shard is recovered only if there can be allocated quorum shards in the cluster.
236− | GCDeletes NominalDiffTime
237− | TTLDisablePurge Bool
238− -- ^ Disables temporarily the purge of expired docs.
239− | TranslogFSType FSType
240− | CompressionSetting Compression
241− | IndexCompoundFormat CompoundFormat
242− | IndexCompoundOnFlush Bool
243− | WarmerEnabled Bool
244− | MappingTotalFieldsLimit Int
245− | AnalysisSetting Analysis
246− -- ^ Analysis is not a dynamic setting and can only be performed on a closed index.
247− deriving (Eq, Show)
248−
249−attrFilterJSON :: NonEmpty NodeAttrFilter -> Value
250−attrFilterJSON fs = object [ n .= T.intercalate "," (toList vs)
251− | NodeAttrFilter (NodeAttrName n) vs <- toList fs]
252−
253−parseAttrFilter :: Value -> Parser (NonEmpty NodeAttrFilter)
254−parseAttrFilter = withObject "NonEmpty NodeAttrFilter" parse
255− where parse o = case HM.toList o of
256− [] -> fail "Expected non-empty list of NodeAttrFilters"
257− x:xs -> DT.mapM (uncurry parse') (x :| xs)
258− parse' n = withText "Text" $ \t ->
259− case T.splitOn "," t of
260− fv:fvs -> return (NodeAttrFilter (NodeAttrName n) (fv :| fvs))
261− [] -> fail "Expected non-empty list of filter values"
262−
263−instance ToJSON UpdatableIndexSetting where
264− toJSON (NumberOfReplicas x) = oPath ("index" :| ["number_of_replicas"]) x
265− toJSON (AutoExpandReplicas x) = oPath ("index" :| ["auto_expand_replicas"]) x
266− toJSON (RefreshInterval x) = oPath ("index" :| ["refresh_interval"]) (NominalDiffTimeJSON x)
267− toJSON (IndexConcurrency x) = oPath ("index" :| ["concurrency"]) x
268− toJSON (FailOnMergeFailure x) = oPath ("index" :| ["fail_on_merge_failure"]) x
269− toJSON (TranslogFlushThresholdOps x) = oPath ("index" :| ["translog", "flush_threshold_ops"]) x
270− toJSON (TranslogFlushThresholdSize x) = oPath ("index" :| ["translog", "flush_threshold_size"]) x
271− toJSON (TranslogFlushThresholdPeriod x) = oPath ("index" :| ["translog", "flush_threshold_period"]) (NominalDiffTimeJSON x)
272− toJSON (TranslogDisableFlush x) = oPath ("index" :| ["translog", "disable_flush"]) x
273− toJSON (CacheFilterMaxSize x) = oPath ("index" :| ["cache", "filter", "max_size"]) x
274− toJSON (CacheFilterExpire x) = oPath ("index" :| ["cache", "filter", "expire"]) (NominalDiffTimeJSON <$> x)
275− toJSON (GatewaySnapshotInterval x) = oPath ("index" :| ["gateway", "snapshot_interval"]) (NominalDiffTimeJSON x)
276− toJSON (RoutingAllocationInclude fs) = oPath ("index" :| ["routing", "allocation", "include"]) (attrFilterJSON fs)
277− toJSON (RoutingAllocationExclude fs) = oPath ("index" :| ["routing", "allocation", "exclude"]) (attrFilterJSON fs)
278− toJSON (RoutingAllocationRequire fs) = oPath ("index" :| ["routing", "allocation", "require"]) (attrFilterJSON fs)
279− toJSON (RoutingAllocationEnable x) = oPath ("index" :| ["routing", "allocation", "enable"]) x
280− toJSON (RoutingAllocationShardsPerNode x) = oPath ("index" :| ["routing", "allocation", "total_shards_per_node"]) x
281− toJSON (RecoveryInitialShards x) = oPath ("index" :| ["recovery", "initial_shards"]) x
282− toJSON (GCDeletes x) = oPath ("index" :| ["gc_deletes"]) (NominalDiffTimeJSON x)
283− toJSON (TTLDisablePurge x) = oPath ("index" :| ["ttl", "disable_purge"]) x
284− toJSON (TranslogFSType x) = oPath ("index" :| ["translog", "fs", "type"]) x
285− toJSON (CompressionSetting x) = oPath ("index" :| ["codec"]) x
286− toJSON (IndexCompoundFormat x) = oPath ("index" :| ["compound_format"]) x
287− toJSON (IndexCompoundOnFlush x) = oPath ("index" :| ["compound_on_flush"]) x
288− toJSON (WarmerEnabled x) = oPath ("index" :| ["warmer", "enabled"]) x
289− toJSON (BlocksReadOnly x) = oPath ("blocks" :| ["read_only"]) x
290− toJSON (BlocksRead x) = oPath ("blocks" :| ["read"]) x
291− toJSON (BlocksWrite x) = oPath ("blocks" :| ["write"]) x
292− toJSON (BlocksMetaData x) = oPath ("blocks" :| ["metadata"]) x
293− toJSON (MappingTotalFieldsLimit x) = oPath ("index" :| ["mapping","total_fields","limit"]) x
294− toJSON (AnalysisSetting x) = oPath ("index" :| ["analysis"]) x
295−
296−instance FromJSON UpdatableIndexSetting where
297− parseJSON = withObject "UpdatableIndexSetting" parse
298− where parse o = numberOfReplicas `taggedAt` ["index", "number_of_replicas"]
299− <|> autoExpandReplicas `taggedAt` ["index", "auto_expand_replicas"]
300− <|> refreshInterval `taggedAt` ["index", "refresh_interval"]
301− <|> indexConcurrency `taggedAt` ["index", "concurrency"]
302− <|> failOnMergeFailure `taggedAt` ["index", "fail_on_merge_failure"]
303− <|> translogFlushThresholdOps `taggedAt` ["index", "translog", "flush_threshold_ops"]
304− <|> translogFlushThresholdSize `taggedAt` ["index", "translog", "flush_threshold_size"]
305− <|> translogFlushThresholdPeriod `taggedAt` ["index", "translog", "flush_threshold_period"]
306− <|> translogDisableFlush `taggedAt` ["index", "translog", "disable_flush"]
307− <|> cacheFilterMaxSize `taggedAt` ["index", "cache", "filter", "max_size"]
308− <|> cacheFilterExpire `taggedAt` ["index", "cache", "filter", "expire"]
309− <|> gatewaySnapshotInterval `taggedAt` ["index", "gateway", "snapshot_interval"]
310− <|> routingAllocationInclude `taggedAt` ["index", "routing", "allocation", "include"]
311− <|> routingAllocationExclude `taggedAt` ["index", "routing", "allocation", "exclude"]
312− <|> routingAllocationRequire `taggedAt` ["index", "routing", "allocation", "require"]
313− <|> routingAllocationEnable `taggedAt` ["index", "routing", "allocation", "enable"]
314− <|> routingAllocationShardsPerNode `taggedAt` ["index", "routing", "allocation", "total_shards_per_node"]
315− <|> recoveryInitialShards `taggedAt` ["index", "recovery", "initial_shards"]
316− <|> gcDeletes `taggedAt` ["index", "gc_deletes"]
317− <|> ttlDisablePurge `taggedAt` ["index", "ttl", "disable_purge"]
318− <|> translogFSType `taggedAt` ["index", "translog", "fs", "type"]
319− <|> compressionSetting `taggedAt` ["index", "codec"]
320− <|> compoundFormat `taggedAt` ["index", "compound_format"]
321− <|> compoundOnFlush `taggedAt` ["index", "compound_on_flush"]
322− <|> warmerEnabled `taggedAt` ["index", "warmer", "enabled"]
323− <|> blocksReadOnly `taggedAt` ["blocks", "read_only"]
324− <|> blocksRead `taggedAt` ["blocks", "read"]
325− <|> blocksWrite `taggedAt` ["blocks", "write"]
326− <|> blocksMetaData `taggedAt` ["blocks", "metadata"]
327− <|> mappingTotalFieldsLimit `taggedAt` ["index", "mapping", "total_fields", "limit"]
328− <|> analysisSetting `taggedAt` ["index", "analysis"]
329− where taggedAt f ks = taggedAt' f (Object o) ks
330− taggedAt' f v [] =
331− f =<< (parseJSON v <|> parseJSON (unStringlyTypeJSON v))
332− taggedAt' f v (k:ks) =
333− withObject "Object" (\o -> do v' <- o .: k
334− taggedAt' f v' ks) v
335− numberOfReplicas = pure . NumberOfReplicas
336− autoExpandReplicas = pure . AutoExpandReplicas
337− refreshInterval = pure . RefreshInterval . ndtJSON
338− indexConcurrency = pure . IndexConcurrency
339− failOnMergeFailure = pure . FailOnMergeFailure
340− translogFlushThresholdOps = pure . TranslogFlushThresholdOps
341− translogFlushThresholdSize = pure . TranslogFlushThresholdSize
342− translogFlushThresholdPeriod = pure . TranslogFlushThresholdPeriod . ndtJSON
343− translogDisableFlush = pure . TranslogDisableFlush
344− cacheFilterMaxSize = pure . CacheFilterMaxSize
345− cacheFilterExpire = pure . CacheFilterExpire . fmap ndtJSON
346− gatewaySnapshotInterval = pure . GatewaySnapshotInterval . ndtJSON
347− routingAllocationInclude = fmap RoutingAllocationInclude . parseAttrFilter
348− routingAllocationExclude = fmap RoutingAllocationExclude . parseAttrFilter
349− routingAllocationRequire = fmap RoutingAllocationRequire . parseAttrFilter
350− routingAllocationEnable = pure . RoutingAllocationEnable
351− routingAllocationShardsPerNode = pure . RoutingAllocationShardsPerNode
352− recoveryInitialShards = pure . RecoveryInitialShards
353− gcDeletes = pure . GCDeletes . ndtJSON
354− ttlDisablePurge = pure . TTLDisablePurge
355− translogFSType = pure . TranslogFSType
356− compressionSetting = pure . CompressionSetting
357− compoundFormat = pure . IndexCompoundFormat
358− compoundOnFlush = pure . IndexCompoundOnFlush
359− warmerEnabled = pure . WarmerEnabled
360− blocksReadOnly = pure . BlocksReadOnly
361− blocksRead = pure . BlocksRead
362− blocksWrite = pure . BlocksWrite
363− blocksMetaData = pure . BlocksMetaData
364− mappingTotalFieldsLimit = pure . MappingTotalFieldsLimit
365− analysisSetting = pure . AnalysisSetting
366−
367−data ReplicaBounds = ReplicasBounded Int Int
368− | ReplicasLowerBounded Int
369− | ReplicasUnbounded
370− deriving (Eq, Show)
371−
372−
373−instance ToJSON ReplicaBounds where
374− toJSON (ReplicasBounded a b) = String (showText a <> "-" <> showText b)
375− toJSON (ReplicasLowerBounded a) = String (showText a <> "-all")
376− toJSON ReplicasUnbounded = Bool False
377−
378−instance FromJSON ReplicaBounds where
379− parseJSON v = withText "ReplicaBounds" parseText v
380− <|> withBool "ReplicaBounds" parseBool v
381− where parseText t = case T.splitOn "-" t of
382− [a, "all"] -> ReplicasLowerBounded <$> parseReadText a
383− [a, b] -> ReplicasBounded <$> parseReadText a
384− <*> parseReadText b
385− _ -> fail ("Could not parse ReplicaBounds: " <> show t)
386− parseBool False = pure ReplicasUnbounded
387− parseBool _ = fail "ReplicasUnbounded cannot be represented with True"
388−
389−data Compression
390− = CompressionDefault
391− -- ^ Compress with LZ4
392− | CompressionBest
393− -- ^ Compress with DEFLATE. Elastic
394− -- <https://www.elastic.co/blog/elasticsearch-storage-the-true-story-2.0 blogs>
395− -- that this can reduce disk use by 15%-25%.
396− deriving (Eq,Show)
397−
398−instance ToJSON Compression where
399− toJSON x = case x of
400− CompressionDefault -> toJSON ("default" :: Text)
401− CompressionBest -> toJSON ("best_compression" :: Text)
402−
403−instance FromJSON Compression where
404− parseJSON = withText "Compression" $ \t -> case t of
405− "default" -> return CompressionDefault
406− "best_compression" -> return CompressionBest
407− _ -> fail "invalid compression codec"
408−
409−-- | A measure of bytes used for various configurations. You may want
410−-- to use smart constructors like 'gigabytes' for larger values.
411−--
412−-- >>> gigabytes 9
413−-- Bytes 9000000000
414−--
415−-- >>> megabytes 9
416−-- Bytes 9000000
417−--
418−-- >>> kilobytes 9
419−-- Bytes 9000
420−newtype Bytes =
421− Bytes Int
422− deriving (Eq, Show, Ord, ToJSON, FromJSON)
423−
424−gigabytes :: Int -> Bytes
425−gigabytes n = megabytes (1000 * n)
426−
427−
428−megabytes :: Int -> Bytes
429−megabytes n = kilobytes (1000 * n)
430−
431−
432−kilobytes :: Int -> Bytes
433−kilobytes n = Bytes (1000 * n)
434−
435−
436−data FSType = FSSimple
437− | FSBuffered deriving (Eq, Show)
438−
439−instance ToJSON FSType where
440− toJSON FSSimple = "simple"
441− toJSON FSBuffered = "buffered"
442−
443−instance FromJSON FSType where
444− parseJSON = withText "FSType" parse
445− where parse "simple" = pure FSSimple
446− parse "buffered" = pure FSBuffered
447− parse t = fail ("Invalid FSType: " <> show t)
448−
449−data InitialShardCount = QuorumShards
450− | QuorumMinus1Shards
451− | FullShards
452− | FullMinus1Shards
453− | ExplicitShards Int
454− deriving (Eq, Show)
455−
456−instance FromJSON InitialShardCount where
457− parseJSON v = withText "InitialShardCount" parseText v
458− <|> ExplicitShards <$> parseJSON v
459− where parseText "quorum" = pure QuorumShards
460− parseText "quorum-1" = pure QuorumMinus1Shards
461− parseText "full" = pure FullShards
462− parseText "full-1" = pure FullMinus1Shards
463− parseText _ = mzero
464−
465−instance ToJSON InitialShardCount where
466− toJSON QuorumShards = String "quorum"
467− toJSON QuorumMinus1Shards = String "quorum-1"
468− toJSON FullShards = String "full"
469− toJSON FullMinus1Shards = String "full-1"
470− toJSON (ExplicitShards x) = toJSON x
471−
472−data NodeAttrFilter = NodeAttrFilter
473− { nodeAttrFilterName :: NodeAttrName
474− , nodeAttrFilterValues :: NonEmpty Text }
475− deriving (Eq, Ord, Show)
476−
477−newtype NodeAttrName = NodeAttrName Text deriving (Eq, Ord, Show)
478−
479−data CompoundFormat = CompoundFileFormat Bool
480− | MergeSegmentVsTotalIndex Double
481− -- ^ percentage between 0 and 1 where 0 is false, 1 is true
482− deriving (Eq, Show)
483−
484−instance ToJSON CompoundFormat where
485− toJSON (CompoundFileFormat x) = Bool x
486− toJSON (MergeSegmentVsTotalIndex x) = toJSON x
487−
488−instance FromJSON CompoundFormat where
489− parseJSON v = CompoundFileFormat <$> parseJSON v
490− <|> MergeSegmentVsTotalIndex <$> parseJSON v
491−
492−newtype NominalDiffTimeJSON =
493− NominalDiffTimeJSON { ndtJSON :: NominalDiffTime }
494−
495−instance ToJSON NominalDiffTimeJSON where
496− toJSON (NominalDiffTimeJSON t) = String (showText (round t :: Integer) <> "s")
497−
498−instance FromJSON NominalDiffTimeJSON where
499− parseJSON = withText "NominalDiffTime" parse
500− where parse t = case T.takeEnd 1 t of
501− "s" -> NominalDiffTimeJSON . fromInteger <$> parseReadText (T.dropEnd 1 t)
502− _ -> fail "Invalid or missing NominalDiffTime unit (expected s)"
503−
504−data IndexSettingsSummary = IndexSettingsSummary
505− { sSummaryIndexName :: IndexName
506− , sSummaryFixedSettings :: IndexSettings
507− , sSummaryUpdateable :: [UpdatableIndexSetting]}
508− deriving (Eq, Show)
509−
510−parseSettings :: Object -> Parser [UpdatableIndexSetting]
511−parseSettings o = do
512− o' <- o .: "index"
513− -- slice the index object into singleton hashmaps and try to parse each
514− parses <- forM (HM.toList o') $ \(k, v) -> do
515− -- blocks are now nested into the "index" key, which is not how they're serialized
516− let atRoot = Object (HM.singleton k v)
517− let atIndex = Object (HM.singleton "index" atRoot)
518− optional (parseJSON atRoot <|> parseJSON atIndex)
519− return (catMaybes parses)
520−
521−instance FromJSON IndexSettingsSummary where
522− parseJSON = withObject "IndexSettingsSummary" parse
523− where parse o = case HM.toList o of
524− [(ixn, v@(Object o'))] -> IndexSettingsSummary (IndexName ixn)
525− <$> parseJSON v
526− <*> (fmap (filter (not . redundant)) . parseSettings =<< o' .: "settings")
527− _ -> fail "Expected single-key object with index name"
528− redundant (NumberOfReplicas _) = True
529− redundant _ = False
530−
531−{-| 'Reply' and 'Method' are type synonyms from 'Network.HTTP.Types.Method.Method' -}
532−type Reply = Network.HTTP.Client.Response LByteString
533−
534−{-| 'OpenCloseIndex' is a sum type for opening and closing indices.
535−
536− <http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/indices-open-close.html>
537−-}
538−data OpenCloseIndex = OpenIndex | CloseIndex deriving (Eq, Show)
539−
540−data FieldType = GeoPointType
541− | GeoShapeType
542− | FloatType
543− | IntegerType
544− | LongType
545− | ShortType
546− | ByteType deriving (Eq, Show)
547−
548−newtype FieldDefinition = FieldDefinition
549− { fieldType :: FieldType
550− } deriving (Eq, Show)
551−
552−{-| An 'IndexTemplate' defines a template that will automatically be
553− applied to new indices created. The templates include both
554− 'IndexSettings' and mappings, and a simple 'TemplatePattern' that
555− controls if the template will be applied to the index created.
556− Specify mappings as follows: @[toJSON TweetMapping, ...]@
557−
558− https://www.elastic.co/guide/en/elasticsearch/reference/1.7/indices-templates.html
559−-}
560−data IndexTemplate =
561− IndexTemplate { templatePattern :: TemplatePattern
562− , templateSettings :: Maybe IndexSettings
563− , templateMappings :: [Value]
564− }
565−
566−instance ToJSON IndexTemplate where
567− toJSON (IndexTemplate p s m) = merge
568− (object [ "template" .= p
569− , "mappings" .= foldl' merge (object []) m
570− ])
571− (toJSON s)
572− where
573− merge (Object o1) (Object o2) = toJSON $ HM.union o1 o2
574− merge o Null = o
575− merge _ _ = undefined
576−
577−data MappingField =
578− MappingField { mappingFieldName :: FieldName
579− , fieldDefinition :: FieldDefinition }
580− deriving (Eq, Show)
581−
582−{-| Support for type reification of 'Mapping's is currently incomplete, for
583− now the mapping API verbiage expects a 'ToJSON'able blob.
584−
585− Indexes have mappings, mappings are schemas for the documents contained
586− in the index. I'd recommend having only one mapping per index, always
587− having a mapping, and keeping different kinds of documents separated
588− if possible.
589−-}
590−data Mapping =
591− Mapping { typeName :: TypeName
592− , mappingFields :: [MappingField] }
593− deriving (Eq, Show)
594−
595−data AllocationPolicy = AllocAll
596− -- ^ Allows shard allocation for all shards.
597− | AllocPrimaries
598− -- ^ Allows shard allocation only for primary shards.
599− | AllocNewPrimaries
600− -- ^ Allows shard allocation only for primary shards for new indices.
601− | AllocNone
602− -- ^ No shard allocation is allowed
603− deriving (Eq, Show)
604−
605−instance ToJSON AllocationPolicy where
606− toJSON AllocAll = String "all"
607− toJSON AllocPrimaries = String "primaries"
608− toJSON AllocNewPrimaries = String "new_primaries"
609− toJSON AllocNone = String "none"
610−
611−instance FromJSON AllocationPolicy where
612− parseJSON = withText "AllocationPolicy" parse
613− where parse "all" = pure AllocAll
614− parse "primaries" = pure AllocPrimaries
615− parse "new_primaries" = pure AllocNewPrimaries
616− parse "none" = pure AllocNone
617− parse t = fail ("Invlaid AllocationPolicy: " <> show t)
618−
619−{-| 'BulkOperation' is a sum type for expressing the four kinds of bulk
620− operation index, create, delete, and update. 'BulkIndex' behaves like an
621− "upsert", 'BulkCreate' will fail if a document already exists at the DocId.
622− Consult the <http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/docs-bulk.html#docs-bulk Bulk API documentation>
623− for further explanation.
624− Warning: Bulk operations suffixed with @Auto@ rely on Elasticsearch to
625− generate the id. Often, people use auto-generated identifiers when
626− Elasticsearch is the only place that their data is stored. Do not let
627− Elasticsearch be the only place your data is stored. It does not guarantee
628− durability, and it may silently discard data.
629− This <https://github.com/elastic/elasticsearch/issues/10708 issue> is
630− discussed further on github.
631−-}
632−data BulkOperation =
633− BulkIndex IndexName MappingName DocId Value
634− -- ^ Create the document, replacing it if it already exists.
635− | BulkIndexAuto IndexName MappingName Value
636− -- ^ Create a document with an autogenerated id.
637− | BulkIndexEncodingAuto IndexName MappingName Encoding
638− -- ^ Create a document with an autogenerated id. Use fast JSON encoding.
639− | BulkCreate IndexName MappingName DocId Value
640− -- ^ Create a document, failing if it already exists.
641− | BulkCreateEncoding IndexName MappingName DocId Encoding
642− -- ^ Create a document, failing if it already exists. Use fast JSON encoding.
643− | BulkDelete IndexName MappingName DocId
644− -- ^ Delete the document
645− | BulkUpdate IndexName MappingName DocId Value
646− -- ^ Update the document, merging the new value with the existing one.
647− deriving (Eq, Show)
648−
649−{-| 'EsResult' describes the standard wrapper JSON document that you see in
650− successful Elasticsearch lookups or lookups that couldn't find the document.
651−-}
652−data EsResult a = EsResult { _index :: Text
653− , _type :: Text
654− , _id :: Text
655− , foundResult :: Maybe (EsResultFound a)} deriving (Eq, Show)
656−
657−{-| 'EsResultFound' contains the document and its metadata inside of an
658− 'EsResult' when the document was successfully found.
659−-}
660−data EsResultFound a =
661− EsResultFound { _version :: DocVersion
662− , _source :: a }
663− deriving (Eq, Show)
664−
665−instance (FromJSON a) => FromJSON (EsResult a) where
666− parseJSON jsonVal@(Object v) = do
667− found <- v .:? "found" .!= False
668− fr <- if found
669− then parseJSON jsonVal
670− else return Nothing
671− EsResult <$> v .: "_index" <*>
672− v .: "_type" <*>
673− v .: "_id" <*>
674− pure fr
675− parseJSON _ = empty
676−
677−instance (FromJSON a) => FromJSON (EsResultFound a) where
678− parseJSON (Object v) = EsResultFound <$>
679− v .: "_version" <*>
680− v .: "_source"
681− parseJSON _ = empty
682−
683−{-| 'EsError' is the generic type that will be returned when there was a
684− problem. If you can't parse the expected response, its a good idea to
685− try parsing this.
686−-}
687−data EsError =
688− EsError { errorStatus :: Int
689− , errorMessage :: Text }
690− deriving (Eq, Show)
691−
692−instance FromJSON EsError where
693− parseJSON (Object v) = EsError <$>
694− v .: "status" <*>
695− (v .: "error" <|> (v .: "error" >>= (.: "reason")))
696− parseJSON _ = empty
697−
698−{-| 'EsProtocolException' will be thrown if Bloodhound cannot parse a response
699−returned by the Elasticsearch server. If you encounter this error, please
700−verify that your domain data types and FromJSON instances are working properly
701−(for example, the 'a' of '[Hit a]' in 'SearchResult.searchHits.hits'). If you're
702−sure that your mappings are correct, then this error may be an indication of an
703−incompatibility between Bloodhound and Elasticsearch. Please open a bug report
704−and be sure to include the exception body.
705−-}
706−data EsProtocolException = EsProtocolException
707− { esProtoExMessage :: !Text
708− , esProtoExBody :: !LByteString
709− } deriving (Eq, Show)
710−
711−instance Exception EsProtocolException
712−
713−data IndexAlias = IndexAlias { srcIndex :: IndexName
714− , indexAlias :: IndexAliasName } deriving (Eq, Show)
715−
716−data IndexAliasAction =
717− AddAlias IndexAlias IndexAliasCreate
718− | RemoveAlias IndexAlias
719− deriving (Eq, Show)
720−
721−data IndexAliasCreate =
722− IndexAliasCreate { aliasCreateRouting :: Maybe AliasRouting
723− , aliasCreateFilter :: Maybe Filter}
724− deriving (Eq, Show)
725−
726−data AliasRouting =
727− AllAliasRouting RoutingValue
728− | GranularAliasRouting (Maybe SearchAliasRouting) (Maybe IndexAliasRouting)
729− deriving (Eq, Show)
730−
731−newtype SearchAliasRouting =
732− SearchAliasRouting (NonEmpty RoutingValue)
733− deriving (Eq, Show)
734−
735−instance ToJSON SearchAliasRouting where
736− toJSON (SearchAliasRouting rvs) = toJSON (T.intercalate "," (routingValue <$> toList rvs))
737−
738−instance FromJSON SearchAliasRouting where
739− parseJSON = withText "SearchAliasRouting" parse
740− where parse t = SearchAliasRouting <$> parseNEJSON (String <$> T.splitOn "," t)
741−
742−newtype IndexAliasRouting =
743− IndexAliasRouting RoutingValue
744− deriving (Eq, Show, ToJSON, FromJSON)
745−
746−newtype RoutingValue =
747− RoutingValue { routingValue :: Text }
748− deriving (Eq, Show, ToJSON, FromJSON)
749−
750−newtype IndexAliasesSummary =
751− IndexAliasesSummary { indexAliasesSummary :: [IndexAliasSummary] }
752− deriving (Eq, Show)
753−
754−instance FromJSON IndexAliasesSummary where
755− parseJSON = withObject "IndexAliasesSummary" parse
756− where parse o = IndexAliasesSummary . mconcat <$> mapM (uncurry go) (HM.toList o)
757− go ixn = withObject "index aliases" $ \ia -> do
758− aliases <- ia .:? "aliases" .!= mempty
759− forM (HM.toList aliases) $ \(aName, v) -> do
760− let indexAlias = IndexAlias (IndexName ixn) (IndexAliasName (IndexName aName))
761− IndexAliasSummary indexAlias <$> parseJSON v
762−
763−
764−instance ToJSON IndexAliasAction where
765− toJSON (AddAlias ia opts) = object ["add" .= (iaObj <> optsObj)]
766− where Object iaObj = toJSON ia
767− Object optsObj = toJSON opts
768− toJSON (RemoveAlias ia) = object ["remove" .= iaObj]
769− where Object iaObj = toJSON ia
770−
771−instance ToJSON IndexAlias where
772− toJSON IndexAlias {..} = object ["index" .= srcIndex
773− , "alias" .= indexAlias
774− ]
775−
776−instance ToJSON IndexAliasCreate where
777− toJSON IndexAliasCreate {..} = Object (filterObj <> routingObj)
778− where filterObj = maybe mempty (HM.singleton "filter" . toJSON) aliasCreateFilter
779− Object routingObj = maybe (Object mempty) toJSON aliasCreateRouting
780−
781−instance ToJSON AliasRouting where
782− toJSON (AllAliasRouting v) = object ["routing" .= v]
783− toJSON (GranularAliasRouting srch idx) = object (catMaybes prs)
784− where prs = [("search_routing" .=) <$> srch
785− ,("index_routing" .=) <$> idx]
786−
787−instance FromJSON AliasRouting where
788− parseJSON = withObject "AliasRouting" parse
789− where parse o = parseAll o <|> parseGranular o
790− parseAll o = AllAliasRouting <$> o .: "routing"
791− parseGranular o = do
792− sr <- o .:? "search_routing"
793− ir <- o .:? "index_routing"
794− if isNothing sr && isNothing ir
795− then fail "Both search_routing and index_routing can't be blank"
796− else return (GranularAliasRouting sr ir)
797−
798−instance FromJSON IndexAliasCreate where
799− parseJSON v = withObject "IndexAliasCreate" parse v
800− where parse o = IndexAliasCreate <$> optional (parseJSON v)
801− <*> o .:? "filter"
802−
803−{-| 'IndexAliasSummary' is a summary of an index alias configured for a server. -}
804−data IndexAliasSummary = IndexAliasSummary
805− { indexAliasSummaryAlias :: IndexAlias
806− , indexAliasSummaryCreate :: IndexAliasCreate }
807− deriving (Eq, Show)
808−
809−{-| 'DocVersion' is an integer version number for a document between 1
810−and 9.2e+18 used for <<https://www.elastic.co/guide/en/elasticsearch/guide/current/optimistic-concurrency-control.html optimistic concurrency control>>.
811−-}
812−newtype DocVersion = DocVersion {
813− docVersionNumber :: Int
814− } deriving (Eq, Show, Ord, ToJSON)
815−
816−-- | Smart constructor for in-range doc version
817−mkDocVersion :: Int -> Maybe DocVersion
818−mkDocVersion i
819− | i >= docVersionNumber minBound
820− && i <= docVersionNumber maxBound =
821− Just $ DocVersion i
822− | otherwise = Nothing
823−
824−instance Bounded DocVersion where
825− minBound = DocVersion 1
826− maxBound = DocVersion 9200000000000000000 -- 9.2e+18
827−
828−instance Enum DocVersion where
829− succ x
830− | x /= maxBound = DocVersion (succ $ docVersionNumber x)
831− | otherwise = succError "DocVersion"
832− pred x
833− | x /= minBound = DocVersion (pred $ docVersionNumber x)
834− | otherwise = predError "DocVersion"
835− toEnum i =
836− fromMaybe (error $ show i ++ " out of DocVersion range") $ mkDocVersion i
837− fromEnum = docVersionNumber
838− enumFrom = boundedEnumFrom
839− enumFromThen = boundedEnumFromThen
840−
841−instance FromJSON DocVersion where
842− parseJSON v = do
843− i <- parseJSON v
844− maybe (fail "DocVersion out of range") return $ mkDocVersion i
845−
846−{-| 'ExternalDocVersion' is a convenience wrapper if your code uses its
847−own version numbers instead of ones from ES.
848−-}
849−newtype ExternalDocVersion = ExternalDocVersion DocVersion
850− deriving (Eq, Show, Ord, Bounded, Enum, ToJSON)
851−
852−{-| 'VersionControl' is specified when indexing documents as a
853−optimistic concurrency control.
854−-}
855−data VersionControl = NoVersionControl
856− -- ^ Don't send a version. This is a pure overwrite.
857− | InternalVersion DocVersion
858− -- ^ Use the default ES versioning scheme. Only
859− -- index the document if the version is the same
860− -- as the one specified. Only applicable to
861− -- updates, as you should be getting Version from
862− -- a search result.
863− | ExternalGT ExternalDocVersion
864− -- ^ Use your own version numbering. Only index
865− -- the document if the version is strictly higher
866− -- OR the document doesn't exist. The given
867− -- version will be used as the new version number
868− -- for the stored document. N.B. All updates must
869− -- increment this number, meaning there is some
870− -- global, external ordering of updates.
871− | ExternalGTE ExternalDocVersion
872− -- ^ Use your own version numbering. Only index
873− -- the document if the version is equal or higher
874− -- than the stored version. Will succeed if there
875− -- is no existing document. The given version will
876− -- be used as the new version number for the
877− -- stored document. Use with care, as this could
878− -- result in data loss.
879− | ForceVersion ExternalDocVersion
880− -- ^ The document will always be indexed and the
881− -- given version will be the new version. This is
882− -- typically used for correcting errors. Use with
883− -- care, as this could result in data loss.
884− deriving (Eq, Show, Ord)
885−
886−{-| 'DocumentParent' is used to specify a parent document.
887−-}
888−newtype DocumentParent = DocumentParent DocId
889− deriving (Eq, Show)
890−
891−{-| 'IndexDocumentSettings' are special settings supplied when indexing
892−a document. For the best backwards compatiblity when new fields are
893−added, you should probably prefer to start with 'defaultIndexDocumentSettings'
894−-}
895−data IndexDocumentSettings =
896− IndexDocumentSettings { idsVersionControl :: VersionControl
897− , idsParent :: Maybe DocumentParent
898− } deriving (Eq, Show)
899−
900−{-| Reasonable default settings. Chooses no version control and no parent.
901−-}
902−defaultIndexDocumentSettings :: IndexDocumentSettings
903−defaultIndexDocumentSettings = IndexDocumentSettings NoVersionControl Nothing
904−
905−{-| 'IndexSelection' is used for APIs which take a single index, a list of
906− indexes, or the special @_all@ index.
907−-}
908−--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.
909−data IndexSelection =
910− IndexList (NonEmpty IndexName)
911− | AllIndexes
912− deriving (Eq, Show)
913−
914−{-| '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.
915−-}
916−data NodeSelection =
917− LocalNode
918− -- ^ Whatever node receives this request
919− | NodeList (NonEmpty NodeSelector)
920− | AllNodes
921− deriving (Eq, Show)
922−
923−
924−-- | An exact match or pattern to identify a node. Note that All of
925−-- these options support wildcarding, so your node name, server, attr
926−-- name can all contain * characters to be a fuzzy match.
927−data NodeSelector =
928− NodeByName NodeName
929− | NodeByFullNodeId FullNodeId
930− | NodeByHost Server
931− -- ^ e.g. 10.0.0.1 or even 10.0.0.*
932− | NodeByAttribute NodeAttrName Text
933− -- ^ NodeAttrName can be a pattern, e.g. rack*. The value can too.
934− deriving (Eq, Show)
935−
936−{-| 'TemplateName' is used to describe which template to query/create/delete
937−-}
938−newtype TemplateName = TemplateName Text deriving (Eq, Show, ToJSON, FromJSON)
939−
940−{-| 'TemplatePattern' represents a pattern which is matched against index names
941−-}
942−newtype TemplatePattern = TemplatePattern Text deriving (Eq, Show, ToJSON, FromJSON)
943−
944−-- | Username type used for HTTP Basic authentication. See 'basicAuthHook'.
945−newtype EsUsername = EsUsername { esUsername :: Text } deriving (Read, Show, Eq)
946−
947−-- | Password type used for HTTP Basic authentication. See 'basicAuthHook'.
948−newtype EsPassword = EsPassword { esPassword :: Text } deriving (Read, Show, Eq)
949−
950−
951−data SnapshotRepoSelection =
952− SnapshotRepoList (NonEmpty SnapshotRepoPattern)
953− | AllSnapshotRepos
954− deriving (Eq, Show)
955−
956−
957−-- | Either specifies an exact repo name or one with globs in it,
958−-- e.g. @RepoPattern "foo*"@ __NOTE__: Patterns are not supported on ES < 1.7
959−data SnapshotRepoPattern =
960− ExactRepo SnapshotRepoName
961− | RepoPattern Text
962− deriving (Eq, Show)
963−
964−-- | The unique name of a snapshot repository.
965−newtype SnapshotRepoName =
966− SnapshotRepoName { snapshotRepoName :: Text }
967− deriving (Eq, Ord, Show, ToJSON, FromJSON)
968−
969−
970−-- | A generic representation of a snapshot repo. This is what gets
971−-- sent to and parsed from the server. For repo types enabled by
972−-- plugins that aren't exported by this library, consider making a
973−-- custom type which implements 'SnapshotRepo'. If it is a common repo
974−-- type, consider submitting a pull request to have it included in the
975−-- library proper
976−data GenericSnapshotRepo = GenericSnapshotRepo {
977− gSnapshotRepoName :: SnapshotRepoName
978− , gSnapshotRepoType :: SnapshotRepoType
979− , gSnapshotRepoSettings :: GenericSnapshotRepoSettings
980− } deriving (Eq, Show)
981−
982−
983−instance SnapshotRepo GenericSnapshotRepo where
984− toGSnapshotRepo = id
985− fromGSnapshotRepo = Right
986−
987−
988−newtype SnapshotRepoType =
989− SnapshotRepoType { snapshotRepoType :: Text }
990− deriving (Eq, Ord, Show, ToJSON, FromJSON)
991−
992−
993−-- | Opaque representation of snapshot repo settings. Instances of
994−-- 'SnapshotRepo' will produce this.
995−newtype GenericSnapshotRepoSettings =
996− GenericSnapshotRepoSettings { gSnapshotRepoSettingsObject :: Object }
997− deriving (Eq, Show, ToJSON)
998−
999−
1000− -- Regardless of whether you send strongly typed json, my version of
1001− -- ES sends back stringly typed json in the settings, e.g. booleans
1002− -- as strings, so we'll try to convert them.
1003−instance FromJSON GenericSnapshotRepoSettings where
1004− parseJSON = fmap (GenericSnapshotRepoSettings . fmap unStringlyTypeJSON). parseJSON
1005−
1006−-- | The result of running 'verifySnapshotRepo'.
1007−newtype SnapshotVerification =
1008− SnapshotVerification {
1009− snapshotNodeVerifications :: [SnapshotNodeVerification]
1010− } deriving (Eq, Show)
1011−
1012−
1013−instance FromJSON SnapshotVerification where
1014− parseJSON = withObject "SnapshotVerification" parse
1015− where
1016− parse o = do
1017− o2 <- o .: "nodes"
1018− SnapshotVerification <$> mapM (uncurry parse') (HM.toList o2)
1019− parse' rawFullId = withObject "SnapshotNodeVerification" $ \o ->
1020− SnapshotNodeVerification (FullNodeId rawFullId) <$> o .: "name"
1021−
1022−
1023−-- | A node that has verified a snapshot
1024−data SnapshotNodeVerification = SnapshotNodeVerification {
1025− snvFullId :: FullNodeId
1026− , snvNodeName :: NodeName
1027− } deriving (Eq, Show)
1028−
1029−
1030−-- | Unique, automatically-generated name assigned to nodes that are
1031−-- usually returned in node-oriented APIs.
1032−newtype FullNodeId = FullNodeId { fullNodeId :: Text }
1033− deriving (Eq, Ord, Show, FromJSON)
1034−
1035−
1036−-- | A human-readable node name that is supplied by the user in the
1037−-- node config or automatically generated by Elasticsearch.
1038−newtype NodeName = NodeName { nodeName :: Text }
1039− deriving (Eq, Ord, Show, FromJSON)
1040−
1041−newtype ClusterName = ClusterName { clusterName :: Text }
1042− deriving (Eq, Ord, Show, FromJSON)
1043−
1044−data NodesInfo = NodesInfo {
1045− nodesInfo :: [NodeInfo]
1046− , nodesClusterName :: ClusterName
1047− } deriving (Eq, Show)
1048−
1049−data NodesStats = NodesStats {
1050− nodesStats :: [NodeStats]
1051− , nodesStatsClusterName :: ClusterName
1052− } deriving (Eq, Show)
1053−
1054−data NodeStats = NodeStats {
1055− nodeStatsName :: NodeName
1056− , nodeStatsFullId :: FullNodeId
1057− , nodeStatsBreakersStats :: Maybe NodeBreakersStats
1058− , nodeStatsHTTP :: NodeHTTPStats
1059− , nodeStatsTransport :: NodeTransportStats
1060− , nodeStatsFS :: NodeFSStats
1061− , nodeStatsNetwork :: Maybe NodeNetworkStats
1062− , nodeStatsThreadPool :: NodeThreadPoolsStats
1063− , nodeStatsJVM :: NodeJVMStats
1064− , nodeStatsProcess :: NodeProcessStats
1065− , nodeStatsOS :: NodeOSStats
1066− , nodeStatsIndices :: NodeIndicesStats
1067− } deriving (Eq, Show)
1068−
1069−data NodeBreakersStats = NodeBreakersStats {
1070− nodeStatsParentBreaker :: NodeBreakerStats
1071− , nodeStatsRequestBreaker :: NodeBreakerStats
1072− , nodeStatsFieldDataBreaker :: NodeBreakerStats
1073− } deriving (Eq, Show)
1074−
1075−data NodeBreakerStats = NodeBreakerStats {
1076− nodeBreakersTripped :: Int
1077− , nodeBreakersOverhead :: Double
1078− , nodeBreakersEstSize :: Bytes
1079− , nodeBreakersLimitSize :: Bytes
1080− } deriving (Eq, Show)
1081−
1082−data NodeHTTPStats = NodeHTTPStats {
1083− nodeHTTPTotalOpened :: Int
1084− , nodeHTTPCurrentOpen :: Int
1085− } deriving (Eq, Show)
1086−
1087−data NodeTransportStats = NodeTransportStats {
1088− nodeTransportTXSize :: Bytes
1089− , nodeTransportCount :: Int
1090− , nodeTransportRXSize :: Bytes
1091− , nodeTransportRXCount :: Int
1092− , nodeTransportServerOpen :: Int
1093− } deriving (Eq, Show)
1094−
1095−data NodeFSStats = NodeFSStats {
1096− nodeFSDataPaths :: [NodeDataPathStats]
1097− , nodeFSTotal :: NodeFSTotalStats
1098− , nodeFSTimestamp :: UTCTime
1099− } deriving (Eq, Show)
1100−
1101−data NodeDataPathStats = NodeDataPathStats {
1102− nodeDataPathDiskServiceTime :: Maybe Double
1103− , nodeDataPathDiskQueue :: Maybe Double
1104− , nodeDataPathIOSize :: Maybe Bytes
1105− , nodeDataPathWriteSize :: Maybe Bytes
1106− , nodeDataPathReadSize :: Maybe Bytes
1107− , nodeDataPathIOOps :: Maybe Int
1108− , nodeDataPathWrites :: Maybe Int
1109− , nodeDataPathReads :: Maybe Int
1110− , nodeDataPathAvailable :: Bytes
1111− , nodeDataPathFree :: Bytes
1112− , nodeDataPathTotal :: Bytes
1113− , nodeDataPathType :: Maybe Text
1114− , nodeDataPathDevice :: Maybe Text
1115− , nodeDataPathMount :: Text
1116− , nodeDataPathPath :: Text
1117− } deriving (Eq, Show)
1118−
1119−data NodeFSTotalStats = NodeFSTotalStats {
1120− nodeFSTotalDiskServiceTime :: Maybe Double
1121− , nodeFSTotalDiskQueue :: Maybe Double
1122− , nodeFSTotalIOSize :: Maybe Bytes
1123− , nodeFSTotalWriteSize :: Maybe Bytes
1124− , nodeFSTotalReadSize :: Maybe Bytes
1125− , nodeFSTotalIOOps :: Maybe Int
1126− , nodeFSTotalWrites :: Maybe Int
1127− , nodeFSTotalReads :: Maybe Int
1128− , nodeFSTotalAvailable :: Bytes
1129− , nodeFSTotalFree :: Bytes
1130− , nodeFSTotalTotal :: Bytes
1131− } deriving (Eq, Show)
1132−
1133−data NodeNetworkStats = NodeNetworkStats {
1134− nodeNetTCPOutRSTs :: Int
1135− , nodeNetTCPInErrs :: Int
1136− , nodeNetTCPAttemptFails :: Int
1137− , nodeNetTCPEstabResets :: Int
1138− , nodeNetTCPRetransSegs :: Int
1139− , nodeNetTCPOutSegs :: Int
1140− , nodeNetTCPInSegs :: Int
1141− , nodeNetTCPCurrEstab :: Int
1142− , nodeNetTCPPassiveOpens :: Int
1143− , nodeNetTCPActiveOpens :: Int
1144− } deriving (Eq, Show)
1145−
1146−data NodeThreadPoolsStats = NodeThreadPoolsStats {
1147− nodeThreadPoolsStatsSnapshot :: NodeThreadPoolStats
1148− , nodeThreadPoolsStatsBulk :: NodeThreadPoolStats
1149− , nodeThreadPoolsStatsMerge :: NodeThreadPoolStats
1150− , nodeThreadPoolsStatsGet :: NodeThreadPoolStats
1151− , nodeThreadPoolsStatsManagement :: NodeThreadPoolStats
1152− , nodeThreadPoolsStatsFetchShardStore :: Maybe NodeThreadPoolStats
1153− , nodeThreadPoolsStatsOptimize :: Maybe NodeThreadPoolStats
1154− , nodeThreadPoolsStatsFlush :: NodeThreadPoolStats
1155− , nodeThreadPoolsStatsSearch :: NodeThreadPoolStats
1156− , nodeThreadPoolsStatsWarmer :: NodeThreadPoolStats
1157− , nodeThreadPoolsStatsGeneric :: NodeThreadPoolStats
1158− , nodeThreadPoolsStatsSuggest :: Maybe NodeThreadPoolStats
1159− , nodeThreadPoolsStatsRefresh :: NodeThreadPoolStats
1160− , nodeThreadPoolsStatsIndex :: NodeThreadPoolStats
1161− , nodeThreadPoolsStatsListener :: Maybe NodeThreadPoolStats
1162− , nodeThreadPoolsStatsFetchShardStarted :: Maybe NodeThreadPoolStats
1163− , nodeThreadPoolsStatsPercolate :: Maybe NodeThreadPoolStats
1164− } deriving (Eq, Show)
1165−
1166−data NodeThreadPoolStats = NodeThreadPoolStats {
1167− nodeThreadPoolCompleted :: Int
1168− , nodeThreadPoolLargest :: Int
1169− , nodeThreadPoolRejected :: Int
1170− , nodeThreadPoolActive :: Int
1171− , nodeThreadPoolQueue :: Int
1172− , nodeThreadPoolThreads :: Int
1173− } deriving (Eq, Show)
1174−
1175−data NodeJVMStats = NodeJVMStats {
1176− nodeJVMStatsMappedBufferPool :: JVMBufferPoolStats
1177− , nodeJVMStatsDirectBufferPool :: JVMBufferPoolStats
1178− , nodeJVMStatsGCOldCollector :: JVMGCStats
1179− , nodeJVMStatsGCYoungCollector :: JVMGCStats
1180− , nodeJVMStatsPeakThreadsCount :: Int
1181− , nodeJVMStatsThreadsCount :: Int
1182− , nodeJVMStatsOldPool :: JVMPoolStats
1183− , nodeJVMStatsSurvivorPool :: JVMPoolStats
1184− , nodeJVMStatsYoungPool :: JVMPoolStats
1185− , nodeJVMStatsNonHeapCommitted :: Bytes
1186− , nodeJVMStatsNonHeapUsed :: Bytes
1187− , nodeJVMStatsHeapMax :: Bytes
1188− , nodeJVMStatsHeapCommitted :: Bytes
1189− , nodeJVMStatsHeapUsedPercent :: Int
1190− , nodeJVMStatsHeapUsed :: Bytes
1191− , nodeJVMStatsUptime :: NominalDiffTime
1192− , nodeJVMStatsTimestamp :: UTCTime
1193− } deriving (Eq, Show)
1194−
1195−data JVMBufferPoolStats = JVMBufferPoolStats {
1196− jvmBufferPoolStatsTotalCapacity :: Bytes
1197− , jvmBufferPoolStatsUsed :: Bytes
1198− , jvmBufferPoolStatsCount :: Int
1199− } deriving (Eq, Show)
1200−
1201−data JVMGCStats = JVMGCStats {
1202− jvmGCStatsCollectionTime :: NominalDiffTime
1203− , jvmGCStatsCollectionCount :: Int
1204− } deriving (Eq, Show)
1205−
1206−data JVMPoolStats = JVMPoolStats {
1207− jvmPoolStatsPeakMax :: Bytes
1208− , jvmPoolStatsPeakUsed :: Bytes
1209− , jvmPoolStatsMax :: Bytes
1210− , jvmPoolStatsUsed :: Bytes
1211− } deriving (Eq, Show)
1212−
1213−data NodeProcessStats = NodeProcessStats {
1214− nodeProcessTimestamp :: UTCTime
1215− , nodeProcessOpenFDs :: Int
1216− , nodeProcessMaxFDs :: Int
1217− , nodeProcessCPUPercent :: Int
1218− , nodeProcessCPUTotal :: NominalDiffTime
1219− , nodeProcessMemTotalVirtual :: Bytes
1220− } deriving (Eq, Show)
1221−
1222−data NodeOSStats = NodeOSStats {
1223− nodeOSTimestamp :: UTCTime
1224− , nodeOSCPUPercent :: Int
1225− , nodeOSLoad :: Maybe LoadAvgs
1226− , nodeOSMemTotal :: Bytes
1227− , nodeOSMemFree :: Bytes
1228− , nodeOSMemFreePercent :: Int
1229− , nodeOSMemUsed :: Bytes
1230− , nodeOSMemUsedPercent :: Int
1231− , nodeOSSwapTotal :: Bytes
1232− , nodeOSSwapFree :: Bytes
1233− , nodeOSSwapUsed :: Bytes
1234− } deriving (Eq, Show)
1235−
1236−data LoadAvgs = LoadAvgs {
1237− loadAvg1Min :: Double
1238− , loadAvg5Min :: Double
1239− , loadAvg15Min :: Double
1240− } deriving (Eq, Show)
1241−
1242−data NodeIndicesStats = NodeIndicesStats {
1243− nodeIndicesStatsRecoveryThrottleTime :: Maybe NominalDiffTime
1244− , nodeIndicesStatsRecoveryCurrentAsTarget :: Maybe Int
1245− , nodeIndicesStatsRecoveryCurrentAsSource :: Maybe Int
1246− , nodeIndicesStatsQueryCacheMisses :: Maybe Int
1247− , nodeIndicesStatsQueryCacheHits :: Maybe Int
1248− , nodeIndicesStatsQueryCacheEvictions :: Maybe Int
1249− , nodeIndicesStatsQueryCacheSize :: Maybe Bytes
1250− , nodeIndicesStatsSuggestCurrent :: Maybe Int
1251− , nodeIndicesStatsSuggestTime :: Maybe NominalDiffTime
1252− , nodeIndicesStatsSuggestTotal :: Maybe Int
1253− , nodeIndicesStatsTranslogSize :: Bytes
1254− , nodeIndicesStatsTranslogOps :: Int
1255− , nodeIndicesStatsSegFixedBitSetMemory :: Maybe Bytes
1256− , nodeIndicesStatsSegVersionMapMemory :: Bytes
1257− , nodeIndicesStatsSegIndexWriterMaxMemory :: Maybe Bytes
1258− , nodeIndicesStatsSegIndexWriterMemory :: Bytes
1259− , nodeIndicesStatsSegMemory :: Bytes
1260− , nodeIndicesStatsSegCount :: Int
1261− , nodeIndicesStatsCompletionSize :: Bytes
1262− , nodeIndicesStatsPercolateQueries :: Maybe Int
1263− , nodeIndicesStatsPercolateMemory :: Maybe Bytes
1264− , nodeIndicesStatsPercolateCurrent :: Maybe Int
1265− , nodeIndicesStatsPercolateTime :: Maybe NominalDiffTime
1266− , nodeIndicesStatsPercolateTotal :: Maybe Int
1267− , nodeIndicesStatsFieldDataEvictions :: Int
1268− , nodeIndicesStatsFieldDataMemory :: Bytes
1269− , nodeIndicesStatsWarmerTotalTime :: NominalDiffTime
1270− , nodeIndicesStatsWarmerTotal :: Int
1271− , nodeIndicesStatsWarmerCurrent :: Int
1272− , nodeIndicesStatsFlushTotalTime :: NominalDiffTime
1273− , nodeIndicesStatsFlushTotal :: Int
1274− , nodeIndicesStatsRefreshTotalTime :: NominalDiffTime
1275− , nodeIndicesStatsRefreshTotal :: Int
1276− , nodeIndicesStatsMergesTotalSize :: Bytes
1277− , nodeIndicesStatsMergesTotalDocs :: Int
1278− , nodeIndicesStatsMergesTotalTime :: NominalDiffTime
1279− , nodeIndicesStatsMergesTotal :: Int
1280− , nodeIndicesStatsMergesCurrentSize :: Bytes
1281− , nodeIndicesStatsMergesCurrentDocs :: Int
1282− , nodeIndicesStatsMergesCurrent :: Int
1283− , nodeIndicesStatsSearchFetchCurrent :: Int
1284− , nodeIndicesStatsSearchFetchTime :: NominalDiffTime
1285− , nodeIndicesStatsSearchFetchTotal :: Int
1286− , nodeIndicesStatsSearchQueryCurrent :: Int
1287− , nodeIndicesStatsSearchQueryTime :: NominalDiffTime
1288− , nodeIndicesStatsSearchQueryTotal :: Int
1289− , nodeIndicesStatsSearchOpenContexts :: Int
1290− , nodeIndicesStatsGetCurrent :: Int
1291− , nodeIndicesStatsGetMissingTime :: NominalDiffTime
1292− , nodeIndicesStatsGetMissingTotal :: Int
1293− , nodeIndicesStatsGetExistsTime :: NominalDiffTime
1294− , nodeIndicesStatsGetExistsTotal :: Int
1295− , nodeIndicesStatsGetTime :: NominalDiffTime
1296− , nodeIndicesStatsGetTotal :: Int
1297− , nodeIndicesStatsIndexingThrottleTime :: Maybe NominalDiffTime
1298− , nodeIndicesStatsIndexingIsThrottled :: Maybe Bool
1299− , nodeIndicesStatsIndexingNoopUpdateTotal :: Maybe Int
1300− , nodeIndicesStatsIndexingDeleteCurrent :: Int
1301− , nodeIndicesStatsIndexingDeleteTime :: NominalDiffTime
1302− , nodeIndicesStatsIndexingDeleteTotal :: Int
1303− , nodeIndicesStatsIndexingIndexCurrent :: Int
1304− , nodeIndicesStatsIndexingIndexTime :: NominalDiffTime
1305− , nodeIndicesStatsIndexingTotal :: Int
1306− , nodeIndicesStatsStoreThrottleTime :: NominalDiffTime
1307− , nodeIndicesStatsStoreSize :: Bytes
1308− , nodeIndicesStatsDocsDeleted :: Int
1309− , nodeIndicesStatsDocsCount :: Int
1310− } deriving (Eq, Show)
1311−
1312−-- | A quirky address format used throughout Elasticsearch. An example
1313−-- would be inet[/1.1.1.1:9200]. inet may be a placeholder for a
1314−-- <https://en.wikipedia.org/wiki/Fully_qualified_domain_name FQDN>.
1315−newtype EsAddress = EsAddress { esAddress :: Text }
1316− deriving (Eq, Ord, Show, FromJSON)
1317−
1318−-- | Typically a 7 character hex string.
1319−newtype BuildHash = BuildHash { buildHash :: Text }
1320− deriving (Eq, Ord, Show, FromJSON, ToJSON)
1321−
1322−newtype PluginName = PluginName { pluginName :: Text }
1323− deriving (Eq, Ord, Show, FromJSON)
1324−
1325−data NodeInfo = NodeInfo {
1326− nodeInfoHTTPAddress :: Maybe EsAddress
1327− , nodeInfoBuild :: BuildHash
1328− , nodeInfoESVersion :: VersionNumber
1329− , nodeInfoIP :: Server
1330− , nodeInfoHost :: Server
1331− , nodeInfoTransportAddress :: EsAddress
1332− , nodeInfoName :: NodeName
1333− , nodeInfoFullId :: FullNodeId
1334− , nodeInfoPlugins :: [NodePluginInfo]
1335− , nodeInfoHTTP :: NodeHTTPInfo
1336− , nodeInfoTransport :: NodeTransportInfo
1337− , nodeInfoNetwork :: Maybe NodeNetworkInfo
1338− , nodeInfoThreadPool :: NodeThreadPoolsInfo
1339− , nodeInfoJVM :: NodeJVMInfo
1340− , nodeInfoProcess :: NodeProcessInfo
1341− , nodeInfoOS :: NodeOSInfo
1342− , nodeInfoSettings :: Object
1343− -- ^ The members of the settings objects are not consistent,
1344− -- dependent on plugins, etc.
1345− } deriving (Eq, Show)
1346−
1347−data NodePluginInfo = NodePluginInfo {
1348− nodePluginSite :: Maybe Bool
1349− -- ^ Is this a site plugin?
1350− , nodePluginJVM :: Maybe Bool
1351− -- ^ Is this plugin running on the JVM
1352− , nodePluginDescription :: Text
1353− , nodePluginVersion :: MaybeNA VersionNumber
1354− , nodePluginName :: PluginName
1355− } deriving (Eq, Show)
1356−
1357−data NodeHTTPInfo = NodeHTTPInfo {
1358− nodeHTTPMaxContentLength :: Bytes
1359− , nodeHTTPTransportAddress :: BoundTransportAddress
1360− } deriving (Eq, Show)
1361−
1362−data NodeTransportInfo = NodeTransportInfo {
1363− nodeTransportProfiles :: [BoundTransportAddress]
1364− , nodeTransportAddress :: BoundTransportAddress
1365− } deriving (Eq, Show)
1366−
1367−data BoundTransportAddress = BoundTransportAddress {
1368− publishAddress :: EsAddress
1369− , boundAddress :: [EsAddress]
1370− } deriving (Eq, Show)
1371−
1372−data NodeNetworkInfo = NodeNetworkInfo {
1373− nodeNetworkPrimaryInterface :: NodeNetworkInterface
1374− , nodeNetworkRefreshInterval :: NominalDiffTime
1375− } deriving (Eq, Show)
1376−
1377−newtype MacAddress = MacAddress { macAddress :: Text }
1378− deriving (Eq, Ord, Show, FromJSON)
1379−
1380−newtype NetworkInterfaceName = NetworkInterfaceName { networkInterfaceName :: Text }
1381− deriving (Eq, Ord, Show, FromJSON)
1382−
1383−data NodeNetworkInterface = NodeNetworkInterface {
1384− nodeNetIfaceMacAddress :: MacAddress
1385− , nodeNetIfaceName :: NetworkInterfaceName
1386− , nodeNetIfaceAddress :: Server
1387− } deriving (Eq, Show)
1388−
1389−data NodeThreadPoolsInfo = NodeThreadPoolsInfo {
1390− nodeThreadPoolsRefresh :: NodeThreadPoolInfo
1391− , nodeThreadPoolsManagement :: NodeThreadPoolInfo
1392− , nodeThreadPoolsPercolate :: Maybe NodeThreadPoolInfo
1393− , nodeThreadPoolsListener :: Maybe NodeThreadPoolInfo
1394− , nodeThreadPoolsFetchShardStarted :: Maybe NodeThreadPoolInfo
1395− , nodeThreadPoolsSearch :: NodeThreadPoolInfo
1396− , nodeThreadPoolsFlush :: NodeThreadPoolInfo
1397− , nodeThreadPoolsWarmer :: NodeThreadPoolInfo
1398− , nodeThreadPoolsOptimize :: Maybe NodeThreadPoolInfo
1399− , nodeThreadPoolsBulk :: NodeThreadPoolInfo
1400− , nodeThreadPoolsSuggest :: Maybe NodeThreadPoolInfo
1401− , nodeThreadPoolsMerge :: NodeThreadPoolInfo
1402− , nodeThreadPoolsSnapshot :: NodeThreadPoolInfo
1403− , nodeThreadPoolsGet :: NodeThreadPoolInfo
1404− , nodeThreadPoolsFetchShardStore :: Maybe NodeThreadPoolInfo
1405− , nodeThreadPoolsIndex :: NodeThreadPoolInfo
1406− , nodeThreadPoolsGeneric :: NodeThreadPoolInfo
1407− } deriving (Eq, Show)
1408−
1409−data NodeThreadPoolInfo = NodeThreadPoolInfo {
1410− nodeThreadPoolQueueSize :: ThreadPoolSize
1411− , nodeThreadPoolKeepalive :: Maybe NominalDiffTime
1412− , nodeThreadPoolMin :: Maybe Int
1413− , nodeThreadPoolMax :: Maybe Int
1414− , nodeThreadPoolType :: ThreadPoolType
1415− } deriving (Eq, Show)
1416−
1417−data ThreadPoolSize = ThreadPoolBounded Int
1418− | ThreadPoolUnbounded
1419− deriving (Eq, Show)
1420−
1421−data ThreadPoolType = ThreadPoolScaling
1422− | ThreadPoolFixed
1423− | ThreadPoolCached
1424− deriving (Eq, Show)
1425−
1426−data NodeJVMInfo = NodeJVMInfo {
1427− nodeJVMInfoMemoryPools :: [JVMMemoryPool]
1428− , nodeJVMInfoMemoryPoolsGCCollectors :: [JVMGCCollector]
1429− , nodeJVMInfoMemoryInfo :: JVMMemoryInfo
1430− , nodeJVMInfoStartTime :: UTCTime
1431− , nodeJVMInfoVMVendor :: Text
1432− , nodeJVMVMVersion :: VMVersion
1433− -- ^ JVM doesn't seme to follow normal version conventions
1434− , nodeJVMVMName :: Text
1435− , nodeJVMVersion :: JVMVersion
1436− , nodeJVMPID :: PID
1437− } deriving (Eq, Show)
1438−
1439−-- | We cannot parse JVM version numbers and we're not going to try.
1440−newtype JVMVersion =
1441− JVMVersion { unJVMVersion :: Text }
1442− deriving (Eq, Show)
1443−
1444−instance FromJSON JVMVersion where
1445− parseJSON = withText "JVMVersion" (pure . JVMVersion)
1446−
1447−data JVMMemoryInfo = JVMMemoryInfo {
1448− jvmMemoryInfoDirectMax :: Bytes
1449− , jvmMemoryInfoNonHeapMax :: Bytes
1450− , jvmMemoryInfoNonHeapInit :: Bytes
1451− , jvmMemoryInfoHeapMax :: Bytes
1452− , jvmMemoryInfoHeapInit :: Bytes
1453− } deriving (Eq, Show)
1454−
1455−-- VM version numbers don't appear to be SemVer
1456−-- so we're special casing this jawn.
1457−newtype VMVersion =
1458− VMVersion { unVMVersion :: Text }
1459− deriving (Eq, Show)
1460−
1461−instance ToJSON VMVersion where
1462− toJSON = toJSON . unVMVersion
1463−
1464−instance FromJSON VMVersion where
1465− parseJSON = withText "VMVersion" (pure . VMVersion)
1466−
1467−newtype JVMMemoryPool = JVMMemoryPool {
1468− jvmMemoryPool :: Text
1469− } deriving (Eq, Show, FromJSON)
1470−
1471−newtype JVMGCCollector = JVMGCCollector {
1472− jvmGCCollector :: Text
1473− } deriving (Eq, Show, FromJSON)
1474−
1475−newtype PID = PID {
1476− pid :: Int
1477− } deriving (Eq, Show, FromJSON)
1478−
1479−data NodeOSInfo = NodeOSInfo {
1480− nodeOSRefreshInterval :: NominalDiffTime
1481− , nodeOSName :: Text
1482− , nodeOSArch :: Text
1483− , nodeOSVersion :: VersionNumber
1484− , nodeOSAvailableProcessors :: Int
1485− , nodeOSAllocatedProcessors :: Int
1486− } deriving (Eq, Show)
1487−
1488−data CPUInfo = CPUInfo {
1489− cpuCacheSize :: Bytes
1490− , cpuCoresPerSocket :: Int
1491− , cpuTotalSockets :: Int
1492− , cpuTotalCores :: Int
1493− , cpuMHZ :: Int
1494− , cpuModel :: Text
1495− , cpuVendor :: Text
1496− } deriving (Eq, Show)
1497−
1498−data NodeProcessInfo = NodeProcessInfo {
1499− nodeProcessMLockAll :: Bool
1500− -- ^ See <https://www.elastic.co/guide/en/elasticsearch/reference/current/setup-configuration.html>
1501− , nodeProcessMaxFileDescriptors :: Maybe Int
1502− , nodeProcessId :: PID
1503− , nodeProcessRefreshInterval :: NominalDiffTime
1504− } deriving (Eq, Show)
1505−
1506−data ShardResult =
1507− ShardResult { shardTotal :: Int
1508− , shardsSuccessful :: Int
1509− , shardsFailed :: Int } deriving (Eq, Show)
1510−
1511−instance FromJSON ShardResult where
1512− parseJSON (Object v) = ShardResult <$>
1513− v .: "total" <*>
1514− v .: "successful" <*>
1515− v .: "failed"
1516− parseJSON _ = empty
1517−
1518−data SnapshotState = SnapshotInit
1519− | SnapshotStarted
1520− | SnapshotSuccess
1521− | SnapshotFailed
1522− | SnapshotAborted
1523− | SnapshotMissing
1524− | SnapshotWaiting
1525− deriving (Eq, Show)
1526−
1527−instance FromJSON SnapshotState where
1528− parseJSON = withText "SnapshotState" parse
1529− where
1530− parse "INIT" = return SnapshotInit
1531− parse "STARTED" = return SnapshotStarted
1532− parse "SUCCESS" = return SnapshotSuccess
1533− parse "FAILED" = return SnapshotFailed
1534− parse "ABORTED" = return SnapshotAborted
1535− parse "MISSING" = return SnapshotMissing
1536− parse "WAITING" = return SnapshotWaiting
1537− parse t = fail ("Invalid snapshot state " <> T.unpack t)
1538−
1539−
1540−data SnapshotRestoreSettings = SnapshotRestoreSettings {
1541− snapRestoreWaitForCompletion :: Bool
1542− -- ^ Should the API call return immediately after initializing
1543− -- the restore or wait until completed? Note that if this is
1544− -- enabled, it could wait a long time, so you should adjust your
1545− -- 'ManagerSettings' accordingly to set long timeouts or
1546− -- explicitly handle timeouts.
1547− , snapRestoreIndices :: Maybe IndexSelection
1548− -- ^ Nothing will restore all indices in the snapshot. Just [] is
1549− -- permissable and will essentially be a no-op restore.
1550− , snapRestoreIgnoreUnavailable :: Bool
1551− -- ^ If set to True, any indices that do not exist will be ignored
1552− -- during snapshot rather than failing the restore.
1553− , snapRestoreIncludeGlobalState :: Bool
1554− -- ^ If set to false, will ignore any global state in the snapshot
1555− -- and will not restore it.
1556− , snapRestoreRenamePattern :: Maybe RestoreRenamePattern
1557− -- ^ A regex pattern for matching indices. Used with
1558− -- 'snapRestoreRenameReplacement', the restore can reference the
1559− -- matched index and create a new index name upon restore.
1560− , snapRestoreRenameReplacement :: Maybe (NonEmpty RestoreRenameToken)
1561− -- ^ Expression of how index renames should be constructed.
1562− , snapRestorePartial :: Bool
1563− -- ^ If some indices fail to restore, should the process proceed?
1564− , snapRestoreIncludeAliases :: Bool
1565− -- ^ Should the restore also restore the aliases captured in the
1566− -- snapshot.
1567− , snapRestoreIndexSettingsOverrides :: Maybe RestoreIndexSettings
1568− -- ^ Settings to apply during the restore process. __NOTE:__ This
1569− -- option is not supported in ES < 1.5 and should be set to
1570− -- Nothing in that case.
1571− , snapRestoreIgnoreIndexSettings :: Maybe (NonEmpty Text)
1572− -- ^ This type could be more rich but it isn't clear which
1573− -- settings are allowed to be ignored during restore, so we're
1574− -- going with including this feature in a basic form rather than
1575− -- omitting it. One example here would be
1576− -- "index.refresh_interval". Any setting specified here will
1577− -- revert back to the server default during the restore process.
1578− } deriving (Eq, Show)
1579−
1580−newtype SnapshotRepoUpdateSettings = SnapshotRepoUpdateSettings
1581− { repoUpdateVerify :: Bool
1582− -- ^ After creation/update, synchronously check that nodes can
1583− -- write to this repo. Defaults to True. You may use False if you
1584− -- need a faster response and plan on verifying manually later
1585− -- with 'verifySnapshotRepo'.
1586− } deriving (Eq, Show)
1587−
1588−
1589−-- | Reasonable defaults for repo creation/update
1590−--
1591−-- * repoUpdateVerify True
1592−defaultSnapshotRepoUpdateSettings :: SnapshotRepoUpdateSettings
1593−defaultSnapshotRepoUpdateSettings = SnapshotRepoUpdateSettings True
1594−
1595−
1596−-- | A filesystem-based snapshot repo that ships with
1597−-- Elasticsearch. This is an instance of 'SnapshotRepo' so it can be
1598−-- used with 'updateSnapshotRepo'
1599−data FsSnapshotRepo = FsSnapshotRepo {
1600− fsrName :: SnapshotRepoName
1601− , fsrLocation :: FilePath
1602− , fsrCompressMetadata :: Bool
1603− , fsrChunkSize :: Maybe Bytes
1604− -- ^ Size by which to split large files during snapshotting.
1605− , fsrMaxRestoreBytesPerSec :: Maybe Bytes
1606− -- ^ Throttle node restore rate. If not supplied, defaults to 40mb/sec
1607− , fsrMaxSnapshotBytesPerSec :: Maybe Bytes
1608− -- ^ Throttle node snapshot rate. If not supplied, defaults to 40mb/sec
1609− } deriving (Eq, Show)
1610−
1611−
1612−instance SnapshotRepo FsSnapshotRepo where
1613− toGSnapshotRepo FsSnapshotRepo {..} =
1614− GenericSnapshotRepo fsrName fsRepoType (GenericSnapshotRepoSettings settings)
1615− where
1616− Object settings = object $ [ "location" .= fsrLocation
1617− , "compress" .= fsrCompressMetadata
1618− ] ++ optionalPairs
1619− optionalPairs = catMaybes [ ("chunk_size" .=) <$> fsrChunkSize
1620− , ("max_restore_bytes_per_sec" .=) <$> fsrMaxRestoreBytesPerSec
1621− , ("max_snapshot_bytes_per_sec" .=) <$> fsrMaxSnapshotBytesPerSec
1622− ]
1623− fromGSnapshotRepo GenericSnapshotRepo {..}
1624− | gSnapshotRepoType == fsRepoType = do
1625− let o = gSnapshotRepoSettingsObject gSnapshotRepoSettings
1626− parseRepo $
1627− FsSnapshotRepo gSnapshotRepoName <$> o .: "location"
1628− <*> o .:? "compress" .!= False
1629− <*> o .:? "chunk_size"
1630− <*> o .:? "max_restore_bytes_per_sec"
1631− <*> o .:? "max_snapshot_bytes_per_sec"
1632− | otherwise = Left (RepoTypeMismatch fsRepoType gSnapshotRepoType)
1633−
1634−
1635−parseRepo :: Parser a -> Either SnapshotRepoConversionError a
1636−parseRepo parser = case parseEither (const parser) () of
1637− Left e -> Left (OtherRepoConversionError (T.pack e))
1638− Right a -> Right a
1639−
1640−
1641−fsRepoType :: SnapshotRepoType
1642−fsRepoType = SnapshotRepoType "fs"
1643−
1644−-- | Law: fromGSnapshotRepo (toGSnapshotRepo r) == Right r
1645−class SnapshotRepo r where
1646− toGSnapshotRepo :: r -> GenericSnapshotRepo
1647− fromGSnapshotRepo :: GenericSnapshotRepo -> Either SnapshotRepoConversionError r
1648−
1649−
1650−data SnapshotRepoConversionError = RepoTypeMismatch SnapshotRepoType SnapshotRepoType
1651− -- ^ Expected type and actual type
1652− | OtherRepoConversionError Text
1653− deriving (Show, Eq)
1654−
1655−
1656−instance Exception SnapshotRepoConversionError
1657−
1658−
1659−data SnapshotCreateSettings = SnapshotCreateSettings {
1660− snapWaitForCompletion :: Bool
1661− -- ^ Should the API call return immediately after initializing
1662− -- the snapshot or wait until completed? Note that if this is
1663− -- enabled it could wait a long time, so you should adjust your
1664− -- 'ManagerSettings' accordingly to set long timeouts or
1665− -- explicitly handle timeouts.
1666− , snapIndices :: Maybe IndexSelection
1667− -- ^ Nothing will snapshot all indices. Just [] is permissable and
1668− -- will essentially be a no-op snapshot.
1669− , snapIgnoreUnavailable :: Bool
1670− -- ^ If set to True, any matched indices that don't exist will be
1671− -- ignored. Otherwise it will be an error and fail.
1672− , snapIncludeGlobalState :: Bool
1673− , snapPartial :: Bool
1674− -- ^ If some indices failed to snapshot (e.g. if not all primary
1675− -- shards are available), should the process proceed?
1676− } deriving (Eq, Show)
1677−
1678−
1679−-- | Reasonable defaults for snapshot creation
1680−--
1681−-- * snapWaitForCompletion False
1682−-- * snapIndices Nothing
1683−-- * snapIgnoreUnavailable False
1684−-- * snapIncludeGlobalState True
1685−-- * snapPartial False
1686−defaultSnapshotCreateSettings :: SnapshotCreateSettings
1687−defaultSnapshotCreateSettings = SnapshotCreateSettings {
1688− snapWaitForCompletion = False
1689− , snapIndices = Nothing
1690− , snapIgnoreUnavailable = False
1691− , snapIncludeGlobalState = True
1692− , snapPartial = False
1693− }
1694−
1695−
1696−data SnapshotSelection =
1697− SnapshotList (NonEmpty SnapshotPattern)
1698− | AllSnapshots
1699− deriving (Eq, Show)
1700−
1701−
1702−-- | Either specifies an exact snapshot name or one with globs in it,
1703−-- e.g. @SnapPattern "foo*"@ __NOTE__: Patterns are not supported on
1704−-- ES < 1.7
1705−data SnapshotPattern =
1706− ExactSnap SnapshotName
1707− | SnapPattern Text
1708− deriving (Eq, Show)
1709−
1710−
1711−-- | General information about the state of a snapshot. Has some
1712−-- redundancies with 'SnapshotStatus'
1713−data SnapshotInfo = SnapshotInfo {
1714− snapInfoShards :: ShardResult
1715− , snapInfoFailures :: [SnapshotShardFailure]
1716− , snapInfoDuration :: NominalDiffTime
1717− , snapInfoEndTime :: UTCTime
1718− , snapInfoStartTime :: UTCTime
1719− , snapInfoState :: SnapshotState
1720− , snapInfoIndices :: [IndexName]
1721− , snapInfoName :: SnapshotName
1722− } deriving (Eq, Show)
1723−
1724−
1725−instance FromJSON SnapshotInfo where
1726− parseJSON = withObject "SnapshotInfo" parse
1727− where
1728− parse o = SnapshotInfo <$> o .: "shards"
1729− <*> o .: "failures"
1730− <*> (unMS <$> o .: "duration_in_millis")
1731− <*> (posixMS <$> o .: "end_time_in_millis")
1732− <*> (posixMS <$> o .: "start_time_in_millis")
1733− <*> o .: "state"
1734− <*> o .: "indices"
1735− <*> o .: "snapshot"
1736−
1737−data SnapshotShardFailure = SnapshotShardFailure {
1738− snapShardFailureIndex :: IndexName
1739− , snapShardFailureNodeId :: Maybe NodeName -- I'm not 100% sure this isn't actually 'FullNodeId'
1740− , snapShardFailureReason :: Text
1741− , snapShardFailureShardId :: ShardId
1742− } deriving (Eq, Show)
1743−
1744−
1745−instance FromJSON SnapshotShardFailure where
1746− parseJSON = withObject "SnapshotShardFailure" parse
1747− where
1748− parse o = SnapshotShardFailure <$> o .: "index"
1749− <*> o .:? "node_id"
1750− <*> o .: "reason"
1751− <*> o .: "shard_id"
1752−
1753−-- | Regex-stype pattern, e.g. "index_(.+)" to match index names
1754−newtype RestoreRenamePattern =
1755− RestoreRenamePattern { rrPattern :: Text }
1756− deriving (Eq, Show, Ord, ToJSON)
1757−
1758−
1759−-- | A single token in a index renaming scheme for a restore. These
1760−-- are concatenated into a string before being sent to
1761−-- Elasticsearch. Check out these Java
1762−-- <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.
1763−data RestoreRenameToken = RRTLit Text
1764− -- ^ Just a literal string of characters
1765− | RRSubWholeMatch
1766− -- ^ Equivalent to $0. The entire matched pattern, not any subgroup
1767− | RRSubGroup RRGroupRefNum
1768− -- ^ A specific reference to a group number
1769− deriving (Eq, Show)
1770−
1771−
1772−-- | A group number for regex matching. Only values from 1-9 are
1773−-- supported. Construct with 'mkRRGroupRefNum'
1774−newtype RRGroupRefNum =
1775− RRGroupRefNum { rrGroupRefNum :: Int }
1776− deriving (Eq, Ord, Show)
1777−
1778−instance Bounded RRGroupRefNum where
1779− minBound = RRGroupRefNum 1
1780− maxBound = RRGroupRefNum 9
1781−
1782−
1783−-- | Only allows valid group number references (1-9).
1784−mkRRGroupRefNum :: Int -> Maybe RRGroupRefNum
1785−mkRRGroupRefNum i
1786− | i >= rrGroupRefNum minBound
1787− && i <= rrGroupRefNum maxBound =
1788− Just $ RRGroupRefNum i
1789− | otherwise = Nothing
1790−
1791−-- | Reasonable defaults for snapshot restores
1792−--
1793−-- * snapRestoreWaitForCompletion False
1794−-- * snapRestoreIndices Nothing
1795−-- * snapRestoreIgnoreUnavailable False
1796−-- * snapRestoreIncludeGlobalState True
1797−-- * snapRestoreRenamePattern Nothing
1798−-- * snapRestoreRenameReplacement Nothing
1799−-- * snapRestorePartial False
1800−-- * snapRestoreIncludeAliases True
1801−-- * snapRestoreIndexSettingsOverrides Nothing
1802−-- * snapRestoreIgnoreIndexSettings Nothing
1803−defaultSnapshotRestoreSettings :: SnapshotRestoreSettings
1804−defaultSnapshotRestoreSettings = SnapshotRestoreSettings {
1805− snapRestoreWaitForCompletion = False
1806− , snapRestoreIndices = Nothing
1807− , snapRestoreIgnoreUnavailable = False
1808− , snapRestoreIncludeGlobalState = True
1809− , snapRestoreRenamePattern = Nothing
1810− , snapRestoreRenameReplacement = Nothing
1811− , snapRestorePartial = False
1812− , snapRestoreIncludeAliases = True
1813− , snapRestoreIndexSettingsOverrides = Nothing
1814− , snapRestoreIgnoreIndexSettings = Nothing
1815− }
1816−
1817−
1818−-- | Index settings that can be overridden. The docs only mention you
1819−-- can update number of replicas, but there may be more. You
1820−-- definitely cannot override shard count.
1821−newtype RestoreIndexSettings = RestoreIndexSettings
1822− { restoreOverrideReplicas :: Maybe ReplicaCount
1823− } deriving (Eq, Show)
1824−
1825−
1826−instance ToJSON RestoreIndexSettings where
1827− toJSON RestoreIndexSettings {..} = object prs
1828− where
1829− prs = catMaybes [("index.number_of_replicas" .=) <$> restoreOverrideReplicas]
1830−
1831−
1832−instance FromJSON NodesInfo where
1833− parseJSON = withObject "NodesInfo" parse
1834− where
1835− parse o = do
1836− nodes <- o .: "nodes"
1837− infos <- forM (HM.toList nodes) $ \(fullNID, v) -> do
1838− node <- parseJSON v
1839− parseNodeInfo (FullNodeId fullNID) node
1840− cn <- o .: "cluster_name"
1841− return (NodesInfo infos cn)
1842−
1843−instance FromJSON NodesStats where
1844− parseJSON = withObject "NodesStats" parse
1845− where
1846− parse o = do
1847− nodes <- o .: "nodes"
1848− stats <- forM (HM.toList nodes) $ \(fullNID, v) -> do
1849− node <- parseJSON v
1850− parseNodeStats (FullNodeId fullNID) node
1851− cn <- o .: "cluster_name"
1852− return (NodesStats stats cn)
1853−
1854−instance FromJSON NodeBreakerStats where
1855− parseJSON = withObject "NodeBreakerStats" parse
1856− where
1857− parse o = NodeBreakerStats <$> o .: "tripped"
1858− <*> o .: "overhead"
1859− <*> o .: "estimated_size_in_bytes"
1860− <*> o .: "limit_size_in_bytes"
1861−
1862−instance FromJSON NodeHTTPStats where
1863− parseJSON = withObject "NodeHTTPStats" parse
1864− where
1865− parse o = NodeHTTPStats <$> o .: "total_opened"
1866− <*> o .: "current_open"
1867−
1868−instance FromJSON NodeTransportStats where
1869− parseJSON = withObject "NodeTransportStats" parse
1870− where
1871− parse o = NodeTransportStats <$> o .: "tx_size_in_bytes"
1872− <*> o .: "tx_count"
1873− <*> o .: "rx_size_in_bytes"
1874− <*> o .: "rx_count"
1875− <*> o .: "server_open"
1876−
1877−instance FromJSON NodeFSStats where
1878− parseJSON = withObject "NodeFSStats" parse
1879− where
1880− parse o = NodeFSStats <$> o .: "data"
1881− <*> o .: "total"
1882− <*> (posixMS <$> o .: "timestamp")
1883−
1884−instance FromJSON NodeDataPathStats where
1885− parseJSON = withObject "NodeDataPathStats" parse
1886− where
1887− parse o =
1888− NodeDataPathStats <$> (fmap unStringlyTypedDouble <$> o .:? "disk_service_time")
1889− <*> (fmap unStringlyTypedDouble <$> o .:? "disk_queue")
1890− <*> o .:? "disk_io_size_in_bytes"
1891− <*> o .:? "disk_write_size_in_bytes"
1892− <*> o .:? "disk_read_size_in_bytes"
1893− <*> o .:? "disk_io_op"
1894− <*> o .:? "disk_writes"
1895− <*> o .:? "disk_reads"
1896− <*> o .: "available_in_bytes"
1897− <*> o .: "free_in_bytes"
1898− <*> o .: "total_in_bytes"
1899− <*> o .:? "type"
1900− <*> o .:? "dev"
1901− <*> o .: "mount"
1902− <*> o .: "path"
1903−
1904−instance FromJSON NodeFSTotalStats where
1905− parseJSON = withObject "NodeFSTotalStats" parse
1906− where
1907− parse o = NodeFSTotalStats <$> (fmap unStringlyTypedDouble <$> o .:? "disk_service_time")
1908− <*> (fmap unStringlyTypedDouble <$> o .:? "disk_queue")
1909− <*> o .:? "disk_io_size_in_bytes"
1910− <*> o .:? "disk_write_size_in_bytes"
1911− <*> o .:? "disk_read_size_in_bytes"
1912− <*> o .:? "disk_io_op"
1913− <*> o .:? "disk_writes"
1914− <*> o .:? "disk_reads"
1915− <*> o .: "available_in_bytes"
1916− <*> o .: "free_in_bytes"
1917− <*> o .: "total_in_bytes"
1918−
1919−instance FromJSON NodeNetworkStats where
1920− parseJSON = withObject "NodeNetworkStats" parse
1921− where
1922− parse o = do
1923− tcp <- o .: "tcp"
1924− NodeNetworkStats <$> tcp .: "out_rsts"
1925− <*> tcp .: "in_errs"
1926− <*> tcp .: "attempt_fails"
1927− <*> tcp .: "estab_resets"
1928− <*> tcp .: "retrans_segs"
1929− <*> tcp .: "out_segs"
1930− <*> tcp .: "in_segs"
1931− <*> tcp .: "curr_estab"
1932− <*> tcp .: "passive_opens"
1933− <*> tcp .: "active_opens"
1934−
1935−instance FromJSON NodeThreadPoolsStats where
1936− parseJSON = withObject "NodeThreadPoolsStats" parse
1937− where
1938− parse o = NodeThreadPoolsStats <$> o .: "snapshot"
1939− <*> o .: "bulk"
1940− <*> o .: "force_merge"
1941− <*> o .: "get"
1942− <*> o .: "management"
1943− <*> o .:? "fetch_shard_store"
1944− <*> o .:? "optimize"
1945− <*> o .: "flush"
1946− <*> o .: "search"
1947− <*> o .: "warmer"
1948− <*> o .: "generic"
1949− <*> o .:? "suggest"
1950− <*> o .: "refresh"
1951− <*> o .: "index"
1952− <*> o .:? "listener"
1953− <*> o .:? "fetch_shard_started"
1954− <*> o .:? "percolate"
1955−instance FromJSON NodeThreadPoolStats where
1956− parseJSON = withObject "NodeThreadPoolStats" parse
1957− where
1958− parse o = NodeThreadPoolStats <$> o .: "completed"
1959− <*> o .: "largest"
1960− <*> o .: "rejected"
1961− <*> o .: "active"
1962− <*> o .: "queue"
1963− <*> o .: "threads"
1964−
1965−instance FromJSON NodeJVMStats where
1966− parseJSON = withObject "NodeJVMStats" parse
1967− where
1968− parse o = do
1969− bufferPools <- o .: "buffer_pools"
1970− mapped <- bufferPools .: "mapped"
1971− direct <- bufferPools .: "direct"
1972− gc <- o .: "gc"
1973− collectors <- gc .: "collectors"
1974− oldC <- collectors .: "old"
1975− youngC <- collectors .: "young"
1976− threads <- o .: "threads"
1977− mem <- o .: "mem"
1978− pools <- mem .: "pools"
1979− oldM <- pools .: "old"
1980− survivorM <- pools .: "survivor"
1981− youngM <- pools .: "young"
1982− NodeJVMStats <$> pure mapped
1983− <*> pure direct
1984− <*> pure oldC
1985− <*> pure youngC
1986− <*> threads .: "peak_count"
1987− <*> threads .: "count"
1988− <*> pure oldM
1989− <*> pure survivorM
1990− <*> pure youngM
1991− <*> mem .: "non_heap_committed_in_bytes"
1992− <*> mem .: "non_heap_used_in_bytes"
1993− <*> mem .: "heap_max_in_bytes"
1994− <*> mem .: "heap_committed_in_bytes"
1995− <*> mem .: "heap_used_percent"
1996− <*> mem .: "heap_used_in_bytes"
1997− <*> (unMS <$> o .: "uptime_in_millis")
1998− <*> (posixMS <$> o .: "timestamp")
1999−
2000−instance FromJSON JVMBufferPoolStats where
2001− parseJSON = withObject "JVMBufferPoolStats" parse
2002− where
2003− parse o = JVMBufferPoolStats <$> o .: "total_capacity_in_bytes"
2004− <*> o .: "used_in_bytes"
2005− <*> o .: "count"
2006−
2007−instance FromJSON JVMGCStats where
2008− parseJSON = withObject "JVMGCStats" parse
2009− where
2010− parse o = JVMGCStats <$> (unMS <$> o .: "collection_time_in_millis")
2011− <*> o .: "collection_count"
2012−
2013−instance FromJSON JVMPoolStats where
2014− parseJSON = withObject "JVMPoolStats" parse
2015− where
2016− parse o = JVMPoolStats <$> o .: "peak_max_in_bytes"
2017− <*> o .: "peak_used_in_bytes"
2018− <*> o .: "max_in_bytes"
2019− <*> o .: "used_in_bytes"
2020−
2021−instance FromJSON NodeProcessStats where
2022− parseJSON = withObject "NodeProcessStats" parse
2023− where
2024− parse o = do
2025− mem <- o .: "mem"
2026− cpu <- o .: "cpu"
2027− NodeProcessStats <$> (posixMS <$> o .: "timestamp")
2028− <*> o .: "open_file_descriptors"
2029− <*> o .: "max_file_descriptors"
2030− <*> cpu .: "percent"
2031− <*> (unMS <$> cpu .: "total_in_millis")
2032− <*> mem .: "total_virtual_in_bytes"
2033−
2034−instance FromJSON NodeOSStats where
2035− parseJSON = withObject "NodeOSStats" parse
2036− where
2037− parse o = do
2038− swap <- o .: "swap"
2039− mem <- o .: "mem"
2040− cpu <- o .: "cpu"
2041− load <- o .:? "load_average"
2042− NodeOSStats <$> (posixMS <$> o .: "timestamp")
2043− <*> cpu .: "percent"
2044− <*> pure load
2045− <*> mem .: "total_in_bytes"
2046− <*> mem .: "free_in_bytes"
2047− <*> mem .: "free_percent"
2048− <*> mem .: "used_in_bytes"
2049− <*> mem .: "used_percent"
2050− <*> swap .: "total_in_bytes"
2051− <*> swap .: "free_in_bytes"
2052− <*> swap .: "used_in_bytes"
2053−
2054−instance FromJSON LoadAvgs where
2055− parseJSON = withArray "LoadAvgs" parse
2056− where
2057− parse v = case V.toList v of
2058− [one, five, fifteen] -> LoadAvgs <$> parseJSON one
2059− <*> parseJSON five
2060− <*> parseJSON fifteen
2061− _ -> fail "Expecting a triple of Doubles"
2062−
2063−instance FromJSON NodeIndicesStats where
2064− parseJSON = withObject "NodeIndicesStats" parse
2065− where
2066− parse o = do
2067− let (.::) mv k = case mv of
2068− Just v -> Just <$> v .: k
2069− Nothing -> pure Nothing
2070− mRecovery <- o .:? "recovery"
2071− mQueryCache <- o .:? "query_cache"
2072− mSuggest <- o .:? "suggest"
2073− translog <- o .: "translog"
2074− segments <- o .: "segments"
2075− completion <- o .: "completion"
2076− mPercolate <- o .:? "percolate"
2077− fielddata <- o .: "fielddata"
2078− warmer <- o .: "warmer"
2079− flush <- o .: "flush"
2080− refresh <- o .: "refresh"
2081− merges <- o .: "merges"
2082− search <- o .: "search"
2083− getStats <- o .: "get"
2084− indexing <- o .: "indexing"
2085− store <- o .: "store"
2086− docs <- o .: "docs"
2087− NodeIndicesStats <$> (fmap unMS <$> mRecovery .:: "throttle_time_in_millis")
2088− <*> mRecovery .:: "current_as_target"
2089− <*> mRecovery .:: "current_as_source"
2090− <*> mQueryCache .:: "miss_count"
2091− <*> mQueryCache .:: "hit_count"
2092− <*> mQueryCache .:: "evictions"
2093− <*> mQueryCache .:: "memory_size_in_bytes"
2094− <*> mSuggest .:: "current"
2095− <*> (fmap unMS <$> mSuggest .:: "time_in_millis")
2096− <*> mSuggest .:: "total"
2097− <*> translog .: "size_in_bytes"
2098− <*> translog .: "operations"
2099− <*> segments .:? "fixed_bit_set_memory_in_bytes"
2100− <*> segments .: "version_map_memory_in_bytes"
2101− <*> segments .:? "index_writer_max_memory_in_bytes"
2102− <*> segments .: "index_writer_memory_in_bytes"
2103− <*> segments .: "memory_in_bytes"
2104− <*> segments .: "count"
2105− <*> completion .: "size_in_bytes"
2106− <*> mPercolate .:: "queries"
2107− <*> mPercolate .:: "memory_size_in_bytes"
2108− <*> mPercolate .:: "current"
2109− <*> (fmap unMS <$> mPercolate .:: "time_in_millis")
2110− <*> mPercolate .:: "total"
2111− <*> fielddata .: "evictions"
2112− <*> fielddata .: "memory_size_in_bytes"
2113− <*> (unMS <$> warmer .: "total_time_in_millis")
2114− <*> warmer .: "total"
2115− <*> warmer .: "current"
2116− <*> (unMS <$> flush .: "total_time_in_millis")
2117− <*> flush .: "total"
2118− <*> (unMS <$> refresh .: "total_time_in_millis")
2119− <*> refresh .: "total"
2120− <*> merges .: "total_size_in_bytes"
2121− <*> merges .: "total_docs"
2122− <*> (unMS <$> merges .: "total_time_in_millis")
2123− <*> merges .: "total"
2124− <*> merges .: "current_size_in_bytes"
2125− <*> merges .: "current_docs"
2126− <*> merges .: "current"
2127− <*> search .: "fetch_current"
2128− <*> (unMS <$> search .: "fetch_time_in_millis")
2129− <*> search .: "fetch_total"
2130− <*> search .: "query_current"
2131− <*> (unMS <$> search .: "query_time_in_millis")
2132− <*> search .: "query_total"
2133− <*> search .: "open_contexts"
2134− <*> getStats .: "current"
2135− <*> (unMS <$> getStats .: "missing_time_in_millis")
2136− <*> getStats .: "missing_total"
2137− <*> (unMS <$> getStats .: "exists_time_in_millis")
2138− <*> getStats .: "exists_total"
2139− <*> (unMS <$> getStats .: "time_in_millis")
2140− <*> getStats .: "total"
2141− <*> (fmap unMS <$> indexing .:? "throttle_time_in_millis")
2142− <*> indexing .:? "is_throttled"
2143− <*> indexing .:? "noop_update_total"
2144− <*> indexing .: "delete_current"
2145− <*> (unMS <$> indexing .: "delete_time_in_millis")
2146− <*> indexing .: "delete_total"
2147− <*> indexing .: "index_current"
2148− <*> (unMS <$> indexing .: "index_time_in_millis")
2149− <*> indexing .: "index_total"
2150− <*> (unMS <$> store .: "throttle_time_in_millis")
2151− <*> store .: "size_in_bytes"
2152− <*> docs .: "deleted"
2153− <*> docs .: "count"
2154−
2155−instance FromJSON NodeBreakersStats where
2156− parseJSON = withObject "NodeBreakersStats" parse
2157− where
2158− parse o = NodeBreakersStats <$> o .: "parent"
2159− <*> o .: "request"
2160− <*> o .: "fielddata"
2161−
2162−parseNodeStats :: FullNodeId -> Object -> Parser NodeStats
2163−parseNodeStats fnid o =
2164− NodeStats <$> o .: "name"
2165− <*> pure fnid
2166− <*> o .:? "breakers"
2167− <*> o .: "http"
2168− <*> o .: "transport"
2169− <*> o .: "fs"
2170− <*> o .:? "network"
2171− <*> o .: "thread_pool"
2172− <*> o .: "jvm"
2173− <*> o .: "process"
2174− <*> o .: "os"
2175− <*> o .: "indices"
2176−
2177−parseNodeInfo :: FullNodeId -> Object -> Parser NodeInfo
2178−parseNodeInfo nid o =
2179− NodeInfo <$> o .:? "http_address"
2180− <*> o .: "build_hash"
2181− <*> o .: "version"
2182− <*> o .: "ip"
2183− <*> o .: "host"
2184− <*> o .: "transport_address"
2185− <*> o .: "name"
2186− <*> pure nid
2187− <*> o .: "plugins"
2188− <*> o .: "http"
2189− <*> o .: "transport"
2190− <*> o .:? "network"
2191− <*> o .: "thread_pool"
2192− <*> o .: "jvm"
2193− <*> o .: "process"
2194− <*> o .: "os"
2195− <*> o .: "settings"
2196−
2197−instance FromJSON NodePluginInfo where
2198− parseJSON = withObject "NodePluginInfo" parse
2199− where
2200− parse o = NodePluginInfo <$> o .:? "site"
2201− <*> o .:? "jvm"
2202− <*> o .: "description"
2203− <*> o .: "version"
2204− <*> o .: "name"
2205−
2206−instance FromJSON NodeHTTPInfo where
2207− parseJSON = withObject "NodeHTTPInfo" parse
2208− where
2209− parse o = NodeHTTPInfo <$> o .: "max_content_length_in_bytes"
2210− <*> parseJSON (Object o)
2211−
2212−instance FromJSON BoundTransportAddress where
2213− parseJSON = withObject "BoundTransportAddress" parse
2214− where
2215− parse o = BoundTransportAddress <$> o .: "publish_address"
2216− <*> o .: "bound_address"
2217−
2218−instance FromJSON NodeOSInfo where
2219− parseJSON = withObject "NodeOSInfo" parse
2220− where
2221− parse o =
2222− NodeOSInfo <$> (unMS <$> o .: "refresh_interval_in_millis")
2223− <*> o .: "name"
2224− <*> o .: "arch"
2225− <*> o .: "version"
2226− <*> o .: "available_processors"
2227− <*> o .: "allocated_processors"
2228−
2229−
2230−instance FromJSON CPUInfo where
2231− parseJSON = withObject "CPUInfo" parse
2232− where
2233− parse o = CPUInfo <$> o .: "cache_size_in_bytes"
2234− <*> o .: "cores_per_socket"
2235− <*> o .: "total_sockets"
2236− <*> o .: "total_cores"
2237− <*> o .: "mhz"
2238− <*> o .: "model"
2239− <*> o .: "vendor"
2240−
2241−instance FromJSON NodeProcessInfo where
2242− parseJSON = withObject "NodeProcessInfo" parse
2243− where
2244− parse o = NodeProcessInfo <$> o .: "mlockall"
2245− <*> o .:? "max_file_descriptors"
2246− <*> o .: "id"
2247− <*> (unMS <$> o .: "refresh_interval_in_millis")
2248−
2249−instance FromJSON NodeJVMInfo where
2250− parseJSON = withObject "NodeJVMInfo" parse
2251− where
2252− parse o = NodeJVMInfo <$> o .: "memory_pools"
2253− <*> o .: "gc_collectors"
2254− <*> o .: "mem"
2255− <*> (posixMS <$> o .: "start_time_in_millis")
2256− <*> o .: "vm_vendor"
2257− <*> o .: "vm_version"
2258− <*> o .: "vm_name"
2259− <*> o .: "version"
2260− <*> o .: "pid"
2261−
2262−instance FromJSON JVMMemoryInfo where
2263− parseJSON = withObject "JVMMemoryInfo" parse
2264− where
2265− parse o = JVMMemoryInfo <$> o .: "direct_max_in_bytes"
2266− <*> o .: "non_heap_max_in_bytes"
2267− <*> o .: "non_heap_init_in_bytes"
2268− <*> o .: "heap_max_in_bytes"
2269− <*> o .: "heap_init_in_bytes"
2270−
2271−instance FromJSON NodeThreadPoolsInfo where
2272− parseJSON = withObject "NodeThreadPoolsInfo" parse
2273− where
2274− parse o = NodeThreadPoolsInfo <$> o .: "refresh"
2275− <*> o .: "management"
2276− <*> o .:? "percolate"
2277− <*> o .:? "listener"
2278− <*> o .:? "fetch_shard_started"
2279− <*> o .: "search"
2280− <*> o .: "flush"
2281− <*> o .: "warmer"
2282− <*> o .:? "optimize"
2283− <*> o .: "bulk"
2284− <*> o .:? "suggest"
2285− <*> o .: "force_merge"
2286− <*> o .: "snapshot"
2287− <*> o .: "get"
2288− <*> o .:? "fetch_shard_store"
2289− <*> o .: "index"
2290− <*> o .: "generic"
2291−
2292−instance FromJSON NodeThreadPoolInfo where
2293− parseJSON = withObject "NodeThreadPoolInfo" parse
2294− where
2295− parse o = do
2296− ka <- maybe (return Nothing) (fmap Just . parseStringInterval) =<< o .:? "keep_alive"
2297− NodeThreadPoolInfo <$> (parseJSON . unStringlyTypeJSON =<< o .: "queue_size")
2298− <*> pure ka
2299− <*> o .:? "min"
2300− <*> o .:? "max"
2301− <*> o .: "type"
2302−
2303−data TimeInterval = Weeks
2304− | Days
2305− | Hours
2306− | Minutes
2307− | Seconds deriving Eq
2308−
2309−instance Show TimeInterval where
2310− show Weeks = "w"
2311− show Days = "d"
2312− show Hours = "h"
2313− show Minutes = "m"
2314− show Seconds = "s"
2315−
2316−instance Read TimeInterval where
2317− readPrec = f =<< TR.get
2318− where
2319− f 'w' = return Weeks
2320− f 'd' = return Days
2321− f 'h' = return Hours
2322− f 'm' = return Minutes
2323− f 's' = return Seconds
2324− f _ = fail "TimeInterval expected one of w, d, h, m, s"
2325−
2326−data Interval = Year
2327− | Quarter
2328− | Month
2329− | Week
2330− | Day
2331− | Hour
2332− | Minute
2333− | Second deriving (Eq, Show)
2334−
2335−instance ToJSON Interval where
2336− toJSON Year = "year"
2337− toJSON Quarter = "quarter"
2338− toJSON Month = "month"
2339− toJSON Week = "week"
2340− toJSON Day = "day"
2341− toJSON Hour = "hour"
2342− toJSON Minute = "minute"
2343− toJSON Second = "second"
2344−
2345−parseStringInterval :: (Monad m) => String -> m NominalDiffTime
2346−parseStringInterval s = case span isNumber s of
2347− ("", _) -> fail "Invalid interval"
2348− (nS, unitS) -> case (readMay nS, readMay unitS) of
2349− (Just n, Just unit) -> return (fromInteger (n * unitNDT unit))
2350− (Nothing, _) -> fail "Invalid interval number"
2351− (_, Nothing) -> fail "Invalid interval unit"
2352− where
2353− unitNDT Seconds = 1
2354− unitNDT Minutes = 60
2355− unitNDT Hours = 60 * 60
2356− unitNDT Days = 24 * 60 * 60
2357− unitNDT Weeks = 7 * 24 * 60 * 60
2358−
2359−instance FromJSON ThreadPoolSize where
2360− parseJSON v = parseAsNumber v <|> parseAsString v
2361− where
2362− parseAsNumber = parseAsInt <=< parseJSON
2363− parseAsInt (-1) = return ThreadPoolUnbounded
2364− parseAsInt n
2365− | n >= 0 = return (ThreadPoolBounded n)
2366− | otherwise = fail "Thread pool size must be >= -1."
2367− parseAsString = withText "ThreadPoolSize" $ \t ->
2368− case first (readMay . T.unpack) (T.span isNumber t) of
2369− (Just n, "k") -> return (ThreadPoolBounded (n * 1000))
2370− (Just n, "") -> return (ThreadPoolBounded n)
2371− _ -> fail ("Invalid thread pool size " <> T.unpack t)
2372−
2373−instance FromJSON ThreadPoolType where
2374− parseJSON = withText "ThreadPoolType" parse
2375− where
2376− parse "scaling" = return ThreadPoolScaling
2377− parse "fixed" = return ThreadPoolFixed
2378− parse "cached" = return ThreadPoolCached
2379− parse e = fail ("Unexpected thread pool type" <> T.unpack e)
2380−
2381−instance FromJSON NodeTransportInfo where
2382− parseJSON = withObject "NodeTransportInfo" parse
2383− where
2384− parse o = NodeTransportInfo <$> (maybe (return mempty) parseProfiles =<< o .:? "profiles")
2385− <*> parseJSON (Object o)
2386− parseProfiles (Object o) | HM.null o = return []
2387− parseProfiles v@(Array _) = parseJSON v
2388− parseProfiles Null = return []
2389− parseProfiles _ = fail "Could not parse profiles"
2390−
2391−instance FromJSON NodeNetworkInfo where
2392− parseJSON = withObject "NodeNetworkInfo" parse
2393− where
2394− parse o = NodeNetworkInfo <$> o .: "primary_interface"
2395− <*> (unMS <$> o .: "refresh_interval_in_millis")
2396−
2397−
2398−instance FromJSON NodeNetworkInterface where
2399− parseJSON = withObject "NodeNetworkInterface" parse
2400− where
2401− parse o = NodeNetworkInterface <$> o .: "mac_address"
2402− <*> o .: "name"
2403− <*> o .: "address"
2404−
2405−
2406−instance ToJSON Version where
2407− toJSON Version {..} = object ["number" .= number
2408− ,"build_hash" .= build_hash
2409− ,"build_date" .= build_date
2410− ,"build_snapshot" .= build_snapshot
2411− ,"lucene_version" .= lucene_version]
2412−
2413−instance FromJSON Version where
2414− parseJSON = withObject "Version" parse
2415− where parse o = Version
2416− <$> o .: "number"
2417− <*> o .: "build_hash"
2418− <*> o .: "build_date"
2419− <*> o .: "build_snapshot"
2420− <*> o .: "lucene_version"
2421−
2422−instance ToJSON VersionNumber where
2423− toJSON = toJSON . SemVer.toText . versionNumber
2424−
2425−instance FromJSON VersionNumber where
2426− parseJSON = withText "VersionNumber" parse
2427− where
2428− parse t =
2429− case SemVer.fromText t of
2430− (Left err) -> fail err
2431− (Right v) -> return (VersionNumber v)
src/Database/Bloodhound/Internal/Highlight.hsdeleted−164
@@ -1,164 +0,0 @@
1−{-# LANGUAGE GeneralizedNewtypeDeriving #-}
2−{-# LANGUAGE OverloadedStrings #-}
3−
4−module Database.Bloodhound.Internal.Highlight where
5−
6−import Bloodhound.Import
7−
8−import qualified Data.Map.Strict as M
9−
10−import Database.Bloodhound.Internal.Newtypes
11−import Database.Bloodhound.Internal.Query
12−
13−type HitHighlight = M.Map Text [Text]
14−
15−data Highlights = Highlights
16− { globalsettings :: Maybe HighlightSettings
17− , highlightFields :: [FieldHighlight]
18− } deriving (Eq, Show)
19−
20−instance ToJSON Highlights where
21− toJSON (Highlights global fields) =
22− omitNulls (("fields" .= fields)
23− : highlightSettingsPairs global)
24−
25−data FieldHighlight =
26− FieldHighlight FieldName (Maybe HighlightSettings)
27− deriving (Eq, Show)
28−
29−
30−instance ToJSON FieldHighlight where
31− toJSON (FieldHighlight (FieldName fName) (Just fSettings)) =
32− object [ fName .= fSettings ]
33− toJSON (FieldHighlight (FieldName fName) Nothing) =
34− object [ fName .= emptyObject ]
35−
36−data HighlightSettings =
37− Plain PlainHighlight
38− | Postings PostingsHighlight
39− | FastVector FastVectorHighlight
40− deriving (Eq, Show)
41−
42−
43−instance ToJSON HighlightSettings where
44− toJSON hs = omitNulls (highlightSettingsPairs (Just hs))
45−
46−data PlainHighlight =
47− PlainHighlight { plainCommon :: Maybe CommonHighlight
48− , plainNonPost :: Maybe NonPostings }
49− deriving (Eq, Show)
50−
51− -- This requires that index_options are set to 'offset' in the mapping.
52−data PostingsHighlight =
53− PostingsHighlight (Maybe CommonHighlight)
54− deriving (Eq, Show)
55−
56−-- This requires that term_vector is set to 'with_positions_offsets' in the mapping.
57−data FastVectorHighlight = FastVectorHighlight
58− { fvCommon :: Maybe CommonHighlight
59− , fvNonPostSettings :: Maybe NonPostings
60− , boundaryChars :: Maybe Text
61− , boundaryMaxScan :: Maybe Int
62− , fragmentOffset :: Maybe Int
63− , matchedFields :: [Text]
64− , phraseLimit :: Maybe Int
65− } deriving (Eq, Show)
66−
67−data CommonHighlight = CommonHighlight
68− { order :: Maybe Text
69− , forceSource :: Maybe Bool
70− , tag :: Maybe HighlightTag
71− , encoder :: Maybe HighlightEncoder
72− , noMatchSize :: Maybe Int
73− , highlightQuery :: Maybe Query
74− , requireFieldMatch :: Maybe Bool
75− } deriving (Eq, Show)
76−
77−-- Settings that are only applicable to FastVector and Plain highlighters.
78−data NonPostings =
79− NonPostings { fragmentSize :: Maybe Int
80− , numberOfFragments :: Maybe Int
81− } deriving (Eq, Show)
82−
83−data HighlightEncoder = DefaultEncoder
84− | HTMLEncoder
85− deriving (Eq, Show)
86−
87−instance ToJSON HighlightEncoder where
88− toJSON DefaultEncoder = String "default"
89− toJSON HTMLEncoder = String "html"
90−
91−-- NOTE: Should the tags use some kind of HTML type, rather than Text?
92−data HighlightTag =
93− TagSchema Text
94− -- Only uses more than the first value in the lists if fvh
95− | CustomTags ([Text], [Text])
96− deriving (Eq, Show)
97−
98−highlightSettingsPairs :: Maybe HighlightSettings -> [Pair]
99−highlightSettingsPairs Nothing = []
100−highlightSettingsPairs (Just (Plain plh)) = plainHighPairs (Just plh)
101−highlightSettingsPairs (Just (Postings ph)) = postHighPairs (Just ph)
102−highlightSettingsPairs (Just (FastVector fvh)) = fastVectorHighPairs (Just fvh)
103−
104−
105−plainHighPairs :: Maybe PlainHighlight -> [Pair]
106−plainHighPairs Nothing = []
107−plainHighPairs (Just (PlainHighlight plCom plNonPost)) =
108− [ "type" .= String "plain"]
109− ++ commonHighlightPairs plCom
110− ++ nonPostingsToPairs plNonPost
111−
112−postHighPairs :: Maybe PostingsHighlight -> [Pair]
113−postHighPairs Nothing = []
114−postHighPairs (Just (PostingsHighlight pCom)) =
115− ("type" .= String "postings")
116− : commonHighlightPairs pCom
117−
118−fastVectorHighPairs :: Maybe FastVectorHighlight -> [Pair]
119−fastVectorHighPairs Nothing = []
120−fastVectorHighPairs
121− (Just
122− (FastVectorHighlight fvCom fvNonPostSettings' fvBoundChars
123− fvBoundMaxScan fvFragOff fvMatchedFields
124− fvPhraseLim)) =
125− [ "type" .= String "fvh"
126− , "boundary_chars" .= fvBoundChars
127− , "boundary_max_scan" .= fvBoundMaxScan
128− , "fragment_offset" .= fvFragOff
129− , "matched_fields" .= fvMatchedFields
130− , "phraseLimit" .= fvPhraseLim]
131− ++ commonHighlightPairs fvCom
132− ++ nonPostingsToPairs fvNonPostSettings'
133−
134−commonHighlightPairs :: Maybe CommonHighlight -> [Pair]
135−commonHighlightPairs Nothing = []
136−commonHighlightPairs (Just (CommonHighlight chScore chForceSource
137− chTag chEncoder chNoMatchSize
138− chHighlightQuery chRequireFieldMatch)) =
139− [ "order" .= chScore
140− , "force_source" .= chForceSource
141− , "encoder" .= chEncoder
142− , "no_match_size" .= chNoMatchSize
143− , "highlight_query" .= chHighlightQuery
144− , "require_fieldMatch" .= chRequireFieldMatch
145− ]
146− ++ highlightTagToPairs chTag
147−
148−
149−nonPostingsToPairs :: Maybe NonPostings -> [Pair]
150−nonPostingsToPairs Nothing = []
151−nonPostingsToPairs (Just (NonPostings npFragSize npNumOfFrags)) =
152− [ "fragment_size" .= npFragSize
153− , "number_of_fragments" .= npNumOfFrags
154− ]
155−
156−highlightTagToPairs :: Maybe HighlightTag -> [Pair]
157−highlightTagToPairs (Just (TagSchema _)) =
158− [ "scheme" .= String "default"
159− ]
160−highlightTagToPairs (Just (CustomTags (pre, post))) =
161− [ "pre_tags" .= pre
162− , "post_tags" .= post
163− ]
164−highlightTagToPairs Nothing = []
src/Database/Bloodhound/Internal/Newtypes.hsdeleted−237
@@ -1,237 +0,0 @@
1−{-# LANGUAGE GeneralizedNewtypeDeriving #-}
2−{-# LANGUAGE OverloadedStrings #-}
3−
4−module Database.Bloodhound.Internal.Newtypes where
5−
6−import Bloodhound.Import
7−
8−import qualified Data.Map.Strict as M
9−
10−newtype From = From Int deriving (Eq, Show, ToJSON)
11−newtype Size = Size Int deriving (Eq, Show, ToJSON, FromJSON)
12−
13−-- Used with scripts
14−newtype HitFields =
15− HitFields (M.Map Text [Value])
16− deriving (Eq, Show)
17−
18−instance FromJSON HitFields where
19− parseJSON x
20− = HitFields <$> parseJSON x
21−
22−-- Slight misnomer.
23−type Score = Maybe Double
24−
25−{-| 'MappingName' is part of mappings which are how ES describes and schematizes
26− the data in the indices.
27−-}
28−newtype MappingName =
29− MappingName Text
30− deriving (Eq, Show, ToJSON, FromJSON)
31−
32−newtype ShardId = ShardId { shardId :: Int }
33− deriving (Eq, Show, FromJSON)
34−
35−{-| 'DocId' is a generic wrapper value for expressing unique Document IDs.
36− Can be set by the user or created by ES itself. Often used in client
37− functions for poking at specific documents.
38−-}
39−newtype DocId =
40− DocId Text
41− deriving (Eq, Show, ToJSON, FromJSON)
42−
43−{-| 'FieldName' is used all over the place wherever a specific field within
44− a document needs to be specified, usually in 'Query's or 'Filter's.
45−-}
46−newtype FieldName =
47− FieldName Text
48− deriving (Eq, Read, Show, ToJSON, FromJSON)
49−
50−newtype TypeName =
51− TypeName Text
52− deriving (Eq, Show, ToJSON, FromJSON)
53−
54−{-| 'QueryString' is used to wrap query text bodies, be they human written or not.
55−-}
56−newtype QueryString =
57− QueryString Text
58− deriving (Eq, Show, ToJSON, FromJSON)
59−
60−
61−-- {-| 'Script' is often used in place of 'FieldName' to specify more
62−-- complex ways of extracting a value from a document.
63−-- -}
64−-- newtype Script =
65−-- Script { scriptText :: Text }
66−-- deriving (Eq, Show)
67−
68−{-| 'CacheName' is used in 'RegexpFilter' for describing the
69− 'CacheKey' keyed caching behavior.
70−-}
71−newtype CacheName =
72− CacheName Text
73− deriving (Eq, Show, FromJSON, ToJSON)
74−
75−{-| 'CacheKey' is used in 'RegexpFilter' to key regex caching.
76−-}
77−newtype CacheKey =
78− CacheKey Text deriving (Eq, Show, FromJSON, ToJSON)
79−newtype Existence =
80− Existence Bool deriving (Eq, Show, FromJSON, ToJSON)
81−newtype NullValue =
82− NullValue Bool deriving (Eq, Show, FromJSON, ToJSON)
83−newtype CutoffFrequency =
84− CutoffFrequency Double deriving (Eq, Show, FromJSON, ToJSON)
85−newtype Analyzer =
86− Analyzer Text deriving (Eq, Show, FromJSON, ToJSON)
87−newtype MaxExpansions =
88− MaxExpansions Int deriving (Eq, Show, FromJSON, ToJSON)
89−
90−{-| 'Lenient', if set to true, will cause format based failures to be
91− ignored. I don't know what the bloody default is, Elasticsearch
92− documentation didn't say what it was. Let me know if you figure it out.
93−-}
94−newtype Lenient =
95− Lenient Bool deriving (Eq, Show, FromJSON, ToJSON)
96−newtype Tiebreaker =
97− Tiebreaker Double deriving (Eq, Show, FromJSON, ToJSON)
98−
99−{-| 'MinimumMatch' controls how many should clauses in the bool query should
100− match. Can be an absolute value (2) or a percentage (30%) or a
101− combination of both.
102−-}
103−newtype MinimumMatch =
104− MinimumMatch Int deriving (Eq, Show, FromJSON, ToJSON)
105−newtype DisableCoord =
106− DisableCoord Bool deriving (Eq, Show, FromJSON, ToJSON)
107−newtype IgnoreTermFrequency =
108− IgnoreTermFrequency Bool deriving (Eq, Show, FromJSON, ToJSON)
109−newtype MinimumTermFrequency =
110− MinimumTermFrequency Int deriving (Eq, Show, FromJSON, ToJSON)
111−newtype MaxQueryTerms =
112− MaxQueryTerms Int deriving (Eq, Show, FromJSON, ToJSON)
113−
114−{-| 'PrefixLength' is the prefix length used in queries, defaults to 0. -}
115−newtype PrefixLength =
116− PrefixLength Int deriving (Eq, Show, FromJSON, ToJSON)
117−newtype PercentMatch =
118− PercentMatch Double deriving (Eq, Show, FromJSON, ToJSON)
119−newtype StopWord =
120− StopWord Text deriving (Eq, Show, FromJSON, ToJSON)
121−newtype QueryPath =
122− QueryPath Text deriving (Eq, Show, FromJSON, ToJSON)
123−
124−{-| Allowing a wildcard at the beginning of a word (eg "*ing") is particularly
125− heavy, because all terms in the index need to be examined, just in case
126− they match. Leading wildcards can be disabled by setting
127− 'AllowLeadingWildcard' to false. -}
128−newtype AllowLeadingWildcard =
129− AllowLeadingWildcard Bool deriving (Eq, Show, FromJSON, ToJSON)
130−newtype LowercaseExpanded =
131− LowercaseExpanded Bool deriving (Eq, Show, FromJSON, ToJSON)
132−newtype EnablePositionIncrements =
133− EnablePositionIncrements Bool deriving (Eq, Show, FromJSON, ToJSON)
134−
135−{-| By default, wildcard terms in a query are not analyzed.
136− Setting 'AnalyzeWildcard' to true enables best-effort analysis.
137−-}
138−newtype AnalyzeWildcard = AnalyzeWildcard Bool deriving (Eq, Show, FromJSON, ToJSON)
139−
140−{-| 'GeneratePhraseQueries' defaults to false.
141−-}
142−newtype GeneratePhraseQueries =
143− GeneratePhraseQueries Bool deriving (Eq, Show, FromJSON, ToJSON)
144−
145−{-| 'Locale' is used for string conversions - defaults to ROOT.
146−-}
147−newtype Locale = Locale Text deriving (Eq, Show, FromJSON, ToJSON)
148−newtype MaxWordLength = MaxWordLength Int deriving (Eq, Show, FromJSON, ToJSON)
149−newtype MinWordLength = MinWordLength Int deriving (Eq, Show, FromJSON, ToJSON)
150−
151−{-| 'PhraseSlop' sets the default slop for phrases, 0 means exact
152− phrase matches. Default is 0.
153−-}
154−newtype PhraseSlop = PhraseSlop Int deriving (Eq, Show, FromJSON, ToJSON)
155−newtype MinDocFrequency = MinDocFrequency Int deriving (Eq, Show, FromJSON, ToJSON)
156−newtype MaxDocFrequency = MaxDocFrequency Int deriving (Eq, Show, FromJSON, ToJSON)
157−
158−-- | Newtype wrapper to parse ES's concerning tendency to in some APIs return a floating point number of milliseconds since epoch ಠ_ಠ
159−newtype POSIXMS = POSIXMS { posixMS :: UTCTime }
160−
161−instance FromJSON POSIXMS where
162− parseJSON = withScientific "POSIXMS" (return . parse)
163− where parse n =
164− let n' = truncate n :: Integer
165− in POSIXMS (posixSecondsToUTCTime (fromInteger (n' `div` 1000)))
166−
167−newtype Boost =
168− Boost Double
169− deriving (Eq, Show, ToJSON, FromJSON)
170−
171−newtype BoostTerms =
172− BoostTerms Double
173− deriving (Eq, Show, ToJSON, FromJSON)
174−
175−{-| 'ReplicaCount' is part of 'IndexSettings' -}
176−newtype ReplicaCount =
177− ReplicaCount Int
178− deriving (Eq, Show, ToJSON)
179−
180−{-| 'ShardCount' is part of 'IndexSettings' -}
181−newtype ShardCount =
182− ShardCount Int
183− deriving (Eq, Show, ToJSON)
184−
185−-- This insanity is because ES *sometimes* returns Replica/Shard counts as strings
186−instance FromJSON ReplicaCount where
187− parseJSON v = parseAsInt v
188− <|> parseAsString v
189− where parseAsInt = fmap ReplicaCount . parseJSON
190− parseAsString = withText "ReplicaCount" (fmap ReplicaCount . parseReadText)
191−
192−instance FromJSON ShardCount where
193− parseJSON v = parseAsInt v
194− <|> parseAsString v
195− where parseAsInt = fmap ShardCount . parseJSON
196− parseAsString = withText "ShardCount" (fmap ShardCount . parseReadText)
197−
198−{-| 'IndexName' is used to describe which index to query/create/delete -}
199−newtype IndexName =
200− IndexName Text
201− deriving (Eq, Show, ToJSON, FromJSON)
202−
203−newtype IndexAliasName =
204− IndexAliasName { indexAliasName :: IndexName }
205− deriving (Eq, Show, ToJSON)
206−
207−newtype MaybeNA a = MaybeNA { unMaybeNA :: Maybe a }
208− deriving (Show, Eq)
209−
210−instance FromJSON a => FromJSON (MaybeNA a) where
211− parseJSON (String "NA") = pure $ MaybeNA Nothing
212− parseJSON o = MaybeNA . Just <$> parseJSON o
213−
214−newtype SnapshotName =
215− SnapshotName { snapshotName :: Text }
216− deriving (Eq, Show, ToJSON, FromJSON)
217−
218−-- | Milliseconds
219−newtype MS = MS NominalDiffTime
220−
221−-- keeps the unexported constructor warnings at bay
222−unMS :: MS -> NominalDiffTime
223−unMS (MS t) = t
224−
225−
226−instance FromJSON MS where
227− parseJSON = withScientific "MS" (return . MS . parse)
228− where
229− parse n = fromInteger (truncate n * 1000)
230−
231−newtype TokenFilter =
232− TokenFilter Text
233− deriving (Eq, Show, FromJSON, ToJSON)
234−
235−newtype CharFilter =
236− CharFilter Text
237− deriving (Eq, Show, FromJSON, ToJSON)
src/Database/Bloodhound/Internal/Query.hsdeleted−1640
@@ -1,1640 +0,0 @@
1−{-# LANGUAGE GeneralizedNewtypeDeriving #-}
2−{-# LANGUAGE OverloadedStrings #-}
3−{-# LANGUAGE RecordWildCards #-}
4−
5−module Database.Bloodhound.Internal.Query
6− ( module X
7− , module Database.Bloodhound.Internal.Query
8− ) where
9−
10−import Bloodhound.Import
11−
12−import Data.Char (isNumber)
13−import qualified Data.HashMap.Strict as HM
14−import Data.List (nub)
15−import qualified Data.Text as T
16−
17−import Database.Bloodhound.Common.Script as X
18−import Database.Bloodhound.Internal.Newtypes
19−
20−data Query =
21− TermQuery Term (Maybe Boost)
22− | TermsQuery Text (NonEmpty Text)
23− | QueryMatchQuery MatchQuery
24− | QueryMultiMatchQuery MultiMatchQuery
25− | QueryBoolQuery BoolQuery
26− | QueryBoostingQuery BoostingQuery
27− | QueryCommonTermsQuery CommonTermsQuery
28− | ConstantScoreQuery Query Boost
29− | QueryFunctionScoreQuery FunctionScoreQuery
30− | QueryDisMaxQuery DisMaxQuery
31− | QueryFuzzyLikeThisQuery FuzzyLikeThisQuery
32− | QueryFuzzyLikeFieldQuery FuzzyLikeFieldQuery
33− | QueryFuzzyQuery FuzzyQuery
34− | QueryHasChildQuery HasChildQuery
35− | QueryHasParentQuery HasParentQuery
36− | IdsQuery MappingName [DocId]
37− | QueryIndicesQuery IndicesQuery
38− | MatchAllQuery (Maybe Boost)
39− | QueryMoreLikeThisQuery MoreLikeThisQuery
40− | QueryMoreLikeThisFieldQuery MoreLikeThisFieldQuery
41− | QueryNestedQuery NestedQuery
42− | QueryPrefixQuery PrefixQuery
43− | QueryQueryStringQuery QueryStringQuery
44− | QuerySimpleQueryStringQuery SimpleQueryStringQuery
45− | QueryRangeQuery RangeQuery
46− | QueryRegexpQuery RegexpQuery
47− | QueryExistsQuery FieldName
48− | QueryTemplateQueryInline TemplateQueryInline
49− | QueryMatchNoneQuery
50− | QueryWildcardQuery WildcardQuery
51− deriving (Eq, Show)
52−
53−instance ToJSON Query where
54− toJSON (TermQuery (Term termQueryField termQueryValue) boost) =
55− object [ "term" .=
56− object [termQueryField .= object merged]]
57− where
58− base = [ "value" .= termQueryValue ]
59− boosted = maybe [] (return . ("boost" .=)) boost
60− merged = mappend base boosted
61−
62− toJSON (TermsQuery fieldName terms) =
63− object [ "terms" .= object conjoined ]
64− where conjoined = [fieldName .= terms]
65−
66− toJSON (IdsQuery idsQueryMappingName docIds) =
67− object [ "ids" .= object conjoined ]
68− where conjoined = [ "type" .= idsQueryMappingName
69− , "values" .= fmap toJSON docIds ]
70−
71− toJSON (QueryQueryStringQuery qQueryStringQuery) =
72− object [ "query_string" .= qQueryStringQuery ]
73−
74− toJSON (QueryMatchQuery matchQuery) =
75− object [ "match" .= matchQuery ]
76−
77− toJSON (QueryMultiMatchQuery multiMatchQuery) =
78− toJSON multiMatchQuery
79−
80− toJSON (QueryBoolQuery boolQuery) =
81− object [ "bool" .= boolQuery ]
82−
83− toJSON (QueryBoostingQuery boostingQuery) =
84− object [ "boosting" .= boostingQuery ]
85−
86− toJSON (QueryCommonTermsQuery commonTermsQuery) =
87− object [ "common" .= commonTermsQuery ]
88−
89− toJSON (ConstantScoreQuery query boost) =
90− object ["constant_score" .= object ["query" .= query
91− , "boost" .= boost]]
92−
93− toJSON (QueryFunctionScoreQuery functionScoreQuery) =
94− object [ "function_score" .= functionScoreQuery ]
95−
96− toJSON (QueryDisMaxQuery disMaxQuery) =
97− object [ "dis_max" .= disMaxQuery ]
98−
99− toJSON (QueryFuzzyLikeThisQuery fuzzyQuery) =
100− object [ "fuzzy_like_this" .= fuzzyQuery ]
101−
102− toJSON (QueryFuzzyLikeFieldQuery fuzzyFieldQuery) =
103− object [ "fuzzy_like_this_field" .= fuzzyFieldQuery ]
104−
105− toJSON (QueryFuzzyQuery fuzzyQuery) =
106− object [ "fuzzy" .= fuzzyQuery ]
107−
108− toJSON (QueryHasChildQuery childQuery) =
109− object [ "has_child" .= childQuery ]
110−
111− toJSON (QueryHasParentQuery parentQuery) =
112− object [ "has_parent" .= parentQuery ]
113−
114− toJSON (QueryIndicesQuery qIndicesQuery) =
115− object [ "indices" .= qIndicesQuery ]
116−
117− toJSON (MatchAllQuery boost) =
118− object [ "match_all" .= omitNulls [ "boost" .= boost ] ]
119−
120− toJSON (QueryMoreLikeThisQuery query) =
121− object [ "more_like_this" .= query ]
122−
123− toJSON (QueryMoreLikeThisFieldQuery query) =
124− object [ "more_like_this_field" .= query ]
125−
126− toJSON (QueryNestedQuery query) =
127− object [ "nested" .= query ]
128−
129− toJSON (QueryPrefixQuery query) =
130− object [ "prefix" .= query ]
131−
132− toJSON (QueryRangeQuery query) =
133− object [ "range" .= query ]
134−
135− toJSON (QueryRegexpQuery query) =
136− object [ "regexp" .= query ]
137−
138− toJSON (QuerySimpleQueryStringQuery query) =
139− object [ "simple_query_string" .= query ]
140−
141− toJSON (QueryExistsQuery (FieldName fieldName)) =
142− object ["exists" .= object
143− ["field" .= fieldName]
144− ]
145− toJSON QueryMatchNoneQuery =
146− object ["match_none" .= object []]
147−
148− toJSON (QueryTemplateQueryInline templateQuery) =
149− object [ "template" .= templateQuery ]
150−
151− toJSON (QueryWildcardQuery query) =
152− object [ "wildcard" .= query ]
153−
154−instance FromJSON Query where
155− parseJSON v = withObject "Query" parse v
156− where parse o = termQuery `taggedWith` "term"
157− <|> termsQuery `taggedWith` "terms"
158− <|> idsQuery `taggedWith` "ids"
159− <|> queryQueryStringQuery `taggedWith` "query_string"
160− <|> queryMatchQuery `taggedWith` "match"
161− <|> queryMultiMatchQuery
162− <|> queryBoolQuery `taggedWith` "bool"
163− <|> queryBoostingQuery `taggedWith` "boosting"
164− <|> queryCommonTermsQuery `taggedWith` "common"
165− <|> constantScoreQuery `taggedWith` "constant_score"
166− <|> queryFunctionScoreQuery `taggedWith` "function_score"
167− <|> queryDisMaxQuery `taggedWith` "dis_max"
168− <|> queryFuzzyLikeThisQuery `taggedWith` "fuzzy_like_this"
169− <|> queryFuzzyLikeFieldQuery `taggedWith` "fuzzy_like_this_field"
170− <|> queryFuzzyQuery `taggedWith` "fuzzy"
171− <|> queryHasChildQuery `taggedWith` "has_child"
172− <|> queryHasParentQuery `taggedWith` "has_parent"
173− <|> queryIndicesQuery `taggedWith` "indices"
174− <|> matchAllQuery `taggedWith` "match_all"
175− <|> queryMoreLikeThisQuery `taggedWith` "more_like_this"
176− <|> queryMoreLikeThisFieldQuery `taggedWith` "more_like_this_field"
177− <|> queryNestedQuery `taggedWith` "nested"
178− <|> queryPrefixQuery `taggedWith` "prefix"
179− <|> queryRangeQuery `taggedWith` "range"
180− <|> queryRegexpQuery `taggedWith` "regexp"
181− <|> querySimpleQueryStringQuery `taggedWith` "simple_query_string"
182− <|> queryTemplateQueryInline `taggedWith` "template"
183− <|> queryWildcardQuery `taggedWith` "wildcard"
184− where taggedWith parser k = parser =<< o .: k
185− termQuery = fieldTagged $ \(FieldName fn) o ->
186− TermQuery <$> (Term fn <$> o .: "value") <*> o .:? "boost"
187− termsQuery o = case HM.toList o of
188− [(fn, vs)] -> do vals <- parseJSON vs
189− case vals of
190− x:xs -> return (TermsQuery fn (x :| xs))
191− _ -> fail "Expected non empty list of values"
192− _ -> fail "Expected object with 1 field-named key"
193− idsQuery o = IdsQuery <$> o .: "type"
194− <*> o .: "values"
195− queryQueryStringQuery = pure . QueryQueryStringQuery
196− queryMatchQuery = pure . QueryMatchQuery
197− queryMultiMatchQuery = QueryMultiMatchQuery <$> parseJSON v
198− queryBoolQuery = pure . QueryBoolQuery
199− queryBoostingQuery = pure . QueryBoostingQuery
200− queryCommonTermsQuery = pure . QueryCommonTermsQuery
201− constantScoreQuery o = case HM.lookup "query" o of
202− Just x -> ConstantScoreQuery <$> parseJSON x
203− <*> o .: "boost"
204− _ -> fail "Does not appear to be a ConstantScoreQuery"
205− queryFunctionScoreQuery = pure . QueryFunctionScoreQuery
206− queryDisMaxQuery = pure . QueryDisMaxQuery
207− queryFuzzyLikeThisQuery = pure . QueryFuzzyLikeThisQuery
208− queryFuzzyLikeFieldQuery = pure . QueryFuzzyLikeFieldQuery
209− queryFuzzyQuery = pure . QueryFuzzyQuery
210− queryHasChildQuery = pure . QueryHasChildQuery
211− queryHasParentQuery = pure . QueryHasParentQuery
212− queryIndicesQuery = pure . QueryIndicesQuery
213− matchAllQuery o = MatchAllQuery <$> o .:? "boost"
214− queryMoreLikeThisQuery = pure . QueryMoreLikeThisQuery
215− queryMoreLikeThisFieldQuery = pure . QueryMoreLikeThisFieldQuery
216− queryNestedQuery = pure . QueryNestedQuery
217− queryPrefixQuery = pure . QueryPrefixQuery
218− queryRangeQuery = pure . QueryRangeQuery
219− queryRegexpQuery = pure . QueryRegexpQuery
220− querySimpleQueryStringQuery = pure . QuerySimpleQueryStringQuery
221− -- queryExistsQuery o = QueryExistsQuery <$> o .: "field"
222− queryTemplateQueryInline = pure . QueryTemplateQueryInline
223− queryWildcardQuery = pure . QueryWildcardQuery
224−
225−-- | As of Elastic 2.0, 'Filters' are just 'Queries' housed in a
226−-- Bool Query, and flagged in a different context.
227−newtype Filter = Filter { unFilter :: Query }
228− deriving (Eq, Show)
229−
230−instance ToJSON Filter where
231− toJSON = toJSON . unFilter
232−
233−instance FromJSON Filter where
234− parseJSON v = Filter <$> parseJSON v
235−
236−data RegexpQuery =
237− RegexpQuery { regexpQueryField :: FieldName
238− , regexpQuery :: Regexp
239− , regexpQueryFlags :: RegexpFlags
240− , regexpQueryBoost :: Maybe Boost
241− } deriving (Eq, Show)
242−
243−instance ToJSON RegexpQuery where
244− toJSON (RegexpQuery (FieldName rqQueryField)
245− (Regexp regexpQueryQuery) rqQueryFlags
246− rqQueryBoost) =
247− object [ rqQueryField .= omitNulls base ]
248− where base = [ "value" .= regexpQueryQuery
249− , "flags" .= rqQueryFlags
250− , "boost" .= rqQueryBoost ]
251−
252−instance FromJSON RegexpQuery where
253− parseJSON = withObject "RegexpQuery" parse
254− where parse = fieldTagged $ \fn o ->
255− RegexpQuery fn
256− <$> o .: "value"
257− <*> o .: "flags"
258− <*> o .:? "boost"
259−
260−data WildcardQuery =
261− WildcardQuery { wildcardQueryField :: FieldName
262− , wildcardQuery :: Text
263− , wildcardQueryBoost :: Maybe Boost
264− } deriving (Eq, Show)
265−
266−instance ToJSON WildcardQuery where
267− toJSON (WildcardQuery (FieldName wcQueryField)
268− (wcQueryQuery) wcQueryBoost) =
269− object [ wcQueryField .= omitNulls base ]
270− where base = [ "value" .= wcQueryQuery
271− , "boost" .= wcQueryBoost ]
272−
273−instance FromJSON WildcardQuery where
274− parseJSON = withObject "WildcardQuery" parse
275− where parse = fieldTagged $ \fn o ->
276− WildcardQuery fn
277− <$> o .: "value"
278− <*> o .:? "boost"
279−
280−data RangeQuery =
281− RangeQuery { rangeQueryField :: FieldName
282− , rangeQueryRange :: RangeValue
283− , rangeQueryBoost :: Boost } deriving (Eq, Show)
284−
285−instance ToJSON RangeQuery where
286− toJSON (RangeQuery (FieldName fieldName) range boost) =
287− object [ fieldName .= object conjoined ]
288− where
289− conjoined = ("boost" .= boost) : rangeValueToPair range
290−
291−instance FromJSON RangeQuery where
292− parseJSON = withObject "RangeQuery" parse
293− where parse = fieldTagged $ \fn o ->
294− RangeQuery fn
295− <$> parseJSON (Object o)
296− <*> o .: "boost"
297−
298−mkRangeQuery :: FieldName -> RangeValue -> RangeQuery
299−mkRangeQuery f r = RangeQuery f r (Boost 1.0)
300−
301−data SimpleQueryStringQuery =
302− SimpleQueryStringQuery
303− { simpleQueryStringQuery :: QueryString
304− , simpleQueryStringField :: Maybe FieldOrFields
305− , simpleQueryStringOperator :: Maybe BooleanOperator
306− , simpleQueryStringAnalyzer :: Maybe Analyzer
307− , simpleQueryStringFlags :: Maybe (NonEmpty SimpleQueryFlag)
308− , simpleQueryStringLowercaseExpanded :: Maybe LowercaseExpanded
309− , simpleQueryStringLocale :: Maybe Locale
310− } deriving (Eq, Show)
311−
312−
313−instance ToJSON SimpleQueryStringQuery where
314− toJSON SimpleQueryStringQuery {..} =
315− omitNulls (base ++ maybeAdd)
316− where base = [ "query" .= simpleQueryStringQuery ]
317− maybeAdd = [ "fields" .= simpleQueryStringField
318− , "default_operator" .= simpleQueryStringOperator
319− , "analyzer" .= simpleQueryStringAnalyzer
320− , "flags" .= simpleQueryStringFlags
321− , "lowercase_expanded_terms" .= simpleQueryStringLowercaseExpanded
322− , "locale" .= simpleQueryStringLocale ]
323−
324−instance FromJSON SimpleQueryStringQuery where
325− parseJSON = withObject "SimpleQueryStringQuery" parse
326− where parse o = SimpleQueryStringQuery <$> o .: "query"
327− <*> o .:? "fields"
328− <*> o .:? "default_operator"
329− <*> o .:? "analyzer"
330− <*> (parseFlags <$> o .:? "flags")
331− <*> o .:? "lowercase_expanded_terms"
332− <*> o .:? "locale"
333− parseFlags (Just (x:xs)) = Just (x :| xs)
334− parseFlags _ = Nothing
335−
336−data SimpleQueryFlag =
337− SimpleQueryAll
338− | SimpleQueryNone
339− | SimpleQueryAnd
340− | SimpleQueryOr
341− | SimpleQueryPrefix
342− | SimpleQueryPhrase
343− | SimpleQueryPrecedence
344− | SimpleQueryEscape
345− | SimpleQueryWhitespace
346− | SimpleQueryFuzzy
347− | SimpleQueryNear
348− | SimpleQuerySlop deriving (Eq, Show)
349−
350−instance ToJSON SimpleQueryFlag where
351− toJSON SimpleQueryAll = "ALL"
352− toJSON SimpleQueryNone = "NONE"
353− toJSON SimpleQueryAnd = "AND"
354− toJSON SimpleQueryOr = "OR"
355− toJSON SimpleQueryPrefix = "PREFIX"
356− toJSON SimpleQueryPhrase = "PHRASE"
357− toJSON SimpleQueryPrecedence = "PRECEDENCE"
358− toJSON SimpleQueryEscape = "ESCAPE"
359− toJSON SimpleQueryWhitespace = "WHITESPACE"
360− toJSON SimpleQueryFuzzy = "FUZZY"
361− toJSON SimpleQueryNear = "NEAR"
362− toJSON SimpleQuerySlop = "SLOP"
363−
364−instance FromJSON SimpleQueryFlag where
365− parseJSON = withText "SimpleQueryFlag" parse
366− where parse "ALL" = pure SimpleQueryAll
367− parse "NONE" = pure SimpleQueryNone
368− parse "AND" = pure SimpleQueryAnd
369− parse "OR" = pure SimpleQueryOr
370− parse "PREFIX" = pure SimpleQueryPrefix
371− parse "PHRASE" = pure SimpleQueryPhrase
372− parse "PRECEDENCE" = pure SimpleQueryPrecedence
373− parse "ESCAPE" = pure SimpleQueryEscape
374− parse "WHITESPACE" = pure SimpleQueryWhitespace
375− parse "FUZZY" = pure SimpleQueryFuzzy
376− parse "NEAR" = pure SimpleQueryNear
377− parse "SLOP" = pure SimpleQuerySlop
378− parse f = fail ("Unexpected SimpleQueryFlag: " <> show f)
379−
380−-- use_dis_max and tie_breaker when fields are plural?
381−data QueryStringQuery =
382− QueryStringQuery
383− { queryStringQuery :: QueryString
384− , queryStringDefaultField :: Maybe FieldName
385− , queryStringOperator :: Maybe BooleanOperator
386− , queryStringAnalyzer :: Maybe Analyzer
387− , queryStringAllowLeadingWildcard :: Maybe AllowLeadingWildcard
388− , queryStringLowercaseExpanded :: Maybe LowercaseExpanded
389− , queryStringEnablePositionIncrements :: Maybe EnablePositionIncrements
390− , queryStringFuzzyMaxExpansions :: Maybe MaxExpansions
391− , queryStringFuzziness :: Maybe Fuzziness
392− , queryStringFuzzyPrefixLength :: Maybe PrefixLength
393− , queryStringPhraseSlop :: Maybe PhraseSlop
394− , queryStringBoost :: Maybe Boost
395− , queryStringAnalyzeWildcard :: Maybe AnalyzeWildcard
396− , queryStringGeneratePhraseQueries :: Maybe GeneratePhraseQueries
397− , queryStringMinimumShouldMatch :: Maybe MinimumMatch
398− , queryStringLenient :: Maybe Lenient
399− , queryStringLocale :: Maybe Locale
400− } deriving (Eq, Show)
401−
402−
403−instance ToJSON QueryStringQuery where
404− toJSON (QueryStringQuery qsQueryString
405− qsDefaultField qsOperator
406− qsAnalyzer qsAllowWildcard
407− qsLowercaseExpanded qsEnablePositionIncrements
408− qsFuzzyMaxExpansions qsFuzziness
409− qsFuzzyPrefixLength qsPhraseSlop
410− qsBoost qsAnalyzeWildcard
411− qsGeneratePhraseQueries qsMinimumShouldMatch
412− qsLenient qsLocale) =
413− omitNulls base
414− where
415− base = [ "query" .= qsQueryString
416− , "default_field" .= qsDefaultField
417− , "default_operator" .= qsOperator
418− , "analyzer" .= qsAnalyzer
419− , "allow_leading_wildcard" .= qsAllowWildcard
420− , "lowercase_expanded_terms" .= qsLowercaseExpanded
421− , "enable_position_increments" .= qsEnablePositionIncrements
422− , "fuzzy_max_expansions" .= qsFuzzyMaxExpansions
423− , "fuzziness" .= qsFuzziness
424− , "fuzzy_prefix_length" .= qsFuzzyPrefixLength
425− , "phrase_slop" .= qsPhraseSlop
426− , "boost" .= qsBoost
427− , "analyze_wildcard" .= qsAnalyzeWildcard
428− , "auto_generate_phrase_queries" .= qsGeneratePhraseQueries
429− , "minimum_should_match" .= qsMinimumShouldMatch
430− , "lenient" .= qsLenient
431− , "locale" .= qsLocale ]
432−
433−instance FromJSON QueryStringQuery where
434− parseJSON = withObject "QueryStringQuery" parse
435− where parse o = QueryStringQuery
436− <$> o .: "query"
437− <*> o .:? "default_field"
438− <*> o .:? "default_operator"
439− <*> o .:? "analyzer"
440− <*> o .:? "allow_leading_wildcard"
441− <*> o .:? "lowercase_expanded_terms"
442− <*> o .:? "enable_position_increments"
443− <*> o .:? "fuzzy_max_expansions"
444− <*> o .:? "fuzziness"
445− <*> o .:? "fuzzy_prefix_length"
446− <*> o .:? "phrase_slop"
447− <*> o .:? "boost"
448− <*> o .:? "analyze_wildcard"
449− <*> o .:? "auto_generate_phrase_queries"
450− <*> o .:? "minimum_should_match"
451− <*> o .:? "lenient"
452− <*> o .:? "locale"
453−
454−mkQueryStringQuery :: QueryString -> QueryStringQuery
455−mkQueryStringQuery qs =
456− QueryStringQuery qs Nothing Nothing
457− Nothing Nothing Nothing Nothing
458− Nothing Nothing Nothing Nothing
459− Nothing Nothing Nothing Nothing
460− Nothing Nothing
461−
462−data FieldOrFields = FofField FieldName
463− | FofFields (NonEmpty FieldName) deriving (Eq, Show)
464−
465−instance ToJSON FieldOrFields where
466− toJSON (FofField fieldName) =
467− toJSON fieldName
468− toJSON (FofFields fieldNames) =
469− toJSON fieldNames
470−
471−instance FromJSON FieldOrFields where
472− parseJSON v = FofField <$> parseJSON v
473− <|> FofFields <$> (parseNEJSON =<< parseJSON v)
474−
475−data PrefixQuery =
476− PrefixQuery
477− { prefixQueryField :: FieldName
478− , prefixQueryPrefixValue :: Text
479− , prefixQueryBoost :: Maybe Boost } deriving (Eq, Show)
480−
481−instance ToJSON PrefixQuery where
482− toJSON (PrefixQuery (FieldName fieldName) queryValue boost) =
483− object [ fieldName .= omitNulls base ]
484− where base = [ "value" .= queryValue
485− , "boost" .= boost ]
486−
487−instance FromJSON PrefixQuery where
488− parseJSON = withObject "PrefixQuery" parse
489− where parse = fieldTagged $ \fn o ->
490− PrefixQuery fn
491− <$> o .: "value"
492− <*> o .:? "boost"
493−
494−data NestedQuery =
495− NestedQuery
496− { nestedQueryPath :: QueryPath
497− , nestedQueryScoreType :: ScoreType
498− , nestedQuery :: Query } deriving (Eq, Show)
499−
500−instance ToJSON NestedQuery where
501− toJSON (NestedQuery nqPath nqScoreType nqQuery) =
502− object [ "path" .= nqPath
503− , "score_mode" .= nqScoreType
504− , "query" .= nqQuery ]
505−
506−instance FromJSON NestedQuery where
507− parseJSON = withObject "NestedQuery" parse
508− where parse o = NestedQuery
509− <$> o .: "path"
510− <*> o .: "score_mode"
511− <*> o .: "query"
512−
513−data MoreLikeThisFieldQuery =
514− MoreLikeThisFieldQuery
515− { moreLikeThisFieldText :: Text
516− , moreLikeThisFieldFields :: FieldName
517− -- default 0.3 (30%)
518− , moreLikeThisFieldPercentMatch :: Maybe PercentMatch
519− , moreLikeThisFieldMinimumTermFreq :: Maybe MinimumTermFrequency
520− , moreLikeThisFieldMaxQueryTerms :: Maybe MaxQueryTerms
521− , moreLikeThisFieldStopWords :: Maybe (NonEmpty StopWord)
522− , moreLikeThisFieldMinDocFrequency :: Maybe MinDocFrequency
523− , moreLikeThisFieldMaxDocFrequency :: Maybe MaxDocFrequency
524− , moreLikeThisFieldMinWordLength :: Maybe MinWordLength
525− , moreLikeThisFieldMaxWordLength :: Maybe MaxWordLength
526− , moreLikeThisFieldBoostTerms :: Maybe BoostTerms
527− , moreLikeThisFieldBoost :: Maybe Boost
528− , moreLikeThisFieldAnalyzer :: Maybe Analyzer
529− } deriving (Eq, Show)
530−
531−
532−instance ToJSON MoreLikeThisFieldQuery where
533− toJSON (MoreLikeThisFieldQuery text (FieldName fieldName)
534− percent mtf mqt stopwords mindf maxdf
535− minwl maxwl boostTerms boost analyzer) =
536− object [ fieldName .= omitNulls base ]
537− where base = [ "like_text" .= text
538− , "percent_terms_to_match" .= percent
539− , "min_term_freq" .= mtf
540− , "max_query_terms" .= mqt
541− , "stop_words" .= stopwords
542− , "min_doc_freq" .= mindf
543− , "max_doc_freq" .= maxdf
544− , "min_word_length" .= minwl
545− , "max_word_length" .= maxwl
546− , "boost_terms" .= boostTerms
547− , "boost" .= boost
548− , "analyzer" .= analyzer ]
549−
550−instance FromJSON MoreLikeThisFieldQuery where
551− parseJSON = withObject "MoreLikeThisFieldQuery" parse
552− where parse = fieldTagged $ \fn o ->
553− MoreLikeThisFieldQuery
554− <$> o .: "like_text"
555− <*> pure fn
556− <*> o .:? "percent_terms_to_match"
557− <*> o .:? "min_term_freq"
558− <*> o .:? "max_query_terms"
559− -- <*> (optionalNE =<< o .:? "stop_words")
560− <*> o .:? "stop_words"
561− <*> o .:? "min_doc_freq"
562− <*> o .:? "max_doc_freq"
563− <*> o .:? "min_word_length"
564− <*> o .:? "max_word_length"
565− <*> o .:? "boost_terms"
566− <*> o .:? "boost"
567− <*> o .:? "analyzer"
568− -- optionalNE = maybe (pure Nothing) (fmap Just . parseNEJSON)
569−
570−data MoreLikeThisQuery =
571− MoreLikeThisQuery
572− { moreLikeThisText :: Text
573− , moreLikeThisFields :: Maybe (NonEmpty FieldName)
574− -- default 0.3 (30%)
575− , moreLikeThisPercentMatch :: Maybe PercentMatch
576− , moreLikeThisMinimumTermFreq :: Maybe MinimumTermFrequency
577− , moreLikeThisMaxQueryTerms :: Maybe MaxQueryTerms
578− , moreLikeThisStopWords :: Maybe (NonEmpty StopWord)
579− , moreLikeThisMinDocFrequency :: Maybe MinDocFrequency
580− , moreLikeThisMaxDocFrequency :: Maybe MaxDocFrequency
581− , moreLikeThisMinWordLength :: Maybe MinWordLength
582− , moreLikeThisMaxWordLength :: Maybe MaxWordLength
583− , moreLikeThisBoostTerms :: Maybe BoostTerms
584− , moreLikeThisBoost :: Maybe Boost
585− , moreLikeThisAnalyzer :: Maybe Analyzer
586− } deriving (Eq, Show)
587−
588−
589−instance ToJSON MoreLikeThisQuery where
590− toJSON (MoreLikeThisQuery text fields percent
591− mtf mqt stopwords mindf maxdf
592− minwl maxwl boostTerms boost analyzer) =
593− omitNulls base
594− where base = [ "like_text" .= text
595− , "fields" .= fields
596− , "percent_terms_to_match" .= percent
597− , "min_term_freq" .= mtf
598− , "max_query_terms" .= mqt
599− , "stop_words" .= stopwords
600− , "min_doc_freq" .= mindf
601− , "max_doc_freq" .= maxdf
602− , "min_word_length" .= minwl
603− , "max_word_length" .= maxwl
604− , "boost_terms" .= boostTerms
605− , "boost" .= boost
606− , "analyzer" .= analyzer ]
607−
608−instance FromJSON MoreLikeThisQuery where
609− parseJSON = withObject "MoreLikeThisQuery" parse
610− where parse o = MoreLikeThisQuery
611− <$> o .: "like_text"
612− -- <*> (optionalNE =<< o .:? "fields")
613− <*> o .:? "fields"
614− <*> o .:? "percent_terms_to_match"
615− <*> o .:? "min_term_freq"
616− <*> o .:? "max_query_terms"
617− -- <*> (optionalNE =<< o .:? "stop_words")
618− <*> o .:? "stop_words"
619− <*> o .:? "min_doc_freq"
620− <*> o .:? "max_doc_freq"
621− <*> o .:? "min_word_length"
622− <*> o .:? "max_word_length"
623− <*> o .:? "boost_terms"
624− <*> o .:? "boost"
625− <*> o .:? "analyzer"
626− -- optionalNE = maybe (pure Nothing) (fmap Just . parseNEJSON)
627−
628−data IndicesQuery =
629− IndicesQuery
630− { indicesQueryIndices :: [IndexName]
631− , indicesQuery :: Query
632− -- default "all"
633− , indicesQueryNoMatch :: Maybe Query } deriving (Eq, Show)
634−
635−
636−instance ToJSON IndicesQuery where
637− toJSON (IndicesQuery indices query noMatch) =
638− omitNulls [ "indices" .= indices
639− , "no_match_query" .= noMatch
640− , "query" .= query ]
641−
642−instance FromJSON IndicesQuery where
643− parseJSON = withObject "IndicesQuery" parse
644− where parse o = IndicesQuery
645− <$> o .:? "indices" .!= []
646− <*> o .: "query"
647− <*> o .:? "no_match_query"
648−
649−data HasParentQuery =
650− HasParentQuery
651− { hasParentQueryType :: TypeName
652− , hasParentQuery :: Query
653− , hasParentQueryScoreType :: Maybe ScoreType } deriving (Eq, Show)
654−
655−instance ToJSON HasParentQuery where
656− toJSON (HasParentQuery queryType query scoreType) =
657− omitNulls [ "parent_type" .= queryType
658− , "score_type" .= scoreType
659− , "query" .= query ]
660−
661−instance FromJSON HasParentQuery where
662− parseJSON = withObject "HasParentQuery" parse
663− where parse o = HasParentQuery
664− <$> o .: "parent_type"
665− <*> o .: "query"
666− <*> o .:? "score_type"
667−
668−data HasChildQuery =
669− HasChildQuery
670− { hasChildQueryType :: TypeName
671− , hasChildQuery :: Query
672− , hasChildQueryScoreType :: Maybe ScoreType } deriving (Eq, Show)
673−
674−instance ToJSON HasChildQuery where
675− toJSON (HasChildQuery queryType query scoreType) =
676− omitNulls [ "query" .= query
677− , "score_type" .= scoreType
678− , "type" .= queryType ]
679−
680−instance FromJSON HasChildQuery where
681− parseJSON = withObject "HasChildQuery" parse
682− where parse o = HasChildQuery
683− <$> o .: "type"
684− <*> o .: "query"
685− <*> o .:? "score_type"
686−
687−data ScoreType =
688− ScoreTypeMax
689− | ScoreTypeSum
690− | ScoreTypeAvg
691− | ScoreTypeNone deriving (Eq, Show)
692−
693−instance ToJSON ScoreType where
694− toJSON ScoreTypeMax = "max"
695− toJSON ScoreTypeAvg = "avg"
696− toJSON ScoreTypeSum = "sum"
697− toJSON ScoreTypeNone = "none"
698−
699−instance FromJSON ScoreType where
700− parseJSON = withText "ScoreType" parse
701− where parse "max" = pure ScoreTypeMax
702− parse "avg" = pure ScoreTypeAvg
703− parse "sum" = pure ScoreTypeSum
704− parse "none" = pure ScoreTypeNone
705− parse t = fail ("Unexpected ScoreType: " <> show t)
706−
707−data FuzzyQuery =
708− FuzzyQuery { fuzzyQueryField :: FieldName
709− , fuzzyQueryValue :: Text
710− , fuzzyQueryPrefixLength :: PrefixLength
711− , fuzzyQueryMaxExpansions :: MaxExpansions
712− , fuzzyQueryFuzziness :: Fuzziness
713− , fuzzyQueryBoost :: Maybe Boost
714− } deriving (Eq, Show)
715−
716−
717−instance ToJSON FuzzyQuery where
718− toJSON (FuzzyQuery (FieldName fieldName) queryText
719− prefixLength maxEx fuzziness boost) =
720− object [ fieldName .= omitNulls base ]
721− where base = [ "value" .= queryText
722− , "fuzziness" .= fuzziness
723− , "prefix_length" .= prefixLength
724− , "boost" .= boost
725− , "max_expansions" .= maxEx ]
726−
727−instance FromJSON FuzzyQuery where
728− parseJSON = withObject "FuzzyQuery" parse
729− where parse = fieldTagged $ \fn o ->
730− FuzzyQuery fn
731− <$> o .: "value"
732− <*> o .: "prefix_length"
733− <*> o .: "max_expansions"
734− <*> o .: "fuzziness"
735− <*> o .:? "boost"
736−
737−data FuzzyLikeFieldQuery =
738− FuzzyLikeFieldQuery
739− { fuzzyLikeField :: FieldName
740− -- anaphora is good for the soul.
741− , fuzzyLikeFieldText :: Text
742− , fuzzyLikeFieldMaxQueryTerms :: MaxQueryTerms
743− , fuzzyLikeFieldIgnoreTermFrequency :: IgnoreTermFrequency
744− , fuzzyLikeFieldFuzziness :: Fuzziness
745− , fuzzyLikeFieldPrefixLength :: PrefixLength
746− , fuzzyLikeFieldBoost :: Boost
747− , fuzzyLikeFieldAnalyzer :: Maybe Analyzer
748− } deriving (Eq, Show)
749−
750−
751−instance ToJSON FuzzyLikeFieldQuery where
752− toJSON (FuzzyLikeFieldQuery (FieldName fieldName)
753− fieldText maxTerms ignoreFreq fuzziness prefixLength
754− boost analyzer) =
755− object [ fieldName .=
756− omitNulls [ "like_text" .= fieldText
757− , "max_query_terms" .= maxTerms
758− , "ignore_tf" .= ignoreFreq
759− , "fuzziness" .= fuzziness
760− , "prefix_length" .= prefixLength
761− , "analyzer" .= analyzer
762− , "boost" .= boost ]]
763−
764−instance FromJSON FuzzyLikeFieldQuery where
765− parseJSON = withObject "FuzzyLikeFieldQuery" parse
766− where parse = fieldTagged $ \fn o ->
767− FuzzyLikeFieldQuery fn
768− <$> o .: "like_text"
769− <*> o .: "max_query_terms"
770− <*> o .: "ignore_tf"
771− <*> o .: "fuzziness"
772− <*> o .: "prefix_length"
773− <*> o .: "boost"
774− <*> o .:? "analyzer"
775−
776−data FuzzyLikeThisQuery =
777− FuzzyLikeThisQuery
778− { fuzzyLikeFields :: [FieldName]
779− , fuzzyLikeText :: Text
780− , fuzzyLikeMaxQueryTerms :: MaxQueryTerms
781− , fuzzyLikeIgnoreTermFrequency :: IgnoreTermFrequency
782− , fuzzyLikeFuzziness :: Fuzziness
783− , fuzzyLikePrefixLength :: PrefixLength
784− , fuzzyLikeBoost :: Boost
785− , fuzzyLikeAnalyzer :: Maybe Analyzer
786− } deriving (Eq, Show)
787−
788−
789−instance ToJSON FuzzyLikeThisQuery where
790− toJSON (FuzzyLikeThisQuery fields text maxTerms
791− ignoreFreq fuzziness prefixLength boost analyzer) =
792− omitNulls base
793− where base = [ "fields" .= fields
794− , "like_text" .= text
795− , "max_query_terms" .= maxTerms
796− , "ignore_tf" .= ignoreFreq
797− , "fuzziness" .= fuzziness
798− , "prefix_length" .= prefixLength
799− , "analyzer" .= analyzer
800− , "boost" .= boost ]
801−
802−instance FromJSON FuzzyLikeThisQuery where
803− parseJSON = withObject "FuzzyLikeThisQuery" parse
804− where parse o = FuzzyLikeThisQuery
805− <$> o .:? "fields" .!= []
806− <*> o .: "like_text"
807− <*> o .: "max_query_terms"
808− <*> o .: "ignore_tf"
809− <*> o .: "fuzziness"
810− <*> o .: "prefix_length"
811− <*> o .: "boost"
812− <*> o .:? "analyzer"
813−
814−data DisMaxQuery =
815− DisMaxQuery { disMaxQueries :: [Query]
816− -- default 0.0
817− , disMaxTiebreaker :: Tiebreaker
818− , disMaxBoost :: Maybe Boost
819− } deriving (Eq, Show)
820−
821−
822−instance ToJSON DisMaxQuery where
823− toJSON (DisMaxQuery queries tiebreaker boost) =
824− omitNulls base
825− where base = [ "queries" .= queries
826− , "boost" .= boost
827− , "tie_breaker" .= tiebreaker ]
828−
829−instance FromJSON DisMaxQuery where
830− parseJSON = withObject "DisMaxQuery" parse
831− where parse o = DisMaxQuery
832− <$> o .:? "queries" .!= []
833− <*> o .: "tie_breaker"
834− <*> o .:? "boost"
835−
836−data MatchQuery = MatchQuery
837− { matchQueryField :: FieldName
838− , matchQueryQueryString :: QueryString
839− , matchQueryOperator :: BooleanOperator
840− , matchQueryZeroTerms :: ZeroTermsQuery
841− , matchQueryCutoffFrequency :: Maybe CutoffFrequency
842− , matchQueryMatchType :: Maybe MatchQueryType
843− , matchQueryAnalyzer :: Maybe Analyzer
844− , matchQueryMaxExpansions :: Maybe MaxExpansions
845− , matchQueryLenient :: Maybe Lenient
846− , matchQueryBoost :: Maybe Boost
847− , matchQueryMinimumShouldMatch :: Maybe Text
848− , matchQueryFuzziness :: Maybe Fuzziness
849− } deriving (Eq, Show)
850−
851−
852−instance ToJSON MatchQuery where
853− toJSON (MatchQuery (FieldName fieldName)
854− (QueryString mqQueryString) booleanOperator
855− zeroTermsQuery cutoffFrequency matchQueryType
856− analyzer maxExpansions lenient boost
857− minShouldMatch mqFuzziness
858− ) =
859− object [ fieldName .= omitNulls base ]
860− where base = [ "query" .= mqQueryString
861− , "operator" .= booleanOperator
862− , "zero_terms_query" .= zeroTermsQuery
863− , "cutoff_frequency" .= cutoffFrequency
864− , "type" .= matchQueryType
865− , "analyzer" .= analyzer
866− , "max_expansions" .= maxExpansions
867− , "lenient" .= lenient
868− , "boost" .= boost
869− , "minimum_should_match" .= minShouldMatch
870− , "fuzziness" .= mqFuzziness
871− ]
872−
873−instance FromJSON MatchQuery where
874− parseJSON = withObject "MatchQuery" parse
875− where parse = fieldTagged $ \fn o ->
876− MatchQuery fn
877− <$> o .: "query"
878− <*> o .: "operator"
879− <*> o .: "zero_terms_query"
880− <*> o .:? "cutoff_frequency"
881− <*> o .:? "type"
882− <*> o .:? "analyzer"
883− <*> o .:? "max_expansions"
884− <*> o .:? "lenient"
885− <*> o .:? "boost"
886− <*> o .:? "minimum_should_match"
887− <*> o .:? "fuzziness"
888−
889−{-| 'mkMatchQuery' is a convenience function that defaults the less common parameters,
890− enabling you to provide only the 'FieldName' and 'QueryString' to make a 'MatchQuery'
891−-}
892−mkMatchQuery :: FieldName -> QueryString -> MatchQuery
893−mkMatchQuery field query = MatchQuery field query Or ZeroTermsNone Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing
894−
895−data MatchQueryType =
896− MatchPhrase
897− | MatchPhrasePrefix deriving (Eq, Show)
898−
899−instance ToJSON MatchQueryType where
900− toJSON MatchPhrase = "phrase"
901− toJSON MatchPhrasePrefix = "phrase_prefix"
902−
903−instance FromJSON MatchQueryType where
904− parseJSON = withText "MatchQueryType" parse
905− where parse "phrase" = pure MatchPhrase
906− parse "phrase_prefix" = pure MatchPhrasePrefix
907− parse t = fail ("Unexpected MatchQueryType: " <> show t)
908−
909−data MultiMatchQuery = MultiMatchQuery
910− { multiMatchQueryFields :: [FieldName]
911− , multiMatchQueryString :: QueryString
912− , multiMatchQueryOperator :: BooleanOperator
913− , multiMatchQueryZeroTerms :: ZeroTermsQuery
914− , multiMatchQueryTiebreaker :: Maybe Tiebreaker
915− , multiMatchQueryType :: Maybe MultiMatchQueryType
916− , multiMatchQueryCutoffFrequency :: Maybe CutoffFrequency
917− , multiMatchQueryAnalyzer :: Maybe Analyzer
918− , multiMatchQueryMaxExpansions :: Maybe MaxExpansions
919− , multiMatchQueryLenient :: Maybe Lenient
920− } deriving (Eq, Show)
921−
922−instance ToJSON MultiMatchQuery where
923− toJSON (MultiMatchQuery fields (QueryString query) boolOp
924− ztQ tb mmqt cf analyzer maxEx lenient) =
925− object ["multi_match" .= omitNulls base]
926− where base = [ "fields" .= fmap toJSON fields
927− , "query" .= query
928− , "operator" .= boolOp
929− , "zero_terms_query" .= ztQ
930− , "tie_breaker" .= tb
931− , "type" .= mmqt
932− , "cutoff_frequency" .= cf
933− , "analyzer" .= analyzer
934− , "max_expansions" .= maxEx
935− , "lenient" .= lenient ]
936−
937−instance FromJSON MultiMatchQuery where
938− parseJSON = withObject "MultiMatchQuery" parse
939− where parse raw = do o <- raw .: "multi_match"
940− MultiMatchQuery
941− <$> o .:? "fields" .!= []
942− <*> o .: "query"
943− <*> o .: "operator"
944− <*> o .: "zero_terms_query"
945− <*> o .:? "tie_breaker"
946− <*> o .:? "type"
947− <*> o .:? "cutoff_frequency"
948− <*> o .:? "analyzer"
949− <*> o .:? "max_expansions"
950− <*> o .:? "lenient"
951−
952−{-| 'mkMultiMatchQuery' is a convenience function that defaults the less common parameters,
953− enabling you to provide only the list of 'FieldName's and 'QueryString' to
954− make a 'MultiMatchQuery'.
955−-}
956−
957−mkMultiMatchQuery :: [FieldName] -> QueryString -> MultiMatchQuery
958−mkMultiMatchQuery matchFields query =
959− MultiMatchQuery matchFields query
960− Or ZeroTermsNone Nothing Nothing Nothing Nothing Nothing Nothing
961−
962−data MultiMatchQueryType =
963− MultiMatchBestFields
964− | MultiMatchMostFields
965− | MultiMatchCrossFields
966− | MultiMatchPhrase
967− | MultiMatchPhrasePrefix deriving (Eq, Show)
968−
969−instance ToJSON MultiMatchQueryType where
970− toJSON MultiMatchBestFields = "best_fields"
971− toJSON MultiMatchMostFields = "most_fields"
972− toJSON MultiMatchCrossFields = "cross_fields"
973− toJSON MultiMatchPhrase = "phrase"
974− toJSON MultiMatchPhrasePrefix = "phrase_prefix"
975−
976−instance FromJSON MultiMatchQueryType where
977− parseJSON = withText "MultiMatchPhrasePrefix" parse
978− where parse "best_fields" = pure MultiMatchBestFields
979− parse "most_fields" = pure MultiMatchMostFields
980− parse "cross_fields" = pure MultiMatchCrossFields
981− parse "phrase" = pure MultiMatchPhrase
982− parse "phrase_prefix" = pure MultiMatchPhrasePrefix
983− parse t = fail ("Unexpected MultiMatchPhrasePrefix: " <> show t)
984−
985−data BoolQuery =
986− BoolQuery { boolQueryMustMatch :: [Query]
987− , boolQueryFilter :: [Filter]
988− , boolQueryMustNotMatch :: [Query]
989− , boolQueryShouldMatch :: [Query]
990− , boolQueryMinimumShouldMatch :: Maybe MinimumMatch
991− , boolQueryBoost :: Maybe Boost
992− , boolQueryDisableCoord :: Maybe DisableCoord
993− } deriving (Eq, Show)
994−
995−
996−instance ToJSON BoolQuery where
997− toJSON (BoolQuery mustM filterM' notM shouldM bqMin boost disableCoord) =
998− omitNulls base
999− where base = [ "must" .= mustM
1000− , "filter" .= filterM'
1001− , "must_not" .= notM
1002− , "should" .= shouldM
1003− , "minimum_should_match" .= bqMin
1004− , "boost" .= boost
1005− , "disable_coord" .= disableCoord ]
1006−
1007−instance FromJSON BoolQuery where
1008− parseJSON = withObject "BoolQuery" parse
1009− where parse o = BoolQuery
1010− <$> o .:? "must" .!= []
1011− <*> o .:? "filter" .!= []
1012− <*> o .:? "must_not" .!= []
1013− <*> o .:? "should" .!= []
1014− <*> o .:? "minimum_should_match"
1015− <*> o .:? "boost"
1016− <*> o .:? "disable_coord"
1017−
1018−mkBoolQuery :: [Query] -> [Filter] -> [Query] -> [Query] -> BoolQuery
1019−mkBoolQuery must filt mustNot should =
1020− BoolQuery must filt mustNot should Nothing Nothing Nothing
1021−
1022−data BoostingQuery =
1023− BoostingQuery { positiveQuery :: Query
1024− , negativeQuery :: Query
1025− , negativeBoost :: Boost } deriving (Eq, Show)
1026−
1027−instance ToJSON BoostingQuery where
1028− toJSON (BoostingQuery bqPositiveQuery bqNegativeQuery bqNegativeBoost) =
1029− object [ "positive" .= bqPositiveQuery
1030− , "negative" .= bqNegativeQuery
1031− , "negative_boost" .= bqNegativeBoost ]
1032−
1033−instance FromJSON BoostingQuery where
1034− parseJSON = withObject "BoostingQuery" parse
1035− where parse o = BoostingQuery
1036− <$> o .: "positive"
1037− <*> o .: "negative"
1038− <*> o .: "negative_boost"
1039−
1040−data CommonTermsQuery =
1041− CommonTermsQuery { commonField :: FieldName
1042− , commonQuery :: QueryString
1043− , commonCutoffFrequency :: CutoffFrequency
1044− , commonLowFreqOperator :: BooleanOperator
1045− , commonHighFreqOperator :: BooleanOperator
1046− , commonMinimumShouldMatch :: Maybe CommonMinimumMatch
1047− , commonBoost :: Maybe Boost
1048− , commonAnalyzer :: Maybe Analyzer
1049− , commonDisableCoord :: Maybe DisableCoord
1050− } deriving (Eq, Show)
1051−
1052−
1053−instance ToJSON CommonTermsQuery where
1054− toJSON (CommonTermsQuery (FieldName fieldName)
1055− (QueryString query) cf lfo hfo msm
1056− boost analyzer disableCoord) =
1057− object [fieldName .= omitNulls base ]
1058− where base = [ "query" .= query
1059− , "cutoff_frequency" .= cf
1060− , "low_freq_operator" .= lfo
1061− , "minimum_should_match" .= msm
1062− , "boost" .= boost
1063− , "analyzer" .= analyzer
1064− , "disable_coord" .= disableCoord
1065− , "high_freq_operator" .= hfo ]
1066−
1067−instance FromJSON CommonTermsQuery where
1068− parseJSON = withObject "CommonTermsQuery" parse
1069− where parse = fieldTagged $ \fn o ->
1070− CommonTermsQuery fn
1071− <$> o .: "query"
1072− <*> o .: "cutoff_frequency"
1073− <*> o .: "low_freq_operator"
1074− <*> o .: "high_freq_operator"
1075− <*> o .:? "minimum_should_match"
1076− <*> o .:? "boost"
1077− <*> o .:? "analyzer"
1078− <*> o .:? "disable_coord"
1079−
1080−data CommonMinimumMatch =
1081− CommonMinimumMatchHighLow MinimumMatchHighLow
1082− | CommonMinimumMatch MinimumMatch
1083− deriving (Eq, Show)
1084−
1085−
1086−instance ToJSON CommonMinimumMatch where
1087− toJSON (CommonMinimumMatch mm) = toJSON mm
1088− toJSON (CommonMinimumMatchHighLow (MinimumMatchHighLow lowF highF)) =
1089− object [ "low_freq" .= lowF
1090− , "high_freq" .= highF ]
1091−
1092−instance FromJSON CommonMinimumMatch where
1093− parseJSON v = parseMinimum v
1094− <|> parseMinimumHighLow v
1095− where parseMinimum = fmap CommonMinimumMatch . parseJSON
1096− parseMinimumHighLow = fmap CommonMinimumMatchHighLow . withObject "CommonMinimumMatchHighLow" (\o ->
1097− MinimumMatchHighLow
1098− <$> o .: "low_freq"
1099− <*> o .: "high_freq")
1100−
1101−data MinimumMatchHighLow =
1102− MinimumMatchHighLow { lowFreq :: MinimumMatch
1103− , highFreq :: MinimumMatch } deriving (Eq, Show)
1104−
1105−data ZeroTermsQuery =
1106− ZeroTermsNone
1107− | ZeroTermsAll deriving (Eq, Show)
1108−
1109−instance ToJSON ZeroTermsQuery where
1110− toJSON ZeroTermsNone = String "none"
1111− toJSON ZeroTermsAll = String "all"
1112−
1113−instance FromJSON ZeroTermsQuery where
1114− parseJSON = withText "ZeroTermsQuery" parse
1115− where parse "none" = pure ZeroTermsNone
1116− parse "all" = pure ZeroTermsAll
1117− parse q = fail ("Unexpected ZeroTermsQuery: " <> show q)
1118−
1119−data RangeExecution = RangeExecutionIndex
1120− | RangeExecutionFielddata deriving (Eq, Show)
1121−
1122−-- index for smaller ranges, fielddata for longer ranges
1123−instance ToJSON RangeExecution where
1124− toJSON RangeExecutionIndex = "index"
1125− toJSON RangeExecutionFielddata = "fielddata"
1126−
1127−
1128−instance FromJSON RangeExecution where
1129− parseJSON = withText "RangeExecution" parse
1130− where parse "index" = pure RangeExecutionIndex
1131− parse "fielddata" = pure RangeExecutionFielddata
1132− parse t = error ("Unrecognized RangeExecution " <> show t)
1133−
1134−newtype Regexp = Regexp Text deriving (Eq, Show, FromJSON)
1135−
1136−data RegexpFlags = AllRegexpFlags
1137− | NoRegexpFlags
1138− | SomeRegexpFlags (NonEmpty RegexpFlag) deriving (Eq, Show)
1139−
1140−instance ToJSON RegexpFlags where
1141− toJSON AllRegexpFlags = String "ALL"
1142− toJSON NoRegexpFlags = String "NONE"
1143− toJSON (SomeRegexpFlags (h :| fs)) = String $ T.intercalate "|" flagStrs
1144− where flagStrs = map flagStr . nub $ h:fs
1145− flagStr AnyString = "ANYSTRING"
1146− flagStr Automaton = "AUTOMATON"
1147− flagStr Complement = "COMPLEMENT"
1148− flagStr Empty = "EMPTY"
1149− flagStr Intersection = "INTERSECTION"
1150− flagStr Interval = "INTERVAL"
1151−
1152−instance FromJSON RegexpFlags where
1153− parseJSON = withText "RegexpFlags" parse
1154− where parse "ALL" = pure AllRegexpFlags
1155− parse "NONE" = pure NoRegexpFlags
1156− parse t = SomeRegexpFlags <$> parseNEJSON (String <$> T.splitOn "|" t)
1157−
1158−data RegexpFlag = AnyString
1159− | Automaton
1160− | Complement
1161− | Empty
1162− | Intersection
1163− | Interval deriving (Eq, Show)
1164−
1165−instance FromJSON RegexpFlag where
1166− parseJSON = withText "RegexpFlag" parse
1167− where parse "ANYSTRING" = pure AnyString
1168− parse "AUTOMATON" = pure Automaton
1169− parse "COMPLEMENT" = pure Complement
1170− parse "EMPTY" = pure Empty
1171− parse "INTERSECTION" = pure Intersection
1172− parse "INTERVAL" = pure Interval
1173− parse f = fail ("Unknown RegexpFlag: " <> show f)
1174−
1175−newtype LessThan = LessThan Double deriving (Eq, Show)
1176−newtype LessThanEq = LessThanEq Double deriving (Eq, Show)
1177−newtype GreaterThan = GreaterThan Double deriving (Eq, Show)
1178−newtype GreaterThanEq = GreaterThanEq Double deriving (Eq, Show)
1179−
1180−newtype LessThanD = LessThanD UTCTime deriving (Eq, Show)
1181−newtype LessThanEqD = LessThanEqD UTCTime deriving (Eq, Show)
1182−newtype GreaterThanD = GreaterThanD UTCTime deriving (Eq, Show)
1183−newtype GreaterThanEqD = GreaterThanEqD UTCTime deriving (Eq, Show)
1184−
1185−data RangeValue = RangeDateLte LessThanEqD
1186− | RangeDateLt LessThanD
1187− | RangeDateGte GreaterThanEqD
1188− | RangeDateGt GreaterThanD
1189− | RangeDateGtLt GreaterThanD LessThanD
1190− | RangeDateGteLte GreaterThanEqD LessThanEqD
1191− | RangeDateGteLt GreaterThanEqD LessThanD
1192− | RangeDateGtLte GreaterThanD LessThanEqD
1193− | RangeDoubleLte LessThanEq
1194− | RangeDoubleLt LessThan
1195− | RangeDoubleGte GreaterThanEq
1196− | RangeDoubleGt GreaterThan
1197− | RangeDoubleGtLt GreaterThan LessThan
1198− | RangeDoubleGteLte GreaterThanEq LessThanEq
1199− | RangeDoubleGteLt GreaterThanEq LessThan
1200− | RangeDoubleGtLte GreaterThan LessThanEq
1201− deriving (Eq, Show)
1202−
1203−
1204−parseRangeValue :: ( FromJSON t4
1205− , FromJSON t3
1206− , FromJSON t2
1207− , FromJSON t1
1208− )
1209− => (t3 -> t5)
1210− -> (t1 -> t6)
1211− -> (t4 -> t7)
1212− -> (t2 -> t8)
1213− -> (t5 -> t6 -> b)
1214− -> (t7 -> t6 -> b)
1215− -> (t5 -> t8 -> b)
1216− -> (t7 -> t8 -> b)
1217− -> (t5 -> b)
1218− -> (t6 -> b)
1219− -> (t7 -> b)
1220− -> (t8 -> b)
1221− -> Parser b
1222− -> Object
1223− -> Parser b
1224−parseRangeValue mkGt mkLt mkGte mkLte
1225− fGtLt fGteLt fGtLte fGteLte
1226− fGt fLt fGte fLte nada o = do
1227− lt <- o .:? "lt"
1228− lte <- o .:? "lte"
1229− gt <- o .:? "gt"
1230− gte <- o .:? "gte"
1231− case (lt, lte, gt, gte) of
1232− (Just a, _, Just b, _) ->
1233− return (fGtLt (mkGt b) (mkLt a))
1234− (Just a, _, _, Just b) ->
1235− return (fGteLt (mkGte b) (mkLt a))
1236− (_, Just a, Just b, _) ->
1237− return (fGtLte (mkGt b) (mkLte a))
1238− (_, Just a, _, Just b) ->
1239− return (fGteLte (mkGte b) (mkLte a))
1240− (_, _, Just a, _) ->
1241− return (fGt (mkGt a))
1242− (Just a, _, _, _) ->
1243− return (fLt (mkLt a))
1244− (_, _, _, Just a) ->
1245− return (fGte (mkGte a))
1246− (_, Just a, _, _) ->
1247− return (fLte (mkLte a))
1248− (Nothing, Nothing, Nothing, Nothing) ->
1249− nada
1250−
1251−
1252−instance FromJSON RangeValue where
1253− parseJSON = withObject "RangeValue" parse
1254− where parse o = parseDate o
1255− <|> parseDouble o
1256− parseDate o =
1257− parseRangeValue
1258− GreaterThanD LessThanD
1259− GreaterThanEqD LessThanEqD
1260− RangeDateGtLt RangeDateGteLt
1261− RangeDateGtLte RangeDateGteLte
1262− RangeDateGt RangeDateLt
1263− RangeDateGte RangeDateLte
1264− mzero o
1265− parseDouble o =
1266− parseRangeValue
1267− GreaterThan LessThan
1268− GreaterThanEq LessThanEq
1269− RangeDoubleGtLt RangeDoubleGteLt
1270− RangeDoubleGtLte RangeDoubleGteLte
1271− RangeDoubleGt RangeDoubleLt
1272− RangeDoubleGte RangeDoubleLte
1273− mzero o
1274−
1275−rangeValueToPair :: RangeValue -> [Pair]
1276−rangeValueToPair rv = case rv of
1277− RangeDateLte (LessThanEqD t) -> ["lte" .= t]
1278− RangeDateGte (GreaterThanEqD t) -> ["gte" .= t]
1279− RangeDateLt (LessThanD t) -> ["lt" .= t]
1280− RangeDateGt (GreaterThanD t) -> ["gt" .= t]
1281− RangeDateGteLte (GreaterThanEqD l) (LessThanEqD g) -> ["gte" .= l, "lte" .= g]
1282− RangeDateGtLte (GreaterThanD l) (LessThanEqD g) -> ["gt" .= l, "lte" .= g]
1283− RangeDateGteLt (GreaterThanEqD l) (LessThanD g) -> ["gte" .= l, "lt" .= g]
1284− RangeDateGtLt (GreaterThanD l) (LessThanD g) -> ["gt" .= l, "lt" .= g]
1285− RangeDoubleLte (LessThanEq t) -> ["lte" .= t]
1286− RangeDoubleGte (GreaterThanEq t) -> ["gte" .= t]
1287− RangeDoubleLt (LessThan t) -> ["lt" .= t]
1288− RangeDoubleGt (GreaterThan t) -> ["gt" .= t]
1289− RangeDoubleGteLte (GreaterThanEq l) (LessThanEq g) -> ["gte" .= l, "lte" .= g]
1290− RangeDoubleGtLte (GreaterThan l) (LessThanEq g) -> ["gt" .= l, "lte" .= g]
1291− RangeDoubleGteLt (GreaterThanEq l) (LessThan g) -> ["gte" .= l, "lt" .= g]
1292− RangeDoubleGtLt (GreaterThan l) (LessThan g) -> ["gt" .= l, "lt" .= g]
1293−
1294−data Term = Term { termField :: Text
1295− , termValue :: Text } deriving (Eq, Show)
1296−
1297−instance ToJSON Term where
1298− toJSON (Term field value) = object ["term" .= object
1299− [field .= value]]
1300−
1301−instance FromJSON Term where
1302− parseJSON = withObject "Term" parse
1303− where parse o = do termObj <- o .: "term"
1304− case HM.toList termObj of
1305− [(fn, v)] -> Term fn <$> parseJSON v
1306− _ -> fail "Expected object with 1 field-named key"
1307−
1308−data BoolMatch = MustMatch Term Cache
1309− | MustNotMatch Term Cache
1310− | ShouldMatch [Term] Cache deriving (Eq, Show)
1311−
1312−
1313−instance ToJSON BoolMatch where
1314− toJSON (MustMatch term cache) = object ["must" .= term,
1315− "_cache" .= cache]
1316− toJSON (MustNotMatch term cache) = object ["must_not" .= term,
1317− "_cache" .= cache]
1318− toJSON (ShouldMatch terms cache) = object ["should" .= fmap toJSON terms,
1319− "_cache" .= cache]
1320−
1321−instance FromJSON BoolMatch where
1322− parseJSON = withObject "BoolMatch" parse
1323− where parse o = mustMatch `taggedWith` "must"
1324− <|> mustNotMatch `taggedWith` "must_not"
1325− <|> shouldMatch `taggedWith` "should"
1326− where taggedWith parser k = parser =<< o .: k
1327− mustMatch t = MustMatch t <$> o .:? "_cache" .!= defaultCache
1328− mustNotMatch t = MustNotMatch t <$> o .:? "_cache" .!= defaultCache
1329− shouldMatch t = ShouldMatch t <$> o .:? "_cache" .!= defaultCache
1330−
1331−-- "memory" or "indexed"
1332−data GeoFilterType = GeoFilterMemory
1333− | GeoFilterIndexed deriving (Eq, Show)
1334−
1335−instance ToJSON GeoFilterType where
1336− toJSON GeoFilterMemory = String "memory"
1337− toJSON GeoFilterIndexed = String "indexed"
1338−
1339−instance FromJSON GeoFilterType where
1340− parseJSON = withText "GeoFilterType" parse
1341− where parse "memory" = pure GeoFilterMemory
1342− parse "indexed" = pure GeoFilterIndexed
1343− parse t = fail ("Unrecognized GeoFilterType: " <> show t)
1344−
1345−data LatLon = LatLon { lat :: Double
1346− , lon :: Double } deriving (Eq, Show)
1347−
1348−instance ToJSON LatLon where
1349− toJSON (LatLon lLat lLon) =
1350− object ["lat" .= lLat
1351− , "lon" .= lLon]
1352−
1353−instance FromJSON LatLon where
1354− parseJSON = withObject "LatLon" parse
1355− where parse o = LatLon <$> o .: "lat"
1356− <*> o .: "lon"
1357−
1358−data GeoBoundingBox =
1359− GeoBoundingBox { topLeft :: LatLon
1360− , bottomRight :: LatLon } deriving (Eq, Show)
1361−
1362−instance ToJSON GeoBoundingBox where
1363− toJSON (GeoBoundingBox gbbTopLeft gbbBottomRight) =
1364− object ["top_left" .= gbbTopLeft
1365− , "bottom_right" .= gbbBottomRight]
1366−
1367−instance FromJSON GeoBoundingBox where
1368− parseJSON = withObject "GeoBoundingBox" parse
1369− where parse o = GeoBoundingBox
1370− <$> o .: "top_left"
1371− <*> o .: "bottom_right"
1372−
1373−data GeoBoundingBoxConstraint =
1374− GeoBoundingBoxConstraint { geoBBField :: FieldName
1375− , constraintBox :: GeoBoundingBox
1376− , bbConstraintcache :: Cache
1377− , geoType :: GeoFilterType
1378− } deriving (Eq, Show)
1379−
1380−instance ToJSON GeoBoundingBoxConstraint where
1381− toJSON (GeoBoundingBoxConstraint
1382− (FieldName gbbcGeoBBField) gbbcConstraintBox cache type') =
1383− object [gbbcGeoBBField .= gbbcConstraintBox
1384− , "_cache" .= cache
1385− , "type" .= type']
1386−
1387−instance FromJSON GeoBoundingBoxConstraint where
1388− parseJSON = withObject "GeoBoundingBoxConstraint" parse
1389− where parse o = case HM.toList (deleteSeveral ["type", "_cache"] o) of
1390− [(fn, v)] -> GeoBoundingBoxConstraint (FieldName fn)
1391− <$> parseJSON v
1392− <*> o .:? "_cache" .!= defaultCache
1393− <*> o .: "type"
1394− _ -> fail "Could not find field name for GeoBoundingBoxConstraint"
1395−
1396−data GeoPoint =
1397− GeoPoint { geoField :: FieldName
1398− , latLon :: LatLon} deriving (Eq, Show)
1399−
1400−instance ToJSON GeoPoint where
1401− toJSON (GeoPoint (FieldName geoPointField) geoPointLatLon) =
1402− object [ geoPointField .= geoPointLatLon ]
1403−
1404−data DistanceUnit = Miles
1405− | Yards
1406− | Feet
1407− | Inches
1408− | Kilometers
1409− | Meters
1410− | Centimeters
1411− | Millimeters
1412− | NauticalMiles deriving (Eq, Show)
1413−
1414−instance ToJSON DistanceUnit where
1415− toJSON Miles = String "mi"
1416− toJSON Yards = String "yd"
1417− toJSON Feet = String "ft"
1418− toJSON Inches = String "in"
1419− toJSON Kilometers = String "km"
1420− toJSON Meters = String "m"
1421− toJSON Centimeters = String "cm"
1422− toJSON Millimeters = String "mm"
1423− toJSON NauticalMiles = String "nmi"
1424−
1425−instance FromJSON DistanceUnit where
1426− parseJSON = withText "DistanceUnit" parse
1427− where parse "mi" = pure Miles
1428− parse "yd" = pure Yards
1429− parse "ft" = pure Feet
1430− parse "in" = pure Inches
1431− parse "km" = pure Kilometers
1432− parse "m" = pure Meters
1433− parse "cm" = pure Centimeters
1434− parse "mm" = pure Millimeters
1435− parse "nmi" = pure NauticalMiles
1436− parse u = fail ("Unrecognized DistanceUnit: " <> show u)
1437−
1438−data DistanceType = Arc
1439− | SloppyArc -- doesn't exist <1.0
1440− | Plane deriving (Eq, Show)
1441−
1442−instance ToJSON DistanceType where
1443− toJSON Arc = String "arc"
1444− toJSON SloppyArc = String "sloppy_arc"
1445− toJSON Plane = String "plane"
1446−
1447−instance FromJSON DistanceType where
1448− parseJSON = withText "DistanceType" parse
1449− where parse "arc" = pure Arc
1450− parse "sloppy_arc" = pure SloppyArc
1451− parse "plane" = pure Plane
1452− parse t = fail ("Unrecognized DistanceType: " <> show t)
1453−
1454−data OptimizeBbox = OptimizeGeoFilterType GeoFilterType
1455− | NoOptimizeBbox deriving (Eq, Show)
1456−
1457−
1458−instance ToJSON OptimizeBbox where
1459− toJSON NoOptimizeBbox = String "none"
1460− toJSON (OptimizeGeoFilterType gft) = toJSON gft
1461−
1462−instance FromJSON OptimizeBbox where
1463− parseJSON v = withText "NoOptimizeBbox" parseNoOptimize v
1464− <|> parseOptimize v
1465− where parseNoOptimize "none" = pure NoOptimizeBbox
1466− parseNoOptimize _ = mzero
1467− parseOptimize = fmap OptimizeGeoFilterType . parseJSON
1468−
1469−data Distance =
1470− Distance { coefficient :: Double
1471− , unit :: DistanceUnit } deriving (Eq, Show)
1472−
1473−
1474−instance ToJSON Distance where
1475− toJSON (Distance dCoefficient dUnit) =
1476− String boltedTogether where
1477− coefText = showText dCoefficient
1478− (String unitText) = toJSON dUnit
1479− boltedTogether = mappend coefText unitText
1480−
1481−instance FromJSON Distance where
1482− parseJSON = withText "Distance" parse
1483− where parse t = Distance <$> parseCoeff nT
1484− <*> parseJSON (String unitT)
1485− where (nT, unitT) = T.span validForNumber t
1486− -- may be a better way to do this
1487− validForNumber '-' = True
1488− validForNumber '.' = True
1489− validForNumber 'e' = True
1490− validForNumber c = isNumber c
1491− parseCoeff "" = fail "Empty string cannot be parsed as number"
1492− parseCoeff s = return (read (T.unpack s))
1493−
1494−data DistanceRange =
1495− DistanceRange { distanceFrom :: Distance
1496− , distanceTo :: Distance } deriving (Eq, Show)
1497−
1498−type TemplateQueryKey = Text
1499−type TemplateQueryValue = Text
1500−
1501−newtype TemplateQueryKeyValuePairs =
1502− TemplateQueryKeyValuePairs (HM.HashMap TemplateQueryKey TemplateQueryValue)
1503− deriving (Eq, Show)
1504−
1505−instance ToJSON TemplateQueryKeyValuePairs where
1506− toJSON (TemplateQueryKeyValuePairs x) =
1507− Object $ HM.map toJSON x
1508−
1509−instance FromJSON TemplateQueryKeyValuePairs where
1510− parseJSON (Object o) =
1511− pure . TemplateQueryKeyValuePairs $ HM.mapMaybe getValue o
1512− where getValue (String x) = Just x
1513− getValue _ = Nothing
1514− parseJSON _ =
1515− fail "error parsing TemplateQueryKeyValuePairs"
1516−
1517−data TemplateQueryInline =
1518− TemplateQueryInline { inline :: Query
1519− , params :: TemplateQueryKeyValuePairs
1520− }
1521− deriving (Eq, Show)
1522−
1523−instance ToJSON TemplateQueryInline where
1524− toJSON TemplateQueryInline{..} = object [ "inline" .= inline
1525− , "params" .= params
1526− ]
1527−
1528−instance FromJSON TemplateQueryInline where
1529− parseJSON = withObject "TemplateQueryInline" parse
1530− where parse o = TemplateQueryInline
1531− <$> o .: "inline"
1532− <*> o .: "params"
1533−
1534−{-| 'BooleanOperator' is the usual And/Or operators with an ES compatible
1535− JSON encoding baked in. Used all over the place.
1536−-}
1537−data BooleanOperator = And | Or deriving (Eq, Show)
1538−
1539−instance ToJSON BooleanOperator where
1540− toJSON And = String "and"
1541− toJSON Or = String "or"
1542−
1543−instance FromJSON BooleanOperator where
1544− parseJSON = withText "BooleanOperator" parse
1545− where parse "and" = pure And
1546− parse "or" = pure Or
1547− parse o = fail ("Unexpected BooleanOperator: " <> show o)
1548−
1549−{-| 'Cache' is for telling ES whether it should cache a 'Filter' not.
1550− 'Query's cannot be cached.
1551−-}
1552−type Cache = Bool -- caching on/off
1553−defaultCache :: Cache
1554−defaultCache = False
1555−
1556−
1557−data FunctionScoreQuery =
1558− FunctionScoreQuery { functionScoreQuery :: Maybe Query
1559− , functionScoreBoost :: Maybe Boost
1560− , functionScoreFunctions :: FunctionScoreFunctions
1561− , functionScoreMaxBoost :: Maybe Boost
1562− , functionScoreBoostMode :: Maybe BoostMode
1563− , functionScoreMinScore :: Score
1564− , functionScoreScoreMode :: Maybe ScoreMode
1565− } deriving (Eq, Show)
1566−
1567−instance ToJSON FunctionScoreQuery where
1568− toJSON (FunctionScoreQuery query boost fns maxBoost boostMode minScore scoreMode) =
1569− omitNulls base
1570− where base = functionScoreFunctionsPair fns :
1571− [ "query" .= query
1572− , "boost" .= boost
1573− , "max_boost" .= maxBoost
1574− , "boost_mode" .= boostMode
1575− , "min_score" .= minScore
1576− , "score_mode" .= scoreMode ]
1577−
1578−instance FromJSON FunctionScoreQuery where
1579− parseJSON = withObject "FunctionScoreQuery" parse
1580− where parse o = FunctionScoreQuery
1581− <$> o .:? "query"
1582− <*> o .:? "boost"
1583− <*> (singleFunction o
1584− <|> multipleFunctions `taggedWith` "functions")
1585− <*> o .:? "max_boost"
1586− <*> o .:? "boost_mode"
1587− <*> o .:? "min_score"
1588− <*> o .:? "score_mode"
1589− where taggedWith parser k = parser =<< o .: k
1590− singleFunction = fmap FunctionScoreSingle . parseFunctionScoreFunction
1591− multipleFunctions = pure . FunctionScoreMultiple
1592−
1593−data FunctionScoreFunctions =
1594− FunctionScoreSingle FunctionScoreFunction
1595− | FunctionScoreMultiple (NonEmpty ComponentFunctionScoreFunction) deriving (Eq, Show)
1596−
1597−data ComponentFunctionScoreFunction =
1598− ComponentFunctionScoreFunction { componentScoreFunctionFilter :: Maybe Filter
1599− , componentScoreFunction :: FunctionScoreFunction
1600− , componentScoreFunctionWeight :: Maybe Weight
1601− } deriving (Eq, Show)
1602−
1603−instance ToJSON ComponentFunctionScoreFunction where
1604− toJSON (ComponentFunctionScoreFunction filter' fn weight) =
1605− omitNulls base
1606− where base = functionScoreFunctionPair fn :
1607− [ "filter" .= filter'
1608− , "weight" .= weight ]
1609−
1610−instance FromJSON ComponentFunctionScoreFunction where
1611− parseJSON = withObject "ComponentFunctionScoreFunction" parse
1612− where parse o = ComponentFunctionScoreFunction
1613− <$> o .:? "filter"
1614− <*> parseFunctionScoreFunction o
1615− <*> o .:? "weight"
1616−
1617−functionScoreFunctionsPair :: FunctionScoreFunctions -> (Text, Value)
1618−functionScoreFunctionsPair (FunctionScoreSingle fn)
1619− = functionScoreFunctionPair fn
1620−functionScoreFunctionsPair (FunctionScoreMultiple componentFns) =
1621− ("functions", toJSON componentFns)
1622−
1623−fieldTagged :: Monad m => (FieldName -> Object -> m a) -> Object -> m a
1624−fieldTagged f o = case HM.toList o of
1625− [(k, Object o')] -> f (FieldName k) o'
1626− _ -> fail "Expected object with 1 field-named key"
1627−
1628−-- | Fuzziness value as a number or 'AUTO'.
1629−-- See:
1630−-- https://www.elastic.co/guide/en/elasticsearch/reference/current/common-options.html#fuzziness
1631−data Fuzziness = Fuzziness Double | FuzzinessAuto
1632− deriving (Eq, Show)
1633−
1634−instance ToJSON Fuzziness where
1635− toJSON (Fuzziness n) = toJSON n
1636− toJSON FuzzinessAuto = String "AUTO"
1637−
1638−instance FromJSON Fuzziness where
1639− parseJSON (String "AUTO") = return FuzzinessAuto
1640− parseJSON v = Fuzziness <$> parseJSON v
src/Database/Bloodhound/Internal/Sort.hsdeleted−107
@@ -1,107 +0,0 @@
1−{-# LANGUAGE GeneralizedNewtypeDeriving #-}
2−{-# LANGUAGE OverloadedStrings #-}
3−{-# LANGUAGE RecordWildCards #-}
4−
5−module Database.Bloodhound.Internal.Sort where
6−
7−import Bloodhound.Import
8−
9−import Database.Bloodhound.Internal.Newtypes
10−import Database.Bloodhound.Internal.Query
11−
12−{-| 'SortMode' prescribes how to handle sorting array/multi-valued fields.
13−
14−http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/search-request-sort.html#_sort_mode_option
15−-}
16−data SortMode = SortMin
17− | SortMax
18− | SortSum
19− | SortAvg deriving (Eq, Show)
20−
21−instance ToJSON SortMode where
22− toJSON SortMin = String "min"
23− toJSON SortMax = String "max"
24− toJSON SortSum = String "sum"
25− toJSON SortAvg = String "avg"
26−
27−{-| 'mkSort' defaults everything but the 'FieldName' and the 'SortOrder' so
28− that you can concisely describe the usual kind of 'SortSpec's you want.
29−-}
30−mkSort :: FieldName -> SortOrder -> DefaultSort
31−mkSort fieldName sOrder = DefaultSort fieldName sOrder Nothing Nothing Nothing Nothing
32−
33−{-| 'Sort' is a synonym for a list of 'SortSpec's. Sort behavior is order
34− dependent with later sorts acting as tie-breakers for earlier sorts.
35−-}
36−type Sort = [SortSpec]
37−
38−{-| The two main kinds of 'SortSpec' are 'DefaultSortSpec' and
39− 'GeoDistanceSortSpec'. The latter takes a 'SortOrder', 'GeoPoint', and
40− 'DistanceUnit' to express "nearness" to a single geographical point as a
41− sort specification.
42−
43−<http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/search-request-sort.html#search-request-sort>
44−-}
45−data SortSpec =
46− DefaultSortSpec DefaultSort
47− | GeoDistanceSortSpec SortOrder GeoPoint DistanceUnit
48− deriving (Eq, Show)
49−
50−instance ToJSON SortSpec where
51− toJSON (DefaultSortSpec
52− (DefaultSort (FieldName dsSortFieldName) dsSortOrder dsIgnoreUnmapped
53− dsSortMode dsMissingSort dsNestedFilter)) =
54− object [dsSortFieldName .= omitNulls base] where
55− base = [ "order" .= dsSortOrder
56− , "unmapped_type" .= dsIgnoreUnmapped
57− , "mode" .= dsSortMode
58− , "missing" .= dsMissingSort
59− , "nested_filter" .= dsNestedFilter ]
60−
61− toJSON (GeoDistanceSortSpec gdsSortOrder (GeoPoint (FieldName field) gdsLatLon) units) =
62− object [ "unit" .= units
63− , field .= gdsLatLon
64− , "order" .= gdsSortOrder ]
65−
66−{-| 'DefaultSort' is usually the kind of 'SortSpec' you'll want. There's a
67− 'mkSort' convenience function for when you want to specify only the most
68− common parameters.
69−
70− The `ignoreUnmapped`, when `Just` field is used to set the elastic 'unmapped_type'
71−
72−<http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/search-request-sort.html#search-request-sort>
73−-}
74−data DefaultSort =
75− DefaultSort { sortFieldName :: FieldName
76− , sortOrder :: SortOrder
77− -- default False
78− , ignoreUnmapped :: Maybe Text
79− , sortMode :: Maybe SortMode
80− , missingSort :: Maybe Missing
81− , nestedFilter :: Maybe Filter } deriving (Eq, Show)
82−
83−{-| 'SortOrder' is 'Ascending' or 'Descending', as you might expect. These get
84− encoded into "asc" or "desc" when turned into JSON.
85−
86−<http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/search-request-sort.html#search-request-sort>
87−-}
88−data SortOrder = Ascending
89− | Descending deriving (Eq, Show)
90−
91−instance ToJSON SortOrder where
92− toJSON Ascending = String "asc"
93− toJSON Descending = String "desc"
94−
95−{-| 'Missing' prescribes how to handle missing fields. A missing field can be
96− sorted last, first, or using a custom value as a substitute.
97−
98−<http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/search-request-sort.html#_missing_values>
99−-}
100−data Missing = LastMissing
101− | FirstMissing
102− | CustomMissing Text deriving (Eq, Show)
103−
104−instance ToJSON Missing where
105− toJSON LastMissing = String "_last"
106− toJSON FirstMissing = String "_first"
107− toJSON (CustomMissing txt) = String txt
src/Database/Bloodhound/Internal/StringlyTyped.hsdeleted−51
@@ -1,51 +0,0 @@
1−{-# LANGUAGE OverloadedStrings #-}
2−
3−module Database.Bloodhound.Internal.StringlyTyped where
4−
5−import Bloodhound.Import
6−
7−import qualified Data.Text as T
8−
9−
10−-- This whole module is a sin bucket to deal with Elasticsearch badness.
11−newtype StringlyTypedDouble = StringlyTypedDouble
12− { unStringlyTypedDouble :: Double }
13−
14−instance FromJSON StringlyTypedDouble where
15− parseJSON =
16− fmap StringlyTypedDouble
17− . parseJSON
18− . unStringlyTypeJSON
19−
20−newtype StringlyTypedInt = StringlyTypedInt
21− { unStringlyTypedInt :: Int }
22−
23−instance FromJSON StringlyTypedInt where
24− parseJSON =
25− fmap StringlyTypedInt
26− . parseJSON
27− . unStringlyTypeJSON
28−
29−newtype StringlyTypedBool = StringlyTypedBool { unStringlyTypedBool :: Bool }
30−
31−instance FromJSON StringlyTypedBool where
32− parseJSON =
33− fmap StringlyTypedBool
34− . parseJSON
35− . unStringlyTypeJSON
36−
37−-- | For some reason in several settings APIs, all leaf values get returned
38−-- as strings. This function attempts to recover from this for all
39−-- non-recursive JSON types. If nothing can be done, the value is left alone.
40−unStringlyTypeJSON :: Value -> Value
41−unStringlyTypeJSON (String "true") =
42− Bool True
43−unStringlyTypeJSON (String "false") =
44− Bool False
45−unStringlyTypeJSON (String "null") =
46− Null
47−unStringlyTypeJSON v@(String t) =
48− case readMay (T.unpack t) of
49− Just n -> Number n
50− Nothing -> v
51−unStringlyTypeJSON v = v
src/Database/Bloodhound/Internal/Suggest.hsdeleted−270
@@ -1,270 +0,0 @@
1−{-# LANGUAGE GeneralizedNewtypeDeriving #-}
2−{-# LANGUAGE RecordWildCards #-}
3−{-# LANGUAGE OverloadedStrings #-}
4−
5−module Database.Bloodhound.Internal.Suggest where
6−
7−import Bloodhound.Import
8−
9−import qualified Data.HashMap.Strict as HM
10−
11−import Database.Bloodhound.Internal.Newtypes
12−import Database.Bloodhound.Internal.Query (TemplateQueryInline(..), params)
13−
14−data Suggest = Suggest
15− { suggestText :: Text
16− , suggestName :: Text
17− , suggestType :: SuggestType
18− } deriving (Eq, Show)
19−
20−instance ToJSON Suggest where
21− toJSON Suggest{..} =
22− object [ "text" .= suggestText
23− , suggestName .= suggestType
24− ]
25−
26−instance FromJSON Suggest where
27− parseJSON (Object o) = do
28− suggestText' <- o .: "text"
29− let dropTextList =
30− HM.toList
31− $ HM.filterWithKey (\x _ -> x /= "text") o
32− suggestName' <-
33− case dropTextList of
34− [(x, _)] -> return x
35− _ -> fail "error parsing Suggest field name"
36− suggestType' <- o .: suggestName'
37− return $ Suggest suggestText' suggestName' suggestType'
38− parseJSON x = typeMismatch "Suggest" x
39−
40−data SuggestType =
41− SuggestTypePhraseSuggester PhraseSuggester
42− deriving (Eq, Show)
43−
44−instance ToJSON SuggestType where
45− toJSON (SuggestTypePhraseSuggester x) =
46− object [ "phrase" .= x ]
47−
48−instance FromJSON SuggestType where
49− parseJSON = withObject "SuggestType" parse
50− where parse o = phraseSuggester `taggedWith` "phrase"
51− where taggedWith parser k = parser =<< o .: k
52− phraseSuggester = pure . SuggestTypePhraseSuggester
53−
54−data PhraseSuggester = PhraseSuggester
55− { phraseSuggesterField :: FieldName
56− , phraseSuggesterGramSize :: Maybe Int
57− , phraseSuggesterRealWordErrorLikelihood :: Maybe Int
58− , phraseSuggesterConfidence :: Maybe Int
59− , phraseSuggesterMaxErrors :: Maybe Int
60− , phraseSuggesterSeparator :: Maybe Text
61− , phraseSuggesterSize :: Maybe Size
62− , phraseSuggesterAnalyzer :: Maybe Analyzer
63− , phraseSuggesterShardSize :: Maybe Int
64− , phraseSuggesterHighlight :: Maybe PhraseSuggesterHighlighter
65− , phraseSuggesterCollate :: Maybe PhraseSuggesterCollate
66− , phraseSuggesterCandidateGenerators :: [DirectGenerators]
67− } deriving (Eq, Show)
68−
69−instance ToJSON PhraseSuggester where
70− toJSON PhraseSuggester{..} =
71− omitNulls [ "field" .= phraseSuggesterField
72− , "gram_size" .= phraseSuggesterGramSize
73− , "real_word_error_likelihood" .=
74− phraseSuggesterRealWordErrorLikelihood
75− , "confidence" .= phraseSuggesterConfidence
76− , "max_errors" .= phraseSuggesterMaxErrors
77− , "separator" .= phraseSuggesterSeparator
78− , "size" .= phraseSuggesterSize
79− , "analyzer" .= phraseSuggesterAnalyzer
80− , "shard_size" .= phraseSuggesterShardSize
81− , "highlight" .= phraseSuggesterHighlight
82− , "collate" .= phraseSuggesterCollate
83− , "direct_generator" .=
84− phraseSuggesterCandidateGenerators
85− ]
86−
87−instance FromJSON PhraseSuggester where
88− parseJSON = withObject "PhraseSuggester" parse
89− where parse o = PhraseSuggester
90− <$> o .: "field"
91− <*> o .:? "gram_size"
92− <*> o .:? "real_word_error_likelihood"
93− <*> o .:? "confidence"
94− <*> o .:? "max_errors"
95− <*> o .:? "separator"
96− <*> o .:? "size"
97− <*> o .:? "analyzer"
98− <*> o .:? "shard_size"
99− <*> o .:? "highlight"
100− <*> o .:? "collate"
101− <*> o .:? "direct_generator" .!= []
102−
103−mkPhraseSuggester :: FieldName -> PhraseSuggester
104−mkPhraseSuggester fName =
105− PhraseSuggester fName Nothing Nothing Nothing Nothing Nothing Nothing
106− Nothing Nothing Nothing Nothing []
107−
108−data PhraseSuggesterHighlighter =
109− PhraseSuggesterHighlighter { phraseSuggesterHighlighterPreTag :: Text
110− , phraseSuggesterHighlighterPostTag :: Text
111− }
112− deriving (Eq, Show)
113−
114−instance ToJSON PhraseSuggesterHighlighter where
115− toJSON PhraseSuggesterHighlighter{..} =
116− object [ "pre_tag" .= phraseSuggesterHighlighterPreTag
117− , "post_tag" .= phraseSuggesterHighlighterPostTag
118− ]
119−
120−instance FromJSON PhraseSuggesterHighlighter where
121− parseJSON = withObject "PhraseSuggesterHighlighter" parse
122− where parse o = PhraseSuggesterHighlighter
123− <$> o .: "pre_tag"
124− <*> o .: "post_tag"
125−
126−data PhraseSuggesterCollate = PhraseSuggesterCollate
127− { phraseSuggesterCollateTemplateQuery :: TemplateQueryInline
128− , phraseSuggesterCollatePrune :: Bool
129− } deriving (Eq, Show)
130−
131−instance ToJSON PhraseSuggesterCollate where
132− toJSON PhraseSuggesterCollate{..} =
133− object [ "query" .= object
134− [ "inline" .= (inline phraseSuggesterCollateTemplateQuery)
135− ]
136− , "params" .= (params phraseSuggesterCollateTemplateQuery)
137− , "prune" .= phraseSuggesterCollatePrune
138− ]
139−
140−instance FromJSON PhraseSuggesterCollate where
141− parseJSON (Object o) = do
142− query' <- o .: "query"
143− inline' <- query' .: "inline"
144− params' <- o .: "params"
145− prune' <- o .:? "prune" .!= False
146− return $ PhraseSuggesterCollate
147− (TemplateQueryInline inline' params') prune'
148− parseJSON x = typeMismatch "PhraseSuggesterCollate" x
149−
150−data SuggestOptions =
151− SuggestOptions { suggestOptionsText :: Text
152− , suggestOptionsScore :: Double
153− , suggestOptionsFreq :: Maybe Int
154− , suggestOptionsHighlighted :: Maybe Text
155− }
156− deriving (Eq, Read, Show)
157−
158−instance FromJSON SuggestOptions where
159− parseJSON = withObject "SuggestOptions" parse
160− where
161− parse o = SuggestOptions
162− <$> o .: "text"
163− <*> o .: "score"
164− <*> o .:? "freq"
165− <*> o .:? "highlighted"
166−
167−data SuggestResponse =
168− SuggestResponse { suggestResponseText :: Text
169− , suggestResponseOffset :: Int
170− , suggestResponseLength :: Int
171− , suggestResponseOptions :: [SuggestOptions]
172− }
173− deriving (Eq, Read, Show)
174−
175−instance FromJSON SuggestResponse where
176− parseJSON = withObject "SuggestResponse" parse
177− where parse o = SuggestResponse
178− <$> o .: "text"
179− <*> o .: "offset"
180− <*> o .: "length"
181− <*> o .: "options"
182−
183−data NamedSuggestionResponse = NamedSuggestionResponse
184− { nsrName :: Text
185− , nsrResponses :: [SuggestResponse]
186− } deriving (Eq, Read, Show)
187−
188−instance FromJSON NamedSuggestionResponse where
189− parseJSON (Object o) = do
190− suggestionName' <- case HM.toList o of
191− [(x, _)] -> return x
192− _ -> fail "error parsing NamedSuggestionResponse name"
193− suggestionResponses' <- o .: suggestionName'
194− return $ NamedSuggestionResponse suggestionName' suggestionResponses'
195−
196− parseJSON x = typeMismatch "NamedSuggestionResponse" x
197−
198−data DirectGeneratorSuggestModeTypes = DirectGeneratorSuggestModeMissing
199− | DirectGeneratorSuggestModePopular
200− | DirectGeneratorSuggestModeAlways
201− deriving (Eq, Show)
202−
203−instance ToJSON DirectGeneratorSuggestModeTypes where
204− toJSON DirectGeneratorSuggestModeMissing = "missing"
205− toJSON DirectGeneratorSuggestModePopular = "popular"
206− toJSON DirectGeneratorSuggestModeAlways = "always"
207−
208−instance FromJSON DirectGeneratorSuggestModeTypes where
209− parseJSON = withText "DirectGeneratorSuggestModeTypes" parse
210− where
211− parse "missing" =
212− pure DirectGeneratorSuggestModeMissing
213− parse "popular" =
214− pure DirectGeneratorSuggestModePopular
215− parse "always" =
216− pure DirectGeneratorSuggestModeAlways
217− parse f =
218− fail ("Unexpected DirectGeneratorSuggestModeTypes: " <> show f)
219−
220−data DirectGenerators = DirectGenerators
221− { directGeneratorsField :: FieldName
222− , directGeneratorsSize :: Maybe Int
223− , directGeneratorSuggestMode :: DirectGeneratorSuggestModeTypes
224− , directGeneratorMaxEdits :: Maybe Double
225− , directGeneratorPrefixLength :: Maybe Int
226− , directGeneratorMinWordLength :: Maybe Int
227− , directGeneratorMaxInspections :: Maybe Int
228− , directGeneratorMinDocFreq :: Maybe Double
229− , directGeneratorMaxTermFreq :: Maybe Double
230− , directGeneratorPreFilter :: Maybe Text
231− , directGeneratorPostFilter :: Maybe Text
232− } deriving (Eq, Show)
233−
234−instance ToJSON DirectGenerators where
235− toJSON DirectGenerators{..} =
236− omitNulls [ "field" .= directGeneratorsField
237− , "size" .= directGeneratorsSize
238− , "suggest_mode" .= directGeneratorSuggestMode
239− , "max_edits" .= directGeneratorMaxEdits
240− , "prefix_length" .= directGeneratorPrefixLength
241− , "min_word_length" .= directGeneratorMinWordLength
242− , "max_inspections" .= directGeneratorMaxInspections
243− , "min_doc_freq" .= directGeneratorMinDocFreq
244− , "max_term_freq" .= directGeneratorMaxTermFreq
245− , "pre_filter" .= directGeneratorPreFilter
246− , "post_filter" .= directGeneratorPostFilter
247− ]
248−
249−instance FromJSON DirectGenerators where
250− parseJSON = withObject "DirectGenerators" parse
251− where parse o = DirectGenerators
252− <$> o .: "field"
253− <*> o .:? "size"
254− <*> o .: "suggest_mode"
255− <*> o .:? "max_edits"
256− <*> o .:? "prefix_length"
257− <*> o .:? "min_word_length"
258− <*> o .:? "max_inspections"
259− <*> o .:? "min_doc_freq"
260− <*> o .:? "max_term_freq"
261− <*> o .:? "pre_filter"
262− <*> o .:? "post_filter"
263−
264−mkDirectGenerators :: FieldName -> DirectGenerators
265−mkDirectGenerators fn =
266− DirectGenerators
267− fn
268− Nothing
269− DirectGeneratorSuggestModeMissing
270− Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing
src/Database/Bloodhound/Types.hsdeleted−542
@@ -1,542 +0,0 @@
1−{-# LANGUAGE FlexibleContexts #-}
2−{-# LANGUAGE FlexibleInstances #-}
3−{-# LANGUAGE GeneralizedNewtypeDeriving #-}
4−{-# LANGUAGE MultiParamTypeClasses #-}
5−{-# LANGUAGE NamedFieldPuns #-}
6−{-# LANGUAGE OverloadedStrings #-}
7−{-# LANGUAGE RecordWildCards #-}
8−{-# LANGUAGE UndecidableInstances #-}
9−
10−-------------------------------------------------------------------------------
11−-- |
12−-- Module : Database.Bloodhound.Types
13−-- Copyright : (C) 2014, 2018 Chris Allen
14−-- License : BSD-style (see the file LICENSE)
15−-- Maintainer : Chris Allen <cma@bitemyapp.com
16−-- Stability : provisional
17−-- Portability : RecordWildCards
18−--
19−-- Data types for describing actions and data structures performed to interact
20−-- with Elasticsearch. The two main buckets your queries against Elasticsearch
21−-- will fall into are 'Query's and 'Filter's. 'Filter's are more like
22−-- traditional database constraints and often have preferable performance
23−-- properties. 'Query's support human-written textual queries, such as fuzzy
24−-- queries.
25−-------------------------------------------------------------------------------
26−
27−
28−
29−module Database.Bloodhound.Types
30− ( defaultCache
31− , defaultIndexSettings
32− , defaultIndexDocumentSettings
33− , mkSort
34− , showText
35− , unpackId
36− , mkMatchQuery
37− , mkMultiMatchQuery
38− , mkBoolQuery
39− , mkRangeQuery
40− , mkQueryStringQuery
41− , mkAggregations
42− , mkTermsAggregation
43− , mkTermsScriptAggregation
44− , mkDateHistogram
45− , mkCardinalityAggregation
46− , mkDocVersion
47− , mkStatsAggregation
48− , mkExtendedStatsAggregation
49− , docVersionNumber
50− , toMissing
51− , toTerms
52− , toDateHistogram
53− , toTopHits
54− , omitNulls
55− , BH(..)
56− , runBH
57− , BHEnv
58− , bhServer
59− , bhManager
60− , bhRequestHook
61− , mkBHEnv
62− , MonadBH(..)
63− , Version(..)
64− , VersionNumber(..)
65− , MaybeNA(..)
66− , BuildHash(..)
67− , Status(..)
68− , Existence(..)
69− , NullValue(..)
70− , IndexSettings(..)
71− , UpdatableIndexSetting(..)
72− , IndexSettingsSummary(..)
73− , AllocationPolicy(..)
74− , Compression(..)
75− , ReplicaBounds(..)
76− , Bytes(..)
77− , gigabytes
78− , megabytes
79− , kilobytes
80− , FSType(..)
81− , InitialShardCount(..)
82− , NodeAttrFilter(..)
83− , NodeAttrName(..)
84− , CompoundFormat(..)
85− , IndexTemplate(..)
86− , Server(..)
87− , Reply
88− , EsResult(..)
89− , EsResultFound(..)
90− , EsError(..)
91− , EsProtocolException(..)
92− , IndexAlias(..)
93− , IndexAliasName(..)
94− , IndexAliasAction(..)
95− , IndexAliasCreate(..)
96− , IndexAliasSummary(..)
97− , IndexAliasesSummary(..)
98− , AliasRouting(..)
99− , SearchAliasRouting(..)
100− , IndexAliasRouting(..)
101− , RoutingValue(..)
102− , DocVersion
103− , ExternalDocVersion(..)
104− , VersionControl(..)
105− , DocumentParent(..)
106− , IndexDocumentSettings(..)
107− , Query(..)
108− , Search(..)
109− , SearchType(..)
110− , SearchResult(..)
111− , ScrollId(..)
112− , SearchHits(..)
113− , TrackSortScores
114− , From(..)
115− , Size(..)
116− , Source(..)
117− , PatternOrPatterns(..)
118− , Include(..)
119− , Exclude(..)
120− , Pattern(..)
121− , ShardResult(..)
122− , Hit(..)
123− , HitFields(..)
124− , Filter(..)
125− , BoolMatch(..)
126− , Term(..)
127− , GeoPoint(..)
128− , GeoBoundingBoxConstraint(..)
129− , GeoBoundingBox(..)
130− , GeoFilterType(..)
131− , Distance(..)
132− , DistanceUnit(..)
133− , DistanceType(..)
134− , DistanceRange(..)
135− , OptimizeBbox(..)
136− , LatLon(..)
137− , RangeValue(..)
138− , RangeExecution(..)
139− , LessThan(..)
140− , LessThanEq(..)
141− , GreaterThan(..)
142− , GreaterThanEq(..)
143− , LessThanD(..)
144− , LessThanEqD(..)
145− , GreaterThanD(..)
146− , GreaterThanEqD(..)
147− , Regexp(..)
148− , RegexpFlags(..)
149− , RegexpFlag(..)
150− , FieldName(..)
151− , ScriptFields(..)
152− , ScriptFieldName
153− , ScriptFieldValue
154− , Script(..)
155− , ScriptLanguage(..)
156− , ScriptInline(..)
157− , ScriptId(..)
158− , ScriptParams(..)
159− , ScriptParamName
160− , ScriptParamValue
161− , IndexName(..)
162− , IndexSelection(..)
163− , NodeSelection(..)
164− , NodeSelector(..)
165− , ForceMergeIndexSettings(..)
166− , defaultForceMergeIndexSettings
167− , TemplateName(..)
168− , TemplatePattern(..)
169− , MappingName(..)
170− , DocId(..)
171− , CacheName(..)
172− , CacheKey(..)
173− , BulkOperation(..)
174− , ReplicaCount(..)
175− , ShardCount(..)
176− , Sort
177− , SortMode(..)
178− , SortOrder(..)
179− , SortSpec(..)
180− , DefaultSort(..)
181− , Missing(..)
182− , OpenCloseIndex(..)
183− , Method
184− , Boost(..)
185− , MatchQuery(..)
186− , MultiMatchQuery(..)
187− , BoolQuery(..)
188− , BoostingQuery(..)
189− , 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(..)
202− , DisMaxQuery(..)
203− , FuzzyLikeThisQuery(..)
204− , FuzzyLikeFieldQuery(..)
205− , FuzzyQuery(..)
206− , HasChildQuery(..)
207− , HasParentQuery(..)
208− , IndicesQuery(..)
209− , MoreLikeThisQuery(..)
210− , MoreLikeThisFieldQuery(..)
211− , NestedQuery(..)
212− , PrefixQuery(..)
213− , QueryStringQuery(..)
214− , SimpleQueryStringQuery(..)
215− , RangeQuery(..)
216− , RegexpQuery(..)
217− , QueryString(..)
218− , TemplateQueryInline(..)
219− , TemplateQueryKeyValuePairs(..)
220− , WildcardQuery(..)
221− , BooleanOperator(..)
222− , ZeroTermsQuery(..)
223− , CutoffFrequency(..)
224− , Analyzer(..)
225− , Tokenizer(..)
226− , TokenFilter(..)
227− , CharFilter(..)
228− , MaxExpansions(..)
229− , Lenient(..)
230− , MatchQueryType(..)
231− , MultiMatchQueryType(..)
232− , Tiebreaker(..)
233− , MinimumMatch(..)
234− , DisableCoord(..)
235− , CommonMinimumMatch(..)
236− , MinimumMatchHighLow(..)
237− , PrefixLength(..)
238− , Fuzziness(..)
239− , IgnoreTermFrequency(..)
240− , MaxQueryTerms(..)
241− , ScoreType(..)
242− , Score
243− , Cache
244− , TypeName(..)
245− , BoostTerms(..)
246− , MaxWordLength(..)
247− , MinWordLength(..)
248− , MaxDocFrequency(..)
249− , MinDocFrequency(..)
250− , PhraseSlop(..)
251− , StopWord(..)
252− , QueryPath(..)
253− , MinimumTermFrequency(..)
254− , PercentMatch(..)
255− , FieldDefinition(..)
256− , MappingField(..)
257− , Mapping(..)
258− , AllowLeadingWildcard(..)
259− , LowercaseExpanded(..)
260− , GeneratePhraseQueries(..)
261− , Locale(..)
262− , AnalyzeWildcard(..)
263− , EnablePositionIncrements(..)
264− , SimpleQueryFlag(..)
265− , FieldOrFields(..)
266− , Monoid(..)
267− , ToJSON(..)
268− , Interval(..)
269− , TimeInterval(..)
270− , ExecutionHint(..)
271− , CollectionMode(..)
272− , TermOrder(..)
273− , TermInclusion(..)
274− , SnapshotRepoSelection(..)
275− , GenericSnapshotRepo(..)
276− , SnapshotRepo(..)
277− , SnapshotRepoConversionError(..)
278− , SnapshotRepoType(..)
279− , GenericSnapshotRepoSettings(..)
280− , SnapshotRepoUpdateSettings(..)
281− , defaultSnapshotRepoUpdateSettings
282− , SnapshotRepoName(..)
283− , SnapshotRepoPattern(..)
284− , SnapshotVerification(..)
285− , SnapshotNodeVerification(..)
286− , FullNodeId(..)
287− , NodeName(..)
288− , ClusterName(..)
289− , 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(..)
310− , EsAddress(..)
311− , PluginName(..)
312− , NodeInfo(..)
313− , NodePluginInfo(..)
314− , NodeHTTPInfo(..)
315− , NodeTransportInfo(..)
316− , BoundTransportAddress(..)
317− , NodeNetworkInfo(..)
318− , MacAddress(..)
319− , NetworkInterfaceName(..)
320− , NodeNetworkInterface(..)
321− , NodeThreadPoolsInfo(..)
322− , NodeThreadPoolInfo(..)
323− , ThreadPoolSize(..)
324− , ThreadPoolType(..)
325− , NodeJVMInfo(..)
326− , JVMMemoryPool(..)
327− , JVMGCCollector(..)
328− , JVMMemoryInfo(..)
329− , PID(..)
330− , NodeOSInfo(..)
331− , CPUInfo(..)
332− , NodeProcessInfo(..)
333− , FsSnapshotRepo(..)
334− , SnapshotCreateSettings(..)
335− , defaultSnapshotCreateSettings
336− , SnapshotSelection(..)
337− , SnapshotPattern(..)
338− , SnapshotInfo(..)
339− , SnapshotShardFailure(..)
340− , ShardId(..)
341− , SnapshotName(..)
342− , SnapshotState(..)
343− , SnapshotRestoreSettings(..)
344− , defaultSnapshotRestoreSettings
345− , RestoreRenamePattern(..)
346− , RestoreRenameToken(..)
347− , RRGroupRefNum
348− , rrGroupRefNum
349− , mkRRGroupRefNum
350− , 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 (..)
363−
364− , Aggregation(..)
365− , Aggregations
366− , AggregationResults
367− , BucketValue(..)
368− , Bucket(..)
369− , BucketAggregation(..)
370− , TermsAggregation(..)
371− , MissingAggregation(..)
372− , ValueCountAggregation(..)
373− , FilterAggregation(..)
374− , CardinalityAggregation(..)
375− , MaxAggregation(..)
376− , DateHistogramAggregation(..)
377− , DateRangeAggregation(..)
378− , DateRangeAggRange(..)
379− , DateMathExpr(..)
380− , DateMathAnchor(..)
381− , DateMathModifier(..)
382− , DateMathUnit(..)
383− , TopHitsAggregation(..)
384− , StatisticsAggregation(..)
385− , SearchAfterKey
386−
387− , Highlights(..)
388− , FieldHighlight(..)
389− , HighlightSettings(..)
390− , PlainHighlight(..)
391− , PostingsHighlight(..)
392− , FastVectorHighlight(..)
393− , CommonHighlight(..)
394− , NonPostings(..)
395− , HighlightEncoder(..)
396− , HighlightTag(..)
397− , HitHighlight
398−
399− , MissingResult(..)
400− , TermsResult(..)
401− , DateHistogramResult(..)
402− , DateRangeResult(..)
403− , TopHitResult(..)
404−
405− , EsUsername(..)
406− , EsPassword(..)
407−
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
429−
430−{-| 'unpackId' is a silly convenience function that gets used once.
431−-}
432−unpackId :: DocId -> Text
433−unpackId (DocId docId) = docId
434−
435−type TrackSortScores = Bool
436−
437−data Search = Search { queryBody :: Maybe Query
438− , filterBody :: Maybe Filter
439− , sortBody :: Maybe Sort
440− , aggBody :: Maybe Aggregations
441− , highlight :: Maybe Highlights
442− -- default False
443− , trackSortScores :: TrackSortScores
444− , from :: From
445− , size :: Size
446− , searchType :: SearchType
447− , searchAfterKey :: Maybe SearchAfterKey
448− , 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] [] []
479−
480−data SearchType = SearchTypeQueryThenFetch
481− | SearchTypeDfsQueryThenFetch
482− deriving (Eq, Show)
483−
484−data Source =
485− NoSource
486− | SourcePatterns PatternOrPatterns
487− | 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 ]
494−
495−data PatternOrPatterns = PopPattern Pattern
496− | PopPatterns [Pattern] deriving (Eq, Read, Show)
497−
498−instance ToJSON PatternOrPatterns where
499− toJSON (PopPattern pattern) = toJSON pattern
500− toJSON (PopPatterns patterns) = toJSON patterns
501−
502−data Include = Include [Pattern] deriving (Eq, Read, Show)
503−data Exclude = Exclude [Pattern] deriving (Eq, Read, Show)
504−
505−instance ToJSON Include where
506− toJSON (Include patterns) = toJSON patterns
507−
508−instance ToJSON Exclude where
509− toJSON (Exclude patterns) = toJSON patterns
510−
511−newtype Pattern = Pattern Text deriving (Eq, Read, Show)
512−
513−instance ToJSON Pattern where
514− toJSON (Pattern pattern) = toJSON pattern
515−
516−data SearchResult a =
517− SearchResult { took :: Int
518− , timedOut :: Bool
519− , shards :: ShardResult
520− , searchHits :: SearchHits a
521− , 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)
528−
529−instance (FromJSON a) => FromJSON (SearchResult a) where
530− parseJSON (Object v) = SearchResult <$>
531− v .: "took" <*>
532− v .: "timed_out" <*>
533− v .: "_shards" <*>
534− v .: "hits" <*>
535− v .:? "aggregations" <*>
536− v .:? "_scroll_id" <*>
537− v .:? "suggest"
538− parseJSON _ = empty
539−
540−newtype ScrollId =
541− ScrollId Text
542− deriving (Eq, Show, Ord, ToJSON, FromJSON)
src/Database/V1/Bloodhound.hsnew file+10
@@ -0,0 +1,10 @@
1+module Database.V1.Bloodhound
2+ ( -- module Data.Aeson.Types
3+ -- ,
4+ module Database.V1.Bloodhound.Client
5+ , module Database.V1.Bloodhound.Types
6+ ) where
7+
8+-- import Data.Aeson.Types
9+import Database.V1.Bloodhound.Client
10+import Database.V1.Bloodhound.Types
src/Database/V1/Bloodhound/Client.hsnew file+917
@@ -0,0 +1,917 @@
1+{-# LANGUAGE OverloadedStrings #-}
2+{-# LANGUAGE RecordWildCards #-}
3+{-# LANGUAGE TupleSections #-}
4+
5+-------------------------------------------------------------------------------
6+-- |
7+-- Module : Database.Bloodhound.Client
8+-- Copyright : (C) 2014 Chris Allen
9+-- License : BSD-style (see the file LICENSE)
10+-- Maintainer : Chris Allen <cma@bitemyapp.com
11+-- Stability : provisional
12+-- Portability : OverloadedStrings
13+--
14+-- Client side functions for talking to Elasticsearch servers.
15+--
16+-------------------------------------------------------------------------------
17+
18+module Database.V1.Bloodhound.Client
19+ ( -- * Bloodhound client functions
20+ -- | The examples in this module assume the following code has been run.
21+ -- The :{ and :} will only work in GHCi. You'll only need the data types
22+ -- and typeclass instances for the functions that make use of them.
23+
24+ -- $setup
25+ withBH
26+ -- ** Indices
27+ , createIndex
28+ , deleteIndex
29+ , updateIndexSettings
30+ , getIndexSettings
31+ , optimizeIndex
32+ , indexExists
33+ , openIndex
34+ , closeIndex
35+ , listIndices
36+ , waitForYellowIndex
37+ -- *** Index Aliases
38+ , updateIndexAliases
39+ , getIndexAliases
40+ -- *** Index Templates
41+ , putTemplate
42+ , templateExists
43+ , deleteTemplate
44+ -- ** Mapping
45+ , putMapping
46+ , deleteMapping
47+ -- ** Documents
48+ , indexDocument
49+ , updateDocument
50+ , getDocument
51+ , documentExists
52+ , deleteDocument
53+ -- ** Searching
54+ , searchAll
55+ , searchByIndex
56+ , searchByType
57+ , scanSearch
58+ , getInitialScroll
59+ , advanceScroll
60+ , refreshIndex
61+ , mkSearch
62+ , mkAggregateSearch
63+ , mkHighlightSearch
64+ , bulk
65+ , pageSearch
66+ , mkShardCount
67+ , mkReplicaCount
68+ , getStatus
69+ -- ** Snapshot/Restore
70+ -- *** Snapshot Repos
71+ , getSnapshotRepos
72+ , updateSnapshotRepo
73+ , verifySnapshotRepo
74+ , deleteSnapshotRepo
75+ -- *** Snapshots
76+ , createSnapshot
77+ , getSnapshots
78+ , deleteSnapshot
79+ -- *** Restoring Snapshots
80+ , restoreSnapshot
81+ -- ** Nodes
82+ , getNodesInfo
83+ , getNodesStats
84+ -- ** Request Utilities
85+ , encodeBulkOperations
86+ , encodeBulkOperation
87+ -- * Authentication
88+ , basicAuthHook
89+ -- * Reply-handling tools
90+ , isVersionConflict
91+ , isSuccess
92+ , isCreated
93+ , parseEsResponse
94+ )
95+ where
96+
97+import qualified Blaze.ByteString.Builder as BB
98+import Control.Applicative as A
99+import Control.Monad
100+import Control.Monad.Catch
101+import Control.Monad.IO.Class
102+import Data.Aeson
103+import Data.ByteString.Lazy.Builder
104+import qualified Data.ByteString.Lazy.Char8 as L
105+import Data.Foldable (toList)
106+import qualified Data.HashMap.Strict as HM
107+import Data.Ix
108+import qualified Data.List as LS (filter, foldl')
109+import Data.List.NonEmpty (NonEmpty (..))
110+import Data.Maybe (catMaybes, fromMaybe, isJust)
111+import Data.Monoid
112+import Data.Text (Text)
113+import qualified Data.Text as T
114+import qualified Data.Text.Encoding as T
115+import Data.Time.Clock
116+import qualified Data.Vector as V
117+import Network.HTTP.Client
118+import qualified Network.HTTP.Types.Method as NHTM
119+import qualified Network.HTTP.Types.Status as NHTS
120+import qualified Network.HTTP.Types.URI as NHTU
121+import qualified Network.URI as URI
122+import Prelude hiding (filter, head)
123+
124+import Database.V1.Bloodhound.Types
125+
126+-- | 'mkShardCount' is a straight-forward smart constructor for 'ShardCount'
127+-- which rejects 'Int' values below 1 and above 1000.
128+mkShardCount :: Int -> Maybe ShardCount
129+mkShardCount n
130+ | n < 1 = Nothing
131+ | n > 1000 = Nothing
132+ | otherwise = Just (ShardCount n)
133+
134+-- | 'mkReplicaCount' is a straight-forward smart constructor for 'ReplicaCount'
135+-- which rejects 'Int' values below 0 and above 1000.
136+mkReplicaCount :: Int -> Maybe ReplicaCount
137+mkReplicaCount n
138+ | n < 0 = Nothing
139+ | n > 1000 = Nothing -- ...
140+ | otherwise = Just (ReplicaCount n)
141+
142+emptyBody :: L.ByteString
143+emptyBody = L.pack ""
144+
145+dispatch :: MonadBH m
146+ => Method
147+ -> Text
148+ -> Maybe L.ByteString
149+ -> m Reply
150+dispatch dMethod url body = do
151+ initReq <- liftIO $ parseUrl' url
152+ reqHook <- bhRequestHook A.<$> getBHEnv
153+ let reqBody = RequestBodyLBS $ fromMaybe emptyBody body
154+ req <- liftIO $ reqHook $ setRequestIgnoreStatus $ initReq { method = dMethod
155+ , requestBody = reqBody }
156+ mgr <- bhManager <$> getBHEnv
157+ liftIO $ httpLbs req mgr
158+
159+joinPath' :: [Text] -> Text
160+joinPath' = T.intercalate "/"
161+
162+joinPath :: MonadBH m => [Text] -> m Text
163+joinPath ps = do
164+ Server s <- bhServer <$> getBHEnv
165+ return $ joinPath' (s:ps)
166+
167+appendSearchTypeParam :: Text -> SearchType -> Text
168+appendSearchTypeParam originalUrl st = addQuery params originalUrl
169+ where stText = "search_type"
170+ params
171+ | st == SearchTypeDfsQueryThenFetch = [(stText, Just "dfs_query_then_fetch")]
172+ | st == SearchTypeCount = [(stText, Just "count")]
173+ | st == SearchTypeScan = [(stText, Just "scan"), ("scroll", Just "1m")]
174+ | st == SearchTypeQueryAndFetch = [(stText, Just "query_and_fetch")]
175+ | st == SearchTypeDfsQueryAndFetch = [(stText, Just "dfs_query_and_fetch")]
176+ -- used to catch 'SearchTypeQueryThenFetch', which is also the default
177+ | otherwise = [(stText, Just "query_then_fetch")]
178+
179+-- | Severely dumbed down query renderer. Assumes your data doesn't
180+-- need any encoding
181+addQuery :: [(Text, Maybe Text)] -> Text -> Text
182+addQuery q u = u <> rendered
183+ where
184+ rendered =
185+ T.decodeUtf8 $ BB.toByteString $ NHTU.renderQueryText prependQuestionMark q
186+ prependQuestionMark = True
187+
188+bindM2 :: (Applicative m, Monad m) => (a -> b -> m c) -> m a -> m b -> m c
189+bindM2 f ma mb = join (f <$> ma <*> mb)
190+
191+-- | Convenience function that sets up a manager and BHEnv and runs
192+-- the given set of bloodhound operations. Connections will be
193+-- pipelined automatically in accordance with the given manager
194+-- settings in IO. If you've got your own monad transformer stack, you
195+-- should use 'runBH' directly.
196+withBH :: ManagerSettings -> Server -> BH IO a -> IO a
197+withBH ms s f = do
198+ mgr <- newManager ms
199+ let env = mkBHEnv s mgr
200+ runBH env f
201+
202+-- Shortcut functions for HTTP methods
203+delete :: MonadBH m => Text -> m Reply
204+delete = flip (dispatch NHTM.methodDelete) Nothing
205+get :: MonadBH m => Text -> m Reply
206+get = flip (dispatch NHTM.methodGet) Nothing
207+head :: MonadBH m => Text -> m Reply
208+head = flip (dispatch NHTM.methodHead) Nothing
209+put :: MonadBH m => Text -> Maybe L.ByteString -> m Reply
210+put = dispatch NHTM.methodPut
211+post :: MonadBH m => Text -> Maybe L.ByteString -> m Reply
212+post = dispatch NHTM.methodPost
213+
214+-- indexDocument s ix name doc = put (root </> s </> ix </> name </> doc) (Just encode doc)
215+-- http://hackage.haskell.org/package/http-client-lens-0.1.0/docs/Network-HTTP-Client-Lens.html
216+-- https://github.com/supki/libjenkins/blob/master/src/Jenkins/Rest/Internal.hs
217+
218+-- | 'getStatus' fetches the 'Status' of a 'Server'
219+getStatus :: MonadBH m => m (Maybe Status)
220+getStatus = do
221+ response <- get =<< url
222+ return $ decode (responseBody response)
223+ where url = joinPath []
224+
225+-- | 'getSnapshotRepos' gets the definitions of a subset of the
226+-- defined snapshot repos.
227+getSnapshotRepos
228+ :: ( MonadBH m
229+ , MonadThrow m
230+ )
231+ => SnapshotRepoSelection
232+ -> m (Either EsError [GenericSnapshotRepo])
233+getSnapshotRepos sel = fmap (fmap unGSRs) . parseEsResponse =<< get =<< url
234+ where
235+ url = joinPath ["_snapshot", selectorSeg]
236+ selectorSeg = case sel of
237+ AllSnapshotRepos -> "_all"
238+ SnapshotRepoList (p :| ps) -> T.intercalate "," (renderPat <$> (p:ps))
239+ renderPat (RepoPattern t) = t
240+ renderPat (ExactRepo (SnapshotRepoName t)) = t
241+
242+
243+-- | Wrapper to extract the list of 'GenericSnapshotRepo' in the
244+-- format they're returned in
245+newtype GSRs = GSRs { unGSRs :: [GenericSnapshotRepo] }
246+
247+
248+instance FromJSON GSRs where
249+ parseJSON = withObject "Collection of GenericSnapshotRepo" parse
250+ where
251+ parse = fmap GSRs . mapM (uncurry go) . HM.toList
252+ go rawName = withObject "GenericSnapshotRepo" $ \o -> do
253+ GenericSnapshotRepo (SnapshotRepoName rawName) <$> o .: "type"
254+ <*> o .: "settings"
255+
256+
257+-- | Create or update a snapshot repo
258+updateSnapshotRepo
259+ :: ( MonadBH m
260+ , SnapshotRepo repo
261+ )
262+ => SnapshotRepoUpdateSettings
263+ -- ^ Use 'defaultSnapshotRepoUpdateSettings' if unsure
264+ -> repo
265+ -> m Reply
266+updateSnapshotRepo SnapshotRepoUpdateSettings {..} repo =
267+ bindM2 put url (return (Just body))
268+ where
269+ url = addQuery params <$> joinPath ["_snapshot", snapshotRepoName gSnapshotRepoName]
270+ params
271+ | repoUpdateVerify = []
272+ | otherwise = [("verify", Just "false")]
273+ body = encode $ object [ "type" .= gSnapshotRepoType
274+ , "settings" .= gSnapshotRepoSettings
275+ ]
276+ GenericSnapshotRepo {..} = toGSnapshotRepo repo
277+
278+
279+
280+-- | Verify if a snapshot repo is working. __NOTE:__ this API did not
281+-- make it into ElasticSearch until 1.4. If you use an older version,
282+-- you will get an error here.
283+verifySnapshotRepo
284+ :: ( MonadBH m
285+ , MonadThrow m
286+ )
287+ => SnapshotRepoName
288+ -> m (Either EsError SnapshotVerification)
289+verifySnapshotRepo (SnapshotRepoName n) =
290+ parseEsResponse =<< bindM2 post url (return Nothing)
291+ where
292+ url = joinPath ["_snapshot", n, "_verify"]
293+
294+
295+deleteSnapshotRepo :: MonadBH m => SnapshotRepoName -> m Reply
296+deleteSnapshotRepo (SnapshotRepoName n) = delete =<< url
297+ where
298+ url = joinPath ["_snapshot", n]
299+
300+
301+-- | Create and start a snapshot
302+createSnapshot
303+ :: (MonadBH m)
304+ => SnapshotRepoName
305+ -> SnapshotName
306+ -> SnapshotCreateSettings
307+ -> m Reply
308+createSnapshot (SnapshotRepoName repoName)
309+ (SnapshotName snapName)
310+ SnapshotCreateSettings {..} =
311+ bindM2 put url (return (Just body))
312+ where
313+ url = addQuery params <$> joinPath ["_snapshot", repoName, snapName]
314+ params = [("wait_for_completion", Just (boolQP snapWaitForCompletion))]
315+ body = encode $ object prs
316+ prs = catMaybes [ ("indices" .=) . indexSelectionName <$> snapIndices
317+ , Just ("ignore_unavailable" .= snapIgnoreUnavailable)
318+ , Just ("ignore_global_state" .= snapIncludeGlobalState)
319+ , Just ("partial" .= snapPartial)
320+ ]
321+
322+
323+indexSelectionName :: IndexSelection -> Text
324+indexSelectionName AllIndexes = "_all"
325+indexSelectionName (IndexList (i :| is)) = T.intercalate "," (renderIndex <$> (i:is))
326+ where
327+ renderIndex (IndexName n) = n
328+
329+
330+-- | Get info about known snapshots given a pattern and repo name.
331+getSnapshots
332+ :: ( MonadBH m
333+ , MonadThrow m
334+ )
335+ => SnapshotRepoName
336+ -> SnapshotSelection
337+ -> m (Either EsError [SnapshotInfo])
338+getSnapshots (SnapshotRepoName repoName) sel =
339+ fmap (fmap unSIs) . parseEsResponse =<< get =<< url
340+ where
341+ url = joinPath ["_snapshot", repoName, snapPath]
342+ snapPath = case sel of
343+ AllSnapshots -> "_all"
344+ SnapshotList (s :| ss) -> T.intercalate "," (renderPath <$> (s:ss))
345+ renderPath (SnapPattern t) = t
346+ renderPath (ExactSnap (SnapshotName t)) = t
347+
348+
349+newtype SIs = SIs { unSIs :: [SnapshotInfo] }
350+
351+
352+instance FromJSON SIs where
353+ parseJSON = withObject "Collection of SnapshotInfo" parse
354+ where
355+ parse o = SIs <$> o .: "snapshots"
356+
357+
358+-- | Delete a snapshot. Cancels if it is running.
359+deleteSnapshot :: MonadBH m => SnapshotRepoName -> SnapshotName -> m Reply
360+deleteSnapshot (SnapshotRepoName repoName) (SnapshotName snapName) =
361+ delete =<< url
362+ where
363+ url = joinPath ["_snapshot", repoName, snapName]
364+
365+
366+-- | Restore a snapshot to the cluster See
367+-- <https://www.elastic.co/guide/en/elasticsearch/reference/1.7/modules-snapshots.html#_restore>
368+-- for more details.
369+restoreSnapshot
370+ :: MonadBH m
371+ => SnapshotRepoName
372+ -> SnapshotName
373+ -> SnapshotRestoreSettings
374+ -- ^ Start with 'defaultSnapshotRestoreSettings' and customize
375+ -- from there for reasonable defaults.
376+ -> m Reply
377+restoreSnapshot (SnapshotRepoName repoName)
378+ (SnapshotName snapName)
379+ SnapshotRestoreSettings {..} = bindM2 post url (return (Just body))
380+ where
381+ url = addQuery params <$> joinPath ["_snapshot", repoName, snapName, "_restore"]
382+ params = [("wait_for_completion", Just (boolQP snapRestoreWaitForCompletion))]
383+ body = encode (object prs)
384+
385+
386+ prs = catMaybes [ ("indices" .=) . indexSelectionName <$> snapRestoreIndices
387+ , Just ("ignore_unavailable" .= snapRestoreIgnoreUnavailable)
388+ , Just ("include_global_state" .= snapRestoreIncludeGlobalState)
389+ , ("rename_pattern" .=) <$> snapRestoreRenamePattern
390+ , ("rename_replacement" .=) . renderTokens <$> snapRestoreRenameReplacement
391+ , Just ("include_aliases" .= snapRestoreIncludeAliases)
392+ , ("index_settings" .= ) <$> snapRestoreIndexSettingsOverrides
393+ , ("ignore_index_settings" .= ) <$> snapRestoreIgnoreIndexSettings
394+ ]
395+ renderTokens (t :| ts) = mconcat (renderToken <$> (t:ts))
396+ renderToken (RRTLit t) = t
397+ renderToken RRSubWholeMatch = "$0"
398+ renderToken (RRSubGroup g) = T.pack (show (rrGroupRefNum g))
399+
400+
401+getNodesInfo
402+ :: ( MonadBH m
403+ , MonadThrow m
404+ )
405+ => NodeSelection
406+ -> m (Either EsError NodesInfo)
407+getNodesInfo sel = parseEsResponse =<< get =<< url
408+ where
409+ url = joinPath ["_nodes", selectionSeg]
410+ selectionSeg = case sel of
411+ LocalNode -> "_local"
412+ NodeList (l :| ls) -> T.intercalate "," (selToSeg <$> (l:ls))
413+ AllNodes -> "_all"
414+ selToSeg (NodeByName (NodeName n)) = n
415+ selToSeg (NodeByFullNodeId (FullNodeId i)) = i
416+ selToSeg (NodeByHost (Server s)) = s
417+ selToSeg (NodeByAttribute (NodeAttrName a) v) = a <> ":" <> v
418+
419+getNodesStats
420+ :: ( MonadBH m
421+ , MonadThrow m
422+ )
423+ => NodeSelection
424+ -> m (Either EsError NodesStats)
425+getNodesStats sel = parseEsResponse =<< get =<< url
426+ where
427+ url = joinPath ["_nodes", selectionSeg, "stats"]
428+ selectionSeg = case sel of
429+ LocalNode -> "_local"
430+ NodeList (l :| ls) -> T.intercalate "," (selToSeg <$> (l:ls))
431+ AllNodes -> "_all"
432+ selToSeg (NodeByName (NodeName n)) = n
433+ selToSeg (NodeByFullNodeId (FullNodeId i)) = i
434+ selToSeg (NodeByHost (Server s)) = s
435+ selToSeg (NodeByAttribute (NodeAttrName a) v) = a <> ":" <> v
436+
437+-- | 'createIndex' will create an index given a 'Server', 'IndexSettings', and an 'IndexName'.
438+createIndex :: MonadBH m => IndexSettings -> IndexName -> m Reply
439+createIndex indexSettings (IndexName indexName) =
440+ bindM2 put url (return body)
441+ where url = joinPath [indexName]
442+ body = Just $ encode indexSettings
443+
444+
445+-- | 'deleteIndex' will delete an index given a 'Server', and an 'IndexName'.
446+deleteIndex :: MonadBH m => IndexName -> m Reply
447+deleteIndex (IndexName indexName) =
448+ delete =<< joinPath [indexName]
449+
450+-- | 'updateIndexSettings' will apply a non-empty list of setting updates to an index
451+updateIndexSettings :: MonadBH m => NonEmpty UpdatableIndexSetting -> IndexName -> m Reply
452+updateIndexSettings updates (IndexName indexName) =
453+ bindM2 put url (return body)
454+ where url = joinPath [indexName, "_settings"]
455+ body = Just (encode jsonBody)
456+ jsonBody = Object (deepMerge [u | Object u <- toJSON <$> toList updates])
457+
458+
459+getIndexSettings :: (MonadBH m, MonadThrow m) => IndexName
460+ -> m (Either EsError IndexSettingsSummary)
461+getIndexSettings (IndexName indexName) = do
462+ parseEsResponse =<< get =<< url
463+ where url = joinPath [indexName, "_settings"]
464+
465+
466+-- | 'optimizeIndex' will optimize a single index, list of indexes or
467+-- all indexes. Note that this call will block until finishing but
468+-- will continue even if the request times out. Concurrent requests to
469+-- optimize an index while another is performing will block until the
470+-- previous one finishes. For more information see
471+-- <https://www.elastic.co/guide/en/elasticsearch/reference/1.7/indices-optimize.html>. Nothing
472+-- worthwhile comes back in the reply body, so matching on the status
473+-- should suffice.
474+--
475+-- 'optimizeIndex' with a maxNumSegments of 1 and onlyExpungeDeletes
476+-- to True is the main way to release disk space back to the OS being
477+-- held by deleted documents.
478+--
479+-- Note that this API was deprecated in ElasticSearch 2.1 for the
480+-- almost completely identical forcemerge API. Adding support to that
481+-- API would be trivial but due to the significant breaking changes,
482+-- this library cannot currently be used with >= 2.0, so that feature was omitted.
483+optimizeIndex :: MonadBH m => IndexSelection -> IndexOptimizationSettings -> m Reply
484+optimizeIndex ixs IndexOptimizationSettings {..} =
485+ bindM2 post url (return body)
486+ where url = addQuery params <$> joinPath [indexName, "_optimize"]
487+ params = catMaybes [ ("max_num_segments",) . Just . showText <$> maxNumSegments
488+ , Just ("only_expunge_deletes", Just (boolQP onlyExpungeDeletes))
489+ , Just ("flush", Just (boolQP flushAfterOptimize))
490+ ]
491+ indexName = indexSelectionName ixs
492+ body = Nothing
493+
494+
495+deepMerge :: [Object] -> Object
496+deepMerge = LS.foldl' go mempty
497+ where go acc = LS.foldl' go' acc . HM.toList
498+ go' acc (k, v) = HM.insertWith merge k v acc
499+ merge (Object a) (Object b) = Object (deepMerge [a, b])
500+ merge _ b = b
501+
502+
503+statusCodeIs :: (Int, Int) -> Reply -> Bool
504+statusCodeIs r resp = inRange r $ NHTS.statusCode (responseStatus resp)
505+
506+respIsTwoHunna :: Reply -> Bool
507+respIsTwoHunna = statusCodeIs (200, 299)
508+
509+existentialQuery :: MonadBH m => Text -> m (Reply, Bool)
510+existentialQuery url = do
511+ reply <- head url
512+ return (reply, respIsTwoHunna reply)
513+
514+
515+-- | Tries to parse a response body as the expected type @a@ and
516+-- failing that tries to parse it as an EsError. All well-formed, JSON
517+-- responses from elasticsearch should fall into these two
518+-- categories. If they don't, a 'EsProtocolException' will be
519+-- thrown. If you encounter this, please report the full body it
520+-- reports along with your ElasticSearch verison.
521+parseEsResponse :: (MonadThrow m, FromJSON a) => Reply
522+ -> m (Either EsError a)
523+parseEsResponse reply
524+ | respIsTwoHunna reply = case eitherDecode body of
525+ Right a -> return (Right a)
526+ Left _ -> tryParseError
527+ | otherwise = tryParseError
528+ where body = responseBody reply
529+ tryParseError = case eitherDecode body of
530+ Right e -> return (Left e)
531+ -- this case should not be possible
532+ Left _ -> explode
533+ explode = throwM (EsProtocolException body)
534+
535+-- | 'indexExists' enables you to check if an index exists. Returns 'Bool'
536+-- in IO
537+indexExists :: MonadBH m => IndexName -> m Bool
538+indexExists (IndexName indexName) = do
539+ (_, exists) <- existentialQuery =<< joinPath [indexName]
540+ return exists
541+
542+-- | 'refreshIndex' will force a refresh on an index. You must
543+-- do this if you want to read what you wrote.
544+refreshIndex :: MonadBH m => IndexName -> m Reply
545+refreshIndex (IndexName indexName) =
546+ bindM2 post url (return Nothing)
547+ where url = joinPath [indexName, "_refresh"]
548+
549+-- | Block until the index becomes available for indexing
550+-- documents. This is useful for integration tests in which
551+-- indices are rapidly created and deleted.
552+waitForYellowIndex :: MonadBH m => IndexName -> m Reply
553+waitForYellowIndex (IndexName indexName) = get =<< url
554+ where url = addQuery q <$> joinPath ["_cluster","health",indexName]
555+ q = [("wait_for_status",Just "yellow"),("timeout",Just "10s")]
556+
557+stringifyOCIndex :: OpenCloseIndex -> Text
558+stringifyOCIndex oci = case oci of
559+ OpenIndex -> "_open"
560+ CloseIndex -> "_close"
561+
562+openOrCloseIndexes :: MonadBH m => OpenCloseIndex -> IndexName -> m Reply
563+openOrCloseIndexes oci (IndexName indexName) =
564+ bindM2 post url (return Nothing)
565+ where ociString = stringifyOCIndex oci
566+ url = joinPath [indexName, ociString]
567+
568+-- | 'openIndex' opens an index given a 'Server' and an 'IndexName'. Explained in further detail at
569+-- <http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/indices-open-close.html>
570+openIndex :: MonadBH m => IndexName -> m Reply
571+openIndex = openOrCloseIndexes OpenIndex
572+
573+-- | 'closeIndex' closes an index given a 'Server' and an 'IndexName'. Explained in further detail at
574+-- <http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/indices-open-close.html>
575+closeIndex :: MonadBH m => IndexName -> m Reply
576+closeIndex = openOrCloseIndexes CloseIndex
577+
578+-- | 'listIndices' returns a list of all index names on a given 'Server'
579+listIndices :: (MonadThrow m, MonadBH m) => m [IndexName]
580+listIndices =
581+ parse . responseBody =<< get =<< url
582+ where
583+ url = joinPath ["_cat/indices?v"]
584+ -- parses the tabular format the indices api provides
585+ parse body = case T.lines (T.decodeUtf8 (L.toStrict body)) of
586+ (hdr:rows) -> let ks = T.words hdr
587+ keyedRows = [ HM.fromList (zip ks (T.words row)) | row <- rows ]
588+ names = catMaybes (HM.lookup "index" <$> keyedRows)
589+ in return (IndexName <$> names)
590+ [] -> throwM (EsProtocolException body)
591+
592+-- | 'updateIndexAliases' updates the server's index alias
593+-- table. Operations are atomic. Explained in further detail at
594+-- <https://www.elastic.co/guide/en/elasticsearch/reference/current/indices-aliases.html>
595+updateIndexAliases :: MonadBH m => NonEmpty IndexAliasAction -> m Reply
596+updateIndexAliases actions = bindM2 post url (return body)
597+ where url = joinPath ["_aliases"]
598+ body = Just (encode bodyJSON)
599+ bodyJSON = object [ "actions" .= toList actions]
600+
601+-- | Get all aliases configured on the server.
602+getIndexAliases :: (MonadBH m, MonadThrow m)
603+ => m (Either EsError IndexAliasesSummary)
604+getIndexAliases = parseEsResponse =<< get =<< url
605+ where url = joinPath ["_aliases"]
606+
607+-- | 'putTemplate' creates a template given an 'IndexTemplate' and a 'TemplateName'.
608+-- Explained in further detail at
609+-- <https://www.elastic.co/guide/en/elasticsearch/reference/1.7/indices-templates.html>
610+putTemplate :: MonadBH m => IndexTemplate -> TemplateName -> m Reply
611+putTemplate indexTemplate (TemplateName templateName) =
612+ bindM2 put url (return body)
613+ where url = joinPath ["_template", templateName]
614+ body = Just $ encode indexTemplate
615+
616+-- | 'templateExists' checks to see if a template exists.
617+templateExists :: MonadBH m => TemplateName -> m Bool
618+templateExists (TemplateName templateName) = do
619+ (_, exists) <- existentialQuery =<< joinPath ["_template", templateName]
620+ return exists
621+
622+-- | 'deleteTemplate' is an HTTP DELETE and deletes a template.
623+deleteTemplate :: MonadBH m => TemplateName -> m Reply
624+deleteTemplate (TemplateName templateName) =
625+ delete =<< joinPath ["_template", templateName]
626+
627+-- | 'putMapping' is an HTTP PUT and has upsert semantics. Mappings are schemas
628+-- for documents in indexes.
629+putMapping :: (MonadBH m, ToJSON a) => IndexName
630+ -> MappingName -> a -> m Reply
631+putMapping (IndexName indexName) (MappingName mappingName) mapping =
632+ bindM2 put url (return body)
633+ where url = joinPath [indexName, "_mapping", mappingName]
634+ -- "_mapping" and mappingName above were originally transposed
635+ -- erroneously. The correct API call is: "/INDEX/_mapping/MAPPING_NAME"
636+ body = Just $ encode mapping
637+
638+-- | 'deleteMapping' is an HTTP DELETE and deletes a mapping for a given index.
639+-- Mappings are schemas for documents in indexes.
640+deleteMapping :: MonadBH m => IndexName -> MappingName -> m Reply
641+deleteMapping (IndexName indexName)
642+ (MappingName mappingName) =
643+ -- "_mapping" and mappingName below were originally transposed
644+ -- erroneously. The correct API call is: "/INDEX/_mapping/MAPPING_NAME"
645+ delete =<< joinPath [indexName, "_mapping", mappingName]
646+
647+versionCtlParams :: IndexDocumentSettings -> [(Text, Maybe Text)]
648+versionCtlParams cfg =
649+ case idsVersionControl cfg of
650+ NoVersionControl -> []
651+ InternalVersion v -> versionParams v "internal"
652+ ExternalGT (ExternalDocVersion v) -> versionParams v "external_gt"
653+ ExternalGTE (ExternalDocVersion v) -> versionParams v "external_gte"
654+ ForceVersion (ExternalDocVersion v) -> versionParams v "force"
655+ where
656+ vt = showText . docVersionNumber
657+ versionParams v t = [ ("version", Just $ vt v)
658+ , ("version_type", Just t)
659+ ]
660+
661+-- | 'indexDocument' is the primary way to save a single document in
662+-- Elasticsearch. The document itself is simply something we can
663+-- convert into a JSON 'Value'. The 'DocId' will function as the
664+-- primary key for the document.
665+indexDocument :: (ToJSON doc, MonadBH m) => IndexName -> MappingName
666+ -> IndexDocumentSettings -> doc -> DocId -> m Reply
667+indexDocument (IndexName indexName)
668+ (MappingName mappingName) cfg document (DocId docId) =
669+ bindM2 put url (return body)
670+ where url = addQuery params <$> joinPath [indexName, mappingName, docId]
671+ parentParams = case idsParent cfg of
672+ Nothing -> []
673+ Just (DocumentParent (DocId p)) -> [ ("parent", Just p) ]
674+ params = versionCtlParams cfg ++ parentParams
675+ body = Just (encode document)
676+
677+-- | 'updateDocument' provides a way to perform an partial update of a
678+-- an already indexed document.
679+updateDocument :: (ToJSON patch, MonadBH m) => IndexName -> MappingName
680+ -> IndexDocumentSettings -> patch -> DocId -> m Reply
681+updateDocument (IndexName indexName)
682+ (MappingName mappingName) cfg patch (DocId docId) =
683+ bindM2 post url (return body)
684+ where url = addQuery (versionCtlParams cfg) <$>
685+ joinPath [indexName, mappingName, docId, "_update"]
686+ body = Just (encode $ object ["doc" .= toJSON patch])
687+
688+-- | 'deleteDocument' is the primary way to delete a single document.
689+deleteDocument :: MonadBH m => IndexName -> MappingName
690+ -> DocId -> m Reply
691+deleteDocument (IndexName indexName)
692+ (MappingName mappingName) (DocId docId) =
693+ delete =<< joinPath [indexName, mappingName, docId]
694+
695+-- | 'bulk' uses
696+-- <http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/docs-bulk.html Elasticsearch's bulk API>
697+-- to perform bulk operations. The 'BulkOperation' data type encodes the
698+-- index\/update\/delete\/create operations. You pass a 'V.Vector' of 'BulkOperation's
699+-- and a 'Server' to 'bulk' in order to send those operations up to your Elasticsearch
700+-- server to be performed. I changed from [BulkOperation] to a Vector due to memory overhead.
701+bulk :: MonadBH m => V.Vector BulkOperation -> m Reply
702+bulk bulkOps = bindM2 post url (return body)
703+ where url = joinPath ["_bulk"]
704+ body = Just $ encodeBulkOperations bulkOps
705+
706+-- | 'encodeBulkOperations' is a convenience function for dumping a vector of 'BulkOperation'
707+-- into an 'L.ByteString'
708+encodeBulkOperations :: V.Vector BulkOperation -> L.ByteString
709+encodeBulkOperations stream = collapsed where
710+ blobs = fmap encodeBulkOperation stream
711+ mashedTaters = mash (mempty :: Builder) blobs
712+ collapsed = toLazyByteString $ mappend mashedTaters (byteString "\n")
713+
714+mash :: Builder -> V.Vector L.ByteString -> Builder
715+mash = V.foldl' (\b x -> b `mappend` (byteString "\n") `mappend` (lazyByteString x))
716+
717+mkBulkStreamValue :: Text -> Text -> Text -> Text -> Value
718+mkBulkStreamValue operation indexName mappingName docId =
719+ object [operation .=
720+ object [ "_index" .= indexName
721+ , "_type" .= mappingName
722+ , "_id" .= docId]]
723+
724+-- | 'encodeBulkOperation' is a convenience function for dumping a single 'BulkOperation'
725+-- into an 'L.ByteString'
726+encodeBulkOperation :: BulkOperation -> L.ByteString
727+encodeBulkOperation (BulkIndex (IndexName indexName)
728+ (MappingName mappingName)
729+ (DocId docId) value) = blob
730+ where metadata = mkBulkStreamValue "index" indexName mappingName docId
731+ blob = encode metadata `mappend` "\n" `mappend` encode value
732+
733+encodeBulkOperation (BulkCreate (IndexName indexName)
734+ (MappingName mappingName)
735+ (DocId docId) value) = blob
736+ where metadata = mkBulkStreamValue "create" indexName mappingName docId
737+ blob = encode metadata `mappend` "\n" `mappend` encode value
738+
739+encodeBulkOperation (BulkDelete (IndexName indexName)
740+ (MappingName mappingName)
741+ (DocId docId)) = blob
742+ where metadata = mkBulkStreamValue "delete" indexName mappingName docId
743+ blob = encode metadata
744+
745+encodeBulkOperation (BulkUpdate (IndexName indexName)
746+ (MappingName mappingName)
747+ (DocId docId) value) = blob
748+ where metadata = mkBulkStreamValue "update" indexName mappingName docId
749+ doc = object ["doc" .= value]
750+ blob = encode metadata `mappend` "\n" `mappend` encode doc
751+
752+-- | 'getDocument' is a straight-forward way to fetch a single document from
753+-- Elasticsearch using a 'Server', 'IndexName', 'MappingName', and a 'DocId'.
754+-- The 'DocId' is the primary key for your Elasticsearch document.
755+getDocument :: MonadBH m => IndexName -> MappingName
756+ -> DocId -> m Reply
757+getDocument (IndexName indexName)
758+ (MappingName mappingName) (DocId docId) =
759+ get =<< joinPath [indexName, mappingName, docId]
760+
761+-- | 'documentExists' enables you to check if a document exists. Returns 'Bool'
762+-- in IO
763+documentExists :: MonadBH m => IndexName -> MappingName
764+ -> Maybe DocumentParent -> DocId -> m Bool
765+documentExists (IndexName indexName) (MappingName mappingName)
766+ parent (DocId docId) = do
767+ (_, exists) <- existentialQuery =<< url
768+ return exists
769+ where url = addQuery params <$> joinPath [indexName, mappingName, docId]
770+ parentParam = fmap (\(DocumentParent (DocId p)) -> p) parent
771+ params = LS.filter (\(_, v) -> isJust v) [("parent", parentParam)]
772+
773+dispatchSearch :: MonadBH m => Text -> Search -> m Reply
774+dispatchSearch url search = post url' (Just (encode search))
775+ where url' = appendSearchTypeParam url (searchType search)
776+
777+-- | 'searchAll', given a 'Search', will perform that search against all indexes
778+-- on an Elasticsearch server. Try to avoid doing this if it can be helped.
779+searchAll :: MonadBH m => Search -> m Reply
780+searchAll = bindM2 dispatchSearch url . return
781+ where url = joinPath ["_search"]
782+
783+-- | 'searchByIndex', given a 'Search' and an 'IndexName', will perform that search
784+-- against all mappings within an index on an Elasticsearch server.
785+searchByIndex :: MonadBH m => IndexName -> Search -> m Reply
786+searchByIndex (IndexName indexName) = bindM2 dispatchSearch url . return
787+ where url = joinPath [indexName, "_search"]
788+
789+-- | 'searchByType', given a 'Search', 'IndexName', and 'MappingName', will perform that
790+-- search against a specific mapping within an index on an Elasticsearch server.
791+searchByType :: MonadBH m => IndexName -> MappingName -> Search
792+ -> m Reply
793+searchByType (IndexName indexName)
794+ (MappingName mappingName) = bindM2 dispatchSearch url . return
795+ where url = joinPath [indexName, mappingName, "_search"]
796+
797+-- | For a given search, request a scroll for efficient streaming of
798+-- search results. Note that the search is put into 'SearchTypeScan'
799+-- mode and thus results will not be sorted. Combine this with
800+-- 'advanceScroll' to efficiently stream through the full result set
801+getInitialScroll :: MonadBH m => IndexName -> MappingName -> Search -> m (Maybe ScrollId)
802+getInitialScroll (IndexName indexName) (MappingName mappingName) search = do
803+ let url = joinPath [indexName, mappingName, "_search"]
804+ search' = search { searchType = SearchTypeScan }
805+ resp' <- bindM2 dispatchSearch url (return search')
806+ let msr = decode' $ responseBody resp' :: Maybe (SearchResult ())
807+ msid = maybe Nothing scrollId msr
808+ return msid
809+
810+scroll' :: (FromJSON a, MonadBH m, MonadThrow m) => Maybe ScrollId -> m ([Hit a], Maybe ScrollId)
811+scroll' Nothing = return ([], Nothing)
812+scroll' (Just sid) = do
813+ res <- advanceScroll sid 60
814+ case res of
815+ Right SearchResult {..} -> return (hits searchHits, scrollId)
816+ Left _ -> return ([], Nothing)
817+
818+-- | Use the given scroll to fetch the next page of documents. If there are no
819+-- further pages, 'SearchResult.searchHits.hits' will be '[]'.
820+advanceScroll
821+ :: ( FromJSON a
822+ , MonadBH m
823+ , MonadThrow m
824+ )
825+ => ScrollId
826+ -> NominalDiffTime
827+ -- ^ How long should the snapshot of data be kept around? This timeout is updated every time 'advanceScroll' is used, so don't feel the need to set it to the entire duration of your search processing. Note that durations < 1s will be rounded up. Also note that 'NominalDiffTime' is an instance of Num so literals like 60 will be interpreted as seconds. 60s is a reasonable default.
828+ -> m (Either EsError (SearchResult a))
829+advanceScroll (ScrollId sid) scroll = do
830+ url <- joinPath ["_search/scroll?scroll=" <> scrollTime]
831+ parseEsResponse =<< post url (Just . L.fromStrict $ T.encodeUtf8 sid)
832+ where scrollTime = showText secs <> "s"
833+ secs :: Integer
834+ secs = round scroll
835+
836+simpleAccumulator :: (FromJSON a, MonadBH m, MonadThrow m) => [Hit a] -> ([Hit a], Maybe ScrollId) -> m ([Hit a], Maybe ScrollId)
837+simpleAccumulator oldHits (newHits, Nothing) = return (oldHits ++ newHits, Nothing)
838+simpleAccumulator oldHits ([], _) = return (oldHits, Nothing)
839+simpleAccumulator oldHits (newHits, msid) = do
840+ (newHits', msid') <- scroll' msid
841+ simpleAccumulator (oldHits ++ newHits) (newHits', msid')
842+
843+-- | 'scanSearch' uses the 'scan&scroll' API of elastic,
844+-- for a given 'IndexName' and 'MappingName'. Note that this will
845+-- consume the entire search result set and will be doing O(n) list
846+-- appends so this may not be suitable for large result sets. In that
847+-- case, 'getInitialScroll' and 'advanceScroll' are good low level
848+-- tools. You should be able to hook them up trivially to conduit,
849+-- pipes, or your favorite streaming IO abstraction of choice. Note
850+-- that ordering on the search would destroy performance and thus is
851+-- ignored.
852+scanSearch :: (FromJSON a, MonadBH m, MonadThrow m) => IndexName -> MappingName -> Search -> m [Hit a]
853+scanSearch indexName mappingName search = do
854+ msid <- getInitialScroll indexName mappingName search
855+ (hits, msid') <- scroll' msid
856+ (totalHits, _) <- simpleAccumulator [] (hits, msid')
857+ return totalHits
858+
859+-- | 'mkSearch' is a helper function for defaulting additional fields of a 'Search'
860+-- to Nothing in case you only care about your 'Query' and 'Filter'. Use record update
861+-- syntax if you want to add things like aggregations or highlights while still using
862+-- this helper function.
863+mkSearch :: Maybe Query -> Maybe Filter -> Search
864+mkSearch query filter = Search query filter Nothing Nothing Nothing False (From 0) (Size 10) SearchTypeQueryThenFetch Nothing Nothing
865+
866+-- | 'mkAggregateSearch' is a helper function that defaults everything in a 'Search' except for
867+-- the 'Query' and the 'Aggregation'.
868+mkAggregateSearch :: Maybe Query -> Aggregations -> Search
869+mkAggregateSearch query mkSearchAggs = Search query Nothing Nothing (Just mkSearchAggs) Nothing False (From 0) (Size 0) SearchTypeQueryThenFetch Nothing Nothing
870+
871+-- | 'mkHighlightSearch' is a helper function that defaults everything in a 'Search' except for
872+-- the 'Query' and the 'Aggregation'.
873+mkHighlightSearch :: Maybe Query -> Highlights -> Search
874+mkHighlightSearch query searchHighlights = Search query Nothing Nothing Nothing (Just searchHighlights) False (From 0) (Size 10) SearchTypeQueryThenFetch Nothing Nothing
875+
876+-- | 'pageSearch' is a helper function that takes a search and assigns the from
877+-- and size fields for the search. The from parameter defines the offset
878+-- from the first result you want to fetch. The size parameter allows you to
879+-- configure the maximum amount of hits to be returned.
880+pageSearch :: From -- ^ The result offset
881+ -> Size -- ^ The number of results to return
882+ -> Search -- ^ The current seach
883+ -> Search -- ^ The paged search
884+pageSearch resultOffset pageSize search = search { from = resultOffset, size = pageSize }
885+
886+parseUrl' :: MonadThrow m => Text -> m Request
887+parseUrl' t = parseRequest (URI.escapeURIString URI.isAllowedInURI (T.unpack t))
888+
889+-- | Was there an optimistic concurrency control conflict when
890+-- indexing a document?
891+isVersionConflict :: Reply -> Bool
892+isVersionConflict = statusCheck (== 409)
893+
894+isSuccess :: Reply -> Bool
895+isSuccess = statusCheck (inRange (200, 299))
896+
897+isCreated :: Reply -> Bool
898+isCreated = statusCheck (== 201)
899+
900+statusCheck :: (Int -> Bool) -> Reply -> Bool
901+statusCheck prd = prd . NHTS.statusCode . responseStatus
902+
903+-- | This is a hook that can be set via the 'bhRequestHook' function
904+-- that will authenticate all requests using an HTTP Basic
905+-- Authentication header. Note that it is *strongly* recommended that
906+-- this option only be used over an SSL connection.
907+--
908+-- >> (mkBHEnv myServer myManager) { bhRequestHook = basicAuthHook (EsUsername "myuser") (EsPassword "mypass") }
909+basicAuthHook :: Monad m => EsUsername -> EsPassword -> Request -> m Request
910+basicAuthHook (EsUsername u) (EsPassword p) = return . applyBasicAuth u' p'
911+ where u' = T.encodeUtf8 u
912+ p' = T.encodeUtf8 p
913+
914+
915+boolQP :: Bool -> Text
916+boolQP True = "true"
917+boolQP False = "false"
src/Database/V1/Bloodhound/Types.hsnew file+5279
@@ -0,0 +1,5279 @@
1+{-# LANGUAGE DeriveDataTypeable #-}
2+{-# LANGUAGE DeriveGeneric #-}
3+{-# LANGUAGE FlexibleContexts #-}
4+{-# LANGUAGE FlexibleInstances #-}
5+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
6+{-# LANGUAGE MultiParamTypeClasses #-}
7+-- {-# LANGUAGE NoMonomorphismRestriction #-}
8+{-# LANGUAGE NamedFieldPuns #-}
9+{-# LANGUAGE OverloadedStrings #-}
10+{-# LANGUAGE RecordWildCards #-}
11+{-# LANGUAGE UndecidableInstances #-}
12+
13+-------------------------------------------------------------------------------
14+-- |
15+-- Module : Database.Bloodhound.Types
16+-- Copyright : (C) 2014, 2015, 2016 Chris Allen
17+-- License : BSD-style (see the file LICENSE)
18+-- Maintainer : Chris Allen <cma@bitemyapp.com
19+-- Stability : provisional
20+-- Portability : DeriveGeneric, RecordWildCards
21+--
22+-- Data types for describing actions and data structures performed to interact
23+-- with Elasticsearch. The two main buckets your queries against Elasticsearch
24+-- will fall into are 'Query's and 'Filter's. 'Filter's are more like
25+-- traditional database constraints and often have preferable performance
26+-- properties. 'Query's support human-written textual queries, such as fuzzy
27+-- queries.
28+-------------------------------------------------------------------------------
29+
30+
31+
32+module Database.V1.Bloodhound.Types
33+ ( defaultCache
34+ , defaultIndexSettings
35+ , defaultIndexDocumentSettings
36+ , mkSort
37+ , showText
38+ , unpackId
39+ , mkMatchQuery
40+ , mkMultiMatchQuery
41+ , mkBoolQuery
42+ , mkRangeQuery
43+ , mkQueryStringQuery
44+ , mkAggregations
45+ , mkTermsAggregation
46+ , mkTermsScriptAggregation
47+ , mkDateHistogram
48+ , mkCardinalityAggregation
49+ , mkDocVersion
50+ , docVersionNumber
51+ , toMissing
52+ , toTerms
53+ , toDateHistogram
54+ , toTopHits
55+ , omitNulls
56+ , BH(..)
57+ , runBH
58+ , BHEnv
59+ , bhServer
60+ , bhManager
61+ , bhRequestHook
62+ , mkBHEnv
63+ , MonadBH(..)
64+ , Version(..)
65+ , VersionNumber(..)
66+ , MaybeNA(..)
67+ , BuildHash(..)
68+ , Status(..)
69+ , Existence(..)
70+ , NullValue(..)
71+ , IndexSettings(..)
72+ , UpdatableIndexSetting(..)
73+ , IndexSettingsSummary(..)
74+ , AllocationPolicy(..)
75+ , ReplicaBounds(..)
76+ , Bytes(..)
77+ , gigabytes
78+ , megabytes
79+ , kilobytes
80+ , FSType(..)
81+ , InitialShardCount(..)
82+ , NodeAttrFilter(..)
83+ , NodeAttrName(..)
84+ , CompoundFormat(..)
85+ , IndexTemplate(..)
86+ , Server(..)
87+ , Reply
88+ , EsResult(..)
89+ , EsResultFound(..)
90+ , EsError(..)
91+ , EsProtocolException(..)
92+ , IndexAlias(..)
93+ , IndexAliasName(..)
94+ , IndexAliasAction(..)
95+ , IndexAliasCreate(..)
96+ , IndexAliasSummary(..)
97+ , IndexAliasesSummary(..)
98+ , AliasRouting(..)
99+ , SearchAliasRouting(..)
100+ , IndexAliasRouting(..)
101+ , RoutingValue(..)
102+ , DocVersion
103+ , ExternalDocVersion(..)
104+ , VersionControl(..)
105+ , DocumentParent(..)
106+ , IndexDocumentSettings(..)
107+ , Query(..)
108+ , Search(..)
109+ , SearchType(..)
110+ , SearchResult(..)
111+ , ScrollId(..)
112+ , SearchHits(..)
113+ , TrackSortScores
114+ , From(..)
115+ , Size(..)
116+ , Source(..)
117+ , PatternOrPatterns(..)
118+ , Include(..)
119+ , Exclude(..)
120+ , Pattern(..)
121+ , ShardResult(..)
122+ , Hit(..)
123+ , Filter(..)
124+ , Seminearring(..)
125+ , BoolMatch(..)
126+ , Term(..)
127+ , GeoPoint(..)
128+ , GeoBoundingBoxConstraint(..)
129+ , GeoBoundingBox(..)
130+ , GeoFilterType(..)
131+ , Distance(..)
132+ , DistanceUnit(..)
133+ , DistanceType(..)
134+ , DistanceRange(..)
135+ , OptimizeBbox(..)
136+ , LatLon(..)
137+ , RangeValue(..)
138+ , RangeExecution(..)
139+ , LessThan(..)
140+ , LessThanEq(..)
141+ , GreaterThan(..)
142+ , GreaterThanEq(..)
143+ , LessThanD(..)
144+ , LessThanEqD(..)
145+ , GreaterThanD(..)
146+ , GreaterThanEqD(..)
147+ , Regexp(..)
148+ , RegexpFlags(..)
149+ , RegexpFlag(..)
150+ , FieldName(..)
151+ , Script(..)
152+ , IndexName(..)
153+ , IndexSelection(..)
154+ , NodeSelection(..)
155+ , NodeSelector(..)
156+ , IndexOptimizationSettings(..)
157+ , defaultIndexOptimizationSettings
158+ , TemplateName(..)
159+ , TemplatePattern(..)
160+ , MappingName(..)
161+ , DocId(..)
162+ , CacheName(..)
163+ , CacheKey(..)
164+ , BulkOperation(..)
165+ , ReplicaCount(..)
166+ , ShardCount(..)
167+ , Sort
168+ , SortMode(..)
169+ , SortOrder(..)
170+ , SortSpec(..)
171+ , DefaultSort(..)
172+ , Missing(..)
173+ , OpenCloseIndex(..)
174+ , Method
175+ , Boost(..)
176+ , MatchQuery(..)
177+ , MultiMatchQuery(..)
178+ , BoolQuery(..)
179+ , BoostingQuery(..)
180+ , CommonTermsQuery(..)
181+ , DisMaxQuery(..)
182+ , FilteredQuery(..)
183+ , FuzzyLikeThisQuery(..)
184+ , FuzzyLikeFieldQuery(..)
185+ , FuzzyQuery(..)
186+ , HasChildQuery(..)
187+ , HasParentQuery(..)
188+ , IndicesQuery(..)
189+ , MoreLikeThisQuery(..)
190+ , MoreLikeThisFieldQuery(..)
191+ , NestedQuery(..)
192+ , PrefixQuery(..)
193+ , QueryStringQuery(..)
194+ , SimpleQueryStringQuery(..)
195+ , RangeQuery(..)
196+ , RegexpQuery(..)
197+ , QueryString(..)
198+ , BooleanOperator(..)
199+ , ZeroTermsQuery(..)
200+ , CutoffFrequency(..)
201+ , Analyzer(..)
202+ , MaxExpansions(..)
203+ , Lenient(..)
204+ , MatchQueryType(..)
205+ , MultiMatchQueryType(..)
206+ , Tiebreaker(..)
207+ , MinimumMatch(..)
208+ , DisableCoord(..)
209+ , CommonMinimumMatch(..)
210+ , MinimumMatchHighLow(..)
211+ , PrefixLength(..)
212+ , Fuzziness(..)
213+ , IgnoreTermFrequency(..)
214+ , MaxQueryTerms(..)
215+ , ScoreType(..)
216+ , Score
217+ , Cache
218+ , TypeName(..)
219+ , BoostTerms(..)
220+ , MaxWordLength(..)
221+ , MinWordLength(..)
222+ , MaxDocFrequency(..)
223+ , MinDocFrequency(..)
224+ , PhraseSlop(..)
225+ , StopWord(..)
226+ , QueryPath(..)
227+ , MinimumTermFrequency(..)
228+ , PercentMatch(..)
229+ , FieldDefinition(..)
230+ , MappingField(..)
231+ , Mapping(..)
232+ , AllowLeadingWildcard(..)
233+ , LowercaseExpanded(..)
234+ , GeneratePhraseQueries(..)
235+ , Locale(..)
236+ , AnalyzeWildcard(..)
237+ , EnablePositionIncrements(..)
238+ , SimpleQueryFlag(..)
239+ , FieldOrFields(..)
240+ , Monoid(..)
241+ , ToJSON(..)
242+ , Interval(..)
243+ , TimeInterval(..)
244+ , ExecutionHint(..)
245+ , CollectionMode(..)
246+ , TermOrder(..)
247+ , TermInclusion(..)
248+ , SnapshotRepoSelection(..)
249+ , GenericSnapshotRepo(..)
250+ , SnapshotRepo(..)
251+ , SnapshotRepoConversionError(..)
252+ , SnapshotRepoType(..)
253+ , GenericSnapshotRepoSettings(..)
254+ , SnapshotRepoUpdateSettings(..)
255+ , defaultSnapshotRepoUpdateSettings
256+ , SnapshotRepoName(..)
257+ , SnapshotRepoPattern(..)
258+ , SnapshotVerification(..)
259+ , SnapshotNodeVerification(..)
260+ , FullNodeId(..)
261+ , NodeName(..)
262+ , ClusterName(..)
263+ , NodesInfo(..)
264+ , NodesStats(..)
265+ , NodeStats(..)
266+ , NodeBreakersStats(..)
267+ , NodeBreakerStats(..)
268+ , NodeHTTPStats(..)
269+ , NodeTransportStats(..)
270+ , NodeFSStats(..)
271+ , NodeDataPathStats(..)
272+ , NodeFSTotalStats(..)
273+ , NodeNetworkStats(..)
274+ , NodeThreadPoolsStats(..)
275+ , NodeThreadPoolStats(..)
276+ , NodeJVMStats(..)
277+ , JVMBufferPoolStats(..)
278+ , JVMGCStats(..)
279+ , JVMPoolStats(..)
280+ , NodeProcessStats(..)
281+ , NodeOSStats(..)
282+ , LoadAvgs(..)
283+ , NodeIndicesStats(..)
284+ , EsAddress(..)
285+ , PluginName(..)
286+ , NodeInfo(..)
287+ , NodePluginInfo(..)
288+ , NodeHTTPInfo(..)
289+ , NodeTransportInfo(..)
290+ , BoundTransportAddress(..)
291+ , NodeNetworkInfo(..)
292+ , MacAddress(..)
293+ , NetworkInterfaceName(..)
294+ , NodeNetworkInterface(..)
295+ , NodeThreadPoolsInfo(..)
296+ , NodeThreadPoolInfo(..)
297+ , ThreadPoolSize(..)
298+ , ThreadPoolType(..)
299+ , NodeJVMInfo(..)
300+ , JVMMemoryPool(..)
301+ , JVMGCCollector(..)
302+ , JVMMemoryInfo(..)
303+ , PID(..)
304+ , NodeOSInfo(..)
305+ , CPUInfo(..)
306+ , NodeProcessInfo(..)
307+ , FsSnapshotRepo(..)
308+ , SnapshotCreateSettings(..)
309+ , defaultSnapshotCreateSettings
310+ , SnapshotSelection(..)
311+ , SnapshotPattern(..)
312+ , SnapshotInfo(..)
313+ , SnapshotShardFailure(..)
314+ , ShardId(..)
315+ , SnapshotName(..)
316+ , SnapshotState(..)
317+ , SnapshotRestoreSettings(..)
318+ , defaultSnapshotRestoreSettings
319+ , RestoreRenamePattern(..)
320+ , RestoreRenameToken(..)
321+ , RRGroupRefNum
322+ , rrGroupRefNum
323+ , mkRRGroupRefNum
324+ , RestoreIndexSettings(..)
325+
326+ , Aggregation(..)
327+ , Aggregations
328+ , AggregationResults
329+ , BucketValue(..)
330+ , Bucket(..)
331+ , BucketAggregation(..)
332+ , TermsAggregation(..)
333+ , MissingAggregation(..)
334+ , ValueCountAggregation(..)
335+ , FilterAggregation(..)
336+ , CardinalityAggregation(..)
337+ , DateHistogramAggregation(..)
338+ , DateRangeAggregation(..)
339+ , DateRangeAggRange(..)
340+ , DateMathExpr(..)
341+ , DateMathAnchor(..)
342+ , DateMathModifier(..)
343+ , DateMathUnit(..)
344+ , TopHitsAggregation(..)
345+
346+ , Highlights(..)
347+ , FieldHighlight(..)
348+ , HighlightSettings(..)
349+ , PlainHighlight(..)
350+ , PostingsHighlight(..)
351+ , FastVectorHighlight(..)
352+ , CommonHighlight(..)
353+ , NonPostings(..)
354+ , HighlightEncoder(..)
355+ , HighlightTag(..)
356+ , HitHighlight
357+
358+ , MissingResult(..)
359+ , TermsResult(..)
360+ , DateHistogramResult(..)
361+ , DateRangeResult(..)
362+ , TopHitResult(..)
363+
364+ , EsUsername(..)
365+ , EsPassword(..)
366+ ) where
367+
368+import Control.Applicative as A
369+import Control.Arrow (first)
370+import Control.Monad.Catch
371+import Control.Monad.Except
372+import Control.Monad.Reader (MonadReader (..),
373+ ReaderT (..))
374+import Control.Monad.State (MonadState)
375+import Control.Monad.Writer (MonadWriter)
376+import Data.Aeson
377+import Data.Aeson.Types (Pair, Parser,
378+ emptyObject,
379+ parseEither, parseMaybe)
380+import qualified Data.ByteString.Lazy.Char8 as L
381+import Data.Char
382+import Data.Hashable (Hashable)
383+import qualified Data.HashMap.Strict as HM
384+import Data.List (foldl', intercalate,
385+ nub)
386+import Data.List.NonEmpty (NonEmpty (..), toList)
387+import qualified Data.Map.Strict as M
388+import Data.Maybe
389+import Data.Scientific (Scientific)
390+import Data.Semigroup
391+import Data.Text (Text)
392+import qualified Data.Text as T
393+import Data.Time.Calendar
394+import Data.Time.Clock (NominalDiffTime,
395+ UTCTime)
396+import Data.Time.Clock.POSIX
397+import qualified Data.Traversable as DT
398+import Data.Typeable (Typeable)
399+import qualified Data.Vector as V
400+import qualified Data.Version as Vers
401+import GHC.Enum
402+import GHC.Generics (Generic)
403+import Network.HTTP.Client
404+import qualified Network.HTTP.Types.Method as NHTM
405+import qualified Text.ParserCombinators.ReadP as RP
406+import qualified Text.Read as TR
407+
408+import Database.V1.Bloodhound.Types.Class
409+import Database.V1.Bloodhound.Types.Internal
410+
411+-- $setup
412+-- >>> :set -XOverloadedStrings
413+-- >>> import Data.Aeson
414+-- >>> import Database.V1.Bloodhound
415+-- >>> let testServer = (Server "http://localhost:9200")
416+-- >>> let testIndex = IndexName "twitter"
417+-- >>> let testMapping = MappingName "tweet"
418+-- >>> let defaultIndexSettings = IndexSettings (ShardCount 3) (ReplicaCount 2)
419+
420+-- defaultIndexSettings is exported by Database.Bloodhound as well
421+-- no trailing slashes in servers, library handles building the path.
422+
423+-- | Create a 'BHEnv' with all optional fields defaulted. HTTP hook
424+-- will be a noop. You can use the exported fields to customize it further, e.g.:
425+--
426+-- >> (mkBHEnv myServer myManager) { bhRequestHook = customHook }
427+mkBHEnv :: Server -> Manager -> BHEnv
428+mkBHEnv s m = BHEnv s m return
429+
430+newtype BH m a = BH {
431+ unBH :: ReaderT BHEnv m a
432+ } deriving ( Functor
433+ , A.Applicative
434+ , Monad
435+ , MonadIO
436+ , MonadState s
437+ , MonadWriter w
438+ , MonadError e
439+ , Alternative
440+ , MonadPlus
441+ , MonadFix
442+ , MonadThrow
443+ , MonadCatch
444+ , MonadMask)
445+
446+instance MonadTrans BH where
447+ lift = BH . lift
448+
449+instance (MonadReader r m) => MonadReader r (BH m) where
450+ ask = lift ask
451+ local f (BH (ReaderT m)) = BH $ ReaderT $ \r ->
452+ local f (m r)
453+
454+instance (Functor m, Applicative m, MonadIO m) => MonadBH (BH m) where
455+ getBHEnv = BH getBHEnv
456+
457+runBH :: BHEnv -> BH m a -> m a
458+runBH e f = runReaderT (unBH f) e
459+
460+{-| 'Version' is embedded in 'Status' -}
461+data Version = Version { number :: VersionNumber
462+ , build_hash :: BuildHash
463+ , build_timestamp :: UTCTime
464+ , build_snapshot :: Bool
465+ , lucene_version :: VersionNumber } deriving (Eq, Read, Show, Generic, Typeable)
466+
467+-- | Traditional software versioning number
468+newtype VersionNumber = VersionNumber { versionNumber :: Vers.Version
469+ } deriving (Eq, Read, Show, Generic, Typeable, Ord)
470+
471+{-| 'Status' is a data type for describing the JSON body returned by
472+ Elasticsearch when you query its status. This was deprecated in 1.2.0.
473+
474+ <http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/indices-status.html#indices-status>
475+-}
476+
477+data Status = Status { ok :: Maybe Bool
478+ , status :: Int
479+ , name :: Text
480+ , version :: Version
481+ , tagline :: Text } deriving (Eq, Read, Show, Generic)
482+
483+{-| 'IndexSettings' is used to configure the shards and replicas when you create
484+ an Elasticsearch Index.
485+
486+ <http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/indices-create-index.html>
487+-}
488+
489+data IndexSettings =
490+ IndexSettings { indexShards :: ShardCount
491+ , indexReplicas :: ReplicaCount } deriving (Eq, Read, Show, Generic, Typeable)
492+
493+{-| 'defaultIndexSettings' is an 'IndexSettings' with 3 shards and 2 replicas. -}
494+defaultIndexSettings :: IndexSettings
495+defaultIndexSettings = IndexSettings (ShardCount 3) (ReplicaCount 2)
496+
497+
498+{-| 'IndexOptimizationSettings' is used to configure index optimization. See
499+ <https://www.elastic.co/guide/en/elasticsearch/reference/1.7/indices-optimize.html>
500+ for more info.
501+-}
502+data IndexOptimizationSettings =
503+ IndexOptimizationSettings { maxNumSegments :: Maybe Int
504+ -- ^ 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.
505+ , onlyExpungeDeletes :: Bool
506+ -- ^ 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.
507+ , flushAfterOptimize :: Bool
508+ -- ^ Should a flush be performed after the optimize.
509+ } deriving (Eq, Show, Generic, Typeable)
510+
511+
512+{-| 'defaultIndexOptimizationSettings' implements the default settings that
513+ ElasticSearch uses for index optimization. 'maxNumSegments' is Nothing,
514+ 'onlyExpungeDeletes' is False, and flushAfterOptimize is True.
515+-}
516+defaultIndexOptimizationSettings :: IndexOptimizationSettings
517+defaultIndexOptimizationSettings = IndexOptimizationSettings Nothing False True
518+
519+{-| 'UpdatableIndexSetting' are settings which may be updated after an index is created.
520+
521+ <https://www.elastic.co/guide/en/elasticsearch/reference/current/indices-update-settings.html>
522+-}
523+data UpdatableIndexSetting = NumberOfReplicas ReplicaCount
524+ -- ^ The number of replicas each shard has.
525+ | AutoExpandReplicas ReplicaBounds
526+ | BlocksReadOnly Bool
527+ -- ^ Set to True to have the index read only. False to allow writes and metadata changes.
528+ | BlocksRead Bool
529+ -- ^ Set to True to disable read operations against the index.
530+ | BlocksWrite Bool
531+ -- ^ Set to True to disable write operations against the index.
532+ | BlocksMetaData Bool
533+ -- ^ Set to True to disable metadata operations against the index.
534+ | RefreshInterval NominalDiffTime
535+ -- ^ The async refresh interval of a shard
536+ | IndexConcurrency Int
537+ | FailOnMergeFailure Bool
538+ | TranslogFlushThresholdOps Int
539+ -- ^ When to flush on operations.
540+ | TranslogFlushThresholdSize Bytes
541+ -- ^ When to flush based on translog (bytes) size.
542+ | TranslogFlushThresholdPeriod NominalDiffTime
543+ -- ^ When to flush based on a period of not flushing.
544+ | TranslogDisableFlush Bool
545+ -- ^ Disables flushing. Note, should be set for a short interval and then enabled.
546+ | CacheFilterMaxSize (Maybe Bytes)
547+ -- ^ The maximum size of filter cache (per segment in shard).
548+ | CacheFilterExpire (Maybe NominalDiffTime)
549+ -- ^ The expire after access time for filter cache.
550+ | GatewaySnapshotInterval NominalDiffTime
551+ -- ^ The gateway snapshot interval (only applies to shared gateways).
552+ | RoutingAllocationInclude (NonEmpty NodeAttrFilter)
553+ -- ^ A node matching any rule will be allowed to host shards from the index.
554+ | RoutingAllocationExclude (NonEmpty NodeAttrFilter)
555+ -- ^ A node matching any rule will NOT be allowed to host shards from the index.
556+ | RoutingAllocationRequire (NonEmpty NodeAttrFilter)
557+ -- ^ Only nodes matching all rules will be allowed to host shards from the index.
558+ | RoutingAllocationEnable AllocationPolicy
559+ -- ^ Enables shard allocation for a specific index.
560+ | RoutingAllocationShardsPerNode ShardCount
561+ -- ^ Controls the total number of shards (replicas and primaries) allowed to be allocated on a single node.
562+ | RecoveryInitialShards InitialShardCount
563+ -- ^ When using local gateway a particular shard is recovered only if there can be allocated quorum shards in the cluster.
564+ | GCDeletes NominalDiffTime
565+ | TTLDisablePurge Bool
566+ -- ^ Disables temporarily the purge of expired docs.
567+ | TranslogFSType FSType
568+ | IndexCompoundFormat CompoundFormat
569+ | IndexCompoundOnFlush Bool
570+ | WarmerEnabled Bool
571+ deriving (Eq, Show, Generic, Typeable)
572+
573+data AllocationPolicy = AllocAll
574+ -- ^ Allows shard allocation for all shards.
575+ | AllocPrimaries
576+ -- ^ Allows shard allocation only for primary shards.
577+ | AllocNewPrimaries
578+ -- ^ Allows shard allocation only for primary shards for new indices.
579+ | AllocNone
580+ -- ^ No shard allocation is allowed
581+ deriving (Eq, Read, Show, Generic, Typeable)
582+
583+data ReplicaBounds = ReplicasBounded Int Int
584+ | ReplicasLowerBounded Int
585+ | ReplicasUnbounded
586+ deriving (Eq, Read, Show, Generic, Typeable)
587+
588+-- | A measure of bytes used for various configurations. You may want
589+-- to use smart constructors like 'gigabytes' for larger values.
590+--
591+-- >>> gigabytes 9
592+-- Bytes 9000000000
593+--
594+-- >>> megabytes 9
595+-- Bytes 9000000
596+--
597+-- >>> kilobytes 9
598+-- Bytes 9000
599+newtype Bytes = Bytes Int deriving (Eq, Read, Show, Generic, Typeable, Ord, ToJSON, FromJSON)
600+
601+gigabytes :: Int -> Bytes
602+gigabytes n = megabytes (1000 * n)
603+
604+
605+megabytes :: Int -> Bytes
606+megabytes n = kilobytes (1000 * n)
607+
608+
609+kilobytes :: Int -> Bytes
610+kilobytes n = Bytes (1000 * n)
611+
612+
613+data FSType = FSSimple
614+ | FSBuffered deriving (Eq, Read, Show, Generic, Typeable, Ord)
615+
616+data InitialShardCount = QuorumShards
617+ | QuorumMinus1Shards
618+ | FullShards
619+ | FullMinus1Shards
620+ | ExplicitShards Int
621+ deriving (Eq, Read, Show, Generic, Typeable)
622+
623+data NodeAttrFilter = NodeAttrFilter { nodeAttrFilterName :: NodeAttrName
624+ , nodeAttrFilterValues :: NonEmpty Text}
625+ deriving (Eq, Read, Show, Generic, Ord, Typeable)
626+
627+newtype NodeAttrName = NodeAttrName Text deriving (Eq, Read, Show, Ord, Generic, Typeable)
628+
629+data CompoundFormat = CompoundFileFormat Bool
630+ | MergeSegmentVsTotalIndex Double
631+ -- ^ percentage between 0 and 1 where 0 is false, 1 is true
632+ deriving (Eq, Read, Show, Generic, Typeable)
633+
634+newtype NominalDiffTimeJSON = NominalDiffTimeJSON { ndtJSON :: NominalDiffTime }
635+
636+data IndexSettingsSummary = IndexSettingsSummary { sSummaryIndexName :: IndexName
637+ , sSummaryFixedSettings :: IndexSettings
638+ , sSummaryUpdateable :: [UpdatableIndexSetting]}
639+ deriving (Eq, Show, Generic, Typeable)
640+
641+{-| 'Reply' and 'Method' are type synonyms from 'Network.HTTP.Types.Method.Method' -}
642+type Reply = Network.HTTP.Client.Response L.ByteString
643+type Method = NHTM.Method
644+
645+{-| 'OpenCloseIndex' is a sum type for opening and closing indices.
646+
647+ <http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/indices-open-close.html>
648+-}
649+data OpenCloseIndex = OpenIndex | CloseIndex deriving (Eq, Read, Show, Generic, Typeable)
650+
651+data FieldType = GeoPointType
652+ | GeoShapeType
653+ | FloatType
654+ | IntegerType
655+ | LongType
656+ | ShortType
657+ | ByteType deriving (Eq, Read, Show, Generic, Typeable)
658+
659+data FieldDefinition =
660+ FieldDefinition { fieldType :: FieldType } deriving (Eq, Read, Show, Generic, Typeable)
661+
662+{-| An 'IndexTemplate' defines a template that will automatically be
663+ applied to new indices created. The templates include both
664+ 'IndexSettings' and mappings, and a simple 'TemplatePattern' that
665+ controls if the template will be applied to the index created.
666+ Specify mappings as follows: @[toJSON TweetMapping, ...]@
667+
668+ https://www.elastic.co/guide/en/elasticsearch/reference/1.7/indices-templates.html
669+-}
670+data IndexTemplate =
671+ IndexTemplate { templatePattern :: TemplatePattern
672+ , templateSettings :: Maybe IndexSettings
673+ , templateMappings :: [Value]
674+ }
675+
676+data MappingField =
677+ MappingField { mappingFieldName :: FieldName
678+ , fieldDefinition :: FieldDefinition } deriving (Eq, Read, Show, Generic, Typeable)
679+
680+{-| Support for type reification of 'Mapping's is currently incomplete, for
681+ now the mapping API verbiage expects a 'ToJSON'able blob.
682+
683+ Indexes have mappings, mappings are schemas for the documents contained in the
684+ index. I'd recommend having only one mapping per index, always having a mapping,
685+ and keeping different kinds of documents separated if possible.
686+-}
687+data Mapping = Mapping { typeName :: TypeName
688+ , mappingFields :: [MappingField] } deriving (Eq, Read, Show, Generic, Typeable)
689+
690+{-| 'BulkOperation' is a sum type for expressing the four kinds of bulk
691+ operation index, create, delete, and update. 'BulkIndex' behaves like an
692+ "upsert", 'BulkCreate' will fail if a document already exists at the DocId.
693+
694+ <http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/docs-bulk.html#docs-bulk>
695+-}
696+data BulkOperation =
697+ BulkIndex IndexName MappingName DocId Value
698+ | BulkCreate IndexName MappingName DocId Value
699+ | BulkDelete IndexName MappingName DocId
700+ | BulkUpdate IndexName MappingName DocId Value deriving (Eq, Read, Show, Generic, Typeable)
701+
702+{-| 'EsResult' describes the standard wrapper JSON document that you see in
703+ successful Elasticsearch lookups or lookups that couldn't find the document.
704+-}
705+data EsResult a = EsResult { _index :: Text
706+ , _type :: Text
707+ , _id :: Text
708+ , foundResult :: Maybe (EsResultFound a)} deriving (Eq, Read, Show, Generic, Typeable)
709+
710+{-| 'EsResultFound' contains the document and its metadata inside of an
711+ 'EsResult' when the document was successfully found.
712+-}
713+data EsResultFound a = EsResultFound { _version :: DocVersion
714+ , _source :: a } deriving (Eq, Read, Show, Generic, Typeable)
715+
716+{-| 'EsError' is the generic type that will be returned when there was a
717+ problem. If you can't parse the expected response, its a good idea to
718+ try parsing this.
719+-}
720+data EsError = EsError { errorStatus :: Int
721+ , errorMessage :: Text } deriving (Eq, Read, Show, Generic, Typeable)
722+
723+{-| 'EsProtocolException' will be thrown if Bloodhound cannot parse a response
724+returned by the ElasticSearch server. If you encounter this error, please
725+verify that your domain data types and FromJSON instances are working properly
726+(for example, the 'a' of '[Hit a]' in 'SearchResult.searchHits.hits'). If you're
727+sure that your mappings are correct, then this error may be an indication of an
728+incompatibility between Bloodhound and ElasticSearch. Please open a bug report
729+and be sure to include the exception body.
730+-}
731+data EsProtocolException = EsProtocolException { esProtoExBody :: L.ByteString }
732+ deriving (Eq, Read, Show, Generic, Typeable)
733+
734+instance Exception EsProtocolException
735+
736+data IndexAlias = IndexAlias { srcIndex :: IndexName
737+ , indexAlias :: IndexAliasName } deriving (Eq, Read, Show, Generic, Typeable)
738+
739+newtype IndexAliasName = IndexAliasName { indexAliasName :: IndexName } deriving (Eq, Read, Show, Generic, ToJSON)
740+
741+data IndexAliasAction = AddAlias IndexAlias IndexAliasCreate
742+ | RemoveAlias IndexAlias deriving (Read, Show, Eq, Generic, Typeable)
743+
744+data IndexAliasCreate = IndexAliasCreate { aliasCreateRouting :: Maybe AliasRouting
745+ , aliasCreateFilter :: Maybe Filter}
746+ deriving (Read, Show, Eq, Generic, Typeable)
747+
748+data AliasRouting = AllAliasRouting RoutingValue
749+ | GranularAliasRouting (Maybe SearchAliasRouting) (Maybe IndexAliasRouting)
750+ deriving (Read, Show, Eq, Generic, Typeable)
751+
752+newtype SearchAliasRouting = SearchAliasRouting (NonEmpty RoutingValue) deriving (Read, Show, Eq, Generic, Typeable)
753+
754+newtype IndexAliasRouting = IndexAliasRouting RoutingValue deriving (Read, Show, Eq, Generic, ToJSON, FromJSON, Typeable)
755+
756+newtype RoutingValue = RoutingValue { routingValue :: Text } deriving (Read, Show, Eq, Generic, ToJSON, FromJSON, Typeable)
757+
758+newtype IndexAliasesSummary = IndexAliasesSummary { indexAliasesSummary :: [IndexAliasSummary] } deriving (Read, Show, Eq, Generic, Typeable)
759+
760+{-| 'IndexAliasSummary' is a summary of an index alias configured for a server. -}
761+data IndexAliasSummary = IndexAliasSummary { indexAliasSummaryAlias :: IndexAlias
762+ , indexAliasSummaryCreate :: IndexAliasCreate} deriving (Read, Show, Eq, Generic, Typeable)
763+
764+{-| 'DocVersion' is an integer version number for a document between 1
765+and 9.2e+18 used for <<https://www.elastic.co/guide/en/elasticsearch/guide/current/optimistic-concurrency-control.html optimistic concurrency control>>.
766+-}
767+newtype DocVersion = DocVersion {
768+ docVersionNumber :: Int
769+ } deriving (Eq, Read, Show, Generic, Ord, ToJSON)
770+
771+-- | Smart constructor for in-range doc version
772+mkDocVersion :: Int -> Maybe DocVersion
773+mkDocVersion i
774+ | i >= (docVersionNumber minBound) && i <= (docVersionNumber maxBound) =
775+ Just $ DocVersion i
776+ | otherwise = Nothing
777+
778+
779+{-| 'ExternalDocVersion' is a convenience wrapper if your code uses its
780+own version numbers instead of ones from ES.
781+-}
782+newtype ExternalDocVersion = ExternalDocVersion DocVersion
783+ deriving (Eq, Read, Show, Generic, Ord, Bounded, Enum, ToJSON)
784+
785+{-| 'VersionControl' is specified when indexing documents as a
786+optimistic concurrency control.
787+-}
788+data VersionControl = NoVersionControl
789+ -- ^ Don't send a version. This is a pure overwrite.
790+ | InternalVersion DocVersion
791+ -- ^ Use the default ES versioning scheme. Only
792+ -- index the document if the version is the same
793+ -- as the one specified. Only applicable to
794+ -- updates, as you should be getting Version from
795+ -- a search result.
796+ | ExternalGT ExternalDocVersion
797+ -- ^ Use your own version numbering. Only index
798+ -- the document if the version is strictly higher
799+ -- OR the document doesn't exist. The given
800+ -- version will be used as the new version number
801+ -- for the stored document. N.B. All updates must
802+ -- increment this number, meaning there is some
803+ -- global, external ordering of updates.
804+ | ExternalGTE ExternalDocVersion
805+ -- ^ Use your own version numbering. Only index
806+ -- the document if the version is equal or higher
807+ -- than the stored version. Will succeed if there
808+ -- is no existing document. The given version will
809+ -- be used as the new version number for the
810+ -- stored document. Use with care, as this could
811+ -- result in data loss.
812+ | ForceVersion ExternalDocVersion
813+ -- ^ The document will always be indexed and the
814+ -- given version will be the new version. This is
815+ -- typically used for correcting errors. Use with
816+ -- care, as this could result in data loss.
817+ deriving (Read, Show, Eq, Generic, Ord)
818+
819+{-| 'DocumentParent' is used to specify a parent document.
820+-}
821+newtype DocumentParent = DocumentParent DocId
822+ deriving (Eq, Read, Show, Generic, Typeable)
823+
824+{-| 'IndexDocumentSettings' are special settings supplied when indexing
825+a document. For the best backwards compatiblity when new fields are
826+added, you should probably prefer to start with 'defaultIndexDocumentSettings'
827+-}
828+data IndexDocumentSettings =
829+ IndexDocumentSettings { idsVersionControl :: VersionControl
830+ , idsParent :: Maybe DocumentParent
831+ } deriving (Eq, Read, Show, Generic, Typeable)
832+
833+{-| Reasonable default settings. Chooses no version control and no parent.
834+-}
835+defaultIndexDocumentSettings :: IndexDocumentSettings
836+defaultIndexDocumentSettings = IndexDocumentSettings NoVersionControl Nothing
837+
838+{-| 'Sort' is a synonym for a list of 'SortSpec's. Sort behavior is order
839+ dependent with later sorts acting as tie-breakers for earlier sorts.
840+-}
841+type Sort = [SortSpec]
842+
843+{-| The two main kinds of 'SortSpec' are 'DefaultSortSpec' and
844+ 'GeoDistanceSortSpec'. The latter takes a 'SortOrder', 'GeoPoint', and
845+ 'DistanceUnit' to express "nearness" to a single geographical point as a
846+ sort specification.
847+
848+<http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/search-request-sort.html#search-request-sort>
849+-}
850+data SortSpec = DefaultSortSpec DefaultSort
851+ | GeoDistanceSortSpec SortOrder GeoPoint DistanceUnit deriving (Eq, Read, Show, Generic, Typeable)
852+
853+{-| 'DefaultSort' is usually the kind of 'SortSpec' you'll want. There's a
854+ 'mkSort' convenience function for when you want to specify only the most
855+ common parameters.
856+
857+<http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/search-request-sort.html#search-request-sort>
858+-}
859+data DefaultSort =
860+ DefaultSort { sortFieldName :: FieldName
861+ , sortOrder :: SortOrder
862+ -- default False
863+ , ignoreUnmapped :: Bool
864+ , sortMode :: Maybe SortMode
865+ , missingSort :: Maybe Missing
866+ , nestedFilter :: Maybe Filter } deriving (Eq, Read, Show, Generic, Typeable)
867+
868+{-| 'SortOrder' is 'Ascending' or 'Descending', as you might expect. These get
869+ encoded into "asc" or "desc" when turned into JSON.
870+
871+<http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/search-request-sort.html#search-request-sort>
872+-}
873+data SortOrder = Ascending
874+ | Descending deriving (Eq, Read, Show, Generic, Typeable)
875+
876+{-| 'Missing' prescribes how to handle missing fields. A missing field can be
877+ sorted last, first, or using a custom value as a substitute.
878+
879+<http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/search-request-sort.html#_missing_values>
880+-}
881+data Missing = LastMissing
882+ | FirstMissing
883+ | CustomMissing Text deriving (Eq, Read, Show, Generic, Typeable)
884+
885+{-| 'SortMode' prescribes how to handle sorting array/multi-valued fields.
886+
887+http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/search-request-sort.html#_sort_mode_option
888+-}
889+data SortMode = SortMin
890+ | SortMax
891+ | SortSum
892+ | SortAvg deriving (Eq, Read, Show, Generic, Typeable)
893+
894+{-| 'mkSort' defaults everything but the 'FieldName' and the 'SortOrder' so
895+ that you can concisely describe the usual kind of 'SortSpec's you want.
896+-}
897+mkSort :: FieldName -> SortOrder -> DefaultSort
898+mkSort fieldName sOrder = DefaultSort fieldName sOrder False Nothing Nothing Nothing
899+
900+{-| 'Cache' is for telling ES whether it should cache a 'Filter' not.
901+ 'Query's cannot be cached.
902+-}
903+type Cache = Bool -- caching on/off
904+defaultCache :: Cache
905+defaultCache = False
906+
907+{-| 'PrefixValue' is used in 'PrefixQuery' as the main query component.
908+-}
909+type PrefixValue = Text
910+
911+{-| 'BooleanOperator' is the usual And/Or operators with an ES compatible
912+ JSON encoding baked in. Used all over the place.
913+-}
914+data BooleanOperator = And | Or deriving (Eq, Read, Show, Generic, Typeable)
915+
916+{-| 'ShardCount' is part of 'IndexSettings'
917+-}
918+newtype ShardCount = ShardCount Int deriving (Eq, Read, Show, Generic, ToJSON, Typeable)
919+
920+{-| 'ReplicaCount' is part of 'IndexSettings'
921+-}
922+newtype ReplicaCount = ReplicaCount Int deriving (Eq, Read, Show, Generic, ToJSON, Typeable)
923+
924+{-| 'IndexName' is used to describe which index to query/create/delete
925+-}
926+newtype IndexName = IndexName Text deriving (Eq, Generic, Read, Show, ToJSON, FromJSON, Typeable)
927+
928+{-| 'IndexSelection' is used for APIs which take a single index, a list of
929+ indexes, or the special @_all@ index.
930+-}
931+--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.
932+data IndexSelection = IndexList (NonEmpty IndexName)
933+ | AllIndexes deriving (Eq, Generic, Show, Typeable)
934+
935+{-| '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.
936+-}
937+data NodeSelection = LocalNode
938+ -- ^ Whatever node receives this request
939+ | NodeList (NonEmpty NodeSelector)
940+ | AllNodes deriving (Eq, Generic, Show, Typeable)
941+
942+
943+-- | An exact match or pattern to identify a node. Note that All of
944+-- these options support wildcarding, so your node name, server, attr
945+-- name can all contain * characters to be a fuzzy match.
946+data NodeSelector = NodeByName NodeName
947+ | NodeByFullNodeId FullNodeId
948+ | NodeByHost Server
949+ -- ^ e.g. 10.0.0.1 or even 10.0.0.*
950+ | NodeByAttribute NodeAttrName Text
951+ -- ^ NodeAttrName can be a pattern, e.g. rack*. The value can too.
952+ deriving (Eq, Generic, Show, Typeable)
953+
954+{-| 'TemplateName' is used to describe which template to query/create/delete
955+-}
956+newtype TemplateName = TemplateName Text deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
957+
958+{-| 'TemplatePattern' represents a pattern which is matched against index names
959+-}
960+newtype TemplatePattern = TemplatePattern Text deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
961+
962+{-| 'MappingName' is part of mappings which are how ES describes and schematizes
963+ the data in the indices.
964+-}
965+newtype MappingName = MappingName Text deriving (Eq, Generic, Read, Show, ToJSON, FromJSON, Typeable)
966+
967+{-| 'DocId' is a generic wrapper value for expressing unique Document IDs.
968+ Can be set by the user or created by ES itself. Often used in client
969+ functions for poking at specific documents.
970+-}
971+newtype DocId = DocId Text deriving (Eq, Generic, Read, Show, ToJSON, FromJSON, Typeable)
972+
973+{-| 'QueryString' is used to wrap query text bodies, be they human written or not.
974+-}
975+newtype QueryString = QueryString Text deriving (Eq, Generic, Read, Show, ToJSON, FromJSON, Typeable)
976+
977+{-| 'FieldName' is used all over the place wherever a specific field within
978+ a document needs to be specified, usually in 'Query's or 'Filter's.
979+-}
980+newtype FieldName = FieldName Text deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
981+
982+
983+{-| 'Script' is often used in place of 'FieldName' to specify more
984+complex ways of extracting a value from a document.
985+-}
986+newtype Script = Script { scriptText :: Text } deriving (Eq, Read, Show, Generic, Typeable)
987+
988+{-| 'CacheName' is used in 'RegexpFilter' for describing the
989+ 'CacheKey' keyed caching behavior.
990+-}
991+newtype CacheName = CacheName Text deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
992+
993+{-| 'CacheKey' is used in 'RegexpFilter' to key regex caching.
994+-}
995+newtype CacheKey =
996+ CacheKey Text deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
997+newtype Existence =
998+ Existence Bool deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
999+newtype NullValue =
1000+ NullValue Bool deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1001+newtype CutoffFrequency =
1002+ CutoffFrequency Double deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1003+newtype Analyzer =
1004+ Analyzer Text deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1005+newtype MaxExpansions =
1006+ MaxExpansions Int deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1007+
1008+{-| 'Lenient', if set to true, will cause format based failures to be
1009+ ignored. I don't know what the bloody default is, Elasticsearch
1010+ documentation didn't say what it was. Let me know if you figure it out.
1011+-}
1012+newtype Lenient =
1013+ Lenient Bool deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1014+newtype Tiebreaker =
1015+ Tiebreaker Double deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1016+newtype Boost =
1017+ Boost Double deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1018+newtype BoostTerms =
1019+ BoostTerms Double deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1020+
1021+{-| 'MinimumMatch' controls how many should clauses in the bool query should
1022+ match. Can be an absolute value (2) or a percentage (30%) or a
1023+ combination of both.
1024+-}
1025+newtype MinimumMatch =
1026+ MinimumMatch Int deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1027+newtype DisableCoord =
1028+ DisableCoord Bool deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1029+newtype IgnoreTermFrequency =
1030+ IgnoreTermFrequency Bool deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1031+newtype MinimumTermFrequency =
1032+ MinimumTermFrequency Int deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1033+newtype MaxQueryTerms =
1034+ MaxQueryTerms Int deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1035+newtype Fuzziness =
1036+ Fuzziness Double deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1037+
1038+{-| 'PrefixLength' is the prefix length used in queries, defaults to 0. -}
1039+newtype PrefixLength =
1040+ PrefixLength Int deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1041+newtype TypeName =
1042+ TypeName Text deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1043+newtype PercentMatch =
1044+ PercentMatch Double deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1045+newtype StopWord =
1046+ StopWord Text deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1047+newtype QueryPath =
1048+ QueryPath Text deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1049+
1050+{-| Allowing a wildcard at the beginning of a word (eg "*ing") is particularly
1051+ heavy, because all terms in the index need to be examined, just in case
1052+ they match. Leading wildcards can be disabled by setting
1053+ 'AllowLeadingWildcard' to false. -}
1054+newtype AllowLeadingWildcard =
1055+ AllowLeadingWildcard Bool deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1056+newtype LowercaseExpanded =
1057+ LowercaseExpanded Bool deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1058+newtype EnablePositionIncrements =
1059+ EnablePositionIncrements Bool deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1060+
1061+{-| By default, wildcard terms in a query are not analyzed.
1062+ Setting 'AnalyzeWildcard' to true enables best-effort analysis.
1063+-}
1064+newtype AnalyzeWildcard = AnalyzeWildcard Bool deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1065+
1066+{-| 'GeneratePhraseQueries' defaults to false.
1067+-}
1068+newtype GeneratePhraseQueries =
1069+ GeneratePhraseQueries Bool deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1070+
1071+{-| 'Locale' is used for string conversions - defaults to ROOT.
1072+-}
1073+newtype Locale = Locale Text deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1074+newtype MaxWordLength = MaxWordLength Int deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1075+newtype MinWordLength = MinWordLength Int deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1076+
1077+{-| 'PhraseSlop' sets the default slop for phrases, 0 means exact
1078+ phrase matches. Default is 0.
1079+-}
1080+newtype PhraseSlop = PhraseSlop Int deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1081+newtype MinDocFrequency = MinDocFrequency Int deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1082+newtype MaxDocFrequency = MaxDocFrequency Int deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1083+
1084+-- | Newtype wrapper to parse ES's concerning tendency to in some APIs return a floating point number of milliseconds since epoch ಠ_ಠ
1085+newtype POSIXMS = POSIXMS { posixMS :: UTCTime }
1086+
1087+{-| 'unpackId' is a silly convenience function that gets used once.
1088+-}
1089+unpackId :: DocId -> Text
1090+unpackId (DocId docId) = docId
1091+
1092+type TrackSortScores = Bool
1093+newtype From = From Int deriving (Eq, Read, Show, Generic, ToJSON)
1094+newtype Size = Size Int deriving (Eq, Read, Show, Generic, ToJSON)
1095+
1096+data Search = Search { queryBody :: Maybe Query
1097+ , filterBody :: Maybe Filter
1098+ , sortBody :: Maybe Sort
1099+ , aggBody :: Maybe Aggregations
1100+ , highlight :: Maybe Highlights
1101+ -- default False
1102+ , trackSortScores :: TrackSortScores
1103+ , from :: From
1104+ , size :: Size
1105+ , searchType :: SearchType
1106+ , fields :: Maybe [FieldName]
1107+ , source :: Maybe Source } deriving (Eq, Read, Show, Generic, Typeable)
1108+
1109+data SearchType = SearchTypeQueryThenFetch
1110+ | SearchTypeDfsQueryThenFetch
1111+ | SearchTypeCount
1112+ | SearchTypeScan
1113+ | SearchTypeQueryAndFetch
1114+ | SearchTypeDfsQueryAndFetch
1115+ deriving (Eq, Read, Show, Generic, Typeable)
1116+
1117+data Source =
1118+ NoSource
1119+ | SourcePatterns PatternOrPatterns
1120+ | SourceIncludeExclude Include Exclude
1121+ deriving (Read, Show, Eq, Generic, Typeable)
1122+
1123+data PatternOrPatterns = PopPattern Pattern
1124+ | PopPatterns [Pattern] deriving (Eq, Read, Show, Generic, Typeable)
1125+
1126+data Include = Include [Pattern] deriving (Eq, Read, Show, Generic, Typeable)
1127+data Exclude = Exclude [Pattern] deriving (Eq, Read, Show, Generic, Typeable)
1128+
1129+newtype Pattern = Pattern Text deriving (Eq, Read, Show, Generic, Typeable)
1130+
1131+data Highlights = Highlights { globalsettings :: Maybe HighlightSettings
1132+ , highlightFields :: [FieldHighlight]
1133+ } deriving (Read, Show, Eq, Generic, Typeable)
1134+
1135+data FieldHighlight = FieldHighlight FieldName (Maybe HighlightSettings)
1136+ deriving (Read, Show, Eq, Generic, Typeable)
1137+
1138+
1139+data HighlightSettings = Plain PlainHighlight
1140+ | Postings PostingsHighlight
1141+ | FastVector FastVectorHighlight
1142+ deriving (Read, Show, Eq, Generic, Typeable)
1143+data PlainHighlight =
1144+ PlainHighlight { plainCommon :: Maybe CommonHighlight
1145+ , plainNonPost :: Maybe NonPostings } deriving (Read, Show, Eq, Generic, Typeable)
1146+
1147+ -- This requires that index_options are set to 'offset' in the mapping.
1148+data PostingsHighlight = PostingsHighlight (Maybe CommonHighlight) deriving (Read, Show, Eq, Generic, Typeable)
1149+
1150+-- This requires that term_vector is set to 'with_positions_offsets' in the mapping.
1151+data FastVectorHighlight =
1152+ FastVectorHighlight { fvCommon :: Maybe CommonHighlight
1153+ , fvNonPostSettings :: Maybe NonPostings
1154+ , boundaryChars :: Maybe Text
1155+ , boundaryMaxScan :: Maybe Int
1156+ , fragmentOffset :: Maybe Int
1157+ , matchedFields :: [Text]
1158+ , phraseLimit :: Maybe Int
1159+ } deriving (Read, Show, Eq, Generic, Typeable)
1160+
1161+data CommonHighlight =
1162+ CommonHighlight { order :: Maybe Text
1163+ , forceSource :: Maybe Bool
1164+ , tag :: Maybe HighlightTag
1165+ , encoder :: Maybe HighlightEncoder
1166+ , noMatchSize :: Maybe Int
1167+ , highlightQuery :: Maybe Query
1168+ , requireFieldMatch :: Maybe Bool
1169+ } deriving (Read, Show, Eq, Generic, Typeable)
1170+
1171+-- Settings that are only applicable to FastVector and Plain highlighters.
1172+data NonPostings =
1173+ NonPostings { fragmentSize :: Maybe Int
1174+ , numberOfFragments :: Maybe Int} deriving (Read, Show, Eq, Generic, Typeable)
1175+
1176+data HighlightEncoder = DefaultEncoder
1177+ | HTMLEncoder
1178+ deriving (Read, Show, Eq, Generic, Typeable)
1179+
1180+-- NOTE: Should the tags use some kind of HTML type, rather than Text?
1181+data HighlightTag = TagSchema Text
1182+ | CustomTags ([Text], [Text]) -- Only uses more than the first value in the lists if fvh
1183+ deriving (Read, Show, Eq, Generic, Typeable)
1184+
1185+
1186+data Query =
1187+ TermQuery Term (Maybe Boost)
1188+ | TermsQuery Text (NonEmpty Text)
1189+ | QueryMatchQuery MatchQuery
1190+ | QueryMultiMatchQuery MultiMatchQuery
1191+ | QueryBoolQuery BoolQuery
1192+ | QueryBoostingQuery BoostingQuery
1193+ | QueryCommonTermsQuery CommonTermsQuery
1194+ | ConstantScoreFilter Filter Boost
1195+ | ConstantScoreQuery Query Boost
1196+ | QueryDisMaxQuery DisMaxQuery
1197+ | QueryFilteredQuery FilteredQuery
1198+ | QueryFuzzyLikeThisQuery FuzzyLikeThisQuery
1199+ | QueryFuzzyLikeFieldQuery FuzzyLikeFieldQuery
1200+ | QueryFuzzyQuery FuzzyQuery
1201+ | QueryHasChildQuery HasChildQuery
1202+ | QueryHasParentQuery HasParentQuery
1203+ | IdsQuery MappingName [DocId]
1204+ | QueryIndicesQuery IndicesQuery
1205+ | MatchAllQuery (Maybe Boost)
1206+ | QueryMoreLikeThisQuery MoreLikeThisQuery
1207+ | QueryMoreLikeThisFieldQuery MoreLikeThisFieldQuery
1208+ | QueryNestedQuery NestedQuery
1209+ | QueryPrefixQuery PrefixQuery
1210+ | QueryQueryStringQuery QueryStringQuery
1211+ | QuerySimpleQueryStringQuery SimpleQueryStringQuery
1212+ | QueryRangeQuery RangeQuery
1213+ | QueryRegexpQuery RegexpQuery
1214+ deriving (Eq, Read, Show, Generic, Typeable)
1215+
1216+data RegexpQuery =
1217+ RegexpQuery { regexpQueryField :: FieldName
1218+ , regexpQuery :: Regexp
1219+ , regexpQueryFlags :: RegexpFlags
1220+ , regexpQueryBoost :: Maybe Boost
1221+ } deriving (Eq, Read, Show, Generic, Typeable)
1222+
1223+data RangeQuery =
1224+ RangeQuery { rangeQueryField :: FieldName
1225+ , rangeQueryRange :: RangeValue
1226+ , rangeQueryBoost :: Boost } deriving (Eq, Read, Show, Generic, Typeable)
1227+
1228+mkRangeQuery :: FieldName -> RangeValue -> RangeQuery
1229+mkRangeQuery f r = RangeQuery f r (Boost 1.0)
1230+
1231+data SimpleQueryStringQuery =
1232+ SimpleQueryStringQuery
1233+ { simpleQueryStringQuery :: QueryString
1234+ , simpleQueryStringField :: Maybe FieldOrFields
1235+ , simpleQueryStringOperator :: Maybe BooleanOperator
1236+ , simpleQueryStringAnalyzer :: Maybe Analyzer
1237+ , simpleQueryStringFlags :: Maybe (NonEmpty SimpleQueryFlag)
1238+ , simpleQueryStringLowercaseExpanded :: Maybe LowercaseExpanded
1239+ , simpleQueryStringLocale :: Maybe Locale
1240+ } deriving (Eq, Read, Show, Generic, Typeable)
1241+
1242+data SimpleQueryFlag =
1243+ SimpleQueryAll
1244+ | SimpleQueryNone
1245+ | SimpleQueryAnd
1246+ | SimpleQueryOr
1247+ | SimpleQueryPrefix
1248+ | SimpleQueryPhrase
1249+ | SimpleQueryPrecedence
1250+ | SimpleQueryEscape
1251+ | SimpleQueryWhitespace
1252+ | SimpleQueryFuzzy
1253+ | SimpleQueryNear
1254+ | SimpleQuerySlop deriving (Eq, Read, Show, Generic, Typeable)
1255+
1256+-- use_dis_max and tie_breaker when fields are plural?
1257+data QueryStringQuery =
1258+ QueryStringQuery
1259+ { queryStringQuery :: QueryString
1260+ , queryStringDefaultField :: Maybe FieldName
1261+ , queryStringOperator :: Maybe BooleanOperator
1262+ , queryStringAnalyzer :: Maybe Analyzer
1263+ , queryStringAllowLeadingWildcard :: Maybe AllowLeadingWildcard
1264+ , queryStringLowercaseExpanded :: Maybe LowercaseExpanded
1265+ , queryStringEnablePositionIncrements :: Maybe EnablePositionIncrements
1266+ , queryStringFuzzyMaxExpansions :: Maybe MaxExpansions
1267+ , queryStringFuzziness :: Maybe Fuzziness
1268+ , queryStringFuzzyPrefixLength :: Maybe PrefixLength
1269+ , queryStringPhraseSlop :: Maybe PhraseSlop
1270+ , queryStringBoost :: Maybe Boost
1271+ , queryStringAnalyzeWildcard :: Maybe AnalyzeWildcard
1272+ , queryStringGeneratePhraseQueries :: Maybe GeneratePhraseQueries
1273+ , queryStringMinimumShouldMatch :: Maybe MinimumMatch
1274+ , queryStringLenient :: Maybe Lenient
1275+ , queryStringLocale :: Maybe Locale
1276+ } deriving (Eq, Read, Show, Generic, Typeable)
1277+
1278+mkQueryStringQuery :: QueryString -> QueryStringQuery
1279+mkQueryStringQuery qs =
1280+ QueryStringQuery qs Nothing Nothing
1281+ Nothing Nothing Nothing Nothing
1282+ Nothing Nothing Nothing Nothing
1283+ Nothing Nothing Nothing Nothing
1284+ Nothing Nothing
1285+
1286+data FieldOrFields = FofField FieldName
1287+ | FofFields (NonEmpty FieldName) deriving (Eq, Read, Show, Generic, Typeable)
1288+
1289+data PrefixQuery =
1290+ PrefixQuery
1291+ { prefixQueryField :: FieldName
1292+ , prefixQueryPrefixValue :: Text
1293+ , prefixQueryBoost :: Maybe Boost } deriving (Eq, Read, Show, Generic, Typeable)
1294+
1295+data NestedQuery =
1296+ NestedQuery
1297+ { nestedQueryPath :: QueryPath
1298+ , nestedQueryScoreType :: ScoreType
1299+ , nestedQuery :: Query } deriving (Eq, Read, Show, Generic, Typeable)
1300+
1301+data MoreLikeThisFieldQuery =
1302+ MoreLikeThisFieldQuery
1303+ { moreLikeThisFieldText :: Text
1304+ , moreLikeThisFieldFields :: FieldName
1305+ -- default 0.3 (30%)
1306+ , moreLikeThisFieldPercentMatch :: Maybe PercentMatch
1307+ , moreLikeThisFieldMinimumTermFreq :: Maybe MinimumTermFrequency
1308+ , moreLikeThisFieldMaxQueryTerms :: Maybe MaxQueryTerms
1309+ , moreLikeThisFieldStopWords :: Maybe (NonEmpty StopWord)
1310+ , moreLikeThisFieldMinDocFrequency :: Maybe MinDocFrequency
1311+ , moreLikeThisFieldMaxDocFrequency :: Maybe MaxDocFrequency
1312+ , moreLikeThisFieldMinWordLength :: Maybe MinWordLength
1313+ , moreLikeThisFieldMaxWordLength :: Maybe MaxWordLength
1314+ , moreLikeThisFieldBoostTerms :: Maybe BoostTerms
1315+ , moreLikeThisFieldBoost :: Maybe Boost
1316+ , moreLikeThisFieldAnalyzer :: Maybe Analyzer
1317+ } deriving (Eq, Read, Show, Generic, Typeable)
1318+
1319+data MoreLikeThisQuery =
1320+ MoreLikeThisQuery
1321+ { moreLikeThisText :: Text
1322+ , moreLikeThisFields :: Maybe (NonEmpty FieldName)
1323+ -- default 0.3 (30%)
1324+ , moreLikeThisPercentMatch :: Maybe PercentMatch
1325+ , moreLikeThisMinimumTermFreq :: Maybe MinimumTermFrequency
1326+ , moreLikeThisMaxQueryTerms :: Maybe MaxQueryTerms
1327+ , moreLikeThisStopWords :: Maybe (NonEmpty StopWord)
1328+ , moreLikeThisMinDocFrequency :: Maybe MinDocFrequency
1329+ , moreLikeThisMaxDocFrequency :: Maybe MaxDocFrequency
1330+ , moreLikeThisMinWordLength :: Maybe MinWordLength
1331+ , moreLikeThisMaxWordLength :: Maybe MaxWordLength
1332+ , moreLikeThisBoostTerms :: Maybe BoostTerms
1333+ , moreLikeThisBoost :: Maybe Boost
1334+ , moreLikeThisAnalyzer :: Maybe Analyzer
1335+ } deriving (Eq, Read, Show, Generic, Typeable)
1336+
1337+data IndicesQuery =
1338+ IndicesQuery
1339+ { indicesQueryIndices :: [IndexName]
1340+ , indicesQuery :: Query
1341+ -- default "all"
1342+ , indicesQueryNoMatch :: Maybe Query } deriving (Eq, Read, Show, Generic, Typeable)
1343+
1344+data HasParentQuery =
1345+ HasParentQuery
1346+ { hasParentQueryType :: TypeName
1347+ , hasParentQuery :: Query
1348+ , hasParentQueryScoreType :: Maybe ScoreType } deriving (Eq, Read, Show, Generic, Typeable)
1349+
1350+data HasChildQuery =
1351+ HasChildQuery
1352+ { hasChildQueryType :: TypeName
1353+ , hasChildQuery :: Query
1354+ , hasChildQueryScoreType :: Maybe ScoreType } deriving (Eq, Read, Show, Generic, Typeable)
1355+
1356+data ScoreType =
1357+ ScoreTypeMax
1358+ | ScoreTypeSum
1359+ | ScoreTypeAvg
1360+ | ScoreTypeNone deriving (Eq, Read, Show, Generic, Typeable)
1361+
1362+data FuzzyQuery =
1363+ FuzzyQuery { fuzzyQueryField :: FieldName
1364+ , fuzzyQueryValue :: Text
1365+ , fuzzyQueryPrefixLength :: PrefixLength
1366+ , fuzzyQueryMaxExpansions :: MaxExpansions
1367+ , fuzzyQueryFuzziness :: Fuzziness
1368+ , fuzzyQueryBoost :: Maybe Boost
1369+ } deriving (Eq, Read, Show, Generic, Typeable)
1370+
1371+data FuzzyLikeFieldQuery =
1372+ FuzzyLikeFieldQuery
1373+ { fuzzyLikeField :: FieldName
1374+ -- anaphora is good for the soul.
1375+ , fuzzyLikeFieldText :: Text
1376+ , fuzzyLikeFieldMaxQueryTerms :: MaxQueryTerms
1377+ , fuzzyLikeFieldIgnoreTermFrequency :: IgnoreTermFrequency
1378+ , fuzzyLikeFieldFuzziness :: Fuzziness
1379+ , fuzzyLikeFieldPrefixLength :: PrefixLength
1380+ , fuzzyLikeFieldBoost :: Boost
1381+ , fuzzyLikeFieldAnalyzer :: Maybe Analyzer
1382+ } deriving (Eq, Read, Show, Generic, Typeable)
1383+
1384+data FuzzyLikeThisQuery =
1385+ FuzzyLikeThisQuery
1386+ { fuzzyLikeFields :: [FieldName]
1387+ , fuzzyLikeText :: Text
1388+ , fuzzyLikeMaxQueryTerms :: MaxQueryTerms
1389+ , fuzzyLikeIgnoreTermFrequency :: IgnoreTermFrequency
1390+ , fuzzyLikeFuzziness :: Fuzziness
1391+ , fuzzyLikePrefixLength :: PrefixLength
1392+ , fuzzyLikeBoost :: Boost
1393+ , fuzzyLikeAnalyzer :: Maybe Analyzer
1394+ } deriving (Eq, Read, Show, Generic, Typeable)
1395+
1396+data FilteredQuery =
1397+ FilteredQuery
1398+ { filteredQuery :: Query
1399+ , filteredFilter :: Filter } deriving (Eq, Read, Show, Generic, Typeable)
1400+
1401+data DisMaxQuery =
1402+ DisMaxQuery { disMaxQueries :: [Query]
1403+ -- default 0.0
1404+ , disMaxTiebreaker :: Tiebreaker
1405+ , disMaxBoost :: Maybe Boost
1406+ } deriving (Eq, Read, Show, Generic, Typeable)
1407+
1408+data MatchQuery =
1409+ MatchQuery { matchQueryField :: FieldName
1410+ , matchQueryQueryString :: QueryString
1411+ , matchQueryOperator :: BooleanOperator
1412+ , matchQueryZeroTerms :: ZeroTermsQuery
1413+ , matchQueryCutoffFrequency :: Maybe CutoffFrequency
1414+ , matchQueryMatchType :: Maybe MatchQueryType
1415+ , matchQueryAnalyzer :: Maybe Analyzer
1416+ , matchQueryMaxExpansions :: Maybe MaxExpansions
1417+ , matchQueryLenient :: Maybe Lenient
1418+ , matchQueryBoost :: Maybe Boost } deriving (Eq, Read, Show, Generic, Typeable)
1419+
1420+{-| 'mkMatchQuery' is a convenience function that defaults the less common parameters,
1421+ enabling you to provide only the 'FieldName' and 'QueryString' to make a 'MatchQuery'
1422+-}
1423+mkMatchQuery :: FieldName -> QueryString -> MatchQuery
1424+mkMatchQuery field query = MatchQuery field query Or ZeroTermsNone Nothing Nothing Nothing Nothing Nothing Nothing
1425+
1426+data MatchQueryType =
1427+ MatchPhrase
1428+ | MatchPhrasePrefix deriving (Eq, Read, Show, Generic, Typeable)
1429+
1430+data MultiMatchQuery =
1431+ MultiMatchQuery { multiMatchQueryFields :: [FieldName]
1432+ , multiMatchQueryString :: QueryString
1433+ , multiMatchQueryOperator :: BooleanOperator
1434+ , multiMatchQueryZeroTerms :: ZeroTermsQuery
1435+ , multiMatchQueryTiebreaker :: Maybe Tiebreaker
1436+ , multiMatchQueryType :: Maybe MultiMatchQueryType
1437+ , multiMatchQueryCutoffFrequency :: Maybe CutoffFrequency
1438+ , multiMatchQueryAnalyzer :: Maybe Analyzer
1439+ , multiMatchQueryMaxExpansions :: Maybe MaxExpansions
1440+ , multiMatchQueryLenient :: Maybe Lenient } deriving (Eq, Read, Show, Generic, Typeable)
1441+
1442+{-| 'mkMultiMatchQuery' is a convenience function that defaults the less common parameters,
1443+ enabling you to provide only the list of 'FieldName's and 'QueryString' to
1444+ make a 'MultiMatchQuery'.
1445+-}
1446+
1447+mkMultiMatchQuery :: [FieldName] -> QueryString -> MultiMatchQuery
1448+mkMultiMatchQuery matchFields query =
1449+ MultiMatchQuery matchFields query
1450+ Or ZeroTermsNone Nothing Nothing Nothing Nothing Nothing Nothing
1451+
1452+data MultiMatchQueryType =
1453+ MultiMatchBestFields
1454+ | MultiMatchMostFields
1455+ | MultiMatchCrossFields
1456+ | MultiMatchPhrase
1457+ | MultiMatchPhrasePrefix deriving (Eq, Read, Show, Generic, Typeable)
1458+
1459+data BoolQuery =
1460+ BoolQuery { boolQueryMustMatch :: [Query]
1461+ , boolQueryMustNotMatch :: [Query]
1462+ , boolQueryShouldMatch :: [Query]
1463+ , boolQueryMinimumShouldMatch :: Maybe MinimumMatch
1464+ , boolQueryBoost :: Maybe Boost
1465+ , boolQueryDisableCoord :: Maybe DisableCoord
1466+ } deriving (Eq, Read, Show, Generic, Typeable)
1467+
1468+mkBoolQuery :: [Query] -> [Query] -> [Query] -> BoolQuery
1469+mkBoolQuery must mustNot should =
1470+ BoolQuery must mustNot should Nothing Nothing Nothing
1471+
1472+data BoostingQuery =
1473+ BoostingQuery { positiveQuery :: Query
1474+ , negativeQuery :: Query
1475+ , negativeBoost :: Boost } deriving (Eq, Read, Show, Generic, Typeable)
1476+
1477+data CommonTermsQuery =
1478+ CommonTermsQuery { commonField :: FieldName
1479+ , commonQuery :: QueryString
1480+ , commonCutoffFrequency :: CutoffFrequency
1481+ , commonLowFreqOperator :: BooleanOperator
1482+ , commonHighFreqOperator :: BooleanOperator
1483+ , commonMinimumShouldMatch :: Maybe CommonMinimumMatch
1484+ , commonBoost :: Maybe Boost
1485+ , commonAnalyzer :: Maybe Analyzer
1486+ , commonDisableCoord :: Maybe DisableCoord
1487+ } deriving (Eq, Read, Show, Generic, Typeable)
1488+
1489+data CommonMinimumMatch =
1490+ CommonMinimumMatchHighLow MinimumMatchHighLow
1491+ | CommonMinimumMatch MinimumMatch
1492+ deriving (Eq, Read, Show, Generic, Typeable)
1493+
1494+data MinimumMatchHighLow =
1495+ MinimumMatchHighLow { lowFreq :: MinimumMatch
1496+ , highFreq :: MinimumMatch } deriving (Eq, Read, Show, Generic, Typeable)
1497+
1498+data Filter = AndFilter [Filter] Cache
1499+ | OrFilter [Filter] Cache
1500+ | NotFilter Filter Cache
1501+ | IdentityFilter
1502+ | BoolFilter BoolMatch
1503+ | ExistsFilter FieldName -- always cached
1504+ | GeoBoundingBoxFilter GeoBoundingBoxConstraint
1505+ | GeoDistanceFilter GeoPoint Distance DistanceType OptimizeBbox Cache
1506+ | GeoDistanceRangeFilter GeoPoint DistanceRange
1507+ | GeoPolygonFilter FieldName [LatLon]
1508+ | IdsFilter MappingName [DocId]
1509+ | LimitFilter Int
1510+ | MissingFilter FieldName Existence NullValue
1511+ | PrefixFilter FieldName PrefixValue Cache
1512+ | QueryFilter Query Cache
1513+ | RangeFilter FieldName RangeValue RangeExecution Cache
1514+ | RegexpFilter FieldName Regexp RegexpFlags CacheName Cache CacheKey
1515+ | TermFilter Term Cache
1516+ deriving (Eq, Read, Show, Generic, Typeable)
1517+
1518+data ZeroTermsQuery = ZeroTermsNone
1519+ | ZeroTermsAll deriving (Eq, Read, Show, Generic, Typeable)
1520+
1521+data RangeExecution = RangeExecutionIndex
1522+ | RangeExecutionFielddata deriving (Eq, Read, Show, Generic, Typeable)
1523+
1524+newtype Regexp = Regexp Text deriving (Eq, Read, Show, Generic, Typeable, FromJSON)
1525+
1526+data RegexpFlags = AllRegexpFlags
1527+ | NoRegexpFlags
1528+ | SomeRegexpFlags (NonEmpty RegexpFlag) deriving (Eq, Read, Show, Generic, Typeable)
1529+
1530+data RegexpFlag = AnyString
1531+ | Automaton
1532+ | Complement
1533+ | Empty
1534+ | Intersection
1535+ | Interval deriving (Eq, Read, Show, Generic, Typeable)
1536+
1537+newtype LessThan = LessThan Double deriving (Eq, Read, Show, Generic, Typeable)
1538+newtype LessThanEq = LessThanEq Double deriving (Eq, Read, Show, Generic, Typeable)
1539+newtype GreaterThan = GreaterThan Double deriving (Eq, Read, Show, Generic, Typeable)
1540+newtype GreaterThanEq = GreaterThanEq Double deriving (Eq, Read, Show, Generic, Typeable)
1541+
1542+newtype LessThanD = LessThanD UTCTime deriving (Eq, Read, Show, Generic, Typeable)
1543+newtype LessThanEqD = LessThanEqD UTCTime deriving (Eq, Read, Show, Generic, Typeable)
1544+newtype GreaterThanD = GreaterThanD UTCTime deriving (Eq, Read, Show, Generic, Typeable)
1545+newtype GreaterThanEqD = GreaterThanEqD UTCTime deriving (Eq, Read, Show, Generic, Typeable)
1546+
1547+data RangeValue = RangeDateLte LessThanEqD
1548+ | RangeDateLt LessThanD
1549+ | RangeDateGte GreaterThanEqD
1550+ | RangeDateGt GreaterThanD
1551+ | RangeDateGtLt GreaterThanD LessThanD
1552+ | RangeDateGteLte GreaterThanEqD LessThanEqD
1553+ | RangeDateGteLt GreaterThanEqD LessThanD
1554+ | RangeDateGtLte GreaterThanD LessThanEqD
1555+ | RangeDoubleLte LessThanEq
1556+ | RangeDoubleLt LessThan
1557+ | RangeDoubleGte GreaterThanEq
1558+ | RangeDoubleGt GreaterThan
1559+ | RangeDoubleGtLt GreaterThan LessThan
1560+ | RangeDoubleGteLte GreaterThanEq LessThanEq
1561+ | RangeDoubleGteLt GreaterThanEq LessThan
1562+ | RangeDoubleGtLte GreaterThan LessThanEq
1563+ deriving (Eq, Read, Show, Generic, Typeable)
1564+
1565+rangeValueToPair :: RangeValue -> [Pair]
1566+rangeValueToPair rv = case rv of
1567+ RangeDateLte (LessThanEqD t) -> ["lte" .= t]
1568+ RangeDateGte (GreaterThanEqD t) -> ["gte" .= t]
1569+ RangeDateLt (LessThanD t) -> ["lt" .= t]
1570+ RangeDateGt (GreaterThanD t) -> ["gt" .= t]
1571+ RangeDateGteLte (GreaterThanEqD l) (LessThanEqD g) -> ["gte" .= l, "lte" .= g]
1572+ RangeDateGtLte (GreaterThanD l) (LessThanEqD g) -> ["gt" .= l, "lte" .= g]
1573+ RangeDateGteLt (GreaterThanEqD l) (LessThanD g) -> ["gte" .= l, "lt" .= g]
1574+ RangeDateGtLt (GreaterThanD l) (LessThanD g) -> ["gt" .= l, "lt" .= g]
1575+ RangeDoubleLte (LessThanEq t) -> ["lte" .= t]
1576+ RangeDoubleGte (GreaterThanEq t) -> ["gte" .= t]
1577+ RangeDoubleLt (LessThan t) -> ["lt" .= t]
1578+ RangeDoubleGt (GreaterThan t) -> ["gt" .= t]
1579+ RangeDoubleGteLte (GreaterThanEq l) (LessThanEq g) -> ["gte" .= l, "lte" .= g]
1580+ RangeDoubleGtLte (GreaterThan l) (LessThanEq g) -> ["gt" .= l, "lte" .= g]
1581+ RangeDoubleGteLt (GreaterThanEq l) (LessThan g) -> ["gte" .= l, "lt" .= g]
1582+ RangeDoubleGtLt (GreaterThan l) (LessThan g) -> ["gt" .= l, "lt" .= g]
1583+
1584+data Term = Term { termField :: Text
1585+ , termValue :: Text } deriving (Eq, Read, Show, Generic, Typeable)
1586+
1587+data BoolMatch = MustMatch Term Cache
1588+ | MustNotMatch Term Cache
1589+ | ShouldMatch [Term] Cache deriving (Eq, Read, Show, Generic, Typeable)
1590+
1591+-- "memory" or "indexed"
1592+data GeoFilterType = GeoFilterMemory
1593+ | GeoFilterIndexed deriving (Eq, Read, Show, Generic, Typeable)
1594+
1595+data LatLon = LatLon { lat :: Double
1596+ , lon :: Double } deriving (Eq, Read, Show, Generic, Typeable)
1597+
1598+data GeoBoundingBox =
1599+ GeoBoundingBox { topLeft :: LatLon
1600+ , bottomRight :: LatLon } deriving (Eq, Read, Show, Generic, Typeable)
1601+
1602+data GeoBoundingBoxConstraint =
1603+ GeoBoundingBoxConstraint { geoBBField :: FieldName
1604+ , constraintBox :: GeoBoundingBox
1605+ , bbConstraintcache :: Cache
1606+ , geoType :: GeoFilterType
1607+ } deriving (Eq, Read, Show, Generic, Typeable)
1608+
1609+data GeoPoint =
1610+ GeoPoint { geoField :: FieldName
1611+ , latLon :: LatLon} deriving (Eq, Read, Show, Generic, Typeable)
1612+
1613+data DistanceUnit = Miles
1614+ | Yards
1615+ | Feet
1616+ | Inches
1617+ | Kilometers
1618+ | Meters
1619+ | Centimeters
1620+ | Millimeters
1621+ | NauticalMiles deriving (Eq, Read, Show, Generic, Typeable)
1622+
1623+data DistanceType = Arc
1624+ | SloppyArc -- doesn't exist <1.0
1625+ | Plane deriving (Eq, Read, Show, Generic, Typeable)
1626+
1627+data OptimizeBbox = OptimizeGeoFilterType GeoFilterType
1628+ | NoOptimizeBbox deriving (Eq, Read, Show, Generic, Typeable)
1629+
1630+data Distance =
1631+ Distance { coefficient :: Double
1632+ , unit :: DistanceUnit } deriving (Eq, Read, Show, Generic, Typeable)
1633+
1634+data DistanceRange =
1635+ DistanceRange { distanceFrom :: Distance
1636+ , distanceTo :: Distance } deriving (Eq, Read, Show, Generic, Typeable)
1637+
1638+data SearchResult a =
1639+ SearchResult { took :: Int
1640+ , timedOut :: Bool
1641+ , shards :: ShardResult
1642+ , searchHits :: SearchHits a
1643+ , aggregations :: Maybe AggregationResults
1644+ , scrollId :: Maybe ScrollId } deriving (Eq, Read, Show, Generic, Typeable)
1645+
1646+newtype ScrollId = ScrollId Text deriving (Eq, Read, Show, Generic, Ord, ToJSON, FromJSON)
1647+
1648+type Score = Maybe Double
1649+
1650+data SearchHits a =
1651+ SearchHits { hitsTotal :: Int
1652+ , maxScore :: Score
1653+ , hits :: [Hit a] } deriving (Eq, Read, Show, Generic, Typeable)
1654+
1655+instance Semigroup (SearchHits a) where
1656+ (SearchHits ta ma ha) <> (SearchHits tb mb hb) = SearchHits (ta + tb) (max ma mb) (ha <> hb)
1657+
1658+instance Monoid (SearchHits a) where
1659+ mempty = SearchHits 0 Nothing mempty
1660+ mappend = (<>)
1661+
1662+data Hit a =
1663+ Hit { hitIndex :: IndexName
1664+ , hitType :: MappingName
1665+ , hitDocId :: DocId
1666+ , hitScore :: Score
1667+ , hitSource :: Maybe a
1668+ , hitHighlight :: Maybe HitHighlight } deriving (Eq, Read, Show, Generic, Typeable)
1669+
1670+data ShardResult =
1671+ ShardResult { shardTotal :: Int
1672+ , shardsSuccessful :: Int
1673+ , shardsFailed :: Int } deriving (Eq, Read, Show, Generic, Typeable)
1674+
1675+type HitHighlight = M.Map Text [Text]
1676+
1677+showText :: Show a => a -> Text
1678+showText = T.pack . show
1679+
1680+readMay :: Read a => String -> Maybe a
1681+readMay s = case reads s of
1682+ (a, ""):_ -> Just a
1683+ _ -> Nothing
1684+
1685+parseReadText :: Read a => Text -> Parser a
1686+parseReadText = maybe mzero return . readMay . T.unpack
1687+
1688+type Aggregations = M.Map Text Aggregation
1689+
1690+emptyAggregations :: Aggregations
1691+emptyAggregations = M.empty
1692+
1693+mkAggregations :: Text -> Aggregation -> Aggregations
1694+mkAggregations name aggregation = M.insert name aggregation emptyAggregations
1695+
1696+data TermOrder = TermOrder{ termSortField :: Text
1697+ , termSortOrder :: SortOrder } deriving (Eq, Read, Show, Generic, Typeable)
1698+
1699+data TermInclusion = TermInclusion Text
1700+ | TermPattern Text Text deriving (Eq, Read, Show, Generic, Typeable)
1701+
1702+data CollectionMode = BreadthFirst
1703+ | DepthFirst deriving (Eq, Read, Show, Generic, Typeable)
1704+
1705+data ExecutionHint = Ordinals
1706+ | GlobalOrdinals
1707+ | GlobalOrdinalsHash
1708+ | GlobalOrdinalsLowCardinality
1709+ | Map deriving (Eq, Read, Show, Generic, Typeable)
1710+
1711+data TimeInterval = Weeks
1712+ | Days
1713+ | Hours
1714+ | Minutes
1715+ | Seconds deriving Eq
1716+
1717+data Interval = Year
1718+ | Quarter
1719+ | Month
1720+ | Week
1721+ | Day
1722+ | Hour
1723+ | Minute
1724+ | Second
1725+ | FractionalInterval Float TimeInterval deriving (Eq, Read, Show, Generic, Typeable)
1726+
1727+data Aggregation = TermsAgg TermsAggregation
1728+ | CardinalityAgg CardinalityAggregation
1729+ | DateHistogramAgg DateHistogramAggregation
1730+ | ValueCountAgg ValueCountAggregation
1731+ | FilterAgg FilterAggregation
1732+ | DateRangeAgg DateRangeAggregation
1733+ | MissingAgg MissingAggregation
1734+ | TopHitsAgg TopHitsAggregation
1735+ deriving (Eq, Read, Show, Generic, Typeable)
1736+
1737+data TopHitsAggregation = TopHitsAggregation
1738+ { taFrom :: Maybe From
1739+ , taSize :: Maybe Size
1740+ , taSort :: Maybe Sort
1741+ } deriving (Eq, Read, Show)
1742+
1743+data MissingAggregation = MissingAggregation
1744+ { maField :: Text
1745+ } deriving (Eq, Read, Show, Generic, Typeable)
1746+
1747+data TermsAggregation = TermsAggregation { term :: Either Text Text
1748+ , termInclude :: Maybe TermInclusion
1749+ , termExclude :: Maybe TermInclusion
1750+ , termOrder :: Maybe TermOrder
1751+ , termMinDocCount :: Maybe Int
1752+ , termSize :: Maybe Int
1753+ , termShardSize :: Maybe Int
1754+ , termCollectMode :: Maybe CollectionMode
1755+ , termExecutionHint :: Maybe ExecutionHint
1756+ , termAggs :: Maybe Aggregations
1757+ } deriving (Eq, Read, Show, Generic, Typeable)
1758+
1759+data CardinalityAggregation = CardinalityAggregation { cardinalityField :: FieldName,
1760+ precisionThreshold :: Maybe Int
1761+ } deriving (Eq, Read, Show, Generic, Typeable)
1762+
1763+data DateHistogramAggregation = DateHistogramAggregation { dateField :: FieldName
1764+ , dateInterval :: Interval
1765+ , dateFormat :: Maybe Text
1766+ -- pre and post deprecated in 1.5
1767+ , datePreZone :: Maybe Text
1768+ , datePostZone :: Maybe Text
1769+ , datePreOffset :: Maybe Text
1770+ , datePostOffset :: Maybe Text
1771+ , dateAggs :: Maybe Aggregations
1772+ } deriving (Eq, Read, Show, Generic, Typeable)
1773+
1774+
1775+data DateRangeAggregation = DateRangeAggregation { draField :: FieldName
1776+ , draFormat :: Maybe Text
1777+ , draRanges :: NonEmpty DateRangeAggRange
1778+ } deriving (Eq, Read, Show, Generic, Typeable)
1779+
1780+data DateRangeAggRange = DateRangeFrom DateMathExpr
1781+ | DateRangeTo DateMathExpr
1782+ | DateRangeFromAndTo DateMathExpr DateMathExpr deriving (Eq, Read, Show, Generic, Typeable)
1783+
1784+-- | See <https://www.elastic.co/guide/en/elasticsearch/reference/current/common-options.html#date-math> for more information.
1785+data DateMathExpr = DateMathExpr DateMathAnchor [DateMathModifier] deriving (Eq, Read, Show, Generic, Typeable)
1786+
1787+
1788+-- | Starting point for a date range. This along with the 'DateMathModifiers' gets you the date ES will start from.
1789+data DateMathAnchor = DMNow
1790+ | DMDate Day deriving (Eq, Read, Show, Generic, Typeable)
1791+
1792+data DateMathModifier = AddTime Int DateMathUnit
1793+ | SubtractTime Int DateMathUnit
1794+ | RoundDownTo DateMathUnit deriving (Eq, Read, Show, Generic, Typeable)
1795+
1796+data DateMathUnit = DMYear
1797+ | DMMonth
1798+ | DMWeek
1799+ | DMDay
1800+ | DMHour
1801+ | DMMinute
1802+ | DMSecond deriving (Eq, Read, Show, Generic, Typeable)
1803+
1804+-- | See <https://www.elastic.co/guide/en/elasticsearch/reference/current/search-aggregations-metrics-valuecount-aggregation.html> for more information.
1805+data ValueCountAggregation = FieldValueCount FieldName
1806+ | ScriptValueCount Script deriving (Eq, Read, Show, Generic, Typeable)
1807+
1808+-- | 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.
1809+data FilterAggregation = FilterAggregation { faFilter :: Filter
1810+ , faAggs :: Maybe Aggregations} deriving (Eq, Read, Show, Generic, Typeable)
1811+
1812+mkTermsAggregation :: Text -> TermsAggregation
1813+mkTermsAggregation t = TermsAggregation (Left t) Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing
1814+
1815+mkTermsScriptAggregation :: Text -> TermsAggregation
1816+mkTermsScriptAggregation t = TermsAggregation (Right t) Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing
1817+
1818+mkDateHistogram :: FieldName -> Interval -> DateHistogramAggregation
1819+mkDateHistogram t i = DateHistogramAggregation t i Nothing Nothing Nothing Nothing Nothing Nothing
1820+
1821+mkCardinalityAggregation :: FieldName -> CardinalityAggregation
1822+mkCardinalityAggregation t = CardinalityAggregation t Nothing
1823+
1824+instance ToJSON Version where
1825+ toJSON Version {..} = object ["number" .= number
1826+ ,"build_hash" .= build_hash
1827+ ,"build_timestamp" .= build_timestamp
1828+ ,"build_snapshot" .= build_snapshot
1829+ ,"lucene_version" .= lucene_version]
1830+
1831+instance FromJSON Version where
1832+ parseJSON = withObject "Version" parse
1833+ where parse o = Version
1834+ <$> o .: "number"
1835+ <*> o .: "build_hash"
1836+ <*> o .: "build_timestamp"
1837+ <*> o .: "build_snapshot"
1838+ <*> o .: "lucene_version"
1839+
1840+instance ToJSON VersionNumber where
1841+ toJSON = toJSON . Vers.showVersion . versionNumber
1842+
1843+instance FromJSON VersionNumber where
1844+ parseJSON = withText "VersionNumber" (parse . T.unpack)
1845+ where
1846+ parse s = case filter (null . snd)(RP.readP_to_S Vers.parseVersion s) of
1847+ [(v, _)] -> pure (VersionNumber v)
1848+ [] -> fail ("Invalid version string " ++ s)
1849+ xs -> fail ("Ambiguous version string " ++ s ++ " (" ++ intercalate ", " (Vers.showVersion . fst <$> xs) ++ ")")
1850+
1851+instance ToJSON TermOrder where
1852+ toJSON (TermOrder termSortField termSortOrder) = object [termSortField .= termSortOrder]
1853+
1854+instance ToJSON TermInclusion where
1855+ toJSON (TermInclusion x) = toJSON x
1856+ toJSON (TermPattern pattern flags) = omitNulls [ "pattern" .= pattern,
1857+ "flags" .= flags]
1858+
1859+instance ToJSON CollectionMode where
1860+ toJSON BreadthFirst = "breadth_first"
1861+ toJSON DepthFirst = "depth_first"
1862+
1863+instance ToJSON ExecutionHint where
1864+ toJSON Ordinals = "ordinals"
1865+ toJSON GlobalOrdinals = "global_ordinals"
1866+ toJSON GlobalOrdinalsHash = "global_ordinals_hash"
1867+ toJSON GlobalOrdinalsLowCardinality = "global_ordinals_low_cardinality"
1868+ toJSON Map = "map"
1869+
1870+instance ToJSON Interval where
1871+ toJSON Year = "year"
1872+ toJSON Quarter = "quarter"
1873+ toJSON Month = "month"
1874+ toJSON Week = "week"
1875+ toJSON Day = "day"
1876+ toJSON Hour = "hour"
1877+ toJSON Minute = "minute"
1878+ toJSON Second = "second"
1879+ toJSON (FractionalInterval fraction interval) = toJSON $ show fraction ++ show interval
1880+
1881+instance Show TimeInterval where
1882+ show Weeks = "w"
1883+ show Days = "d"
1884+ show Hours = "h"
1885+ show Minutes = "m"
1886+ show Seconds = "s"
1887+
1888+instance Read TimeInterval where
1889+ readPrec = f =<< TR.get
1890+ where
1891+ f 'w' = return Weeks
1892+ f 'd' = return Days
1893+ f 'h' = return Hours
1894+ f 'm' = return Minutes
1895+ f 's' = return Seconds
1896+ f _ = fail "TimeInterval expected one of w, d, h, m, s"
1897+
1898+instance ToJSON Aggregation where
1899+ toJSON (TermsAgg (TermsAggregation term include exclude order minDocCount size shardSize collectMode executionHint termAggs)) =
1900+ omitNulls ["terms" .= omitNulls [ toJSON' term,
1901+ "include" .= include,
1902+ "exclude" .= exclude,
1903+ "order" .= order,
1904+ "min_doc_count" .= minDocCount,
1905+ "size" .= size,
1906+ "shard_size" .= shardSize,
1907+ "collect_mode" .= collectMode,
1908+ "execution_hint" .= executionHint
1909+ ],
1910+ "aggs" .= termAggs ]
1911+ where
1912+ toJSON' x = case x of { Left y -> "field" .= y; Right y -> "script" .= y }
1913+
1914+ toJSON (CardinalityAgg (CardinalityAggregation field precisionThreshold)) =
1915+ object ["cardinality" .= omitNulls [ "field" .= field,
1916+ "precisionThreshold" .= precisionThreshold
1917+ ]
1918+ ]
1919+
1920+ toJSON (DateHistogramAgg (DateHistogramAggregation field interval format preZone postZone preOffset postOffset dateHistoAggs)) =
1921+ omitNulls ["date_histogram" .= omitNulls [ "field" .= field,
1922+ "interval" .= interval,
1923+ "format" .= format,
1924+ "pre_zone" .= preZone,
1925+ "post_zone" .= postZone,
1926+ "pre_offset" .= preOffset,
1927+ "post_offset" .= postOffset
1928+ ],
1929+ "aggs" .= dateHistoAggs ]
1930+ toJSON (ValueCountAgg a) = object ["value_count" .= v]
1931+ where v = case a of
1932+ (FieldValueCount (FieldName n)) -> object ["field" .= n]
1933+ (ScriptValueCount (Script s)) -> object ["script" .= s]
1934+ toJSON (FilterAgg (FilterAggregation filt ags)) =
1935+ omitNulls [ "filter" .= filt
1936+ , "aggs" .= ags]
1937+ toJSON (DateRangeAgg a) = object [ "date_range" .= a
1938+ ]
1939+ toJSON (MissingAgg (MissingAggregation{..})) =
1940+ object ["missing" .= object ["field" .= maField]]
1941+
1942+ toJSON (TopHitsAgg (TopHitsAggregation mfrom msize msort)) =
1943+ omitNulls ["top_hits" .= omitNulls [ "size" .= msize
1944+ , "from" .= mfrom
1945+ , "sort" .= msort
1946+ ]
1947+ ]
1948+
1949+instance ToJSON DateRangeAggregation where
1950+ toJSON DateRangeAggregation {..} =
1951+ omitNulls [ "field" .= draField
1952+ , "format" .= draFormat
1953+ , "ranges" .= toList draRanges
1954+ ]
1955+
1956+instance ToJSON DateRangeAggRange where
1957+ toJSON (DateRangeFrom e) = object [ "from" .= e ]
1958+ toJSON (DateRangeTo e) = object [ "to" .= e ]
1959+ toJSON (DateRangeFromAndTo f t) = object [ "from" .= f, "to" .= t ]
1960+
1961+instance ToJSON DateMathExpr where
1962+ toJSON (DateMathExpr a mods) = String (fmtA a <> mconcat (fmtMod <$> mods))
1963+ where fmtA DMNow = "now"
1964+ fmtA (DMDate date) = (T.pack $ showGregorian date) <> "||"
1965+ fmtMod (AddTime n u) = "+" <> showText n <> fmtU u
1966+ fmtMod (SubtractTime n u) = "-" <> showText n <> fmtU u
1967+ fmtMod (RoundDownTo u) = "/" <> fmtU u
1968+ fmtU DMYear = "y"
1969+ fmtU DMMonth = "M"
1970+ fmtU DMWeek = "w"
1971+ fmtU DMDay = "d"
1972+ fmtU DMHour = "h"
1973+ fmtU DMMinute = "m"
1974+ fmtU DMSecond = "s"
1975+
1976+
1977+type AggregationResults = M.Map Text Value
1978+
1979+class BucketAggregation a where
1980+ key :: a -> BucketValue
1981+ docCount :: a -> Int
1982+ aggs :: a -> Maybe AggregationResults
1983+
1984+
1985+data Bucket a = Bucket { buckets :: [a]} deriving (Read, Show)
1986+
1987+data BucketValue = TextValue Text
1988+ | ScientificValue Scientific
1989+ | BoolValue Bool deriving (Read, Show)
1990+
1991+data MissingResult = MissingResult { missingDocCount :: Int } deriving (Show)
1992+
1993+data TopHitResult a = TopHitResult { tarHits :: (SearchHits a)
1994+ } deriving Show
1995+
1996+data TermsResult = TermsResult { termKey :: BucketValue
1997+ , termsDocCount :: Int
1998+ , termsAggs :: Maybe AggregationResults } deriving (Read, Show)
1999+
2000+data DateHistogramResult = DateHistogramResult { dateKey :: Int
2001+ , dateKeyStr :: Maybe Text
2002+ , dateDocCount :: Int
2003+ , dateHistogramAggs :: Maybe AggregationResults } deriving (Read, Show)
2004+
2005+data DateRangeResult = DateRangeResult { dateRangeKey :: Text
2006+ , dateRangeFrom :: Maybe UTCTime
2007+ , dateRangeFromAsString :: Maybe Text
2008+ , dateRangeTo :: Maybe UTCTime
2009+ , dateRangeToAsString :: Maybe Text
2010+ , dateRangeDocCount :: Int
2011+ , dateRangeAggs :: Maybe AggregationResults } deriving (Read, Show, Eq, Generic, Typeable)
2012+
2013+toTerms :: Text -> AggregationResults -> Maybe (Bucket TermsResult)
2014+toTerms = toAggResult
2015+
2016+toDateHistogram :: Text -> AggregationResults -> Maybe (Bucket DateHistogramResult)
2017+toDateHistogram = toAggResult
2018+
2019+toMissing :: Text -> AggregationResults -> Maybe MissingResult
2020+toMissing = toAggResult
2021+
2022+toTopHits :: (FromJSON a) => Text -> AggregationResults -> Maybe (TopHitResult a)
2023+toTopHits = toAggResult
2024+
2025+toAggResult :: (FromJSON a) => Text -> AggregationResults -> Maybe a
2026+toAggResult t a = M.lookup t a >>= deserialize
2027+ where deserialize = parseMaybe parseJSON
2028+
2029+instance BucketAggregation TermsResult where
2030+ key = termKey
2031+ docCount = termsDocCount
2032+ aggs = termsAggs
2033+
2034+instance BucketAggregation DateHistogramResult where
2035+ key = TextValue . showText . dateKey
2036+ docCount = dateDocCount
2037+ aggs = dateHistogramAggs
2038+
2039+instance BucketAggregation DateRangeResult where
2040+ key = TextValue . dateRangeKey
2041+ docCount = dateRangeDocCount
2042+ aggs = dateRangeAggs
2043+
2044+instance (FromJSON a) => FromJSON (Bucket a) where
2045+ parseJSON (Object v) = Bucket <$>
2046+ v .: "buckets"
2047+ parseJSON _ = mempty
2048+
2049+instance FromJSON BucketValue where
2050+ parseJSON (String t) = return $ TextValue t
2051+ parseJSON (Number s) = return $ ScientificValue s
2052+ parseJSON (Bool b) = return $ BoolValue b
2053+ parseJSON _ = mempty
2054+
2055+instance FromJSON MissingResult where
2056+ parseJSON = withObject "MissingResult" parse
2057+ where parse v = MissingResult <$> v .: "doc_count"
2058+
2059+instance FromJSON TermsResult where
2060+ parseJSON (Object v) = TermsResult <$>
2061+ v .: "key" <*>
2062+ v .: "doc_count" <*>
2063+ (pure $ getNamedSubAgg v ["key", "doc_count"])
2064+ parseJSON _ = mempty
2065+
2066+instance FromJSON DateHistogramResult where
2067+ parseJSON (Object v) = DateHistogramResult <$>
2068+ v .: "key" <*>
2069+ v .:? "key_as_string" <*>
2070+ v .: "doc_count" <*>
2071+ (pure $ getNamedSubAgg v [ "key"
2072+ , "doc_count"
2073+ , "key_as_string"
2074+ ]
2075+ )
2076+ parseJSON _ = mempty
2077+
2078+instance FromJSON DateRangeResult where
2079+ parseJSON = withObject "DateRangeResult" parse
2080+ where parse v = DateRangeResult <$>
2081+ v .: "key" <*>
2082+ (fmap posixMS <$> v .:? "from") <*>
2083+ v .:? "from_as_string" <*>
2084+ (fmap posixMS <$> v .:? "to") <*>
2085+ v .:? "to_as_string" <*>
2086+ v .: "doc_count" <*>
2087+ (pure $ getNamedSubAgg v [ "key"
2088+ , "from"
2089+ , "from_as_string"
2090+ , "to"
2091+ , "to_as_string"
2092+ , "doc_count"
2093+ ]
2094+ )
2095+
2096+instance FromJSON POSIXMS where
2097+ parseJSON = withScientific "POSIXMS" (return . parse)
2098+ where parse n = let n' = truncate n :: Integer
2099+ in POSIXMS (posixSecondsToUTCTime (fromInteger (n' `div` 1000)))
2100+
2101+instance (FromJSON a) => FromJSON (TopHitResult a) where
2102+ parseJSON (Object v) = TopHitResult <$>
2103+ v .: "hits"
2104+ parseJSON _ = fail "Failure in FromJSON (TopHitResult a)"
2105+
2106+instance Semigroup Filter where
2107+ a <> b = AndFilter [a, b] defaultCache
2108+
2109+instance Monoid Filter where
2110+ mempty = IdentityFilter
2111+ mappend = (<>)
2112+
2113+instance Seminearring Filter where
2114+ a <||> b = OrFilter [a, b] defaultCache
2115+
2116+instance ToJSON Filter where
2117+ toJSON (AndFilter filters cache) =
2118+ object ["and" .=
2119+ object [ "filters" .= fmap toJSON filters
2120+ , "_cache" .= cache]]
2121+
2122+ toJSON (OrFilter filters cache) =
2123+ object ["or" .=
2124+ object [ "filters" .= fmap toJSON filters
2125+ , "_cache" .= cache]]
2126+
2127+ toJSON (NotFilter notFilter cache) =
2128+ object ["not" .=
2129+ object ["filter" .= notFilter
2130+ , "_cache" .= cache]]
2131+
2132+ toJSON (IdentityFilter) =
2133+ object ["match_all" .= object []]
2134+
2135+ toJSON (TermFilter (Term termFilterField termFilterValue) cache) =
2136+ object ["term" .= object base]
2137+ where base = [termFilterField .= termFilterValue,
2138+ "_cache" .= cache]
2139+
2140+ toJSON (ExistsFilter (FieldName fieldName)) =
2141+ object ["exists" .= object
2142+ ["field" .= fieldName]]
2143+
2144+ toJSON (BoolFilter boolMatch) =
2145+ object ["bool" .= boolMatch]
2146+
2147+ toJSON (GeoBoundingBoxFilter bbConstraint) =
2148+ object ["geo_bounding_box" .= bbConstraint]
2149+
2150+ toJSON (GeoDistanceFilter (GeoPoint (FieldName distanceGeoField) geoDistLatLon)
2151+ distance distanceType optimizeBbox cache) =
2152+ object ["geo_distance" .=
2153+ object ["distance" .= distance
2154+ , "distance_type" .= distanceType
2155+ , "optimize_bbox" .= optimizeBbox
2156+ , distanceGeoField .= geoDistLatLon
2157+ , "_cache" .= cache]]
2158+
2159+ toJSON (GeoDistanceRangeFilter (GeoPoint (FieldName gddrField) drLatLon)
2160+ (DistanceRange geoDistRangeDistFrom drDistanceTo)) =
2161+ object ["geo_distance_range" .=
2162+ object ["from" .= geoDistRangeDistFrom
2163+ , "to" .= drDistanceTo
2164+ , gddrField .= drLatLon]]
2165+
2166+ toJSON (GeoPolygonFilter (FieldName geoPolygonFilterField) latLons) =
2167+ object ["geo_polygon" .=
2168+ object [geoPolygonFilterField .=
2169+ object ["points" .= fmap toJSON latLons]]]
2170+
2171+ toJSON (IdsFilter (MappingName mappingName) values) =
2172+ object ["ids" .=
2173+ object ["type" .= mappingName
2174+ , "values" .= fmap unpackId values]]
2175+
2176+ toJSON (LimitFilter limit) =
2177+ object ["limit" .= object ["value" .= limit]]
2178+
2179+ toJSON (MissingFilter (FieldName fieldName) (Existence existence) (NullValue nullValue)) =
2180+ object ["missing" .=
2181+ object ["field" .= fieldName
2182+ , "existence" .= existence
2183+ , "null_value" .= nullValue]]
2184+
2185+ toJSON (PrefixFilter (FieldName fieldName) fieldValue cache) =
2186+ object ["prefix" .=
2187+ object [fieldName .= fieldValue
2188+ , "_cache" .= cache]]
2189+
2190+ toJSON (QueryFilter query False) =
2191+ object ["query" .= toJSON query ]
2192+ toJSON (QueryFilter query True) =
2193+ object ["fquery" .=
2194+ object [ "query" .= toJSON query
2195+ , "_cache" .= True ]]
2196+
2197+ toJSON (RangeFilter (FieldName fieldName) rangeValue rangeExecution cache) =
2198+ object ["range" .=
2199+ object [ fieldName .= object (rangeValueToPair rangeValue)
2200+ , "execution" .= rangeExecution
2201+ , "_cache" .= cache]]
2202+
2203+ toJSON (RegexpFilter (FieldName fieldName)
2204+ (Regexp regexText) flags (CacheName cacheName) cache (CacheKey cacheKey)) =
2205+ object ["regexp" .=
2206+ object [fieldName .=
2207+ object ["value" .= regexText
2208+ , "flags" .= flags]
2209+ , "_name" .= cacheName
2210+ , "_cache" .= cache
2211+ , "_cache_key" .= cacheKey]]
2212+
2213+instance FromJSON Filter where
2214+ parseJSON = withObject "Filter" parse
2215+ where parse o = andFilter `taggedWith` "and"
2216+ <|> orFilter `taggedWith` "or"
2217+ <|> notFilter `taggedWith` "not"
2218+ <|> identityFilter `taggedWith` "match_all"
2219+ <|> boolFilter `taggedWith` "bool"
2220+ <|> existsFilter `taggedWith` "exists"
2221+ <|> geoBoundingBoxFilter `taggedWith` "geo_bounding_box"
2222+ <|> geoDistanceFilter `taggedWith` "geo_distance"
2223+ <|> geoDistanceRangeFilter `taggedWith` "geo_distance_range"
2224+ <|> geoPolygonFilter `taggedWith` "geo_polygon"
2225+ <|> idsFilter `taggedWith` "ids"
2226+ <|> limitFilter `taggedWith` "limit"
2227+ <|> missingFilter `taggedWith` "missing"
2228+ <|> prefixFilter `taggedWith` "prefix"
2229+ <|> queryFilter `taggedWith` "query"
2230+ <|> fqueryFilter `taggedWith` "fquery"
2231+ <|> rangeFilter `taggedWith` "range"
2232+ <|> regexpFilter `taggedWith` "regexp"
2233+ <|> termFilter `taggedWith` "term"
2234+ where taggedWith parser k = parser =<< o .: k
2235+ andFilter o = AndFilter <$> o .: "filters"
2236+ <*> o .:? "_cache" .!= defaultCache
2237+ orFilter o = OrFilter <$> o .: "filters"
2238+ <*> o .:? "_cache" .!= defaultCache
2239+ notFilter o = NotFilter <$> o .: "filter"
2240+ <*> o .: "_cache" .!= defaultCache
2241+ identityFilter :: Object -> Parser Filter
2242+ identityFilter m
2243+ | HM.null m = pure IdentityFilter
2244+ | otherwise = fail ("Identityfilter expected empty object but got " <> show m)
2245+ boolFilter = pure . BoolFilter
2246+ existsFilter o = ExistsFilter <$> o .: "field"
2247+ geoBoundingBoxFilter = pure . GeoBoundingBoxFilter
2248+ geoDistanceFilter o = do
2249+ case HM.toList (deleteSeveral ["distance", "distance_type", "optimize_bbox", "_cache"] o) of
2250+ [(fn, v)] -> do
2251+ gp <- GeoPoint (FieldName fn) <$> parseJSON v
2252+ GeoDistanceFilter gp <$> o .: "distance"
2253+ <*> o .: "distance_type"
2254+ <*> o .: "optimize_bbox"
2255+ <*> o .:? "_cache" .!= defaultCache
2256+ _ -> fail "Could not find GeoDistanceFilter field name"
2257+ geoDistanceRangeFilter o = do
2258+ case HM.toList (deleteSeveral ["from", "to"] o) of
2259+ [(fn, v)] -> do
2260+ gp <- GeoPoint (FieldName fn) <$> parseJSON v
2261+ rng <- DistanceRange <$> o .: "from" <*> o .: "to"
2262+ return (GeoDistanceRangeFilter gp rng)
2263+ _ -> fail "Could not find GeoDistanceRangeFilter field name"
2264+ geoPolygonFilter = fieldTagged $ \fn o -> GeoPolygonFilter fn <$> o .: "points"
2265+ idsFilter o = IdsFilter <$> o .: "type"
2266+ <*> o .: "values"
2267+ limitFilter o = LimitFilter <$> o .: "value"
2268+ missingFilter o = MissingFilter <$> o .: "field"
2269+ <*> o .: "existence"
2270+ <*> o .: "null_value"
2271+ prefixFilter o = case HM.toList (HM.delete "_cache" o) of
2272+ [(fn, String v)] -> PrefixFilter (FieldName fn) v <$> o .:? "_cache" .!= defaultCache
2273+ _ -> fail "Could not parse PrefixFilter"
2274+
2275+ queryFilter q = pure (QueryFilter q False)
2276+ fqueryFilter o = QueryFilter <$> o .: "query" <*> pure True
2277+ rangeFilter o = case HM.toList (deleteSeveral ["execution", "_cache"] o) of
2278+ [(fn, v)] -> RangeFilter (FieldName fn)
2279+ <$> parseJSON v
2280+ <*> o .: "execution"
2281+ <*> o .:? "_cache" .!= defaultCache
2282+ _ -> fail "Could not find field name for RangeFilter"
2283+ regexpFilter o = case HM.toList (deleteSeveral ["_name", "_cache", "_cache_key"] o) of
2284+ [(fn, Object o')] -> RegexpFilter (FieldName fn)
2285+ <$> o' .: "value"
2286+ <*> o' .: "flags"
2287+ <*> o .: "_name"
2288+ <*> o .:? "_cache" .!= defaultCache
2289+ <*> o .: "_cache_key"
2290+ _ -> fail "Could not find field name for RegexpFilter"
2291+ termFilter o = case HM.toList (HM.delete "_cache" o) of
2292+ [(termField, String termVal)] -> TermFilter (Term termField termVal)
2293+ <$> o .:? "_cache" .!= defaultCache
2294+ _ -> fail "Could not find term field for TermFilter"
2295+
2296+fieldTagged :: Monad m => (FieldName -> Object -> m a) -> Object -> m a
2297+fieldTagged f o = case HM.toList o of
2298+ [(k, Object o')] -> f (FieldName k) o'
2299+ _ -> fail "Expected object with 1 field-named key"
2300+
2301+-- Try to get an AggregationResults when we don't know the
2302+-- field name. We filter out the known keys to try to minimize the noise.
2303+getNamedSubAgg :: Object -> [Text] -> Maybe AggregationResults
2304+getNamedSubAgg o knownKeys = maggRes
2305+ where unknownKeys = HM.filterWithKey (\k _ -> k `notElem` knownKeys) o
2306+ maggRes
2307+ | HM.null unknownKeys = Nothing
2308+ | otherwise = Just . M.fromList $ HM.toList unknownKeys
2309+
2310+instance ToJSON GeoPoint where
2311+ toJSON (GeoPoint (FieldName geoPointField) geoPointLatLon) =
2312+ object [ geoPointField .= geoPointLatLon ]
2313+
2314+
2315+instance ToJSON Query where
2316+ toJSON (TermQuery (Term termQueryField termQueryValue) boost) =
2317+ object [ "term" .=
2318+ object [termQueryField .= object merged]]
2319+ where
2320+ base = [ "value" .= termQueryValue ]
2321+ boosted = maybe [] (return . ("boost" .=)) boost
2322+ merged = mappend base boosted
2323+
2324+ toJSON (TermsQuery fieldName terms) =
2325+ object [ "terms" .= object conjoined ]
2326+ where conjoined = [fieldName .= terms]
2327+
2328+ toJSON (IdsQuery idsQueryMappingName docIds) =
2329+ object [ "ids" .= object conjoined ]
2330+ where conjoined = [ "type" .= idsQueryMappingName
2331+ , "values" .= fmap toJSON docIds ]
2332+
2333+ toJSON (QueryQueryStringQuery qQueryStringQuery) =
2334+ object [ "query_string" .= qQueryStringQuery ]
2335+
2336+ toJSON (QueryMatchQuery matchQuery) =
2337+ object [ "match" .= matchQuery ]
2338+
2339+ toJSON (QueryMultiMatchQuery multiMatchQuery) =
2340+ toJSON multiMatchQuery
2341+
2342+ toJSON (QueryBoolQuery boolQuery) =
2343+ object [ "bool" .= boolQuery ]
2344+
2345+ toJSON (QueryBoostingQuery boostingQuery) =
2346+ object [ "boosting" .= boostingQuery ]
2347+
2348+ toJSON (QueryCommonTermsQuery commonTermsQuery) =
2349+ object [ "common" .= commonTermsQuery ]
2350+
2351+ toJSON (ConstantScoreFilter csFilter boost) =
2352+ object ["constant_score" .= object ["filter" .= csFilter
2353+ , "boost" .= boost]]
2354+
2355+ toJSON (ConstantScoreQuery query boost) =
2356+ object ["constant_score" .= object ["query" .= query
2357+ , "boost" .= boost]]
2358+
2359+ toJSON (QueryDisMaxQuery disMaxQuery) =
2360+ object [ "dis_max" .= disMaxQuery ]
2361+
2362+ toJSON (QueryFilteredQuery qFilteredQuery) =
2363+ object [ "filtered" .= qFilteredQuery ]
2364+
2365+ toJSON (QueryFuzzyLikeThisQuery fuzzyQuery) =
2366+ object [ "fuzzy_like_this" .= fuzzyQuery ]
2367+
2368+ toJSON (QueryFuzzyLikeFieldQuery fuzzyFieldQuery) =
2369+ object [ "fuzzy_like_this_field" .= fuzzyFieldQuery ]
2370+
2371+ toJSON (QueryFuzzyQuery fuzzyQuery) =
2372+ object [ "fuzzy" .= fuzzyQuery ]
2373+
2374+ toJSON (QueryHasChildQuery childQuery) =
2375+ object [ "has_child" .= childQuery ]
2376+
2377+ toJSON (QueryHasParentQuery parentQuery) =
2378+ object [ "has_parent" .= parentQuery ]
2379+
2380+ toJSON (QueryIndicesQuery qIndicesQuery) =
2381+ object [ "indices" .= qIndicesQuery ]
2382+
2383+ toJSON (MatchAllQuery boost) =
2384+ object [ "match_all" .= omitNulls [ "boost" .= boost ] ]
2385+
2386+ toJSON (QueryMoreLikeThisQuery query) =
2387+ object [ "more_like_this" .= query ]
2388+
2389+ toJSON (QueryMoreLikeThisFieldQuery query) =
2390+ object [ "more_like_this_field" .= query ]
2391+
2392+ toJSON (QueryNestedQuery query) =
2393+ object [ "nested" .= query ]
2394+
2395+ toJSON (QueryPrefixQuery query) =
2396+ object [ "prefix" .= query ]
2397+
2398+ toJSON (QueryRangeQuery query) =
2399+ object [ "range" .= query ]
2400+
2401+ toJSON (QueryRegexpQuery query) =
2402+ object [ "regexp" .= query ]
2403+
2404+ toJSON (QuerySimpleQueryStringQuery query) =
2405+ object [ "simple_query_string" .= query ]
2406+
2407+instance FromJSON Query where
2408+ parseJSON v = withObject "Query" parse v
2409+ where parse o = termQuery `taggedWith` "term"
2410+ <|> termsQuery `taggedWith` "terms"
2411+ <|> idsQuery `taggedWith` "ids"
2412+ <|> queryQueryStringQuery `taggedWith` "query_string"
2413+ <|> queryMatchQuery `taggedWith` "match"
2414+ <|> queryMultiMatchQuery
2415+ <|> queryBoolQuery `taggedWith` "bool"
2416+ <|> queryBoostingQuery `taggedWith` "boosting"
2417+ <|> queryCommonTermsQuery `taggedWith` "common"
2418+ <|> constantScoreFilter `taggedWith` "constant_score"
2419+ <|> constantScoreQuery `taggedWith` "constant_score"
2420+ <|> queryDisMaxQuery `taggedWith` "dis_max"
2421+ <|> queryFilteredQuery `taggedWith` "filtered"
2422+ <|> queryFuzzyLikeThisQuery `taggedWith` "fuzzy_like_this"
2423+ <|> queryFuzzyLikeFieldQuery `taggedWith` "fuzzy_like_this_field"
2424+ <|> queryFuzzyQuery `taggedWith` "fuzzy"
2425+ <|> queryHasChildQuery `taggedWith` "has_child"
2426+ <|> queryHasParentQuery `taggedWith` "has_parent"
2427+ <|> queryIndicesQuery `taggedWith` "indices"
2428+ <|> matchAllQuery `taggedWith` "match_all"
2429+ <|> queryMoreLikeThisQuery `taggedWith` "more_like_this"
2430+ <|> queryMoreLikeThisFieldQuery `taggedWith` "more_like_this_field"
2431+ <|> queryNestedQuery `taggedWith` "nested"
2432+ <|> queryPrefixQuery `taggedWith` "prefix"
2433+ <|> queryRangeQuery `taggedWith` "range"
2434+ <|> queryRegexpQuery `taggedWith` "regexp"
2435+ <|> querySimpleQueryStringQuery `taggedWith` "simple_query_string"
2436+ where taggedWith parser k = parser =<< o .: k
2437+ termQuery = fieldTagged $ \(FieldName fn) o ->
2438+ TermQuery <$> (Term fn <$> o .: "value") <*> o .:? "boost"
2439+ termsQuery o = case HM.toList o of
2440+ [(fn, vs)] -> do vals <- parseJSON vs
2441+ case vals of
2442+ x:xs -> return (TermsQuery fn (x :| xs))
2443+ _ -> fail "Expected non empty list of values"
2444+ _ -> fail "Expected object with 1 field-named key"
2445+ idsQuery o = IdsQuery <$> o .: "type"
2446+ <*> o .: "values"
2447+ queryQueryStringQuery = pure . QueryQueryStringQuery
2448+ queryMatchQuery = pure . QueryMatchQuery
2449+ queryMultiMatchQuery = QueryMultiMatchQuery <$> parseJSON v
2450+ queryBoolQuery = pure . QueryBoolQuery
2451+ queryBoostingQuery = pure . QueryBoostingQuery
2452+ queryCommonTermsQuery = pure . QueryCommonTermsQuery
2453+ constantScoreFilter o = case HM.lookup "filter" o of
2454+ Just x -> ConstantScoreFilter <$> parseJSON x
2455+ <*> o .: "boost"
2456+ _ -> fail "Does not appear to be a ConstantScoreFilter"
2457+ constantScoreQuery o = case HM.lookup "query" o of
2458+ Just x -> ConstantScoreQuery <$> parseJSON x
2459+ <*> o .: "boost"
2460+ _ -> fail "Does not appear to be a ConstantScoreQuery"
2461+ queryDisMaxQuery = pure . QueryDisMaxQuery
2462+ queryFilteredQuery = pure . QueryFilteredQuery
2463+ queryFuzzyLikeThisQuery = pure . QueryFuzzyLikeThisQuery
2464+ queryFuzzyLikeFieldQuery = pure . QueryFuzzyLikeFieldQuery
2465+ queryFuzzyQuery = pure . QueryFuzzyQuery
2466+ queryHasChildQuery = pure . QueryHasChildQuery
2467+ queryHasParentQuery = pure . QueryHasParentQuery
2468+ queryIndicesQuery = pure . QueryIndicesQuery
2469+ matchAllQuery o = MatchAllQuery <$> o .:? "boost"
2470+ queryMoreLikeThisQuery = pure . QueryMoreLikeThisQuery
2471+ queryMoreLikeThisFieldQuery = pure . QueryMoreLikeThisFieldQuery
2472+ queryNestedQuery = pure . QueryNestedQuery
2473+ queryPrefixQuery = pure . QueryPrefixQuery
2474+ queryRangeQuery = pure . QueryRangeQuery
2475+ queryRegexpQuery = pure . QueryRegexpQuery
2476+ querySimpleQueryStringQuery = pure . QuerySimpleQueryStringQuery
2477+
2478+
2479+omitNulls :: [(Text, Value)] -> Value
2480+omitNulls = object . filter notNull where
2481+ notNull (_, Null) = False
2482+ notNull (_, Array a) = (not . V.null) a
2483+ notNull _ = True
2484+
2485+
2486+instance ToJSON SimpleQueryStringQuery where
2487+ toJSON SimpleQueryStringQuery {..} =
2488+ omitNulls (base ++ maybeAdd)
2489+ where base = [ "query" .= simpleQueryStringQuery ]
2490+ maybeAdd = [ "fields" .= simpleQueryStringField
2491+ , "default_operator" .= simpleQueryStringOperator
2492+ , "analyzer" .= simpleQueryStringAnalyzer
2493+ , "flags" .= simpleQueryStringFlags
2494+ , "lowercase_expanded_terms" .= simpleQueryStringLowercaseExpanded
2495+ , "locale" .= simpleQueryStringLocale ]
2496+
2497+instance FromJSON SimpleQueryStringQuery where
2498+ parseJSON = withObject "SimpleQueryStringQuery" parse
2499+ where parse o = SimpleQueryStringQuery <$> o .: "query"
2500+ <*> o .:? "fields"
2501+ <*> o .:? "default_operator"
2502+ <*> o .:? "analyzer"
2503+ <*> (parseFlags <$> o .:? "flags")
2504+ <*> o .:? "lowercase_expanded_terms"
2505+ <*> o .:? "locale"
2506+ parseFlags (Just (x:xs)) = Just (x :| xs)
2507+ parseFlags _ = Nothing
2508+
2509+instance ToJSON FieldOrFields where
2510+ toJSON (FofField fieldName) =
2511+ toJSON fieldName
2512+ toJSON (FofFields fieldNames) =
2513+ toJSON fieldNames
2514+
2515+instance FromJSON FieldOrFields where
2516+ parseJSON v = FofField <$> parseJSON v
2517+ <|> FofFields <$> (parseNEJSON =<< parseJSON v)
2518+
2519+instance ToJSON SimpleQueryFlag where
2520+ toJSON SimpleQueryAll = "ALL"
2521+ toJSON SimpleQueryNone = "NONE"
2522+ toJSON SimpleQueryAnd = "AND"
2523+ toJSON SimpleQueryOr = "OR"
2524+ toJSON SimpleQueryPrefix = "PREFIX"
2525+ toJSON SimpleQueryPhrase = "PHRASE"
2526+ toJSON SimpleQueryPrecedence = "PRECEDENCE"
2527+ toJSON SimpleQueryEscape = "ESCAPE"
2528+ toJSON SimpleQueryWhitespace = "WHITESPACE"
2529+ toJSON SimpleQueryFuzzy = "FUZZY"
2530+ toJSON SimpleQueryNear = "NEAR"
2531+ toJSON SimpleQuerySlop = "SLOP"
2532+
2533+instance FromJSON SimpleQueryFlag where
2534+ parseJSON = withText "SimpleQueryFlag" parse
2535+ where parse "ALL" = pure SimpleQueryAll
2536+ parse "NONE" = pure SimpleQueryNone
2537+ parse "AND" = pure SimpleQueryAnd
2538+ parse "OR" = pure SimpleQueryOr
2539+ parse "PREFIX" = pure SimpleQueryPrefix
2540+ parse "PHRASE" = pure SimpleQueryPhrase
2541+ parse "PRECEDENCE" = pure SimpleQueryPrecedence
2542+ parse "ESCAPE" = pure SimpleQueryEscape
2543+ parse "WHITESPACE" = pure SimpleQueryWhitespace
2544+ parse "FUZZY" = pure SimpleQueryFuzzy
2545+ parse "NEAR" = pure SimpleQueryNear
2546+ parse "SLOP" = pure SimpleQuerySlop
2547+ parse f = fail ("Unexpected SimpleQueryFlag: " <> show f)
2548+
2549+instance ToJSON RegexpQuery where
2550+ toJSON (RegexpQuery (FieldName rqQueryField)
2551+ (Regexp regexpQueryQuery) rqQueryFlags
2552+ rqQueryBoost) =
2553+ object [ rqQueryField .= omitNulls base ]
2554+ where base = [ "value" .= regexpQueryQuery
2555+ , "flags" .= rqQueryFlags
2556+ , "boost" .= rqQueryBoost ]
2557+
2558+instance FromJSON RegexpQuery where
2559+ parseJSON = withObject "RegexpQuery" parse
2560+ where parse = fieldTagged $ \fn o ->
2561+ RegexpQuery fn
2562+ <$> o .: "value"
2563+ <*> o .: "flags"
2564+ <*> o .:? "boost"
2565+
2566+instance ToJSON QueryStringQuery where
2567+ toJSON (QueryStringQuery qsQueryString
2568+ qsDefaultField qsOperator
2569+ qsAnalyzer qsAllowWildcard
2570+ qsLowercaseExpanded qsEnablePositionIncrements
2571+ qsFuzzyMaxExpansions qsFuzziness
2572+ qsFuzzyPrefixLength qsPhraseSlop
2573+ qsBoost qsAnalyzeWildcard
2574+ qsGeneratePhraseQueries qsMinimumShouldMatch
2575+ qsLenient qsLocale) =
2576+ omitNulls base
2577+ where
2578+ base = [ "query" .= qsQueryString
2579+ , "default_field" .= qsDefaultField
2580+ , "default_operator" .= qsOperator
2581+ , "analyzer" .= qsAnalyzer
2582+ , "allow_leading_wildcard" .= qsAllowWildcard
2583+ , "lowercase_expanded_terms" .= qsLowercaseExpanded
2584+ , "enable_position_increments" .= qsEnablePositionIncrements
2585+ , "fuzzy_max_expansions" .= qsFuzzyMaxExpansions
2586+ , "fuzziness" .= qsFuzziness
2587+ , "fuzzy_prefix_length" .= qsFuzzyPrefixLength
2588+ , "phrase_slop" .= qsPhraseSlop
2589+ , "boost" .= qsBoost
2590+ , "analyze_wildcard" .= qsAnalyzeWildcard
2591+ , "auto_generate_phrase_queries" .= qsGeneratePhraseQueries
2592+ , "minimum_should_match" .= qsMinimumShouldMatch
2593+ , "lenient" .= qsLenient
2594+ , "locale" .= qsLocale ]
2595+
2596+instance FromJSON QueryStringQuery where
2597+ parseJSON = withObject "QueryStringQuery" parse
2598+ where parse o = QueryStringQuery
2599+ <$> o .: "query"
2600+ <*> o .:? "default_field"
2601+ <*> o .:? "default_operator"
2602+ <*> o .:? "analyzer"
2603+ <*> o .:? "allow_leading_wildcard"
2604+ <*> o .:? "lowercase_expanded_terms"
2605+ <*> o .:? "enable_position_increments"
2606+ <*> o .:? "fuzzy_max_expansions"
2607+ <*> o .:? "fuzziness"
2608+ <*> o .:? "fuzzy_prefix_length"
2609+ <*> o .:? "phrase_slop"
2610+ <*> o .:? "boost"
2611+ <*> o .:? "analyze_wildcard"
2612+ <*> o .:? "auto_generate_phrase_queries"
2613+ <*> o .:? "minimum_should_match"
2614+ <*> o .:? "lenient"
2615+ <*> o .:? "locale"
2616+
2617+instance ToJSON RangeQuery where
2618+ toJSON (RangeQuery (FieldName fieldName) range boost) =
2619+ object [ fieldName .= object conjoined ]
2620+ where conjoined = [ "boost" .= boost ] ++ (rangeValueToPair range)
2621+
2622+instance FromJSON RangeQuery where
2623+ parseJSON = withObject "RangeQuery" parse
2624+ where parse = fieldTagged $ \fn o ->
2625+ RangeQuery fn
2626+ <$> parseJSON (Object o)
2627+ <*> o .: "boost"
2628+
2629+instance FromJSON RangeValue where
2630+ parseJSON = withObject "RangeValue" parse
2631+ where parse o = parseDate o
2632+ <|> parseDouble o
2633+ parseDate o = do lt <- o .:? "lt"
2634+ lte <- o .:? "lte"
2635+ gt <- o .:? "gt"
2636+ gte <- o .:? "gte"
2637+ case (lt, lte, gt, gte) of
2638+ (Just a, _, Just b, _) -> return (RangeDateGtLt (GreaterThanD b) (LessThanD a))
2639+ (Just a, _, _, Just b)-> return (RangeDateGteLt (GreaterThanEqD b) (LessThanD a))
2640+ (_, Just a, Just b, _)-> return (RangeDateGtLte (GreaterThanD b) (LessThanEqD a))
2641+ (_, Just a, _, Just b)-> return (RangeDateGteLte (GreaterThanEqD b) (LessThanEqD a))
2642+ (_, _, Just a, _)-> return (RangeDateGt (GreaterThanD a))
2643+ (Just a, _, _, _)-> return (RangeDateLt (LessThanD a))
2644+ (_, _, _, Just a)-> return (RangeDateGte (GreaterThanEqD a))
2645+ (_, Just a, _, _)-> return (RangeDateLte (LessThanEqD a))
2646+ (Nothing, Nothing, Nothing, Nothing) -> mzero
2647+ parseDouble o = do lt <- o .:? "lt"
2648+ lte <- o .:? "lte"
2649+ gt <- o .:? "gt"
2650+ gte <- o .:? "gte"
2651+ case (lt, lte, gt, gte) of
2652+ (Just a, _, Just b, _) -> return (RangeDoubleGtLt (GreaterThan b) (LessThan a))
2653+ (Just a, _, _, Just b)-> return (RangeDoubleGteLt (GreaterThanEq b) (LessThan a))
2654+ (_, Just a, Just b, _)-> return (RangeDoubleGtLte (GreaterThan b) (LessThanEq a))
2655+ (_, Just a, _, Just b)-> return (RangeDoubleGteLte (GreaterThanEq b) (LessThanEq a))
2656+ (_, _, Just a, _)-> return (RangeDoubleGt (GreaterThan a))
2657+ (Just a, _, _, _)-> return (RangeDoubleLt (LessThan a))
2658+ (_, _, _, Just a)-> return (RangeDoubleGte (GreaterThanEq a))
2659+ (_, Just a, _, _)-> return (RangeDoubleLte (LessThanEq a))
2660+ (Nothing, Nothing, Nothing, Nothing) -> mzero
2661+
2662+instance ToJSON PrefixQuery where
2663+ toJSON (PrefixQuery (FieldName fieldName) queryValue boost) =
2664+ object [ fieldName .= omitNulls base ]
2665+ where base = [ "value" .= queryValue
2666+ , "boost" .= boost ]
2667+
2668+instance FromJSON PrefixQuery where
2669+ parseJSON = withObject "PrefixQuery" parse
2670+ where parse = fieldTagged $ \fn o ->
2671+ PrefixQuery fn
2672+ <$> o .: "value"
2673+ <*> o .:? "boost"
2674+
2675+instance ToJSON NestedQuery where
2676+ toJSON (NestedQuery nqPath nqScoreType nqQuery) =
2677+ object [ "path" .= nqPath
2678+ , "score_mode" .= nqScoreType
2679+ , "query" .= nqQuery ]
2680+
2681+instance FromJSON NestedQuery where
2682+ parseJSON = withObject "NestedQuery" parse
2683+ where parse o = NestedQuery
2684+ <$> o .: "path"
2685+ <*> o .: "score_mode"
2686+ <*> o .: "query"
2687+
2688+instance ToJSON MoreLikeThisFieldQuery where
2689+ toJSON (MoreLikeThisFieldQuery text (FieldName fieldName)
2690+ percent mtf mqt stopwords mindf maxdf
2691+ minwl maxwl boostTerms boost analyzer) =
2692+ object [ fieldName .= omitNulls base ]
2693+ where base = [ "like_text" .= text
2694+ , "percent_terms_to_match" .= percent
2695+ , "min_term_freq" .= mtf
2696+ , "max_query_terms" .= mqt
2697+ , "stop_words" .= stopwords
2698+ , "min_doc_freq" .= mindf
2699+ , "max_doc_freq" .= maxdf
2700+ , "min_word_length" .= minwl
2701+ , "max_word_length" .= maxwl
2702+ , "boost_terms" .= boostTerms
2703+ , "boost" .= boost
2704+ , "analyzer" .= analyzer ]
2705+
2706+instance FromJSON MoreLikeThisFieldQuery where
2707+ parseJSON = withObject "MoreLikeThisFieldQuery" parse
2708+ where parse = fieldTagged $ \fn o ->
2709+ MoreLikeThisFieldQuery
2710+ <$> o .: "like_text"
2711+ <*> pure fn
2712+ <*> o .:? "percent_terms_to_match"
2713+ <*> o .:? "min_term_freq"
2714+ <*> o .:? "max_query_terms"
2715+ -- <*> (optionalNE =<< o .:? "stop_words")
2716+ <*> o .:? "stop_words"
2717+ <*> o .:? "min_doc_freq"
2718+ <*> o .:? "max_doc_freq"
2719+ <*> o .:? "min_word_length"
2720+ <*> o .:? "max_word_length"
2721+ <*> o .:? "boost_terms"
2722+ <*> o .:? "boost"
2723+ <*> o .:? "analyzer"
2724+ -- optionalNE = maybe (pure Nothing) (fmap Just . parseNEJSON)
2725+
2726+instance ToJSON MoreLikeThisQuery where
2727+ toJSON (MoreLikeThisQuery text fields percent
2728+ mtf mqt stopwords mindf maxdf
2729+ minwl maxwl boostTerms boost analyzer) =
2730+ omitNulls base
2731+ where base = [ "like_text" .= text
2732+ , "fields" .= fields
2733+ , "percent_terms_to_match" .= percent
2734+ , "min_term_freq" .= mtf
2735+ , "max_query_terms" .= mqt
2736+ , "stop_words" .= stopwords
2737+ , "min_doc_freq" .= mindf
2738+ , "max_doc_freq" .= maxdf
2739+ , "min_word_length" .= minwl
2740+ , "max_word_length" .= maxwl
2741+ , "boost_terms" .= boostTerms
2742+ , "boost" .= boost
2743+ , "analyzer" .= analyzer ]
2744+
2745+instance FromJSON MoreLikeThisQuery where
2746+ parseJSON = withObject "MoreLikeThisQuery" parse
2747+ where parse o = MoreLikeThisQuery
2748+ <$> o .: "like_text"
2749+ -- <*> (optionalNE =<< o .:? "fields")
2750+ <*> o .:? "fields"
2751+ <*> o .:? "percent_terms_to_match"
2752+ <*> o .:? "min_term_freq"
2753+ <*> o .:? "max_query_terms"
2754+ -- <*> (optionalNE =<< o .:? "stop_words")
2755+ <*> o .:? "stop_words"
2756+ <*> o .:? "min_doc_freq"
2757+ <*> o .:? "max_doc_freq"
2758+ <*> o .:? "min_word_length"
2759+ <*> o .:? "max_word_length"
2760+ <*> o .:? "boost_terms"
2761+ <*> o .:? "boost"
2762+ <*> o .:? "analyzer"
2763+ -- optionalNE = maybe (pure Nothing) (fmap Just . parseNEJSON)
2764+
2765+instance ToJSON IndicesQuery where
2766+ toJSON (IndicesQuery indices query noMatch) =
2767+ omitNulls [ "indices" .= indices
2768+ , "no_match_query" .= noMatch
2769+ , "query" .= query ]
2770+
2771+instance FromJSON IndicesQuery where
2772+ parseJSON = withObject "IndicesQuery" parse
2773+ where parse o = IndicesQuery
2774+ <$> o .:? "indices" .!= []
2775+ <*> o .: "query"
2776+ <*> o .:? "no_match_query"
2777+
2778+instance ToJSON HasParentQuery where
2779+ toJSON (HasParentQuery queryType query scoreType) =
2780+ omitNulls [ "parent_type" .= queryType
2781+ , "score_type" .= scoreType
2782+ , "query" .= query ]
2783+
2784+instance FromJSON HasParentQuery where
2785+ parseJSON = withObject "HasParentQuery" parse
2786+ where parse o = HasParentQuery
2787+ <$> o .: "parent_type"
2788+ <*> o .: "query"
2789+ <*> o .:? "score_type"
2790+
2791+instance ToJSON HasChildQuery where
2792+ toJSON (HasChildQuery queryType query scoreType) =
2793+ omitNulls [ "query" .= query
2794+ , "score_type" .= scoreType
2795+ , "type" .= queryType ]
2796+
2797+instance FromJSON HasChildQuery where
2798+ parseJSON = withObject "HasChildQuery" parse
2799+ where parse o = HasChildQuery
2800+ <$> o .: "type"
2801+ <*> o .: "query"
2802+ <*> o .:? "score_type"
2803+
2804+instance ToJSON FuzzyQuery where
2805+ toJSON (FuzzyQuery (FieldName fieldName) queryText
2806+ prefixLength maxEx fuzziness boost) =
2807+ object [ fieldName .= omitNulls base ]
2808+ where base = [ "value" .= queryText
2809+ , "fuzziness" .= fuzziness
2810+ , "prefix_length" .= prefixLength
2811+ , "boost" .= boost
2812+ , "max_expansions" .= maxEx ]
2813+
2814+instance FromJSON FuzzyQuery where
2815+ parseJSON = withObject "FuzzyQuery" parse
2816+ where parse = fieldTagged $ \fn o ->
2817+ FuzzyQuery fn
2818+ <$> o .: "value"
2819+ <*> o .: "prefix_length"
2820+ <*> o .: "max_expansions"
2821+ <*> o .: "fuzziness"
2822+ <*> o .:? "boost"
2823+
2824+instance ToJSON FuzzyLikeFieldQuery where
2825+ toJSON (FuzzyLikeFieldQuery (FieldName fieldName)
2826+ fieldText maxTerms ignoreFreq fuzziness prefixLength
2827+ boost analyzer) =
2828+ object [ fieldName .=
2829+ omitNulls [ "like_text" .= fieldText
2830+ , "max_query_terms" .= maxTerms
2831+ , "ignore_tf" .= ignoreFreq
2832+ , "fuzziness" .= fuzziness
2833+ , "prefix_length" .= prefixLength
2834+ , "analyzer" .= analyzer
2835+ , "boost" .= boost ]]
2836+
2837+instance FromJSON FuzzyLikeFieldQuery where
2838+ parseJSON = withObject "FuzzyLikeFieldQuery" parse
2839+ where parse = fieldTagged $ \fn o ->
2840+ FuzzyLikeFieldQuery fn
2841+ <$> o .: "like_text"
2842+ <*> o .: "max_query_terms"
2843+ <*> o .: "ignore_tf"
2844+ <*> o .: "fuzziness"
2845+ <*> o .: "prefix_length"
2846+ <*> o .: "boost"
2847+ <*> o .:? "analyzer"
2848+
2849+instance ToJSON FuzzyLikeThisQuery where
2850+ toJSON (FuzzyLikeThisQuery fields text maxTerms
2851+ ignoreFreq fuzziness prefixLength boost analyzer) =
2852+ omitNulls base
2853+ where base = [ "fields" .= fields
2854+ , "like_text" .= text
2855+ , "max_query_terms" .= maxTerms
2856+ , "ignore_tf" .= ignoreFreq
2857+ , "fuzziness" .= fuzziness
2858+ , "prefix_length" .= prefixLength
2859+ , "analyzer" .= analyzer
2860+ , "boost" .= boost ]
2861+
2862+instance FromJSON FuzzyLikeThisQuery where
2863+ parseJSON = withObject "FuzzyLikeThisQuery" parse
2864+ where parse o = FuzzyLikeThisQuery
2865+ <$> o .:? "fields" .!= []
2866+ <*> o .: "like_text"
2867+ <*> o .: "max_query_terms"
2868+ <*> o .: "ignore_tf"
2869+ <*> o .: "fuzziness"
2870+ <*> o .: "prefix_length"
2871+ <*> o .: "boost"
2872+ <*> o .:? "analyzer"
2873+
2874+instance ToJSON FilteredQuery where
2875+ toJSON (FilteredQuery query fFilter) =
2876+ object [ "query" .= query
2877+ , "filter" .= fFilter ]
2878+
2879+instance FromJSON FilteredQuery where
2880+ parseJSON = withObject "FilteredQuery" parse
2881+ where parse o = FilteredQuery
2882+ <$> o .: "query"
2883+ <*> o .: "filter"
2884+
2885+instance ToJSON DisMaxQuery where
2886+ toJSON (DisMaxQuery queries tiebreaker boost) =
2887+ omitNulls base
2888+ where base = [ "queries" .= queries
2889+ , "boost" .= boost
2890+ , "tie_breaker" .= tiebreaker ]
2891+
2892+instance FromJSON DisMaxQuery where
2893+ parseJSON = withObject "DisMaxQuery" parse
2894+ where parse o = DisMaxQuery
2895+ <$> o .:? "queries" .!= []
2896+ <*> o .: "tie_breaker"
2897+ <*> o .:? "boost"
2898+
2899+instance ToJSON CommonTermsQuery where
2900+ toJSON (CommonTermsQuery (FieldName fieldName)
2901+ (QueryString query) cf lfo hfo msm
2902+ boost analyzer disableCoord) =
2903+ object [fieldName .= omitNulls base ]
2904+ where base = [ "query" .= query
2905+ , "cutoff_frequency" .= cf
2906+ , "low_freq_operator" .= lfo
2907+ , "minimum_should_match" .= msm
2908+ , "boost" .= boost
2909+ , "analyzer" .= analyzer
2910+ , "disable_coord" .= disableCoord
2911+ , "high_freq_operator" .= hfo ]
2912+
2913+instance FromJSON CommonTermsQuery where
2914+ parseJSON = withObject "CommonTermsQuery" parse
2915+ where parse = fieldTagged $ \fn o ->
2916+ CommonTermsQuery fn
2917+ <$> o .: "query"
2918+ <*> o .: "cutoff_frequency"
2919+ <*> o .: "low_freq_operator"
2920+ <*> o .: "high_freq_operator"
2921+ <*> o .:? "minimum_should_match"
2922+ <*> o .:? "boost"
2923+ <*> o .:? "analyzer"
2924+ <*> o .:? "disable_coord"
2925+
2926+instance ToJSON CommonMinimumMatch where
2927+ toJSON (CommonMinimumMatch mm) = toJSON mm
2928+ toJSON (CommonMinimumMatchHighLow (MinimumMatchHighLow lowF highF)) =
2929+ object [ "low_freq" .= lowF
2930+ , "high_freq" .= highF ]
2931+
2932+instance FromJSON CommonMinimumMatch where
2933+ parseJSON v = parseMinimum v
2934+ <|> parseMinimumHighLow v
2935+ where parseMinimum = fmap CommonMinimumMatch . parseJSON
2936+ parseMinimumHighLow = fmap CommonMinimumMatchHighLow . withObject "CommonMinimumMatchHighLow" (\o ->
2937+ MinimumMatchHighLow
2938+ <$> o .: "low_freq"
2939+ <*> o .: "high_freq")
2940+
2941+
2942+instance ToJSON BoostingQuery where
2943+ toJSON (BoostingQuery bqPositiveQuery bqNegativeQuery bqNegativeBoost) =
2944+ object [ "positive" .= bqPositiveQuery
2945+ , "negative" .= bqNegativeQuery
2946+ , "negative_boost" .= bqNegativeBoost ]
2947+
2948+instance FromJSON BoostingQuery where
2949+ parseJSON = withObject "BoostingQuery" parse
2950+ where parse o = BoostingQuery
2951+ <$> o .: "positive"
2952+ <*> o .: "negative"
2953+ <*> o .: "negative_boost"
2954+
2955+instance ToJSON BoolQuery where
2956+ toJSON (BoolQuery mustM notM shouldM bqMin boost disableCoord) =
2957+ omitNulls base
2958+ where base = [ "must" .= mustM
2959+ , "must_not" .= notM
2960+ , "should" .= shouldM
2961+ , "minimum_should_match" .= bqMin
2962+ , "boost" .= boost
2963+ , "disable_coord" .= disableCoord ]
2964+
2965+instance FromJSON BoolQuery where
2966+ parseJSON = withObject "BoolQuery" parse
2967+ where parse o = BoolQuery
2968+ <$> o .:? "must" .!= []
2969+ <*> o .:? "must_not" .!= []
2970+ <*> o .:? "should" .!= []
2971+ <*> o .:? "minimum_should_match"
2972+ <*> o .:? "boost"
2973+ <*> o .:? "disable_coord"
2974+
2975+instance ToJSON MatchQuery where
2976+ toJSON (MatchQuery (FieldName fieldName)
2977+ (QueryString mqQueryString) booleanOperator
2978+ zeroTermsQuery cutoffFrequency matchQueryType
2979+ analyzer maxExpansions lenient boost) =
2980+ object [ fieldName .= omitNulls base ]
2981+ where base = [ "query" .= mqQueryString
2982+ , "operator" .= booleanOperator
2983+ , "zero_terms_query" .= zeroTermsQuery
2984+ , "cutoff_frequency" .= cutoffFrequency
2985+ , "type" .= matchQueryType
2986+ , "analyzer" .= analyzer
2987+ , "max_expansions" .= maxExpansions
2988+ , "lenient" .= lenient
2989+ , "boost" .= boost ]
2990+
2991+instance FromJSON MatchQuery where
2992+ parseJSON = withObject "MatchQuery" parse
2993+ where parse = fieldTagged $ \fn o ->
2994+ MatchQuery fn
2995+ <$> o .: "query"
2996+ <*> o .: "operator"
2997+ <*> o .: "zero_terms_query"
2998+ <*> o .:? "cutoff_frequency"
2999+ <*> o .:? "type"
3000+ <*> o .:? "analyzer"
3001+ <*> o .:? "max_expansions"
3002+ <*> o .:? "lenient"
3003+ <*> o .:? "boost"
3004+
3005+instance ToJSON MultiMatchQuery where
3006+ toJSON (MultiMatchQuery fields (QueryString query) boolOp
3007+ ztQ tb mmqt cf analyzer maxEx lenient) =
3008+ object ["multi_match" .= omitNulls base]
3009+ where base = [ "fields" .= fmap toJSON fields
3010+ , "query" .= query
3011+ , "operator" .= boolOp
3012+ , "zero_terms_query" .= ztQ
3013+ , "tie_breaker" .= tb
3014+ , "type" .= mmqt
3015+ , "cutoff_frequency" .= cf
3016+ , "analyzer" .= analyzer
3017+ , "max_expansions" .= maxEx
3018+ , "lenient" .= lenient ]
3019+
3020+instance FromJSON MultiMatchQuery where
3021+ parseJSON = withObject "MultiMatchQuery" parse
3022+ where parse raw = do o <- raw .: "multi_match"
3023+ MultiMatchQuery
3024+ <$> o .:? "fields" .!= []
3025+ <*> o .: "query"
3026+ <*> o .: "operator"
3027+ <*> o .: "zero_terms_query"
3028+ <*> o .:? "tie_breaker"
3029+ <*> o .:? "type"
3030+ <*> o .:? "cutoff_frequency"
3031+ <*> o .:? "analyzer"
3032+ <*> o .:? "max_expansions"
3033+ <*> o .:? "lenient"
3034+
3035+instance ToJSON MultiMatchQueryType where
3036+ toJSON MultiMatchBestFields = "best_fields"
3037+ toJSON MultiMatchMostFields = "most_fields"
3038+ toJSON MultiMatchCrossFields = "cross_fields"
3039+ toJSON MultiMatchPhrase = "phrase"
3040+ toJSON MultiMatchPhrasePrefix = "phrase_prefix"
3041+
3042+instance FromJSON MultiMatchQueryType where
3043+ parseJSON = withText "MultiMatchPhrasePrefix" parse
3044+ where parse "best_fields" = pure MultiMatchBestFields
3045+ parse "most_fields" = pure MultiMatchMostFields
3046+ parse "cross_fields" = pure MultiMatchCrossFields
3047+ parse "phrase" = pure MultiMatchPhrase
3048+ parse "phrase_prefix" = pure MultiMatchPhrasePrefix
3049+ parse t = fail ("Unexpected MultiMatchPhrasePrefix: " <> show t)
3050+
3051+instance ToJSON BooleanOperator where
3052+ toJSON And = String "and"
3053+ toJSON Or = String "or"
3054+
3055+instance FromJSON BooleanOperator where
3056+ parseJSON = withText "BooleanOperator" parse
3057+ where parse "and" = pure And
3058+ parse "or" = pure Or
3059+ parse o = fail ("Unexpected BooleanOperator: " <> show o)
3060+
3061+instance ToJSON ZeroTermsQuery where
3062+ toJSON ZeroTermsNone = String "none"
3063+ toJSON ZeroTermsAll = String "all"
3064+
3065+instance FromJSON ZeroTermsQuery where
3066+ parseJSON = withText "ZeroTermsQuery" parse
3067+ where parse "none" = pure ZeroTermsNone
3068+ parse "all" = pure ZeroTermsAll
3069+ parse q = fail ("Unexpected ZeroTermsQuery: " <> show q)
3070+
3071+instance ToJSON MatchQueryType where
3072+ toJSON MatchPhrase = "phrase"
3073+ toJSON MatchPhrasePrefix = "phrase_prefix"
3074+
3075+instance FromJSON MatchQueryType where
3076+ parseJSON = withText "MatchQueryType" parse
3077+ where parse "phrase" = pure MatchPhrase
3078+ parse "phrase_prefix" = pure MatchPhrasePrefix
3079+ parse t = fail ("Unexpected MatchQueryType: " <> show t)
3080+
3081+instance FromJSON Status where
3082+ parseJSON (Object v) = Status <$>
3083+ v .:? "ok" <*>
3084+ (v .:? "status" .!= 200) <*>
3085+ v .: "name" <*>
3086+ v .: "version" <*>
3087+ v .: "tagline"
3088+ parseJSON _ = empty
3089+
3090+
3091+instance ToJSON IndexSettings where
3092+ toJSON (IndexSettings s r) = object ["settings" .=
3093+ object ["index" .=
3094+ object ["number_of_shards" .= s, "number_of_replicas" .= r]
3095+ ]
3096+ ]
3097+
3098+instance FromJSON IndexSettings where
3099+ parseJSON = withObject "IndexSettings" parse
3100+ where parse o = do s <- o .: "settings"
3101+ i <- s .: "index"
3102+ IndexSettings <$> i .: "number_of_shards"
3103+ <*> i .: "number_of_replicas"
3104+
3105+instance ToJSON UpdatableIndexSetting where
3106+ toJSON (NumberOfReplicas x) = oPath ("index" :| ["number_of_replicas"]) x
3107+ toJSON (AutoExpandReplicas x) = oPath ("index" :| ["auto_expand_replicas"]) x
3108+ toJSON (RefreshInterval x) = oPath ("index" :| ["refresh_interval"]) (NominalDiffTimeJSON x)
3109+ toJSON (IndexConcurrency x) = oPath ("index" :| ["concurrency"]) x
3110+ toJSON (FailOnMergeFailure x) = oPath ("index" :| ["fail_on_merge_failure"]) x
3111+ toJSON (TranslogFlushThresholdOps x) = oPath ("index" :| ["translog", "flush_threshold_ops"]) x
3112+ toJSON (TranslogFlushThresholdSize x) = oPath ("index" :| ["translog", "flush_threshold_size"]) x
3113+ toJSON (TranslogFlushThresholdPeriod x) = oPath ("index" :| ["translog", "flush_threshold_period"]) (NominalDiffTimeJSON x)
3114+ toJSON (TranslogDisableFlush x) = oPath ("index" :| ["translog", "disable_flush"]) x
3115+ toJSON (CacheFilterMaxSize x) = oPath ("index" :| ["cache", "filter", "max_size"]) x
3116+ toJSON (CacheFilterExpire x) = oPath ("index" :| ["cache", "filter", "expire"]) (NominalDiffTimeJSON <$> x)
3117+ toJSON (GatewaySnapshotInterval x) = oPath ("index" :| ["gateway", "snapshot_interval"]) (NominalDiffTimeJSON x)
3118+ toJSON (RoutingAllocationInclude fs) = oPath ("index" :| ["routing", "allocation", "include"]) (attrFilterJSON fs)
3119+ toJSON (RoutingAllocationExclude fs) = oPath ("index" :| ["routing", "allocation", "exclude"]) (attrFilterJSON fs)
3120+ toJSON (RoutingAllocationRequire fs) = oPath ("index" :| ["routing", "allocation", "require"]) (attrFilterJSON fs)
3121+ toJSON (RoutingAllocationEnable x) = oPath ("index" :| ["routing", "allocation", "enable"]) x
3122+ toJSON (RoutingAllocationShardsPerNode x) = oPath ("index" :| ["routing", "allocation", "total_shards_per_node"]) x
3123+ toJSON (RecoveryInitialShards x) = oPath ("index" :| ["recovery", "initial_shards"]) x
3124+ toJSON (GCDeletes x) = oPath ("index" :| ["gc_deletes"]) (NominalDiffTimeJSON x)
3125+ toJSON (TTLDisablePurge x) = oPath ("index" :| ["ttl", "disable_purge"]) x
3126+ toJSON (TranslogFSType x) = oPath ("index" :| ["translog", "fs", "type"]) x
3127+ toJSON (IndexCompoundFormat x) = oPath ("index" :| ["compound_format"]) x
3128+ toJSON (IndexCompoundOnFlush x) = oPath ("index" :| ["compound_on_flush"]) x
3129+ toJSON (WarmerEnabled x) = oPath ("index" :| ["warmer", "enabled"]) x
3130+ toJSON (BlocksReadOnly x) = oPath ("blocks" :| ["read_only"]) x
3131+ toJSON (BlocksRead x) = oPath ("blocks" :| ["read"]) x
3132+ toJSON (BlocksWrite x) = oPath ("blocks" :| ["write"]) x
3133+ toJSON (BlocksMetaData x) = oPath ("blocks" :| ["metadata"]) x
3134+
3135+instance FromJSON UpdatableIndexSetting where
3136+ parseJSON = withObject "UpdatableIndexSetting" parse
3137+ where parse o = numberOfReplicas `taggedAt` ["index", "number_of_replicas"]
3138+ <|> autoExpandReplicas `taggedAt` ["index", "auto_expand_replicas"]
3139+ <|> refreshInterval `taggedAt` ["index", "refresh_interval"]
3140+ <|> indexConcurrency `taggedAt` ["index", "concurrency"]
3141+ <|> failOnMergeFailure `taggedAt` ["index", "fail_on_merge_failure"]
3142+ <|> translogFlushThresholdOps `taggedAt` ["index", "translog", "flush_threshold_ops"]
3143+ <|> translogFlushThresholdSize `taggedAt` ["index", "translog", "flush_threshold_size"]
3144+ <|> translogFlushThresholdPeriod `taggedAt` ["index", "translog", "flush_threshold_period"]
3145+ <|> translogDisableFlush `taggedAt` ["index", "translog", "disable_flush"]
3146+ <|> cacheFilterMaxSize `taggedAt` ["index", "cache", "filter", "max_size"]
3147+ <|> cacheFilterExpire `taggedAt` ["index", "cache", "filter", "expire"]
3148+ <|> gatewaySnapshotInterval `taggedAt` ["index", "gateway", "snapshot_interval"]
3149+ <|> routingAllocationInclude `taggedAt` ["index", "routing", "allocation", "include"]
3150+ <|> routingAllocationExclude `taggedAt` ["index", "routing", "allocation", "exclude"]
3151+ <|> routingAllocationRequire `taggedAt` ["index", "routing", "allocation", "require"]
3152+ <|> routingAllocationEnable `taggedAt` ["index", "routing", "allocation", "enable"]
3153+ <|> routingAllocationShardsPerNode `taggedAt` ["index", "routing", "allocation", "total_shards_per_node"]
3154+ <|> recoveryInitialShards `taggedAt` ["index", "recovery", "initial_shards"]
3155+ <|> gcDeletes `taggedAt` ["index", "gc_deletes"]
3156+ <|> ttlDisablePurge `taggedAt` ["index", "ttl", "disable_purge"]
3157+ <|> translogFSType `taggedAt` ["index", "translog", "fs", "type"]
3158+ <|> compoundFormat `taggedAt` ["index", "compound_format"]
3159+ <|> compoundOnFlush `taggedAt` ["index", "compound_on_flush"]
3160+ <|> warmerEnabled `taggedAt` ["index", "warmer", "enabled"]
3161+ <|> blocksReadOnly `taggedAt` ["blocks", "read_only"]
3162+ <|> blocksRead `taggedAt` ["blocks", "read"]
3163+ <|> blocksWrite `taggedAt` ["blocks", "write"]
3164+ <|> blocksMetaData `taggedAt` ["blocks", "metadata"]
3165+ where taggedAt f ks = taggedAt' f (Object o) ks
3166+ taggedAt' f v [] = f =<< (parseJSON v <|> (parseJSON (unStringlyTypeJSON v)))
3167+ taggedAt' f v (k:ks) = withObject "Object" (\o -> do v' <- o .: k
3168+ taggedAt' f v' ks) v
3169+ numberOfReplicas = pure . NumberOfReplicas
3170+ autoExpandReplicas = pure . AutoExpandReplicas
3171+ refreshInterval = pure . RefreshInterval . ndtJSON
3172+ indexConcurrency = pure . IndexConcurrency
3173+ failOnMergeFailure = pure . FailOnMergeFailure
3174+ translogFlushThresholdOps = pure . TranslogFlushThresholdOps
3175+ translogFlushThresholdSize = pure . TranslogFlushThresholdSize
3176+ translogFlushThresholdPeriod = pure . TranslogFlushThresholdPeriod . ndtJSON
3177+ translogDisableFlush = pure . TranslogDisableFlush
3178+ cacheFilterMaxSize = pure . CacheFilterMaxSize
3179+ cacheFilterExpire = pure . CacheFilterExpire . fmap ndtJSON
3180+ gatewaySnapshotInterval = pure . GatewaySnapshotInterval . ndtJSON
3181+ routingAllocationInclude = fmap RoutingAllocationInclude . parseAttrFilter
3182+ routingAllocationExclude = fmap RoutingAllocationExclude . parseAttrFilter
3183+ routingAllocationRequire = fmap RoutingAllocationRequire . parseAttrFilter
3184+ routingAllocationEnable = pure . RoutingAllocationEnable
3185+ routingAllocationShardsPerNode = pure . RoutingAllocationShardsPerNode
3186+ recoveryInitialShards = pure . RecoveryInitialShards
3187+ gcDeletes = pure . GCDeletes . ndtJSON
3188+ ttlDisablePurge = pure . TTLDisablePurge
3189+ translogFSType = pure . TranslogFSType
3190+ compoundFormat = pure . IndexCompoundFormat
3191+ compoundOnFlush = pure . IndexCompoundOnFlush
3192+ warmerEnabled = pure . WarmerEnabled
3193+ blocksReadOnly = pure . BlocksReadOnly
3194+ blocksRead = pure . BlocksRead
3195+ blocksWrite = pure . BlocksWrite
3196+ blocksMetaData = pure . BlocksMetaData
3197+
3198+instance FromJSON IndexSettingsSummary where
3199+ parseJSON = withObject "IndexSettingsSummary" parse
3200+ where parse o = case HM.toList o of
3201+ [(ixn, v@(Object o'))] -> IndexSettingsSummary (IndexName ixn)
3202+ <$> parseJSON v
3203+ <*> (fmap (filter (not . redundant)) . parseSettings =<< o' .: "settings")
3204+ _ -> fail "Expected single-key object with index name"
3205+ redundant (NumberOfReplicas _) = True
3206+ redundant _ = False
3207+
3208+-- | For some reason in several settings APIs, all leaf values get returned
3209+-- as strings. This function attepmts to recover from this for all
3210+-- non-recursive JSON types. If nothing can be done, the value is left alone.
3211+unStringlyTypeJSON :: Value -> Value
3212+unStringlyTypeJSON (String "true") = Bool True
3213+unStringlyTypeJSON (String "false") = Bool False
3214+unStringlyTypeJSON (String "null") = Null
3215+unStringlyTypeJSON v@(String t) = case readMay (T.unpack t) of
3216+ Just n -> Number n
3217+ Nothing -> v
3218+unStringlyTypeJSON v = v
3219+
3220+
3221+parseSettings :: Object -> Parser [UpdatableIndexSetting]
3222+parseSettings o = do
3223+ o' <- o .: "index"
3224+ -- slice the index object into singleton hashmaps and try to parse each
3225+ parses <- forM (HM.toList o') $ \(k, v) -> do
3226+ -- blocks are now nested into the "index" key, which is not how they're serialized
3227+ let atRoot = Object (HM.singleton k v)
3228+ let atIndex = Object (HM.singleton "index" atRoot)
3229+ optional (parseJSON atRoot <|> parseJSON atIndex)
3230+ return (catMaybes parses)
3231+
3232+oPath :: ToJSON a => NonEmpty Text -> a -> Value
3233+oPath (k :| []) v = object [k .= v]
3234+oPath (k:| (h:t)) v = object [k .= oPath (h :| t) v]
3235+
3236+attrFilterJSON :: NonEmpty NodeAttrFilter -> Value
3237+attrFilterJSON fs = object [ n .= T.intercalate "," (toList vs)
3238+ | NodeAttrFilter (NodeAttrName n) vs <- toList fs]
3239+
3240+parseAttrFilter :: Value -> Parser (NonEmpty NodeAttrFilter)
3241+parseAttrFilter = withObject "NonEmpty NodeAttrFilter" parse
3242+ where parse o = case HM.toList o of
3243+ [] -> fail "Expected non-empty list of NodeAttrFilters"
3244+ x:xs -> DT.mapM (uncurry parse') (x :| xs)
3245+ parse' n = withText "Text" $ \t ->
3246+ case T.splitOn "," t of
3247+ fv:fvs -> return (NodeAttrFilter (NodeAttrName n) (fv :| fvs))
3248+ [] -> fail "Expected non-empty list of filter values"
3249+
3250+instance ToJSON ReplicaBounds where
3251+ toJSON (ReplicasBounded a b) = String (showText a <> "-" <> showText b)
3252+ toJSON (ReplicasLowerBounded a) = String (showText a <> "-all")
3253+ toJSON ReplicasUnbounded = Bool False
3254+
3255+instance FromJSON ReplicaBounds where
3256+ parseJSON v = withText "ReplicaBounds" parseText v
3257+ <|> withBool "ReplicaBounds" parseBool v
3258+ where parseText t = case T.splitOn "-" t of
3259+ [a, "all"] -> ReplicasLowerBounded <$> parseReadText a
3260+ [a, b] -> ReplicasBounded <$> parseReadText a
3261+ <*> parseReadText b
3262+ _ -> fail ("Could not parse ReplicaBounds: " <> show t)
3263+ parseBool False = pure ReplicasUnbounded
3264+ parseBool _ = fail "ReplicasUnbounded cannot be represented with True"
3265+
3266+instance ToJSON AllocationPolicy where
3267+ toJSON AllocAll = String "all"
3268+ toJSON AllocPrimaries = String "primaries"
3269+ toJSON AllocNewPrimaries = String "new_primaries"
3270+ toJSON AllocNone = String "none"
3271+
3272+instance FromJSON AllocationPolicy where
3273+ parseJSON = withText "AllocationPolicy" parse
3274+ where parse "all" = pure AllocAll
3275+ parse "primaries" = pure AllocPrimaries
3276+ parse "new_primaries" = pure AllocNewPrimaries
3277+ parse "none" = pure AllocNone
3278+ parse t = fail ("Invlaid AllocationPolicy: " <> show t)
3279+
3280+instance ToJSON InitialShardCount where
3281+ toJSON QuorumShards = String "quorum"
3282+ toJSON QuorumMinus1Shards = String "quorum-1"
3283+ toJSON FullShards = String "full"
3284+ toJSON FullMinus1Shards = String "full-1"
3285+ toJSON (ExplicitShards x) = toJSON x
3286+
3287+instance FromJSON InitialShardCount where
3288+ parseJSON v = withText "InitialShardCount" parseText v
3289+ <|> ExplicitShards <$> parseJSON v
3290+ where parseText "quorum" = pure QuorumShards
3291+ parseText "quorum-1" = pure QuorumMinus1Shards
3292+ parseText "full" = pure FullShards
3293+ parseText "full-1" = pure FullMinus1Shards
3294+ parseText _ = mzero
3295+
3296+instance ToJSON FSType where
3297+ toJSON FSSimple = "simple"
3298+ toJSON FSBuffered = "buffered"
3299+
3300+instance FromJSON FSType where
3301+ parseJSON = withText "FSType" parse
3302+ where parse "simple" = pure FSSimple
3303+ parse "buffered" = pure FSBuffered
3304+ parse t = fail ("Invalid FSType: " <> show t)
3305+
3306+instance ToJSON CompoundFormat where
3307+ toJSON (CompoundFileFormat x) = Bool x
3308+ toJSON (MergeSegmentVsTotalIndex x) = toJSON x
3309+
3310+instance FromJSON CompoundFormat where
3311+ parseJSON v = CompoundFileFormat <$> parseJSON v
3312+ <|> MergeSegmentVsTotalIndex <$> parseJSON v
3313+
3314+instance ToJSON NominalDiffTimeJSON where
3315+ toJSON (NominalDiffTimeJSON t) = String (showText (round t :: Integer) <> "s")
3316+
3317+instance FromJSON NominalDiffTimeJSON where
3318+ parseJSON = withText "NominalDiffTime" parse
3319+ where parse t = case T.takeEnd 1 t of
3320+ "s" -> NominalDiffTimeJSON . fromInteger <$> parseReadText (T.dropEnd 1 t)
3321+ _ -> fail "Invalid or missing NominalDiffTime unit (expected s)"
3322+
3323+instance ToJSON IndexTemplate where
3324+ toJSON (IndexTemplate p s m) = merge
3325+ (object [ "template" .= p
3326+ , "mappings" .= foldl' merge (object []) m
3327+ ])
3328+ (toJSON s)
3329+ where
3330+ merge (Object o1) (Object o2) = toJSON $ HM.union o1 o2
3331+ merge o Null = o
3332+ merge _ _ = undefined
3333+
3334+instance (FromJSON a) => FromJSON (EsResult a) where
3335+ parseJSON jsonVal@(Object v) = do
3336+ found <- v .:? "found" .!= False
3337+ fr <- if found
3338+ then parseJSON jsonVal
3339+ else return Nothing
3340+ EsResult <$> v .: "_index" <*>
3341+ v .: "_type" <*>
3342+ v .: "_id" <*>
3343+ pure fr
3344+ parseJSON _ = empty
3345+
3346+instance (FromJSON a) => FromJSON (EsResultFound a) where
3347+ parseJSON (Object v) = EsResultFound <$>
3348+ v .: "_version" <*>
3349+ v .: "_source"
3350+ parseJSON _ = empty
3351+
3352+instance FromJSON EsError where
3353+ parseJSON (Object v) = EsError <$>
3354+ v .: "status" <*>
3355+ (v .: "error" <|> (v .: "error" >>= (.: "reason")))
3356+ parseJSON _ = empty
3357+
3358+instance FromJSON IndexAliasesSummary where
3359+ parseJSON = withObject "IndexAliasesSummary" parse
3360+ where parse o = IndexAliasesSummary . mconcat <$> mapM (uncurry go) (HM.toList o)
3361+ go ixn = withObject "index aliases" $ \ia -> do
3362+ aliases <- ia .:? "aliases" .!= mempty
3363+ forM (HM.toList aliases) $ \(aName, v) -> do
3364+ let indexAlias = IndexAlias (IndexName ixn) (IndexAliasName (IndexName aName))
3365+ IndexAliasSummary indexAlias <$> parseJSON v
3366+
3367+
3368+instance ToJSON IndexAliasAction where
3369+ toJSON (AddAlias ia opts) = object ["add" .= (iaObj <> optsObj)]
3370+ where Object iaObj = toJSON ia
3371+ Object optsObj = toJSON opts
3372+ toJSON (RemoveAlias ia) = object ["remove" .= iaObj]
3373+ where Object iaObj = toJSON ia
3374+
3375+instance ToJSON IndexAlias where
3376+ toJSON IndexAlias {..} = object ["index" .= srcIndex
3377+ , "alias" .= indexAlias
3378+ ]
3379+
3380+instance ToJSON IndexAliasCreate where
3381+ toJSON IndexAliasCreate {..} = Object (filterObj <> routingObj)
3382+ where filterObj = maybe mempty (HM.singleton "filter" . toJSON) aliasCreateFilter
3383+ Object routingObj = maybe (Object mempty) toJSON aliasCreateRouting
3384+
3385+instance ToJSON AliasRouting where
3386+ toJSON (AllAliasRouting v) = object ["routing" .= v]
3387+ toJSON (GranularAliasRouting srch idx) = object (catMaybes prs)
3388+ where prs = [("search_routing" .=) <$> srch
3389+ ,("index_routing" .=) <$> idx]
3390+
3391+instance FromJSON AliasRouting where
3392+ parseJSON = withObject "AliasRouting" parse
3393+ where parse o = parseAll o <|> parseGranular o
3394+ parseAll o = AllAliasRouting <$> o .: "routing"
3395+ parseGranular o = do
3396+ sr <- o .:? "search_routing"
3397+ ir <- o .:? "index_routing"
3398+ if isNothing sr && isNothing ir
3399+ then fail "Both search_routing and index_routing can't be blank"
3400+ else return (GranularAliasRouting sr ir)
3401+
3402+instance FromJSON IndexAliasCreate where
3403+ parseJSON v = withObject "IndexAliasCreate" parse v
3404+ where parse o = IndexAliasCreate <$> optional (parseJSON v)
3405+ <*> o .:? "filter"
3406+
3407+instance ToJSON SearchAliasRouting where
3408+ toJSON (SearchAliasRouting rvs) = toJSON (T.intercalate "," (routingValue <$> toList rvs))
3409+
3410+instance FromJSON SearchAliasRouting where
3411+ parseJSON = withText "SearchAliasRouting" parse
3412+ where parse t = SearchAliasRouting <$> parseNEJSON (String <$> T.splitOn "," t)
3413+
3414+instance ToJSON Search where
3415+ toJSON (Search query sFilter sort searchAggs highlight sTrackSortScores sFrom sSize _ sFields sSource) =
3416+ omitNulls [ "query" .= query
3417+ , "filter" .= sFilter
3418+ , "sort" .= sort
3419+ , "aggregations" .= searchAggs
3420+ , "highlight" .= highlight
3421+ , "from" .= sFrom
3422+ , "size" .= sSize
3423+ , "track_scores" .= sTrackSortScores
3424+ , "fields" .= sFields
3425+ , "_source" .= sSource]
3426+
3427+
3428+instance ToJSON Source where
3429+ toJSON NoSource = toJSON False
3430+ toJSON (SourcePatterns patterns) = toJSON patterns
3431+ toJSON (SourceIncludeExclude incl excl) = object [ "include" .= incl, "exclude" .= excl ]
3432+
3433+instance ToJSON PatternOrPatterns where
3434+ toJSON (PopPattern pattern) = toJSON pattern
3435+ toJSON (PopPatterns patterns) = toJSON patterns
3436+
3437+instance ToJSON Include where
3438+ toJSON (Include patterns) = toJSON patterns
3439+
3440+instance ToJSON Exclude where
3441+ toJSON (Exclude patterns) = toJSON patterns
3442+
3443+instance ToJSON Pattern where
3444+ toJSON (Pattern pattern) = toJSON pattern
3445+
3446+
3447+instance ToJSON FieldHighlight where
3448+ toJSON (FieldHighlight (FieldName fName) (Just fSettings)) =
3449+ object [ fName .= fSettings ]
3450+ toJSON (FieldHighlight (FieldName fName) Nothing) =
3451+ object [ fName .= emptyObject ]
3452+
3453+instance ToJSON Highlights where
3454+ toJSON (Highlights global fields) =
3455+ omitNulls (("fields" .= fields)
3456+ : highlightSettingsPairs global)
3457+
3458+instance ToJSON HighlightSettings where
3459+ toJSON hs = omitNulls (highlightSettingsPairs (Just hs))
3460+
3461+highlightSettingsPairs :: Maybe HighlightSettings -> [Pair]
3462+highlightSettingsPairs Nothing = []
3463+highlightSettingsPairs (Just (Plain plh)) = plainHighPairs (Just plh)
3464+highlightSettingsPairs (Just (Postings ph)) = postHighPairs (Just ph)
3465+highlightSettingsPairs (Just (FastVector fvh)) = fastVectorHighPairs (Just fvh)
3466+
3467+
3468+plainHighPairs :: Maybe PlainHighlight -> [Pair]
3469+plainHighPairs Nothing = []
3470+plainHighPairs (Just (PlainHighlight plCom plNonPost)) =
3471+ [ "type" .= String "plain"]
3472+ ++ commonHighlightPairs plCom
3473+ ++ nonPostingsToPairs plNonPost
3474+
3475+postHighPairs :: Maybe PostingsHighlight -> [Pair]
3476+postHighPairs Nothing = []
3477+postHighPairs (Just (PostingsHighlight pCom)) =
3478+ ("type" .= String "postings")
3479+ : commonHighlightPairs pCom
3480+
3481+fastVectorHighPairs :: Maybe FastVectorHighlight -> [Pair]
3482+fastVectorHighPairs Nothing = []
3483+fastVectorHighPairs (Just
3484+ (FastVectorHighlight fvCom fvNonPostSettings fvBoundChars
3485+ fvBoundMaxScan fvFragOff fvMatchedFields
3486+ fvPhraseLim)) =
3487+ [ "type" .= String "fvh"
3488+ , "boundary_chars" .= fvBoundChars
3489+ , "boundary_max_scan" .= fvBoundMaxScan
3490+ , "fragment_offset" .= fvFragOff
3491+ , "matched_fields" .= fvMatchedFields
3492+ , "phraseLimit" .= fvPhraseLim]
3493+ ++ commonHighlightPairs fvCom
3494+ ++ nonPostingsToPairs fvNonPostSettings
3495+
3496+deleteSeveral :: (Eq k, Hashable k) => [k] -> HM.HashMap k v -> HM.HashMap k v
3497+deleteSeveral ks hm = foldr HM.delete hm ks
3498+
3499+commonHighlightPairs :: Maybe CommonHighlight -> [Pair]
3500+commonHighlightPairs Nothing = []
3501+commonHighlightPairs (Just (CommonHighlight chScore chForceSource chTag chEncoder
3502+ chNoMatchSize chHighlightQuery
3503+ chRequireFieldMatch)) =
3504+ [ "order" .= chScore
3505+ , "force_source" .= chForceSource
3506+ , "encoder" .= chEncoder
3507+ , "no_match_size" .= chNoMatchSize
3508+ , "highlight_query" .= chHighlightQuery
3509+ , "require_fieldMatch" .= chRequireFieldMatch]
3510+ ++ highlightTagToPairs chTag
3511+
3512+
3513+nonPostingsToPairs :: Maybe NonPostings -> [Pair]
3514+nonPostingsToPairs Nothing = []
3515+nonPostingsToPairs (Just (NonPostings npFragSize npNumOfFrags)) =
3516+ [ "fragment_size" .= npFragSize
3517+ , "number_of_fragments" .= npNumOfFrags]
3518+
3519+parseNEJSON :: (FromJSON a) => [Value] -> Parser (NonEmpty a)
3520+parseNEJSON [] = fail "Expected non-empty list"
3521+parseNEJSON (x:xs) = DT.mapM parseJSON (x :| xs)
3522+
3523+
3524+instance ToJSON HighlightEncoder where
3525+ toJSON DefaultEncoder = String "default"
3526+ toJSON HTMLEncoder = String "html"
3527+
3528+highlightTagToPairs :: Maybe HighlightTag -> [Pair]
3529+highlightTagToPairs (Just (TagSchema _)) = [ "scheme" .= String "default"]
3530+highlightTagToPairs (Just (CustomTags (pre, post))) = [ "pre_tags" .= pre
3531+ , "post_tags" .= post]
3532+highlightTagToPairs Nothing = []
3533+
3534+instance ToJSON SortSpec where
3535+ toJSON (DefaultSortSpec
3536+ (DefaultSort (FieldName dsSortFieldName) dsSortOrder dsIgnoreUnmapped
3537+ dsSortMode dsMissingSort dsNestedFilter)) =
3538+ object [dsSortFieldName .= omitNulls base] where
3539+ base = [ "order" .= dsSortOrder
3540+ , "ignore_unmapped" .= dsIgnoreUnmapped
3541+ , "mode" .= dsSortMode
3542+ , "missing" .= dsMissingSort
3543+ , "nested_filter" .= dsNestedFilter ]
3544+
3545+ toJSON (GeoDistanceSortSpec gdsSortOrder (GeoPoint (FieldName field) gdsLatLon) units) =
3546+ object [ "unit" .= units
3547+ , field .= gdsLatLon
3548+ , "order" .= gdsSortOrder ]
3549+
3550+
3551+instance ToJSON SortOrder where
3552+ toJSON Ascending = String "asc"
3553+ toJSON Descending = String "desc"
3554+
3555+
3556+instance ToJSON SortMode where
3557+ toJSON SortMin = String "min"
3558+ toJSON SortMax = String "max"
3559+ toJSON SortSum = String "sum"
3560+ toJSON SortAvg = String "avg"
3561+
3562+
3563+instance ToJSON Missing where
3564+ toJSON LastMissing = String "_last"
3565+ toJSON FirstMissing = String "_first"
3566+ toJSON (CustomMissing txt) = String txt
3567+
3568+
3569+instance ToJSON ScoreType where
3570+ toJSON ScoreTypeMax = "max"
3571+ toJSON ScoreTypeAvg = "avg"
3572+ toJSON ScoreTypeSum = "sum"
3573+ toJSON ScoreTypeNone = "none"
3574+
3575+instance FromJSON ScoreType where
3576+ parseJSON = withText "ScoreType" parse
3577+ where parse "max" = pure ScoreTypeMax
3578+ parse "avg" = pure ScoreTypeAvg
3579+ parse "sum" = pure ScoreTypeSum
3580+ parse "none" = pure ScoreTypeNone
3581+ parse t = fail ("Unexpected ScoreType: " <> show t)
3582+
3583+instance ToJSON Distance where
3584+ toJSON (Distance dCoefficient dUnit) =
3585+ String boltedTogether where
3586+ coefText = showText dCoefficient
3587+ (String unitText) = toJSON dUnit
3588+ boltedTogether = mappend coefText unitText
3589+
3590+instance FromJSON Distance where
3591+ parseJSON = withText "Distance" parse
3592+ where parse t = Distance <$> parseCoeff nT
3593+ <*> parseJSON (String unitT)
3594+ where (nT, unitT) = T.span validForNumber t
3595+ -- may be a better way to do this
3596+ validForNumber '-' = True
3597+ validForNumber '.' = True
3598+ validForNumber 'e' = True
3599+ validForNumber c = isNumber c
3600+ parseCoeff "" = fail "Empty string cannot be parsed as number"
3601+ parseCoeff s = return (read (T.unpack s))
3602+
3603+instance ToJSON DistanceUnit where
3604+ toJSON Miles = String "mi"
3605+ toJSON Yards = String "yd"
3606+ toJSON Feet = String "ft"
3607+ toJSON Inches = String "in"
3608+ toJSON Kilometers = String "km"
3609+ toJSON Meters = String "m"
3610+ toJSON Centimeters = String "cm"
3611+ toJSON Millimeters = String "mm"
3612+ toJSON NauticalMiles = String "nmi"
3613+
3614+
3615+instance FromJSON DistanceUnit where
3616+ parseJSON = withText "DistanceUnit" parse
3617+ where parse "mi" = pure Miles
3618+ parse "yd" = pure Yards
3619+ parse "ft" = pure Feet
3620+ parse "in" = pure Inches
3621+ parse "km" = pure Kilometers
3622+ parse "m" = pure Meters
3623+ parse "cm" = pure Centimeters
3624+ parse "mm" = pure Millimeters
3625+ parse "nmi" = pure NauticalMiles
3626+ parse u = fail ("Unrecognized DistanceUnit: " <> show u)
3627+
3628+instance ToJSON DistanceType where
3629+ toJSON Arc = String "arc"
3630+ toJSON SloppyArc = String "sloppy_arc"
3631+ toJSON Plane = String "plane"
3632+
3633+instance FromJSON DistanceType where
3634+ parseJSON = withText "DistanceType" parse
3635+ where parse "arc" = pure Arc
3636+ parse "sloppy_arc" = pure SloppyArc
3637+ parse "plane" = pure Plane
3638+ parse t = fail ("Unrecognized DistanceType: " <> show t)
3639+
3640+
3641+instance ToJSON OptimizeBbox where
3642+ toJSON NoOptimizeBbox = String "none"
3643+ toJSON (OptimizeGeoFilterType gft) = toJSON gft
3644+
3645+instance FromJSON OptimizeBbox where
3646+ parseJSON v = withText "NoOptimizeBbox" parseNoOptimize v
3647+ <|> parseOptimize v
3648+ where parseNoOptimize "none" = pure NoOptimizeBbox
3649+ parseNoOptimize _ = mzero
3650+ parseOptimize = fmap OptimizeGeoFilterType . parseJSON
3651+
3652+instance ToJSON GeoBoundingBoxConstraint where
3653+ toJSON (GeoBoundingBoxConstraint
3654+ (FieldName gbbcGeoBBField) gbbcConstraintBox cache type') =
3655+ object [gbbcGeoBBField .= gbbcConstraintBox
3656+ , "_cache" .= cache
3657+ , "type" .= type']
3658+
3659+instance FromJSON GeoBoundingBoxConstraint where
3660+ parseJSON = withObject "GeoBoundingBoxConstraint" parse
3661+ where parse o = case HM.toList (deleteSeveral ["type", "_cache"] o) of
3662+ [(fn, v)] -> GeoBoundingBoxConstraint (FieldName fn)
3663+ <$> parseJSON v
3664+ <*> o .:? "_cache" .!= defaultCache
3665+ <*> o .: "type"
3666+ _ -> fail "Could not find field name for GeoBoundingBoxConstraint"
3667+
3668+instance ToJSON GeoFilterType where
3669+ toJSON GeoFilterMemory = String "memory"
3670+ toJSON GeoFilterIndexed = String "indexed"
3671+
3672+instance FromJSON GeoFilterType where
3673+ parseJSON = withText "GeoFilterType" parse
3674+ where parse "memory" = pure GeoFilterMemory
3675+ parse "indexed" = pure GeoFilterIndexed
3676+ parse t = fail ("Unrecognized GeoFilterType: " <> show t)
3677+
3678+instance ToJSON GeoBoundingBox where
3679+ toJSON (GeoBoundingBox gbbTopLeft gbbBottomRight) =
3680+ object ["top_left" .= gbbTopLeft
3681+ , "bottom_right" .= gbbBottomRight]
3682+
3683+instance FromJSON GeoBoundingBox where
3684+ parseJSON = withObject "GeoBoundingBox" parse
3685+ where parse o = GeoBoundingBox
3686+ <$> o .: "top_left"
3687+ <*> o .: "bottom_right"
3688+
3689+instance ToJSON LatLon where
3690+ toJSON (LatLon lLat lLon) =
3691+ object ["lat" .= lLat
3692+ , "lon" .= lLon]
3693+
3694+instance FromJSON LatLon where
3695+ parseJSON = withObject "LatLon" parse
3696+ where parse o = LatLon <$> o .: "lat"
3697+ <*> o .: "lon"
3698+
3699+-- index for smaller ranges, fielddata for longer ranges
3700+instance ToJSON RangeExecution where
3701+ toJSON RangeExecutionIndex = "index"
3702+ toJSON RangeExecutionFielddata = "fielddata"
3703+
3704+
3705+instance FromJSON RangeExecution where
3706+ parseJSON = withText "RangeExecution" parse
3707+ where parse "index" = pure RangeExecutionIndex
3708+ parse "fielddata" = pure RangeExecutionFielddata
3709+ parse t = error ("Unrecognized RangeExecution " <> show t)
3710+
3711+instance ToJSON RegexpFlags where
3712+ toJSON AllRegexpFlags = String "ALL"
3713+ toJSON NoRegexpFlags = String "NONE"
3714+ toJSON (SomeRegexpFlags (h :| fs)) = String $ T.intercalate "|" flagStrs
3715+ where flagStrs = map flagStr . nub $ h:fs
3716+ flagStr AnyString = "ANYSTRING"
3717+ flagStr Automaton = "AUTOMATON"
3718+ flagStr Complement = "COMPLEMENT"
3719+ flagStr Empty = "EMPTY"
3720+ flagStr Intersection = "INTERSECTION"
3721+ flagStr Interval = "INTERVAL"
3722+
3723+instance FromJSON RegexpFlags where
3724+ parseJSON = withText "RegexpFlags" parse
3725+ where parse "ALL" = pure AllRegexpFlags
3726+ parse "NONE" = pure NoRegexpFlags
3727+ parse t = SomeRegexpFlags <$> parseNEJSON (String <$> T.splitOn "|" t)
3728+
3729+instance FromJSON RegexpFlag where
3730+ parseJSON = withText "RegexpFlag" parse
3731+ where parse "ANYSTRING" = pure AnyString
3732+ parse "AUTOMATON" = pure Automaton
3733+ parse "COMPLEMENT" = pure Complement
3734+ parse "EMPTY" = pure Empty
3735+ parse "INTERSECTION" = pure Intersection
3736+ parse "INTERVAL" = pure Interval
3737+ parse f = fail ("Unknown RegexpFlag: " <> show f)
3738+
3739+instance ToJSON Term where
3740+ toJSON (Term field value) = object ["term" .= object
3741+ [field .= value]]
3742+
3743+instance FromJSON Term where
3744+ parseJSON = withObject "Term" parse
3745+ where parse o = do termObj <- o .: "term"
3746+ case HM.toList termObj of
3747+ [(fn, v)] -> Term fn <$> parseJSON v
3748+ _ -> fail "Expected object with 1 field-named key"
3749+
3750+instance ToJSON BoolMatch where
3751+ toJSON (MustMatch term cache) = object ["must" .= term,
3752+ "_cache" .= cache]
3753+ toJSON (MustNotMatch term cache) = object ["must_not" .= term,
3754+ "_cache" .= cache]
3755+ toJSON (ShouldMatch terms cache) = object ["should" .= fmap toJSON terms,
3756+ "_cache" .= cache]
3757+
3758+instance FromJSON BoolMatch where
3759+ parseJSON = withObject "BoolMatch" parse
3760+ where parse o = mustMatch `taggedWith` "must"
3761+ <|> mustNotMatch `taggedWith` "must_not"
3762+ <|> shouldMatch `taggedWith` "should"
3763+ where taggedWith parser k = parser =<< o .: k
3764+ mustMatch t = MustMatch t <$> o .:? "_cache" .!= defaultCache
3765+ mustNotMatch t = MustNotMatch t <$> o .:? "_cache" .!= defaultCache
3766+ shouldMatch t = ShouldMatch t <$> o .:? "_cache" .!= defaultCache
3767+
3768+instance (FromJSON a) => FromJSON (SearchResult a) where
3769+ parseJSON (Object v) = SearchResult <$>
3770+ v .: "took" <*>
3771+ v .: "timed_out" <*>
3772+ v .: "_shards" <*>
3773+ v .: "hits" <*>
3774+ v .:? "aggregations" <*>
3775+ v .:? "_scroll_id"
3776+ parseJSON _ = empty
3777+
3778+instance (FromJSON a) => FromJSON (SearchHits a) where
3779+ parseJSON (Object v) = SearchHits <$>
3780+ v .: "total" <*>
3781+ v .: "max_score" <*>
3782+ v .: "hits"
3783+ parseJSON _ = empty
3784+
3785+instance (FromJSON a) => FromJSON (Hit a) where
3786+ parseJSON (Object v) = Hit <$>
3787+ v .: "_index" <*>
3788+ v .: "_type" <*>
3789+ v .: "_id" <*>
3790+ v .: "_score" <*>
3791+ v .:? "_source" <*>
3792+ v .:? "highlight"
3793+ parseJSON _ = empty
3794+
3795+instance FromJSON ShardResult where
3796+ parseJSON (Object v) = ShardResult <$>
3797+ v .: "total" <*>
3798+ v .: "successful" <*>
3799+ v .: "failed"
3800+ parseJSON _ = empty
3801+
3802+
3803+instance FromJSON DocVersion where
3804+ parseJSON v = do
3805+ i <- parseJSON v
3806+ maybe (fail "DocVersion out of range") return $ mkDocVersion i
3807+
3808+-- This insanity is because ES *sometimes* returns Replica/Shard counts as strings
3809+instance FromJSON ReplicaCount where
3810+ parseJSON v = parseAsInt v
3811+ <|> parseAsString v
3812+ where parseAsInt = fmap ReplicaCount . parseJSON
3813+ parseAsString = withText "ReplicaCount" (fmap ReplicaCount . parseReadText)
3814+
3815+instance FromJSON ShardCount where
3816+ parseJSON v = parseAsInt v
3817+ <|> parseAsString v
3818+ where parseAsInt = fmap ShardCount . parseJSON
3819+ parseAsString = withText "ShardCount" (fmap ShardCount . parseReadText)
3820+
3821+instance Bounded DocVersion where
3822+ minBound = DocVersion 1
3823+ maxBound = DocVersion 9200000000000000000 -- 9.2e+18
3824+
3825+instance Enum DocVersion where
3826+ succ x
3827+ | x /= maxBound = DocVersion (succ $ docVersionNumber x)
3828+ | otherwise = succError "DocVersion"
3829+ pred x
3830+ | x /= minBound = DocVersion (pred $ docVersionNumber x)
3831+ | otherwise = predError "DocVersion"
3832+ toEnum i =
3833+ fromMaybe (error $ show i ++ " out of DocVersion range") $ mkDocVersion i
3834+ fromEnum = docVersionNumber
3835+ enumFrom = boundedEnumFrom
3836+ enumFromThen = boundedEnumFromThen
3837+
3838+-- | Username type used for HTTP Basic authentication. See 'basicAuthHook'.
3839+newtype EsUsername = EsUsername { esUsername :: Text } deriving (Read, Show, Eq)
3840+
3841+-- | Password type used for HTTP Basic authentication. See 'basicAuthHook'.
3842+newtype EsPassword = EsPassword { esPassword :: Text } deriving (Read, Show, Eq)
3843+
3844+
3845+data SnapshotRepoSelection = SnapshotRepoList (NonEmpty SnapshotRepoPattern)
3846+ | AllSnapshotRepos deriving (Eq, Generic, Show, Typeable)
3847+
3848+
3849+-- | Either specifies an exact repo name or one with globs in it,
3850+-- e.g. @RepoPattern "foo*"@ __NOTE__: Patterns are not supported on ES < 1.7
3851+data SnapshotRepoPattern = ExactRepo SnapshotRepoName
3852+ | RepoPattern Text
3853+ deriving (Eq, Generic, Show, Typeable)
3854+
3855+-- | The unique name of a snapshot repository.
3856+newtype SnapshotRepoName = SnapshotRepoName { snapshotRepoName :: Text }
3857+ deriving (Eq, Ord, Generic, Show, Typeable, ToJSON, FromJSON)
3858+
3859+
3860+-- | A generic representation of a snapshot repo. This is what gets
3861+-- sent to and parsed from the server. For repo types enabled by
3862+-- plugins that aren't exported by this library, consider making a
3863+-- custom type which implements 'SnapshotRepo'. If it is a common repo
3864+-- type, consider submitting a pull request to have it included in the
3865+-- library proper
3866+data GenericSnapshotRepo = GenericSnapshotRepo {
3867+ gSnapshotRepoName :: SnapshotRepoName
3868+ , gSnapshotRepoType :: SnapshotRepoType
3869+ , gSnapshotRepoSettings :: GenericSnapshotRepoSettings
3870+ } deriving (Eq, Generic, Show, Typeable)
3871+
3872+
3873+instance SnapshotRepo GenericSnapshotRepo where
3874+ toGSnapshotRepo = id
3875+ fromGSnapshotRepo = Right
3876+
3877+
3878+newtype SnapshotRepoType = SnapshotRepoType { snapshotRepoType :: Text }
3879+ deriving (Eq, Ord, Generic, Show, Typeable, ToJSON, FromJSON)
3880+
3881+
3882+-- | Opaque representation of snapshot repo settings. Instances of
3883+-- 'SnapshotRepo' will produce this.
3884+newtype GenericSnapshotRepoSettings = GenericSnapshotRepoSettings { gSnapshotRepoSettingsObject :: Object }
3885+ deriving (Eq, Generic, Show, Typeable, ToJSON)
3886+
3887+
3888+ -- Regardless of whether you send strongly typed json, my version of
3889+ -- ES sends back stringly typed json in the settings, e.g. booleans
3890+ -- as strings, so we'll try to convert them.
3891+instance FromJSON GenericSnapshotRepoSettings where
3892+ parseJSON = fmap (GenericSnapshotRepoSettings . fmap unStringlyTypeJSON). parseJSON
3893+
3894+-- | The result of running 'verifySnapshotRepo'.
3895+newtype SnapshotVerification = SnapshotVerification { snapshotNodeVerifications :: [SnapshotNodeVerification] }
3896+ deriving (Eq, Generic, Show, Typeable)
3897+
3898+
3899+instance FromJSON SnapshotVerification where
3900+ parseJSON = withObject "SnapshotVerification" parse
3901+ where
3902+ parse o = do
3903+ o2 <- o .: "nodes"
3904+ SnapshotVerification <$> mapM (uncurry parse') (HM.toList o2)
3905+ parse' rawFullId = withObject "SnapshotNodeVerification" $ \o ->
3906+ SnapshotNodeVerification (FullNodeId rawFullId) <$> o .: "name"
3907+
3908+
3909+-- | A node that has verified a snapshot
3910+data SnapshotNodeVerification = SnapshotNodeVerification {
3911+ snvFullId :: FullNodeId
3912+ , snvNodeName :: NodeName
3913+ } deriving (Eq, Generic, Show, Typeable)
3914+
3915+
3916+-- | Unique, automatically-generated name assigned to nodes that are
3917+-- usually returned in node-oriented APIs.
3918+newtype FullNodeId = FullNodeId { fullNodeId :: Text }
3919+ deriving (Eq, Ord, Generic, Show, Typeable, FromJSON)
3920+
3921+
3922+-- | A human-readable node name that is supplied by the user in the
3923+-- node config or automatically generated by ElasticSearch.
3924+newtype NodeName = NodeName { nodeName :: Text }
3925+ deriving (Eq, Ord, Generic, Show, Typeable, FromJSON)
3926+
3927+newtype ClusterName = ClusterName { clusterName :: Text }
3928+ deriving (Eq, Ord, Generic, Show, Typeable, FromJSON)
3929+
3930+data NodesInfo = NodesInfo {
3931+ nodesInfo :: [NodeInfo]
3932+ , nodesClusterName :: ClusterName
3933+ } deriving (Eq, Show, Generic, Typeable)
3934+
3935+data NodesStats = NodesStats {
3936+ nodesStats :: [NodeStats]
3937+ , nodesStatsClusterName :: ClusterName
3938+ } deriving (Eq, Show, Generic, Typeable)
3939+
3940+data NodeStats = NodeStats {
3941+ nodeStatsName :: NodeName
3942+ , nodeStatsFullId :: FullNodeId
3943+ , nodeStatsBreakersStats :: Maybe NodeBreakersStats
3944+ , nodeStatsHTTP :: NodeHTTPStats
3945+ , nodeStatsTransport :: NodeTransportStats
3946+ , nodeStatsFS :: NodeFSStats
3947+ , nodeStatsNetwork :: NodeNetworkStats
3948+ , nodeStatsThreadPool :: NodeThreadPoolsStats
3949+ , nodeStatsJVM :: NodeJVMStats
3950+ , nodeStatsProcess :: NodeProcessStats
3951+ , nodeStatsOS :: NodeOSStats
3952+ , nodeStatsIndices :: NodeIndicesStats
3953+ } deriving (Eq, Show, Generic, Typeable)
3954+
3955+data NodeBreakersStats = NodeBreakersStats {
3956+ nodeStatsParentBreaker :: NodeBreakerStats
3957+ , nodeStatsRequestBreaker :: NodeBreakerStats
3958+ , nodeStatsFieldDataBreaker :: NodeBreakerStats
3959+ } deriving (Eq, Show, Generic, Typeable)
3960+
3961+data NodeBreakerStats = NodeBreakerStats {
3962+ nodeBreakersTripped :: Int
3963+ , nodeBreakersOverhead :: Double
3964+ , nodeBreakersEstSize :: Bytes
3965+ , nodeBreakersLimitSize :: Bytes
3966+ } deriving (Eq, Show, Generic, Typeable)
3967+
3968+data NodeHTTPStats = NodeHTTPStats {
3969+ nodeHTTPTotalOpened :: Int
3970+ , nodeHTTPCurrentOpen :: Int
3971+ } deriving (Eq, Show, Generic, Typeable)
3972+
3973+data NodeTransportStats = NodeTransportStats {
3974+ nodeTransportTXSize :: Bytes
3975+ , nodeTransportCount :: Int
3976+ , nodeTransportRXSize :: Bytes
3977+ , nodeTransportRXCount :: Int
3978+ , nodeTransportServerOpen :: Int
3979+ } deriving (Eq, Show, Generic, Typeable)
3980+
3981+data NodeFSStats = NodeFSStats {
3982+ nodeFSDataPaths :: [NodeDataPathStats]
3983+ , nodeFSTotal :: NodeFSTotalStats
3984+ , nodeFSTimestamp :: UTCTime
3985+ } deriving (Eq, Show, Generic, Typeable)
3986+
3987+data NodeDataPathStats = NodeDataPathStats {
3988+ nodeDataPathDiskServiceTime :: Maybe Double
3989+ , nodeDataPathDiskQueue :: Maybe Double
3990+ , nodeDataPathIOSize :: Maybe Bytes
3991+ , nodeDataPathWriteSize :: Maybe Bytes
3992+ , nodeDataPathReadSize :: Maybe Bytes
3993+ , nodeDataPathIOOps :: Maybe Int
3994+ , nodeDataPathWrites :: Maybe Int
3995+ , nodeDataPathReads :: Maybe Int
3996+ , nodeDataPathAvailable :: Bytes
3997+ , nodeDataPathFree :: Bytes
3998+ , nodeDataPathTotal :: Bytes
3999+ , nodeDataPathType :: Maybe Text
4000+ , nodeDataPathDevice :: Text
4001+ , nodeDataPathMount :: Text
4002+ , nodeDataPathPath :: Text
4003+ } deriving (Eq, Show, Generic, Typeable)
4004+
4005+data NodeFSTotalStats = NodeFSTotalStats {
4006+ nodeFSTotalDiskServiceTime :: Maybe Double
4007+ , nodeFSTotalDiskQueue :: Maybe Double
4008+ , nodeFSTotalIOSize :: Maybe Bytes
4009+ , nodeFSTotalWriteSize :: Maybe Bytes
4010+ , nodeFSTotalReadSize :: Maybe Bytes
4011+ , nodeFSTotalIOOps :: Maybe Int
4012+ , nodeFSTotalWrites :: Maybe Int
4013+ , nodeFSTotalReads :: Maybe Int
4014+ , nodeFSTotalAvailable :: Bytes
4015+ , nodeFSTotalFree :: Bytes
4016+ , nodeFSTotalTotal :: Bytes
4017+ } deriving (Eq, Show, Generic, Typeable)
4018+
4019+data NodeNetworkStats = NodeNetworkStats {
4020+ nodeNetTCPOutRSTs :: Int
4021+ , nodeNetTCPInErrs :: Int
4022+ , nodeNetTCPAttemptFails :: Int
4023+ , nodeNetTCPEstabResets :: Int
4024+ , nodeNetTCPRetransSegs :: Int
4025+ , nodeNetTCPOutSegs :: Int
4026+ , nodeNetTCPInSegs :: Int
4027+ , nodeNetTCPCurrEstab :: Int
4028+ , nodeNetTCPPassiveOpens :: Int
4029+ , nodeNetTCPActiveOpens :: Int
4030+ } deriving (Eq, Show, Generic, Typeable)
4031+
4032+data NodeThreadPoolsStats = NodeThreadPoolsStats {
4033+ nodeThreadPoolsStatsSnapshot :: NodeThreadPoolStats
4034+ , nodeThreadPoolsStatsBulk :: NodeThreadPoolStats
4035+ , nodeThreadPoolsStatsMerge :: NodeThreadPoolStats
4036+ , nodeThreadPoolsStatsGet :: NodeThreadPoolStats
4037+ , nodeThreadPoolsStatsManagement :: NodeThreadPoolStats
4038+ , nodeThreadPoolsStatsFetchShardStore :: Maybe NodeThreadPoolStats
4039+ , nodeThreadPoolsStatsOptimize :: NodeThreadPoolStats
4040+ , nodeThreadPoolsStatsFlush :: NodeThreadPoolStats
4041+ , nodeThreadPoolsStatsSearch :: NodeThreadPoolStats
4042+ , nodeThreadPoolsStatsWarmer :: NodeThreadPoolStats
4043+ , nodeThreadPoolsStatsGeneric :: NodeThreadPoolStats
4044+ , nodeThreadPoolsStatsSuggest :: NodeThreadPoolStats
4045+ , nodeThreadPoolsStatsRefresh :: NodeThreadPoolStats
4046+ , nodeThreadPoolsStatsIndex :: NodeThreadPoolStats
4047+ , nodeThreadPoolsStatsListener :: Maybe NodeThreadPoolStats
4048+ , nodeThreadPoolsStatsFetchShardStarted :: Maybe NodeThreadPoolStats
4049+ , nodeThreadPoolsStatsPercolate :: NodeThreadPoolStats
4050+ } deriving (Eq, Show, Generic, Typeable)
4051+
4052+data NodeThreadPoolStats = NodeThreadPoolStats {
4053+ nodeThreadPoolCompleted :: Int
4054+ , nodeThreadPoolLargest :: Int
4055+ , nodeThreadPoolRejected :: Int
4056+ , nodeThreadPoolActive :: Int
4057+ , nodeThreadPoolQueue :: Int
4058+ , nodeThreadPoolThreads :: Int
4059+ } deriving (Eq, Show, Generic, Typeable)
4060+
4061+data NodeJVMStats = NodeJVMStats {
4062+ nodeJVMStatsMappedBufferPool :: JVMBufferPoolStats
4063+ , nodeJVMStatsDirectBufferPool :: JVMBufferPoolStats
4064+ , nodeJVMStatsGCOldCollector :: JVMGCStats
4065+ , nodeJVMStatsGCYoungCollector :: JVMGCStats
4066+ , nodeJVMStatsPeakThreadsCount :: Int
4067+ , nodeJVMStatsThreadsCount :: Int
4068+ , nodeJVMStatsOldPool :: JVMPoolStats
4069+ , nodeJVMStatsSurvivorPool :: JVMPoolStats
4070+ , nodeJVMStatsYoungPool :: JVMPoolStats
4071+ , nodeJVMStatsNonHeapCommitted :: Bytes
4072+ , nodeJVMStatsNonHeapUsed :: Bytes
4073+ , nodeJVMStatsHeapMax :: Bytes
4074+ , nodeJVMStatsHeapCommitted :: Bytes
4075+ , nodeJVMStatsHeapUsedPercent :: Int
4076+ , nodeJVMStatsHeapUsed :: Bytes
4077+ , nodeJVMStatsUptime :: NominalDiffTime
4078+ , nodeJVMStatsTimestamp :: UTCTime
4079+ } deriving (Eq, Show, Generic, Typeable)
4080+
4081+data JVMBufferPoolStats = JVMBufferPoolStats {
4082+ jvmBufferPoolStatsTotalCapacity :: Bytes
4083+ , jvmBufferPoolStatsUsed :: Bytes
4084+ , jvmBufferPoolStatsCount :: Int
4085+ } deriving (Eq, Show, Generic, Typeable)
4086+
4087+data JVMGCStats = JVMGCStats {
4088+ jvmGCStatsCollectionTime :: NominalDiffTime
4089+ , jvmGCStatsCollectionCount :: Int
4090+ } deriving (Eq, Show, Generic, Typeable)
4091+
4092+data JVMPoolStats = JVMPoolStats {
4093+ jvmPoolStatsPeakMax :: Bytes
4094+ , jvmPoolStatsPeakUsed :: Bytes
4095+ , jvmPoolStatsMax :: Bytes
4096+ , jvmPoolStatsUsed :: Bytes
4097+ } deriving (Eq, Show, Generic, Typeable)
4098+
4099+data NodeProcessStats = NodeProcessStats {
4100+ nodeProcessMemTotalVirtual :: Bytes
4101+ , nodeProcessMemShare :: Bytes
4102+ , nodeProcessMemResident :: Bytes
4103+ , nodeProcessCPUTotal :: NominalDiffTime
4104+ , nodeProcessCPUUser :: NominalDiffTime
4105+ , nodeProcessCPUSys :: NominalDiffTime
4106+ , nodeProcessCPUPercent :: Int
4107+ , nodeProcessOpenFDs :: Int
4108+ , nodeProcessTimestamp :: UTCTime
4109+ } deriving (Eq, Show, Generic, Typeable)
4110+
4111+data NodeOSStats = NodeOSStats {
4112+ nodeOSSwapFree :: Bytes
4113+ , nodeOSSwapUsed :: Bytes
4114+ , nodeOSMemActualUsed :: Bytes
4115+ , nodeOSMemActualFree :: Bytes
4116+ , nodeOSMemUsedPercent :: Int
4117+ , nodeOSMemFreePercent :: Int
4118+ , nodeOSMemUsed :: Bytes
4119+ , nodeOSMemFree :: Bytes
4120+ , nodeOSCPUStolen :: Int
4121+ , nodeOSCPUUsage :: Int
4122+ , nodeOSCPUIdle :: Int
4123+ , nodeOSCPUUser :: Int
4124+ , nodeOSCPUSys :: Int
4125+ , nodeOSLoad :: Maybe LoadAvgs
4126+ , nodeOSUptime :: NominalDiffTime
4127+ , nodeOSTimestamp :: UTCTime
4128+ } deriving (Eq, Show, Generic, Typeable)
4129+
4130+data LoadAvgs = LoadAvgs {
4131+ loadAvg1Min :: Double
4132+ , loadAvg5Min :: Double
4133+ , loadAvg15Min :: Double
4134+ } deriving (Eq, Show, Generic, Typeable)
4135+
4136+data NodeIndicesStats = NodeIndicesStats {
4137+ nodeIndicesStatsRecoveryThrottleTime :: Maybe NominalDiffTime
4138+ , nodeIndicesStatsRecoveryCurrentAsTarget :: Maybe Int
4139+ , nodeIndicesStatsRecoveryCurrentAsSource :: Maybe Int
4140+ , nodeIndicesStatsQueryCacheMisses :: Maybe Int
4141+ , nodeIndicesStatsQueryCacheHits :: Maybe Int
4142+ , nodeIndicesStatsQueryCacheEvictions :: Maybe Int
4143+ , nodeIndicesStatsQueryCacheSize :: Maybe Bytes
4144+ , nodeIndicesStatsSuggestCurrent :: Int
4145+ , nodeIndicesStatsSuggestTime :: NominalDiffTime
4146+ , nodeIndicesStatsSuggestTotal :: Int
4147+ , nodeIndicesStatsTranslogSize :: Bytes
4148+ , nodeIndicesStatsTranslogOps :: Int
4149+ , nodeIndicesStatsSegFixedBitSetMemory :: Maybe Bytes
4150+ , nodeIndicesStatsSegVersionMapMemory :: Bytes
4151+ , nodeIndicesStatsSegIndexWriterMaxMemory :: Maybe Bytes
4152+ , nodeIndicesStatsSegIndexWriterMemory :: Bytes
4153+ , nodeIndicesStatsSegMemory :: Bytes
4154+ , nodeIndicesStatsSegCount :: Int
4155+ , nodeIndicesStatsCompletionSize :: Bytes
4156+ , nodeIndicesStatsPercolateQueries :: Int
4157+ , nodeIndicesStatsPercolateMemory :: Bytes
4158+ , nodeIndicesStatsPercolateCurrent :: Int
4159+ , nodeIndicesStatsPercolateTime :: NominalDiffTime
4160+ , nodeIndicesStatsPercolateTotal :: Int
4161+ , nodeIndicesStatsFieldDataEvictions :: Int
4162+ , nodeIndicesStatsFieldDataMemory :: Bytes
4163+ , nodeIndicesStatsIDCacheMemory :: Bytes
4164+ , nodeIndicesStatsFilterCacheEvictions :: Int
4165+ , nodeIndicesStatsFilterCacheMemory :: Bytes
4166+ , nodeIndicesStatsWarmerTotalTime :: NominalDiffTime
4167+ , nodeIndicesStatsWarmerTotal :: Int
4168+ , nodeIndicesStatsWarmerCurrent :: Int
4169+ , nodeIndicesStatsFlushTotalTime :: NominalDiffTime
4170+ , nodeIndicesStatsFlushTotal :: Int
4171+ , nodeIndicesStatsRefreshTotalTime :: NominalDiffTime
4172+ , nodeIndicesStatsRefreshTotal :: Int
4173+ , nodeIndicesStatsMergesTotalSize :: Bytes
4174+ , nodeIndicesStatsMergesTotalDocs :: Int
4175+ , nodeIndicesStatsMergesTotalTime :: NominalDiffTime
4176+ , nodeIndicesStatsMergesTotal :: Int
4177+ , nodeIndicesStatsMergesCurrentSize :: Bytes
4178+ , nodeIndicesStatsMergesCurrentDocs :: Int
4179+ , nodeIndicesStatsMergesCurrent :: Int
4180+ , nodeIndicesStatsSearchFetchCurrent :: Int
4181+ , nodeIndicesStatsSearchFetchTime :: NominalDiffTime
4182+ , nodeIndicesStatsSearchFetchTotal :: Int
4183+ , nodeIndicesStatsSearchQueryCurrent :: Int
4184+ , nodeIndicesStatsSearchQueryTime :: NominalDiffTime
4185+ , nodeIndicesStatsSearchQueryTotal :: Int
4186+ , nodeIndicesStatsSearchOpenContexts :: Int
4187+ , nodeIndicesStatsGetCurrent :: Int
4188+ , nodeIndicesStatsGetMissingTime :: NominalDiffTime
4189+ , nodeIndicesStatsGetMissingTotal :: Int
4190+ , nodeIndicesStatsGetExistsTime :: NominalDiffTime
4191+ , nodeIndicesStatsGetExistsTotal :: Int
4192+ , nodeIndicesStatsGetTime :: NominalDiffTime
4193+ , nodeIndicesStatsGetTotal :: Int
4194+ , nodeIndicesStatsIndexingThrottleTime :: Maybe NominalDiffTime
4195+ , nodeIndicesStatsIndexingIsThrottled :: Maybe Bool
4196+ , nodeIndicesStatsIndexingNoopUpdateTotal :: Maybe Int
4197+ , nodeIndicesStatsIndexingDeleteCurrent :: Int
4198+ , nodeIndicesStatsIndexingDeleteTime :: NominalDiffTime
4199+ , nodeIndicesStatsIndexingDeleteTotal :: Int
4200+ , nodeIndicesStatsIndexingIndexCurrent :: Int
4201+ , nodeIndicesStatsIndexingIndexTime :: NominalDiffTime
4202+ , nodeIndicesStatsIndexingTotal :: Int
4203+ , nodeIndicesStatsStoreThrottleTime :: NominalDiffTime
4204+ , nodeIndicesStatsStoreSize :: Bytes
4205+ , nodeIndicesStatsDocsDeleted :: Int
4206+ , nodeIndicesStatsDocsCount :: Int
4207+ } deriving (Eq, Show, Generic, Typeable)
4208+
4209+-- | A quirky address format used throughout ElasticSearch. An example
4210+-- would be inet[/1.1.1.1:9200]. inet may be a placeholder for a
4211+-- <https://en.wikipedia.org/wiki/Fully_qualified_domain_name FQDN>.
4212+newtype EsAddress = EsAddress { esAddress :: Text }
4213+ deriving (Eq, Ord, Generic, Show, Typeable, FromJSON)
4214+
4215+-- | Typically a 7 character hex string.
4216+newtype BuildHash = BuildHash { buildHash :: Text }
4217+ deriving (Eq, Ord, Generic, Read, Show, Typeable, FromJSON, ToJSON)
4218+
4219+newtype PluginName = PluginName { pluginName :: Text }
4220+ deriving (Eq, Ord, Generic, Show, Typeable, FromJSON)
4221+
4222+data NodeInfo = NodeInfo {
4223+ nodeInfoHTTPAddress :: EsAddress
4224+ , nodeInfoBuild :: BuildHash
4225+ , nodeInfoESVersion :: VersionNumber
4226+ , nodeInfoIP :: Server
4227+ , nodeInfoHost :: Server
4228+ , nodeInfoTransportAddress :: EsAddress
4229+ , nodeInfoName :: NodeName
4230+ , nodeInfoFullId :: FullNodeId
4231+ , nodeInfoPlugins :: [NodePluginInfo]
4232+ , nodeInfoHTTP :: NodeHTTPInfo
4233+ , nodeInfoTransport :: NodeTransportInfo
4234+ , nodeInfoNetwork :: NodeNetworkInfo
4235+ , nodeInfoThreadPool :: NodeThreadPoolsInfo
4236+ , nodeInfoJVM :: NodeJVMInfo
4237+ , nodeInfoProcess :: NodeProcessInfo
4238+ , nodeInfoOS :: NodeOSInfo
4239+ , nodeInfoSettings :: Object
4240+ -- ^ The members of the settings objects are not consistent,
4241+ -- dependent on plugins, etc.
4242+ } deriving (Eq, Show, Generic, Typeable)
4243+
4244+data NodePluginInfo = NodePluginInfo {
4245+ nodePluginSite :: Bool
4246+ -- ^ Is this a site plugin?
4247+ , nodePluginJVM :: Bool
4248+ -- ^ Is this plugin running on the JVM
4249+ , nodePluginDescription :: Text
4250+ , nodePluginVersion :: MaybeNA VersionNumber
4251+ , nodePluginName :: PluginName
4252+ } deriving (Eq, Show, Generic, Typeable)
4253+
4254+data NodeHTTPInfo = NodeHTTPInfo {
4255+ nodeHTTPMaxContentLength :: Bytes
4256+ , nodeHTTPTransportAddress :: BoundTransportAddress
4257+ } deriving (Eq, Show, Generic, Typeable)
4258+
4259+data NodeTransportInfo = NodeTransportInfo {
4260+ nodeTransportProfiles :: [BoundTransportAddress]
4261+ , nodeTransportAddress :: BoundTransportAddress
4262+ } deriving (Eq, Show, Generic, Typeable)
4263+
4264+data BoundTransportAddress = BoundTransportAddress {
4265+ publishAddress :: EsAddress
4266+ , boundAddress :: EsAddress
4267+ } deriving (Eq, Show, Generic, Typeable)
4268+
4269+data NodeNetworkInfo = NodeNetworkInfo {
4270+ nodeNetworkPrimaryInterface :: NodeNetworkInterface
4271+ , nodeNetworkRefreshInterval :: NominalDiffTime
4272+ } deriving (Eq, Show, Generic, Typeable)
4273+
4274+newtype MacAddress = MacAddress { macAddress :: Text }
4275+ deriving (Eq, Ord, Generic, Show, Typeable, FromJSON)
4276+
4277+newtype NetworkInterfaceName = NetworkInterfaceName { networkInterfaceName :: Text }
4278+ deriving (Eq, Ord, Generic, Show, Typeable, FromJSON)
4279+
4280+data NodeNetworkInterface = NodeNetworkInterface {
4281+ nodeNetIfaceMacAddress :: MacAddress
4282+ , nodeNetIfaceName :: NetworkInterfaceName
4283+ , nodeNetIfaceAddress :: Server
4284+ } deriving (Eq, Show, Generic, Typeable)
4285+
4286+data NodeThreadPoolsInfo = NodeThreadPoolsInfo {
4287+ nodeThreadPoolsRefresh :: NodeThreadPoolInfo
4288+ , nodeThreadPoolsManagement :: NodeThreadPoolInfo
4289+ , nodeThreadPoolsPercolate :: NodeThreadPoolInfo
4290+ , nodeThreadPoolsListener :: Maybe NodeThreadPoolInfo
4291+ , nodeThreadPoolsFetchShardStarted :: Maybe NodeThreadPoolInfo
4292+ , nodeThreadPoolsSearch :: NodeThreadPoolInfo
4293+ , nodeThreadPoolsFlush :: NodeThreadPoolInfo
4294+ , nodeThreadPoolsWarmer :: NodeThreadPoolInfo
4295+ , nodeThreadPoolsOptimize :: NodeThreadPoolInfo
4296+ , nodeThreadPoolsBulk :: NodeThreadPoolInfo
4297+ , nodeThreadPoolsSuggest :: NodeThreadPoolInfo
4298+ , nodeThreadPoolsMerge :: NodeThreadPoolInfo
4299+ , nodeThreadPoolsSnapshot :: NodeThreadPoolInfo
4300+ , nodeThreadPoolsGet :: NodeThreadPoolInfo
4301+ , nodeThreadPoolsFetchShardStore :: Maybe NodeThreadPoolInfo
4302+ , nodeThreadPoolsIndex :: NodeThreadPoolInfo
4303+ , nodeThreadPoolsGeneric :: NodeThreadPoolInfo
4304+ } deriving (Eq, Show, Generic, Typeable)
4305+
4306+data NodeThreadPoolInfo = NodeThreadPoolInfo {
4307+ nodeThreadPoolQueueSize :: ThreadPoolSize
4308+ , nodeThreadPoolKeepalive :: Maybe NominalDiffTime
4309+ , nodeThreadPoolMin :: Maybe Int
4310+ , nodeThreadPoolMax :: Maybe Int
4311+ , nodeThreadPoolType :: ThreadPoolType
4312+ } deriving (Eq, Show, Generic, Typeable)
4313+
4314+data ThreadPoolSize = ThreadPoolBounded Int
4315+ | ThreadPoolUnbounded
4316+ deriving (Eq, Show, Generic, Typeable)
4317+
4318+data ThreadPoolType = ThreadPoolScaling
4319+ | ThreadPoolFixed
4320+ | ThreadPoolCached
4321+ deriving (Eq, Show, Generic, Typeable)
4322+
4323+data NodeJVMInfo = NodeJVMInfo {
4324+ nodeJVMInfoMemoryPools :: [JVMMemoryPool]
4325+ , nodeJVMInfoMemoryPoolsGCCollectors :: [JVMGCCollector]
4326+ , nodeJVMInfoMemoryInfo :: JVMMemoryInfo
4327+ , nodeJVMInfoStartTime :: UTCTime
4328+ , nodeJVMInfoVMVendor :: Text
4329+ , nodeJVMVMVersion :: VersionNumber
4330+ -- ^ JVM doesn't seme to follow normal version conventions
4331+ , nodeJVMVMName :: Text
4332+ , nodeJVMVersion :: VersionNumber
4333+ , nodeJVMPID :: PID
4334+ } deriving (Eq, Show, Generic, Typeable)
4335+
4336+-- | Handles quirks in the way JVM versions are rendered (1.7.0_101 -> 1.7.0.101)
4337+newtype JVMVersion = JVMVersion { unJVMVersion :: VersionNumber }
4338+
4339+data JVMMemoryInfo = JVMMemoryInfo {
4340+ jvmMemoryInfoDirectMax :: Bytes
4341+ , jvmMemoryInfoNonHeapMax :: Bytes
4342+ , jvmMemoryInfoNonHeapInit :: Bytes
4343+ , jvmMemoryInfoHeapMax :: Bytes
4344+ , jvmMemoryInfoHeapInit :: Bytes
4345+ } deriving (Eq, Show, Generic, Typeable)
4346+
4347+newtype JVMMemoryPool = JVMMemoryPool {
4348+ jvmMemoryPool :: Text
4349+ } deriving (Eq, Show, Generic, Typeable, FromJSON)
4350+
4351+newtype JVMGCCollector = JVMGCCollector {
4352+ jvmGCCollector :: Text
4353+ } deriving (Eq, Show, Generic, Typeable, FromJSON)
4354+
4355+newtype PID = PID {
4356+ pid :: Int
4357+ } deriving (Eq, Show, Generic, Typeable, FromJSON)
4358+
4359+data NodeOSInfo = NodeOSInfo {
4360+ nodeOSSwap :: Bytes
4361+ , nodeOSMem :: Bytes
4362+ , nodeOSCPUInfo :: CPUInfo
4363+ , nodeOSAvailableProcessors :: Int
4364+ , nodeOSRefreshInterval :: NominalDiffTime
4365+ } deriving (Eq, Show, Generic, Typeable)
4366+
4367+data CPUInfo = CPUInfo {
4368+ cpuCacheSize :: Bytes
4369+ , cpuCoresPerSocket :: Int
4370+ , cpuTotalSockets :: Int
4371+ , cpuTotalCores :: Int
4372+ , cpuMHZ :: Int
4373+ , cpuModel :: Text
4374+ , cpuVendor :: Text
4375+ } deriving (Eq, Show, Generic, Typeable)
4376+
4377+data NodeProcessInfo = NodeProcessInfo {
4378+ nodeProcessMLockAll :: Bool
4379+ -- ^ See <https://www.elastic.co/guide/en/elasticsearch/reference/current/setup-configuration.html>
4380+ , nodeProcessMaxFileDescriptors :: Int
4381+ , nodeProcessId :: PID
4382+ , nodeProcessRefreshInterval :: NominalDiffTime
4383+ } deriving (Eq, Show, Generic, Typeable)
4384+
4385+data SnapshotRepoUpdateSettings = SnapshotRepoUpdateSettings {
4386+ repoUpdateVerify :: Bool
4387+ -- ^ After creation/update, synchronously check that nodes can
4388+ -- write to this repo. Defaults to True. You may use False if you
4389+ -- need a faster response and plan on verifying manually later
4390+ -- with 'verifySnapshotRepo'.
4391+ } deriving (Eq, Show, Generic, Typeable)
4392+
4393+
4394+-- | Reasonable defaults for repo creation/update
4395+--
4396+-- * repoUpdateVerify True
4397+defaultSnapshotRepoUpdateSettings :: SnapshotRepoUpdateSettings
4398+defaultSnapshotRepoUpdateSettings = SnapshotRepoUpdateSettings True
4399+
4400+
4401+-- | A filesystem-based snapshot repo that ships with
4402+-- ElasticSearch. This is an instance of 'SnapshotRepo' so it can be
4403+-- used with 'updateSnapshotRepo'
4404+data FsSnapshotRepo = FsSnapshotRepo {
4405+ fsrName :: SnapshotRepoName
4406+ , fsrLocation :: FilePath
4407+ , fsrCompressMetadata :: Bool
4408+ , fsrChunkSize :: Maybe Bytes
4409+ -- ^ Size by which to split large files during snapshotting.
4410+ , fsrMaxRestoreBytesPerSec :: Maybe Bytes
4411+ -- ^ Throttle node restore rate. If not supplied, defaults to 40mb/sec
4412+ , fsrMaxSnapshotBytesPerSec :: Maybe Bytes
4413+ -- ^ Throttle node snapshot rate. If not supplied, defaults to 40mb/sec
4414+ } deriving (Eq, Generic, Show, Typeable)
4415+
4416+
4417+instance SnapshotRepo FsSnapshotRepo where
4418+ toGSnapshotRepo FsSnapshotRepo {..} =
4419+ GenericSnapshotRepo fsrName fsRepoType (GenericSnapshotRepoSettings settings)
4420+ where
4421+ Object settings = object $ [ "location" .= fsrLocation
4422+ , "compress" .= fsrCompressMetadata
4423+ ] ++ optionalPairs
4424+ optionalPairs = catMaybes [ ("chunk_size" .=) <$> fsrChunkSize
4425+ , ("max_restore_bytes_per_sec" .=) <$> fsrMaxRestoreBytesPerSec
4426+ , ("max_snapshot_bytes_per_sec" .=) <$> fsrMaxSnapshotBytesPerSec
4427+ ]
4428+ fromGSnapshotRepo GenericSnapshotRepo {..}
4429+ | gSnapshotRepoType == fsRepoType = do
4430+ let o = gSnapshotRepoSettingsObject gSnapshotRepoSettings
4431+ parseRepo $ do
4432+ FsSnapshotRepo gSnapshotRepoName <$> o .: "location"
4433+ <*> o .:? "compress" .!= False
4434+ <*> o .:? "chunk_size"
4435+ <*> o .:? "max_restore_bytes_per_sec"
4436+ <*> o .:? "max_snapshot_bytes_per_sec"
4437+ | otherwise = Left (RepoTypeMismatch fsRepoType gSnapshotRepoType)
4438+
4439+
4440+parseRepo :: Parser a -> Either SnapshotRepoConversionError a
4441+parseRepo parser = case parseEither (const parser) () of
4442+ Left e -> Left (OtherRepoConversionError (T.pack e))
4443+ Right a -> Right a
4444+
4445+
4446+fsRepoType :: SnapshotRepoType
4447+fsRepoType = SnapshotRepoType "fs"
4448+
4449+-- | Law: fromGSnapshotRepo (toGSnapshotRepo r) == Right r
4450+class SnapshotRepo r where
4451+ toGSnapshotRepo :: r -> GenericSnapshotRepo
4452+ fromGSnapshotRepo :: GenericSnapshotRepo -> Either SnapshotRepoConversionError r
4453+
4454+
4455+data SnapshotRepoConversionError = RepoTypeMismatch SnapshotRepoType SnapshotRepoType
4456+ -- ^ Expected type and actual type
4457+ | OtherRepoConversionError Text
4458+ deriving (Show, Eq, Generic, Typeable)
4459+
4460+
4461+instance Exception SnapshotRepoConversionError
4462+
4463+
4464+data SnapshotCreateSettings = SnapshotCreateSettings {
4465+ snapWaitForCompletion :: Bool
4466+ -- ^ Should the API call return immediately after initializing
4467+ -- the snapshot or wait until completed? Note that if this is
4468+ -- enabled it could wait a long time, so you should adjust your
4469+ -- 'ManagerSettings' accordingly to set long timeouts or
4470+ -- explicitly handle timeouts.
4471+ , snapIndices :: Maybe IndexSelection
4472+ -- ^ Nothing will snapshot all indices. Just [] is permissable and
4473+ -- will essentially be a no-op snapshot.
4474+ , snapIgnoreUnavailable :: Bool
4475+ -- ^ If set to True, any matched indices that don't exist will be
4476+ -- ignored. Otherwise it will be an error and fail.
4477+ , snapIncludeGlobalState :: Bool
4478+ , snapPartial :: Bool
4479+ -- ^ If some indices failed to snapshot (e.g. if not all primary
4480+ -- shards are available), should the process proceed?
4481+ } deriving (Eq, Generic, Show, Typeable)
4482+
4483+
4484+-- | Reasonable defaults for snapshot creation
4485+--
4486+-- * snapWaitForCompletion False
4487+-- * snapIndices Nothing
4488+-- * snapIgnoreUnavailable False
4489+-- * snapIncludeGlobalState True
4490+-- * snapPartial False
4491+defaultSnapshotCreateSettings :: SnapshotCreateSettings
4492+defaultSnapshotCreateSettings = SnapshotCreateSettings {
4493+ snapWaitForCompletion = False
4494+ , snapIndices = Nothing
4495+ , snapIgnoreUnavailable = False
4496+ , snapIncludeGlobalState = True
4497+ , snapPartial = False
4498+ }
4499+
4500+
4501+data SnapshotSelection = SnapshotList (NonEmpty SnapshotPattern)
4502+ | AllSnapshots deriving (Eq, Generic, Show, Typeable)
4503+
4504+
4505+-- | Either specifies an exact snapshot name or one with globs in it,
4506+-- e.g. @SnapPattern "foo*"@ __NOTE__: Patterns are not supported on
4507+-- ES < 1.7
4508+data SnapshotPattern = ExactSnap SnapshotName
4509+ | SnapPattern Text
4510+ deriving (Eq, Generic, Show, Typeable)
4511+
4512+
4513+-- | General information about the state of a snapshot. Has some
4514+-- redundancies with 'SnapshotStatus'
4515+data SnapshotInfo = SnapshotInfo {
4516+ snapInfoShards :: ShardResult
4517+ , snapInfoFailures :: [SnapshotShardFailure]
4518+ , snapInfoDuration :: NominalDiffTime
4519+ , snapInfoEndTime :: UTCTime
4520+ , snapInfoStartTime :: UTCTime
4521+ , snapInfoState :: SnapshotState
4522+ , snapInfoIndices :: [IndexName]
4523+ , snapInfoName :: SnapshotName
4524+ } deriving (Eq, Generic, Show, Typeable)
4525+
4526+
4527+instance FromJSON SnapshotInfo where
4528+ parseJSON = withObject "SnapshotInfo" parse
4529+ where
4530+ parse o = SnapshotInfo <$> o .: "shards"
4531+ <*> o .: "failures"
4532+ <*> (unMS <$> o .: "duration_in_millis")
4533+ <*> (posixMS <$> o .: "end_time_in_millis")
4534+ <*> (posixMS <$> o .: "start_time_in_millis")
4535+ <*> o .: "state"
4536+ <*> o .: "indices"
4537+ <*> o .: "snapshot"
4538+
4539+data SnapshotShardFailure = SnapshotShardFailure {
4540+ snapShardFailureIndex :: IndexName
4541+ , snapShardFailureNodeId :: Maybe NodeName -- I'm not 100% sure this isn't actually 'FullNodeId'
4542+ , snapShardFailureReason :: Text
4543+ , snapShardFailureShardId :: ShardId
4544+ } deriving (Eq, Show, Generic, Typeable)
4545+
4546+
4547+instance FromJSON SnapshotShardFailure where
4548+ parseJSON = withObject "SnapshotShardFailure" parse
4549+ where
4550+ parse o = SnapshotShardFailure <$> o .: "index"
4551+ <*> o .:? "node_id"
4552+ <*> o .: "reason"
4553+ <*> o .: "shard_id"
4554+
4555+
4556+newtype ShardId = ShardId { shardId :: Int }
4557+ deriving (Eq, Show, Generic, Typeable, FromJSON)
4558+
4559+-- | Milliseconds
4560+newtype MS = MS NominalDiffTime
4561+
4562+
4563+-- keeps the unexported constructor warnings at bay
4564+unMS :: MS -> NominalDiffTime
4565+unMS (MS t) = t
4566+
4567+
4568+instance FromJSON MS where
4569+ parseJSON = withScientific "MS" (return . MS . parse)
4570+ where
4571+ parse n = fromInteger ((truncate n) * 1000)
4572+
4573+
4574+data SnapshotState = SnapshotInit
4575+ | SnapshotStarted
4576+ | SnapshotSuccess
4577+ | SnapshotFailed
4578+ | SnapshotAborted
4579+ | SnapshotMissing
4580+ | SnapshotWaiting
4581+ deriving (Show, Eq, Generic, Typeable)
4582+
4583+instance FromJSON SnapshotState where
4584+ parseJSON = withText "SnapshotState" parse
4585+ where
4586+ parse "INIT" = return SnapshotInit
4587+ parse "STARTED" = return SnapshotStarted
4588+ parse "SUCCESS" = return SnapshotSuccess
4589+ parse "FAILED" = return SnapshotFailed
4590+ parse "ABORTED" = return SnapshotAborted
4591+ parse "MISSING" = return SnapshotMissing
4592+ parse "WAITING" = return SnapshotWaiting
4593+ parse t = fail ("Invalid snapshot state " <> T.unpack t)
4594+
4595+
4596+newtype SnapshotName = SnapshotName { snapshotName :: Text }
4597+ deriving (Show, Eq, Ord, Generic, Typeable, ToJSON, FromJSON)
4598+
4599+
4600+data SnapshotRestoreSettings = SnapshotRestoreSettings {
4601+ snapRestoreWaitForCompletion :: Bool
4602+ -- ^ Should the API call return immediately after initializing
4603+ -- the restore or wait until completed? Note that if this is
4604+ -- enabled, it could wait a long time, so you should adjust your
4605+ -- 'ManagerSettings' accordingly to set long timeouts or
4606+ -- explicitly handle timeouts.
4607+ , snapRestoreIndices :: Maybe IndexSelection
4608+ -- ^ Nothing will restore all indices in the snapshot. Just [] is
4609+ -- permissable and will essentially be a no-op restore.
4610+ , snapRestoreIgnoreUnavailable :: Bool
4611+ -- ^ If set to True, any indices that do not exist will be ignored
4612+ -- during snapshot rather than failing the restore.
4613+ , snapRestoreIncludeGlobalState :: Bool
4614+ -- ^ If set to false, will ignore any global state in the snapshot
4615+ -- and will not restore it.
4616+ , snapRestoreRenamePattern :: Maybe RestoreRenamePattern
4617+ -- ^ A regex pattern for matching indices. Used with
4618+ -- 'snapRestoreRenameReplacement', the restore can reference the
4619+ -- matched index and create a new index name upon restore.
4620+ , snapRestoreRenameReplacement :: Maybe (NonEmpty RestoreRenameToken)
4621+ -- ^ Expression of how index renames should be constructed.
4622+ , snapRestorePartial :: Bool
4623+ -- ^ If some indices fail to restore, should the process proceed?
4624+ , snapRestoreIncludeAliases :: Bool
4625+ -- ^ Should the restore also restore the aliases captured in the
4626+ -- snapshot.
4627+ , snapRestoreIndexSettingsOverrides :: Maybe RestoreIndexSettings
4628+ -- ^ Settings to apply during the restore process. __NOTE:__ This
4629+ -- option is not supported in ES < 1.5 and should be set to
4630+ -- Nothing in that case.
4631+ , snapRestoreIgnoreIndexSettings :: Maybe (NonEmpty Text)
4632+ -- ^ This type could be more rich but it isn't clear which
4633+ -- settings are allowed to be ignored during restore, so we're
4634+ -- going with including this feature in a basic form rather than
4635+ -- omitting it. One example here would be
4636+ -- "index.refresh_interval". Any setting specified here will
4637+ -- revert back to the server default during the restore process.
4638+ } deriving (Eq, Generic, Show, Typeable)
4639+
4640+-- | Regex-stype pattern, e.g. "index_(.+)" to match index names
4641+newtype RestoreRenamePattern = RestoreRenamePattern { rrPattern :: Text }
4642+ deriving (Show, Eq, Generic, Typeable, Ord, ToJSON)
4643+
4644+
4645+-- | A single token in a index renaming scheme for a restore. These
4646+-- are concatenated into a string before being sent to
4647+-- ElasticSearch. Check out these Java
4648+-- <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.
4649+data RestoreRenameToken = RRTLit Text
4650+ -- ^ Just a literal string of characters
4651+ | RRSubWholeMatch
4652+ -- ^ Equivalent to $0. The entire matched pattern, not any subgroup
4653+ | RRSubGroup RRGroupRefNum
4654+ -- ^ A specific reference to a group number
4655+ deriving (Show, Eq, Generic, Typeable)
4656+
4657+
4658+-- | A group number for regex matching. Only values from 1-9 are
4659+-- supported. Construct with 'mkRRGroupRefNum'
4660+newtype RRGroupRefNum = RRGroupRefNum { rrGroupRefNum :: Int }
4661+ deriving (Show, Eq, Generic, Typeable, Ord)
4662+
4663+instance Bounded RRGroupRefNum where
4664+ minBound = RRGroupRefNum 1
4665+ maxBound = RRGroupRefNum 9
4666+
4667+
4668+-- | Only allows valid group number references (1-9).
4669+mkRRGroupRefNum :: Int -> Maybe RRGroupRefNum
4670+mkRRGroupRefNum i
4671+ | i >= (rrGroupRefNum minBound) && i <= (rrGroupRefNum maxBound) =
4672+ Just $ RRGroupRefNum i
4673+ | otherwise = Nothing
4674+
4675+
4676+-- | Reasonable defaults for snapshot restores
4677+--
4678+-- * snapRestoreWaitForCompletion False
4679+-- * snapRestoreIndices Nothing
4680+-- * snapRestoreIgnoreUnavailable False
4681+-- * snapRestoreIncludeGlobalState True
4682+-- * snapRestoreRenamePattern Nothing
4683+-- * snapRestoreRenameReplacement Nothing
4684+-- * snapRestorePartial False
4685+-- * snapRestoreIncludeAliases True
4686+-- * snapRestoreIndexSettingsOverrides Nothing
4687+-- * snapRestoreIgnoreIndexSettings Nothing
4688+defaultSnapshotRestoreSettings :: SnapshotRestoreSettings
4689+defaultSnapshotRestoreSettings = SnapshotRestoreSettings {
4690+ snapRestoreWaitForCompletion = False
4691+ , snapRestoreIndices = Nothing
4692+ , snapRestoreIgnoreUnavailable = False
4693+ , snapRestoreIncludeGlobalState = True
4694+ , snapRestoreRenamePattern = Nothing
4695+ , snapRestoreRenameReplacement = Nothing
4696+ , snapRestorePartial = False
4697+ , snapRestoreIncludeAliases = True
4698+ , snapRestoreIndexSettingsOverrides = Nothing
4699+ , snapRestoreIgnoreIndexSettings = Nothing
4700+ }
4701+
4702+
4703+-- | Index settings that can be overridden. The docs only mention you
4704+-- can update number of replicas, but there may be more. You
4705+-- definitely cannot override shard count.
4706+data RestoreIndexSettings = RestoreIndexSettings {
4707+ restoreOverrideReplicas :: Maybe ReplicaCount
4708+ } deriving (Show, Eq, Generic, Typeable)
4709+
4710+
4711+instance ToJSON RestoreIndexSettings where
4712+ toJSON RestoreIndexSettings {..} = object prs
4713+ where
4714+ prs = catMaybes [("index.number_of_replicas" .=) <$> restoreOverrideReplicas]
4715+
4716+
4717+instance FromJSON NodesInfo where
4718+ parseJSON = withObject "NodesInfo" parse
4719+ where
4720+ parse o = do
4721+ nodes <- o .: "nodes"
4722+ infos <- forM (HM.toList nodes) $ \(fullNID, v) -> do
4723+ node <- parseJSON v
4724+ parseNodeInfo (FullNodeId fullNID) node
4725+ cn <- o .: "cluster_name"
4726+ return (NodesInfo infos cn)
4727+
4728+instance FromJSON NodesStats where
4729+ parseJSON = withObject "NodesStats" parse
4730+ where
4731+ parse o = do
4732+ nodes <- o .: "nodes"
4733+ stats <- forM (HM.toList nodes) $ \(fullNID, v) -> do
4734+ node <- parseJSON v
4735+ parseNodeStats (FullNodeId fullNID) node
4736+ cn <- o .: "cluster_name"
4737+ return (NodesStats stats cn)
4738+
4739+instance FromJSON NodeBreakerStats where
4740+ parseJSON = withObject "NodeBreakerStats" parse
4741+ where
4742+ parse o = NodeBreakerStats <$> o .: "tripped"
4743+ <*> o .: "overhead"
4744+ <*> o .: "estimated_size_in_bytes"
4745+ <*> o .: "limit_size_in_bytes"
4746+
4747+instance FromJSON NodeHTTPStats where
4748+ parseJSON = withObject "NodeHTTPStats" parse
4749+ where
4750+ parse o = NodeHTTPStats <$> o .: "total_opened"
4751+ <*> o .: "current_open"
4752+
4753+instance FromJSON NodeTransportStats where
4754+ parseJSON = withObject "NodeTransportStats" parse
4755+ where
4756+ parse o = NodeTransportStats <$> o .: "tx_size_in_bytes"
4757+ <*> o .: "tx_count"
4758+ <*> o .: "rx_size_in_bytes"
4759+ <*> o .: "rx_count"
4760+ <*> o .: "server_open"
4761+
4762+instance FromJSON NodeFSStats where
4763+ parseJSON = withObject "NodeFSStats" parse
4764+ where
4765+ parse o = NodeFSStats <$> o .: "data"
4766+ <*> o .: "total"
4767+ <*> (posixMS <$> o .: "timestamp")
4768+
4769+instance FromJSON NodeDataPathStats where
4770+ parseJSON = withObject "NodeDataPathStats" parse
4771+ where
4772+ parse o =
4773+ NodeDataPathStats <$> (fmap unStringlyTypedDouble <$> o .:? "disk_service_time")
4774+ <*> (fmap unStringlyTypedDouble <$> o .:? "disk_queue")
4775+ <*> o .:? "disk_io_size_in_bytes"
4776+ <*> o .:? "disk_write_size_in_bytes"
4777+ <*> o .:? "disk_read_size_in_bytes"
4778+ <*> o .:? "disk_io_op"
4779+ <*> o .:? "disk_writes"
4780+ <*> o .:? "disk_reads"
4781+ <*> o .: "available_in_bytes"
4782+ <*> o .: "free_in_bytes"
4783+ <*> o .: "total_in_bytes"
4784+ <*> o .:? "type"
4785+ <*> o .: "dev"
4786+ <*> o .: "mount"
4787+ <*> o .: "path"
4788+
4789+newtype StringlyTypedDouble = StringlyTypedDouble { unStringlyTypedDouble :: Double }
4790+
4791+
4792+instance FromJSON StringlyTypedDouble where
4793+ parseJSON = fmap StringlyTypedDouble . parseJSON . unStringlyTypeJSON
4794+
4795+
4796+instance FromJSON NodeFSTotalStats where
4797+ parseJSON = withObject "NodeFSTotalStats" parse
4798+ where
4799+ parse o = NodeFSTotalStats <$> (fmap unStringlyTypedDouble <$> o .:? "disk_service_time")
4800+ <*> (fmap unStringlyTypedDouble <$> o .:? "disk_queue")
4801+ <*> o .:? "disk_io_size_in_bytes"
4802+ <*> o .:? "disk_write_size_in_bytes"
4803+ <*> o .:? "disk_read_size_in_bytes"
4804+ <*> o .:? "disk_io_op"
4805+ <*> o .:? "disk_writes"
4806+ <*> o .:? "disk_reads"
4807+ <*> o .: "available_in_bytes"
4808+ <*> o .: "free_in_bytes"
4809+ <*> o .: "total_in_bytes"
4810+
4811+instance FromJSON NodeNetworkStats where
4812+ parseJSON = withObject "NodeNetworkStats" parse
4813+ where
4814+ parse o = do
4815+ tcp <- o .: "tcp"
4816+ NodeNetworkStats <$> tcp .: "out_rsts"
4817+ <*> tcp .: "in_errs"
4818+ <*> tcp .: "attempt_fails"
4819+ <*> tcp .: "estab_resets"
4820+ <*> tcp .: "retrans_segs"
4821+ <*> tcp .: "out_segs"
4822+ <*> tcp .: "in_segs"
4823+ <*> tcp .: "curr_estab"
4824+ <*> tcp .: "passive_opens"
4825+ <*> tcp .: "active_opens"
4826+
4827+instance FromJSON NodeThreadPoolsStats where
4828+ parseJSON = withObject "NodeThreadPoolsStats" parse
4829+ where
4830+ parse o = NodeThreadPoolsStats <$> o .: "snapshot"
4831+ <*> o .: "bulk"
4832+ <*> o .: "merge"
4833+ <*> o .: "get"
4834+ <*> o .: "management"
4835+ <*> o .:? "fetch_shard_store"
4836+ <*> o .: "optimize"
4837+ <*> o .: "flush"
4838+ <*> o .: "search"
4839+ <*> o .: "warmer"
4840+ <*> o .: "generic"
4841+ <*> o .: "suggest"
4842+ <*> o .: "refresh"
4843+ <*> o .: "index"
4844+ <*> o .:? "listener"
4845+ <*> o .:? "fetch_shard_started"
4846+ <*> o .: "percolate"
4847+instance FromJSON NodeThreadPoolStats where
4848+ parseJSON = withObject "NodeThreadPoolStats" parse
4849+ where
4850+ parse o = NodeThreadPoolStats <$> o .: "completed"
4851+ <*> o .: "largest"
4852+ <*> o .: "rejected"
4853+ <*> o .: "active"
4854+ <*> o .: "queue"
4855+ <*> o .: "threads"
4856+
4857+instance FromJSON NodeJVMStats where
4858+ parseJSON = withObject "NodeJVMStats" parse
4859+ where
4860+ parse o = do
4861+ bufferPools <- o .: "buffer_pools"
4862+ mapped <- bufferPools .: "mapped"
4863+ direct <- bufferPools .: "direct"
4864+ gc <- o .: "gc"
4865+ collectors <- gc .: "collectors"
4866+ oldC <- collectors .: "old"
4867+ youngC <- collectors .: "young"
4868+ threads <- o .: "threads"
4869+ mem <- o .: "mem"
4870+ pools <- mem .: "pools"
4871+ oldM <- pools .: "old"
4872+ survivorM <- pools .: "survivor"
4873+ youngM <- pools .: "young"
4874+ NodeJVMStats <$> pure mapped
4875+ <*> pure direct
4876+ <*> pure oldC
4877+ <*> pure youngC
4878+ <*> threads .: "peak_count"
4879+ <*> threads .: "count"
4880+ <*> pure oldM
4881+ <*> pure survivorM
4882+ <*> pure youngM
4883+ <*> mem .: "non_heap_committed_in_bytes"
4884+ <*> mem .: "non_heap_used_in_bytes"
4885+ <*> mem .: "heap_max_in_bytes"
4886+ <*> mem .: "heap_committed_in_bytes"
4887+ <*> mem .: "heap_used_percent"
4888+ <*> mem .: "heap_used_in_bytes"
4889+ <*> (unMS <$> o .: "uptime_in_millis")
4890+ <*> (posixMS <$> o .: "timestamp")
4891+
4892+instance FromJSON JVMBufferPoolStats where
4893+ parseJSON = withObject "JVMBufferPoolStats" parse
4894+ where
4895+ parse o = JVMBufferPoolStats <$> o .: "total_capacity_in_bytes"
4896+ <*> o .: "used_in_bytes"
4897+ <*> o .: "count"
4898+
4899+instance FromJSON JVMGCStats where
4900+ parseJSON = withObject "JVMGCStats" parse
4901+ where
4902+ parse o = JVMGCStats <$> (unMS <$> o .: "collection_time_in_millis")
4903+ <*> o .: "collection_count"
4904+
4905+instance FromJSON JVMPoolStats where
4906+ parseJSON = withObject "JVMPoolStats" parse
4907+ where
4908+ parse o = JVMPoolStats <$> o .: "peak_max_in_bytes"
4909+ <*> o .: "peak_used_in_bytes"
4910+ <*> o .: "max_in_bytes"
4911+ <*> o .: "used_in_bytes"
4912+
4913+instance FromJSON NodeProcessStats where
4914+ parseJSON = withObject "NodeProcessStats" parse
4915+ where
4916+ parse o = do
4917+ mem <- o .: "mem"
4918+ cpu <- o .: "cpu"
4919+ NodeProcessStats <$> mem .: "total_virtual_in_bytes"
4920+ <*> mem .: "share_in_bytes"
4921+ <*> mem .: "resident_in_bytes"
4922+ <*> (unMS <$> cpu .: "total_in_millis")
4923+ <*> (unMS <$> cpu .: "user_in_millis")
4924+ <*> (unMS <$> cpu .: "sys_in_millis")
4925+ <*> cpu .: "percent"
4926+ <*> o .: "open_file_descriptors"
4927+ <*> (posixMS <$> o .: "timestamp")
4928+
4929+instance FromJSON NodeOSStats where
4930+ parseJSON = withObject "NodeOSStats" parse
4931+ where
4932+ parse o = do
4933+ swap <- o .: "swap"
4934+ mem <- o .: "mem"
4935+ cpu <- o .: "cpu"
4936+ load <- o .:? "load_average"
4937+ NodeOSStats <$> swap .: "free_in_bytes"
4938+ <*> swap .: "used_in_bytes"
4939+ <*> mem .: "actual_used_in_bytes"
4940+ <*> mem .: "actual_free_in_bytes"
4941+ <*> mem .: "used_percent"
4942+ <*> mem .: "free_percent"
4943+ <*> mem .: "used_in_bytes"
4944+ <*> mem .: "free_in_bytes"
4945+ <*> cpu .: "stolen"
4946+ <*> cpu .: "usage"
4947+ <*> cpu .: "idle"
4948+ <*> cpu .: "user"
4949+ <*> cpu .: "sys"
4950+ <*> pure load
4951+ <*> (unMS <$> o .: "uptime_in_millis")
4952+ <*> (posixMS <$> o .: "timestamp")
4953+
4954+instance FromJSON LoadAvgs where
4955+ parseJSON = withArray "LoadAvgs" parse
4956+ where
4957+ parse v = case V.toList v of
4958+ [one, five, fifteen] -> LoadAvgs <$> parseJSON one
4959+ <*> parseJSON five
4960+ <*> parseJSON fifteen
4961+ _ -> fail "Expecting a triple of Doubles"
4962+
4963+instance FromJSON NodeIndicesStats where
4964+ parseJSON = withObject "NodeIndicesStats" parse
4965+ where
4966+ parse o = do
4967+ let (.::) mv k = case mv of
4968+ Just v -> Just <$> v .: k
4969+ Nothing -> pure Nothing
4970+ mRecovery <- o .:? "recovery"
4971+ mQueryCache <- o .:? "query_cache"
4972+ suggest <- o .: "suggest"
4973+ translog <- o .: "translog"
4974+ segments <- o .: "segments"
4975+ completion <- o .: "completion"
4976+ percolate <- o .: "percolate"
4977+ fielddata <- o .: "fielddata"
4978+ idCache <- o .: "id_cache"
4979+ filterCache <- o .: "filter_cache"
4980+ warmer <- o .: "warmer"
4981+ flush <- o .: "flush"
4982+ refresh <- o .: "refresh"
4983+ merges <- o .: "merges"
4984+ search <- o .: "search"
4985+ getStats <- o .: "get"
4986+ indexing <- o .: "indexing"
4987+ store <- o .: "store"
4988+ docs <- o .: "docs"
4989+ NodeIndicesStats <$> (fmap unMS <$> mRecovery .:: "throttle_time_in_millis")
4990+ <*> mRecovery .:: "current_as_target"
4991+ <*> mRecovery .:: "current_as_source"
4992+ <*> mQueryCache .:: "miss_count"
4993+ <*> mQueryCache .:: "hit_count"
4994+ <*> mQueryCache .:: "evictions"
4995+ <*> mQueryCache .:: "memory_size_in_bytes"
4996+ <*> suggest .: "current"
4997+ <*> (unMS <$> suggest .: "time_in_millis")
4998+ <*> suggest .: "total"
4999+ <*> translog .: "size_in_bytes"
5000+ <*> translog .: "operations"
5001+ <*> segments .:? "fixed_bit_set_memory_in_bytes"
5002+ <*> segments .: "version_map_memory_in_bytes"
5003+ <*> segments .:? "index_writer_max_memory_in_bytes"
5004+ <*> segments .: "index_writer_memory_in_bytes"
5005+ <*> segments .: "memory_in_bytes"
5006+ <*> segments .: "count"
5007+ <*> completion .: "size_in_bytes"
5008+ <*> percolate .: "queries"
5009+ <*> percolate .: "memory_size_in_bytes"
5010+ <*> percolate .: "current"
5011+ <*> (unMS <$> percolate .: "time_in_millis")
5012+ <*> percolate .: "total"
5013+ <*> fielddata .: "evictions"
5014+ <*> fielddata .: "memory_size_in_bytes"
5015+ <*> idCache .: "memory_size_in_bytes"
5016+ <*> filterCache .: "evictions"
5017+ <*> filterCache .: "memory_size_in_bytes"
5018+ <*> (unMS <$> warmer .: "total_time_in_millis")
5019+ <*> warmer .: "total"
5020+ <*> warmer .: "current"
5021+ <*> (unMS <$> flush .: "total_time_in_millis")
5022+ <*> flush .: "total"
5023+ <*> (unMS <$> refresh .: "total_time_in_millis")
5024+ <*> refresh .: "total"
5025+ <*> merges .: "total_size_in_bytes"
5026+ <*> merges .: "total_docs"
5027+ <*> (unMS <$> merges .: "total_time_in_millis")
5028+ <*> merges .: "total"
5029+ <*> merges .: "current_size_in_bytes"
5030+ <*> merges .: "current_docs"
5031+ <*> merges .: "current"
5032+ <*> search .: "fetch_current"
5033+ <*> (unMS <$> search .: "fetch_time_in_millis")
5034+ <*> search .: "fetch_total"
5035+ <*> search .: "query_current"
5036+ <*> (unMS <$> search .: "query_time_in_millis")
5037+ <*> search .: "query_total"
5038+ <*> search .: "open_contexts"
5039+ <*> getStats .: "current"
5040+ <*> (unMS <$> getStats .: "missing_time_in_millis")
5041+ <*> getStats .: "missing_total"
5042+ <*> (unMS <$> getStats .: "exists_time_in_millis")
5043+ <*> getStats .: "exists_total"
5044+ <*> (unMS <$> getStats .: "time_in_millis")
5045+ <*> getStats .: "total"
5046+ <*> (fmap unMS <$> indexing .:? "throttle_time_in_millis")
5047+ <*> indexing .:? "is_throttled"
5048+ <*> indexing .:? "noop_update_total"
5049+ <*> indexing .: "delete_current"
5050+ <*> (unMS <$> indexing .: "delete_time_in_millis")
5051+ <*> indexing .: "delete_total"
5052+ <*> indexing .: "index_current"
5053+ <*> (unMS <$> indexing .: "index_time_in_millis")
5054+ <*> indexing .: "index_total"
5055+ <*> (unMS <$> store .: "throttle_time_in_millis")
5056+ <*> store .: "size_in_bytes"
5057+ <*> docs .: "deleted"
5058+ <*> docs .: "count"
5059+
5060+instance FromJSON NodeBreakersStats where
5061+ parseJSON = withObject "NodeBreakersStats" parse
5062+ where
5063+ parse o = NodeBreakersStats <$> o .: "parent"
5064+ <*> o .: "request"
5065+ <*> o .: "fielddata"
5066+
5067+parseNodeStats :: FullNodeId -> Object -> Parser NodeStats
5068+parseNodeStats fnid o = do
5069+ NodeStats <$> o .: "name"
5070+ <*> pure fnid
5071+ <*> o .:? "breakers"
5072+ <*> o .: "http"
5073+ <*> o .: "transport"
5074+ <*> o .: "fs"
5075+ <*> o .: "network"
5076+ <*> o .: "thread_pool"
5077+ <*> o .: "jvm"
5078+ <*> o .: "process"
5079+ <*> o .: "os"
5080+ <*> o .: "indices"
5081+
5082+parseNodeInfo :: FullNodeId -> Object -> Parser NodeInfo
5083+parseNodeInfo nid o =
5084+ NodeInfo <$> o .: "http_address"
5085+ <*> o .: "build"
5086+ <*> o .: "version"
5087+ <*> o .: "ip"
5088+ <*> o .: "host"
5089+ <*> o .: "transport_address"
5090+ <*> o .: "name"
5091+ <*> pure nid
5092+ <*> o .: "plugins"
5093+ <*> o .: "http"
5094+ <*> o .: "transport"
5095+ <*> o .: "network"
5096+ <*> o .: "thread_pool"
5097+ <*> o .: "jvm"
5098+ <*> o .: "process"
5099+ <*> o .: "os"
5100+ <*> o .: "settings"
5101+
5102+instance FromJSON NodePluginInfo where
5103+ parseJSON = withObject "NodePluginInfo" parse
5104+ where
5105+ parse o = NodePluginInfo <$> o .: "site"
5106+ <*> o .: "jvm"
5107+ <*> o .: "description"
5108+ <*> o .: "version"
5109+ <*> o .: "name"
5110+
5111+instance FromJSON NodeHTTPInfo where
5112+ parseJSON = withObject "NodeHTTPInfo" parse
5113+ where
5114+ parse o = NodeHTTPInfo <$> o .: "max_content_length_in_bytes"
5115+ <*> parseJSON (Object o)
5116+
5117+instance FromJSON BoundTransportAddress where
5118+ parseJSON = withObject "BoundTransportAddress" parse
5119+ where
5120+ parse o = BoundTransportAddress <$> o .: "publish_address"
5121+ <*> o .: "bound_address"
5122+
5123+instance FromJSON NodeOSInfo where
5124+ parseJSON = withObject "NodeOSInfo" parse
5125+ where
5126+ parse o = do
5127+ swap <- o .: "swap"
5128+ mem <- o .: "mem"
5129+ NodeOSInfo <$> swap .: "total_in_bytes"
5130+ <*> mem .: "total_in_bytes"
5131+ <*> o .: "cpu"
5132+ <*> o .: "available_processors"
5133+ <*> (unMS <$> o .: "refresh_interval_in_millis")
5134+
5135+
5136+instance FromJSON CPUInfo where
5137+ parseJSON = withObject "CPUInfo" parse
5138+ where
5139+ parse o = CPUInfo <$> o .: "cache_size_in_bytes"
5140+ <*> o .: "cores_per_socket"
5141+ <*> o .: "total_sockets"
5142+ <*> o .: "total_cores"
5143+ <*> o .: "mhz"
5144+ <*> o .: "model"
5145+ <*> o .: "vendor"
5146+
5147+instance FromJSON NodeProcessInfo where
5148+ parseJSON = withObject "NodeProcessInfo" parse
5149+ where
5150+ parse o = NodeProcessInfo <$> o .: "mlockall"
5151+ <*> o .: "max_file_descriptors"
5152+ <*> o .: "id"
5153+ <*> (unMS <$> o .: "refresh_interval_in_millis")
5154+
5155+instance FromJSON NodeJVMInfo where
5156+ parseJSON = withObject "NodeJVMInfo" parse
5157+ where
5158+ parse o = NodeJVMInfo <$> o .: "memory_pools"
5159+ <*> o .: "gc_collectors"
5160+ <*> o .: "mem"
5161+ <*> (posixMS <$> o .: "start_time_in_millis")
5162+ <*> o .: "vm_vendor"
5163+ <*> o .: "vm_version"
5164+ <*> o .: "vm_name"
5165+ <*> (unJVMVersion <$> o .: "version")
5166+ <*> o .: "pid"
5167+
5168+instance FromJSON JVMVersion where
5169+ parseJSON (String t) =
5170+ JVMVersion <$> parseJSON (String (T.replace "_" "." t))
5171+ parseJSON v = JVMVersion <$> parseJSON v
5172+
5173+instance FromJSON JVMMemoryInfo where
5174+ parseJSON = withObject "JVMMemoryInfo" parse
5175+ where
5176+ parse o = JVMMemoryInfo <$> o .: "direct_max_in_bytes"
5177+ <*> o .: "non_heap_max_in_bytes"
5178+ <*> o .: "non_heap_init_in_bytes"
5179+ <*> o .: "heap_max_in_bytes"
5180+ <*> o .: "heap_init_in_bytes"
5181+
5182+instance FromJSON NodeThreadPoolsInfo where
5183+ parseJSON = withObject "NodeThreadPoolsInfo" parse
5184+ where
5185+ parse o = NodeThreadPoolsInfo <$> o .: "refresh"
5186+ <*> o .: "management"
5187+ <*> o .: "percolate"
5188+ <*> o .:? "listener"
5189+ <*> o .:? "fetch_shard_started"
5190+ <*> o .: "search"
5191+ <*> o .: "flush"
5192+ <*> o .: "warmer"
5193+ <*> o .: "optimize"
5194+ <*> o .: "bulk"
5195+ <*> o .: "suggest"
5196+ <*> o .: "merge"
5197+ <*> o .: "snapshot"
5198+ <*> o .: "get"
5199+ <*> o .:? "fetch_shard_store"
5200+ <*> o .: "index"
5201+ <*> o .: "generic"
5202+
5203+instance FromJSON NodeThreadPoolInfo where
5204+ parseJSON = withObject "NodeThreadPoolInfo" parse
5205+ where
5206+ parse o = do
5207+ ka <- maybe (return Nothing) (fmap Just . parseStringInterval) =<< o .:? "keep_alive"
5208+ NodeThreadPoolInfo <$> (parseJSON . unStringlyTypeJSON =<< o .: "queue_size")
5209+ <*> pure ka
5210+ <*> o .:? "min"
5211+ <*> o .:? "max"
5212+ <*> o .: "type"
5213+
5214+parseStringInterval :: (Monad m) => String -> m NominalDiffTime
5215+parseStringInterval s = case span isNumber s of
5216+ ("", _) -> fail "Invalid interval"
5217+ (nS, unitS) -> case (readMay nS, readMay unitS) of
5218+ (Just n, Just unit) -> return (fromInteger (n * unitNDT unit))
5219+ (Nothing, _) -> fail "Invalid interval number"
5220+ (_, Nothing) -> fail "Invalid interval unit"
5221+ where
5222+ unitNDT Seconds = 1
5223+ unitNDT Minutes = 60
5224+ unitNDT Hours = 60 * 60
5225+ unitNDT Days = 24 * 60 * 60
5226+ unitNDT Weeks = 7 * 24 * 60 * 60
5227+
5228+instance FromJSON ThreadPoolSize where
5229+ parseJSON v = parseAsNumber v <|> parseAsString v
5230+ where
5231+ parseAsNumber = parseAsInt <=< parseJSON
5232+ parseAsInt (-1) = return ThreadPoolUnbounded
5233+ parseAsInt n
5234+ | n >= 0 = return (ThreadPoolBounded n)
5235+ | otherwise = fail "Thread pool size must be >= -1."
5236+ parseAsString = withText "ThreadPoolSize" $ \t ->
5237+ case first (readMay . T.unpack) (T.span isNumber t) of
5238+ (Just n, "k") -> return (ThreadPoolBounded (n * 1000))
5239+ (Just n, "") -> return (ThreadPoolBounded n)
5240+ _ -> fail ("Invalid thread pool size " <> T.unpack t)
5241+
5242+instance FromJSON ThreadPoolType where
5243+ parseJSON = withText "ThreadPoolType" parse
5244+ where
5245+ parse "scaling" = return ThreadPoolScaling
5246+ parse "fixed" = return ThreadPoolFixed
5247+ parse "cached" = return ThreadPoolCached
5248+ parse e = fail ("Unexpected thread pool type" <> T.unpack e)
5249+
5250+instance FromJSON NodeTransportInfo where
5251+ parseJSON = withObject "NodeTransportInfo" parse
5252+ where
5253+ parse o = NodeTransportInfo <$> (maybe (return mempty) parseProfiles =<< o .:? "profiles")
5254+ <*> parseJSON (Object o)
5255+ parseProfiles (Object o) | HM.null o = return []
5256+ parseProfiles v@(Array _) = parseJSON v
5257+ parseProfiles Null = return []
5258+ parseProfiles _ = fail "Could not parse profiles"
5259+
5260+instance FromJSON NodeNetworkInfo where
5261+ parseJSON = withObject "NodeNetworkInfo" parse
5262+ where
5263+ parse o = NodeNetworkInfo <$> o .: "primary_interface"
5264+ <*> (unMS <$> o .: "refresh_interval_in_millis")
5265+
5266+
5267+instance FromJSON NodeNetworkInterface where
5268+ parseJSON = withObject "NodeNetworkInterface" parse
5269+ where
5270+ parse o = NodeNetworkInterface <$> o .: "mac_address"
5271+ <*> o .: "name"
5272+ <*> o .: "address"
5273+
5274+newtype MaybeNA a = MaybeNA { unMaybeNA :: Maybe a }
5275+ deriving (Show, Eq)
5276+
5277+instance FromJSON a => FromJSON (MaybeNA a) where
5278+ parseJSON (String "NA") = pure $ MaybeNA Nothing
5279+ parseJSON o = MaybeNA . Just <$> parseJSON o
src/Database/V1/Bloodhound/Types/Class.hsnew file+17
@@ -0,0 +1,17 @@
1+{-# LANGUAGE CPP #-}
2+module Database.V1.Bloodhound.Types.Class
3+ ( Seminearring(..) )
4+ where
5+
6+#if !MIN_VERSION_base(4,8,0)
7+import Data.Monoid
8+#endif
9+
10+class Monoid a => Seminearring a where
11+ -- 0, +, *
12+ (<||>) :: a -> a -> a
13+ (<&&>) :: a -> a -> a
14+ (<&&>) = mappend
15+
16+infixr 5 <||>
17+infixr 5 <&&>
src/Database/V1/Bloodhound/Types/Internal.hsnew file+57
@@ -0,0 +1,57 @@
1+{-# LANGUAGE DeriveDataTypeable #-}
2+{-# LANGUAGE DeriveGeneric #-}
3+{-# LANGUAGE FlexibleInstances #-}
4+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
5+
6+-------------------------------------------------------------------------------
7+-- |
8+-- Module : Database.Bloodhound.Types.Internal
9+-- Copyright : (C) 2014 Chris Allen
10+-- License : BSD-style (see the file LICENSE)
11+-- Maintainer : Chris Allen <cma@bitemyapp.com>
12+-- Stability : provisional
13+-- Portability : DeriveGeneric, RecordWildCards
14+--
15+-- Internal data types for Bloodhound. These types may change without
16+-- notice so import at your own risk.
17+-------------------------------------------------------------------------------
18+module Database.V1.Bloodhound.Types.Internal
19+ ( BHEnv(..)
20+ , Server(..)
21+ , MonadBH(..)
22+ ) where
23+
24+
25+import Control.Applicative as A
26+import Control.Monad.Reader
27+import Data.Aeson
28+import Data.Text (Text)
29+import Data.Typeable (Typeable)
30+import GHC.Generics (Generic)
31+import Network.HTTP.Client
32+
33+{-| Common environment for Elasticsearch calls. Connections will be
34+ pipelined according to the provided HTTP connection manager.
35+-}
36+data BHEnv = BHEnv { bhServer :: Server
37+ , bhManager :: Manager
38+ , bhRequestHook :: Request -> IO Request
39+ -- ^ Low-level hook that is run before every request is sent. Used to implement custom authentication strategies. Defaults to 'return' with 'mkBHEnv'.
40+ }
41+
42+instance (Functor m, Applicative m, MonadIO m) => MonadBH (ReaderT BHEnv m) where
43+ getBHEnv = ask
44+
45+{-| 'Server' is used with the client functions to point at the ES instance
46+-}
47+newtype Server = Server Text deriving (Eq, Show, Generic, Typeable, FromJSON)
48+
49+{-| All API calls to Elasticsearch operate within
50+ MonadBH
51+ . The idea is that it can be easily embedded in your
52+ own monad transformer stack. A default instance for a ReaderT and
53+ alias 'BH' is provided for the simple case.
54+-}
55+class (Functor m, A.Applicative m, MonadIO m) => MonadBH m where
56+ getBHEnv :: m BHEnv
57+
src/Database/V5/Bloodhound.hsnew file+10
@@ -0,0 +1,10 @@
1+module Database.V5.Bloodhound
2+ ( -- module Data.Aeson.Types
3+ -- ,
4+ module Database.V5.Bloodhound.Client
5+ , module Database.V5.Bloodhound.Types
6+ ) where
7+
8+-- import Data.Aeson.Types
9+import Database.V5.Bloodhound.Client
10+import Database.V5.Bloodhound.Types
src/Database/Bloodhound/Client.hs → src/Database/V5/Bloodhound/Client.hsrenamed+56−148
@@ -5,9 +5,9 @@
5-------------------------------------------------------------------------------
5-------------------------------------------------------------------------------
6-- |
6-- |
7-- Module : Database.Bloodhound.Client
7-- Module : Database.Bloodhound.Client
8−-- Copyright : (C) 2014, 2018 Chris Allen
8+-- Copyright : (C) 2014 Chris Allen
9-- License : BSD-style (see the file LICENSE)
9-- License : BSD-style (see the file LICENSE)
10−-- Maintainer : Chris Allen <cma@bitemyapp.com>
10+-- Maintainer : Chris Allen <cma@bitemyapp.com
11-- Stability : provisional
11-- Stability : provisional
12-- Portability : OverloadedStrings
12-- Portability : OverloadedStrings
13--
13--
@@ -15,7 +15,7 @@
15--
15--
16-------------------------------------------------------------------------------
16-------------------------------------------------------------------------------
17
17
18−module Database.Bloodhound.Client
18+module Database.V5.Bloodhound.Client
19 ( -- * Bloodhound client functions
19 ( -- * Bloodhound client functions
20 -- | The examples in this module assume the following code has been run.
20 -- | The examples in this module assume the following code has been run.
21 -- The :{ and :} will only work in GHCi. You'll only need the data types
21 -- The :{ and :} will only work in GHCi. You'll only need the data types
@@ -25,8 +25,6 @@ module Database.Bloodhound.Client
25 withBH
25 withBH
26 -- ** Indices
26 -- ** Indices
27 , createIndex
27 , createIndex
28− , createIndexWith
29− , flushIndex
30 , deleteIndex
28 , deleteIndex
31 , updateIndexSettings
29 , updateIndexSettings
32 , getIndexSettings
30 , getIndexSettings
@@ -39,7 +37,6 @@ module Database.Bloodhound.Client
39 -- *** Index Aliases
37 -- *** Index Aliases
40 , updateIndexAliases
38 , updateIndexAliases
41 , getIndexAliases
39 , getIndexAliases
42− , deleteIndexAlias
43 -- *** Index Templates
40 -- *** Index Templates
44 , putTemplate
41 , putTemplate
45 , templateExists
42 , templateExists
@@ -55,7 +52,6 @@ module Database.Bloodhound.Client
55 -- ** Searching
52 -- ** Searching
56 , searchAll
53 , searchAll
57 , searchByIndex
54 , searchByIndex
58− , searchByIndices
59 , searchByType
55 , searchByType
60 , scanSearch
56 , scanSearch
61 , getInitialScroll
57 , getInitialScroll
@@ -125,13 +121,12 @@ import qualified Network.HTTP.Types.URI as NHTU
125import qualified Network.URI as URI
121import qualified Network.URI as URI
126import Prelude hiding (filter, head)
122import Prelude hiding (filter, head)
127
123
128−import Database.Bloodhound.Types
124+import Database.V5.Bloodhound.Types
129
125
130-- $setup
126-- $setup
131-- >>> :set -XOverloadedStrings
127-- >>> :set -XOverloadedStrings
132-- >>> :set -XDeriveGeneric
128-- >>> :set -XDeriveGeneric
133−-- >>> import Database.Bloodhound
129+-- >>> import Database.V5.Bloodhound
134−-- >>> import Network.HTTP.Client
135-- >>> let testServer = (Server "http://localhost:9200")
130-- >>> let testServer = (Server "http://localhost:9200")
136-- >>> let runBH' = withBH defaultManagerSettings testServer
131-- >>> let runBH' = withBH defaultManagerSettings testServer
137-- >>> let testIndex = IndexName "twitter"
132-- >>> let testIndex = IndexName "twitter"
@@ -212,16 +207,8 @@ dispatch dMethod url body = do
212 initReq <- liftIO $ parseUrl' url
207 initReq <- liftIO $ parseUrl' url
213 reqHook <- bhRequestHook A.<$> getBHEnv
208 reqHook <- bhRequestHook A.<$> getBHEnv
214 let reqBody = RequestBodyLBS $ fromMaybe emptyBody body
209 let reqBody = RequestBodyLBS $ fromMaybe emptyBody body
215− req <- liftIO
216− $ reqHook
217− $ setRequestIgnoreStatus
218− $ initReq { method = dMethod
219− , requestHeaders =
220− -- "application/x-ndjson" for bulk
221− ("Content-Type", "application/json") : requestHeaders initReq
222− , requestBody = reqBody }
223− -- req <- liftIO $ reqHook $ setRequestIgnoreStatus $ initReq { method = dMethod
210+ req <- liftIO $ reqHook $ setRequestIgnoreStatus $ initReq { method = dMethod
224− -- , requestBody = reqBody }
211+ , requestBody = reqBody }
225 mgr <- bhManager <$> getBHEnv
212 mgr <- bhManager <$> getBHEnv
226 liftIO $ httpLbs req mgr
213 liftIO $ httpLbs req mgr
227
214
@@ -318,7 +305,7 @@ instance FromJSON GSRs where
318 parseJSON = withObject "Collection of GenericSnapshotRepo" parse
305 parseJSON = withObject "Collection of GenericSnapshotRepo" parse
319 where
306 where
320 parse = fmap GSRs . mapM (uncurry go) . HM.toList
307 parse = fmap GSRs . mapM (uncurry go) . HM.toList
321− go rawName = withObject "GenericSnapshotRepo" $ \o ->
308+ go rawName = withObject "GenericSnapshotRepo" $ \o -> do
322 GenericSnapshotRepo (SnapshotRepoName rawName) <$> o .: "type"
309 GenericSnapshotRepo (SnapshotRepoName rawName) <$> o .: "type"
323 <*> o .: "settings"
310 <*> o .: "settings"
324
311
@@ -347,7 +334,7 @@ updateSnapshotRepo SnapshotRepoUpdateSettings {..} repo =
347
334
348
335
349-- | Verify if a snapshot repo is working. __NOTE:__ this API did not
336-- | Verify if a snapshot repo is working. __NOTE:__ this API did not
350−-- make it into Elasticsearch until 1.4. If you use an older version,
337+-- make it into ElasticSearch until 1.4. If you use an older version,
351-- you will get an error here.
338-- you will get an error here.
352verifySnapshotRepo
339verifySnapshotRepo
353 :: ( MonadBH m
340 :: ( MonadBH m
@@ -516,32 +503,8 @@ createIndex indexSettings (IndexName indexName) =
516 where url = joinPath [indexName]
503 where url = joinPath [indexName]
517 body = Just $ encode indexSettings
504 body = Just $ encode indexSettings
518
505
519−-- | Create an index, providing it with any number of settings. This
506+
520−-- is more expressive than 'createIndex' but makes is more verbose
521−-- for the common case of configuring only the shard count and
522−-- replica count.
523−createIndexWith :: MonadBH m
524− => [UpdatableIndexSetting]
525− -> Int -- ^ shard count
526− -> IndexName
527− -> m Reply
528−createIndexWith updates shards (IndexName indexName) =
529− bindM2 put url (return (Just body))
530− where url = joinPath [indexName]
531− body = encode $ object
532− ["settings" .= deepMerge
533− ( HM.singleton "index.number_of_shards" (toJSON shards) :
534− [u | Object u <- toJSON <$> updates]
535− )
536− ]
537−
538−-- | 'flushIndex' will flush an index given a 'Server' and an 'IndexName'.
539−flushIndex :: MonadBH m => IndexName -> m Reply
540−flushIndex (IndexName indexName) = do
541− path <- joinPath [indexName, "_flush"]
542− post path Nothing
543−
544−-- | 'deleteIndex' will delete an index given a 'Server' and an 'IndexName'.
507+-- | 'deleteIndex' will delete an index given a 'Server', and an 'IndexName'.
545--
508--
546-- >>> _ <- runBH' $ createIndex defaultIndexSettings (IndexName "didimakeanindex")
509-- >>> _ <- runBH' $ createIndex defaultIndexSettings (IndexName "didimakeanindex")
547-- >>> response <- runBH' $ deleteIndex (IndexName "didimakeanindex")
510-- >>> response <- runBH' $ deleteIndex (IndexName "didimakeanindex")
@@ -562,21 +525,20 @@ deleteIndex (IndexName indexName) =
562updateIndexSettings :: MonadBH m => NonEmpty UpdatableIndexSetting -> IndexName -> m Reply
525updateIndexSettings :: MonadBH m => NonEmpty UpdatableIndexSetting -> IndexName -> m Reply
563updateIndexSettings updates (IndexName indexName) =
526updateIndexSettings updates (IndexName indexName) =
564 bindM2 put url (return body)
527 bindM2 put url (return body)
565− where
566− url = joinPath [indexName, "_settings"]
528+ where url = joinPath [indexName, "_settings"]
567− body = Just (encode jsonBody)
529+ body = Just (encode jsonBody)
568− jsonBody = Object (deepMerge [u | Object u <- toJSON <$> toList updates])
530+ jsonBody = Object (deepMerge [u | Object u <- toJSON <$> toList updates])
569
531
570
532
571getIndexSettings :: (MonadBH m, MonadThrow m) => IndexName
533getIndexSettings :: (MonadBH m, MonadThrow m) => IndexName
572 -> m (Either EsError IndexSettingsSummary)
534 -> m (Either EsError IndexSettingsSummary)
573−getIndexSettings (IndexName indexName) =
535+getIndexSettings (IndexName indexName) = do
574 parseEsResponse =<< get =<< url
536 parseEsResponse =<< get =<< url
575− where
576− url = joinPath [indexName, "_settings"]
537+ where url = joinPath [indexName, "_settings"]
577
538
539+
578−-- | 'forceMergeIndex'
540+-- | 'forceMergeIndex'
579−--
541+--
580-- The force merge API allows to force merging of one or more indices through
542-- The force merge API allows to force merging of one or more indices through
581-- an API. The merge relates to the number of segments a Lucene index holds
543-- an API. The merge relates to the number of segments a Lucene index holds
582-- within each shard. The force merge operation allows to reduce the number of
544-- within each shard. The force merge operation allows to reduce the number of
@@ -638,25 +600,20 @@ existentialQuery url = do
638-- responses from elasticsearch should fall into these two
600-- responses from elasticsearch should fall into these two
639-- categories. If they don't, a 'EsProtocolException' will be
601-- categories. If they don't, a 'EsProtocolException' will be
640-- thrown. If you encounter this, please report the full body it
602-- thrown. If you encounter this, please report the full body it
641−-- reports along with your Elasticsearch verison.
603+-- reports along with your ElasticSearch verison.
642−parseEsResponse :: ( MonadThrow m
604+parseEsResponse :: (MonadThrow m, FromJSON a) => Reply
643− , FromJSON a
644− )
645− => Reply
646 -> m (Either EsError a)
605 -> m (Either EsError a)
647parseEsResponse reply
606parseEsResponse reply
648 | respIsTwoHunna reply = case eitherDecode body of
607 | respIsTwoHunna reply = case eitherDecode body of
649 Right a -> return (Right a)
608 Right a -> return (Right a)
650− Left err ->
609+ Left _ -> tryParseError
651− tryParseError err
652− | otherwise = tryParseError "Non-200 status code"
610+ | otherwise = tryParseError
653 where body = responseBody reply
611 where body = responseBody reply
654− tryParseError originalError
655− = case eitherDecode body of
612+ tryParseError = case eitherDecode body of
656− Right e -> return (Left e)
613+ Right e -> return (Left e)
657− -- Failed to parse the error message.
614+ -- this case should not be possible
658− Left err -> explode ("Original error was: " <> originalError <> " Error parse failure was: " <> err)
615+ Left _ -> explode
659− explode errorMsg = throwM (EsProtocolException (T.pack errorMsg) body)
616+ explode = throwM (EsProtocolException body)
660
617
661-- | 'indexExists' enables you to check if an index exists. Returns 'Bool'
618-- | 'indexExists' enables you to check if an index exists. Returns 'Bool'
662-- in IO
619-- in IO
@@ -715,16 +672,14 @@ listIndices :: (MonadThrow m, MonadBH m) => m [IndexName]
715listIndices =
672listIndices =
716 parse . responseBody =<< get =<< url
673 parse . responseBody =<< get =<< url
717 where
674 where
718− url = joinPath ["_cat/indices?format=json"]
675+ url = joinPath ["_cat/indices?v"]
719− parse body = either (\msg -> (throwM (EsProtocolException (T.pack msg) body))) return $ do
676+ -- parses the tabular format the indices api provides
720− vals <- eitherDecode body
677+ parse body = case T.lines (T.decodeUtf8 (L.toStrict body)) of
721− forM vals $ \val ->
678+ (hdr:rows) -> let ks = T.words hdr
722− case val of
679+ keyedRows = [ HM.fromList (zip ks (T.words row)) | row <- rows ]
723− Object obj ->
724− case HM.lookup "index" obj of
680+ names = catMaybes (HM.lookup "index" <$> keyedRows)
725− (Just (String txt)) -> Right (IndexName txt)
681+ in return (IndexName <$> names)
726− v -> Left $ "indexVal in listIndices failed on non-string, was: " <> show v
682+ [] -> throwM (EsProtocolException body)
727− v -> Left $ "One of the values parsed in listIndices wasn't an object, it was: " <> show v
728
683
729-- | 'updateIndexAliases' updates the server's index alias
684-- | 'updateIndexAliases' updates the server's index alias
730-- table. Operations are atomic. Explained in further detail at
685-- table. Operations are atomic. Explained in further detail at
@@ -755,12 +710,6 @@ getIndexAliases :: (MonadBH m, MonadThrow m)
755getIndexAliases = parseEsResponse =<< get =<< url
710getIndexAliases = parseEsResponse =<< get =<< url
756 where url = joinPath ["_aliases"]
711 where url = joinPath ["_aliases"]
757
712
758−-- | Delete a single alias, removing it from all indices it
759−-- is currently associated with.
760−deleteIndexAlias :: MonadBH m => IndexAliasName -> m Reply
761−deleteIndexAlias (IndexAliasName (IndexName name)) = delete =<< url
762− where url = joinPath ["_all","_alias",name]
763−
764-- | 'putTemplate' creates a template given an 'IndexTemplate' and a 'TemplateName'.
713-- | 'putTemplate' creates a template given an 'IndexTemplate' and a 'TemplateName'.
765-- Explained in further detail at
714-- Explained in further detail at
766-- <https://www.elastic.co/guide/en/elasticsearch/reference/1.7/indices-templates.html>
715-- <https://www.elastic.co/guide/en/elasticsearch/reference/1.7/indices-templates.html>
@@ -823,10 +772,7 @@ versionCtlParams cfg =
823-- | 'indexDocument' is the primary way to save a single document in
772-- | 'indexDocument' is the primary way to save a single document in
824-- Elasticsearch. The document itself is simply something we can
773-- Elasticsearch. The document itself is simply something we can
825-- convert into a JSON 'Value'. The 'DocId' will function as the
774-- convert into a JSON 'Value'. The 'DocId' will function as the
826−-- primary key for the document. You are encouraged to generate
775+-- primary key for the document.
827−-- your own id's and not rely on Elasticsearch's automatic id
828−-- generation. Read more about it here:
829−-- https://github.com/bitemyapp/bloodhound/issues/107
830--
776--
831-- >>> resp <- runBH' $ indexDocument testIndex testMapping defaultIndexDocumentSettings exampleTweet (DocId "1")
777-- >>> resp <- runBH' $ indexDocument testIndex testMapping defaultIndexDocumentSettings exampleTweet (DocId "1")
832-- >>> print resp
778-- >>> print resp
@@ -874,11 +820,9 @@ deleteDocument (IndexName indexName)
874-- >>> _ <- runBH' $ bulk stream
820-- >>> _ <- runBH' $ bulk stream
875-- >>> _ <- runBH' $ refreshIndex testIndex
821-- >>> _ <- runBH' $ refreshIndex testIndex
876bulk :: MonadBH m => V.Vector BulkOperation -> m Reply
822bulk :: MonadBH m => V.Vector BulkOperation -> m Reply
877−bulk bulkOps =
878− bindM2 post url (return body)
823+bulk bulkOps = bindM2 post url (return body)
879− where
880− url = joinPath ["_bulk"]
824+ where url = joinPath ["_bulk"]
881− body = Just $ encodeBulkOperations bulkOps
825+ body = Just $ encodeBulkOperations bulkOps
882
826
883-- | 'encodeBulkOperations' is a convenience function for dumping a vector of 'BulkOperation'
827-- | 'encodeBulkOperations' is a convenience function for dumping a vector of 'BulkOperation'
884-- into an 'L.ByteString'
828-- into an 'L.ByteString'
@@ -888,15 +832,12 @@ bulk bulkOps =
888-- "\n{\"index\":{\"_type\":\"tweet\",\"_id\":\"2\",\"_index\":\"twitter\"}}\n{\"name\":\"blah\"}\n"
832-- "\n{\"index\":{\"_type\":\"tweet\",\"_id\":\"2\",\"_index\":\"twitter\"}}\n{\"name\":\"blah\"}\n"
889encodeBulkOperations :: V.Vector BulkOperation -> L.ByteString
833encodeBulkOperations :: V.Vector BulkOperation -> L.ByteString
890encodeBulkOperations stream = collapsed where
834encodeBulkOperations stream = collapsed where
891− blobs =
892− fmap encodeBulkOperation stream
835+ blobs = fmap encodeBulkOperation stream
893− mashedTaters =
894− mash (mempty :: Builder) blobs
836+ mashedTaters = mash (mempty :: Builder) blobs
895− collapsed =
896− toLazyByteString $ mappend mashedTaters (byteString "\n")
837+ collapsed = toLazyByteString $ mappend mashedTaters (byteString "\n")
897
838
898mash :: Builder -> V.Vector L.ByteString -> Builder
839mash :: Builder -> V.Vector L.ByteString -> Builder
899−mash = V.foldl' (\b x -> b <> byteString "\n" <> lazyByteString x)
840+mash = V.foldl' (\b x -> b `mappend` (byteString "\n") `mappend` (lazyByteString x))
900
841
901mkBulkStreamValue :: Text -> Text -> Text -> Text -> Value
842mkBulkStreamValue :: Text -> Text -> Text -> Text -> Value
902mkBulkStreamValue operation indexName mappingName docId =
843mkBulkStreamValue operation indexName mappingName docId =
@@ -905,12 +846,6 @@ mkBulkStreamValue operation indexName mappingName docId =
905 , "_type" .= mappingName
846 , "_type" .= mappingName
906 , "_id" .= docId]]
847 , "_id" .= docId]]
907
848
908−mkBulkStreamValueAuto :: Text -> Text -> Text -> Value
909−mkBulkStreamValueAuto operation indexName mappingName =
910− object [operation .=
911− object [ "_index" .= indexName
912− , "_type" .= mappingName]]
913−
914-- | 'encodeBulkOperation' is a convenience function for dumping a single 'BulkOperation'
849-- | 'encodeBulkOperation' is a convenience function for dumping a single 'BulkOperation'
915-- into an 'L.ByteString'
850-- into an 'L.ByteString'
916--
851--
@@ -924,18 +859,6 @@ encodeBulkOperation (BulkIndex (IndexName indexName)
924 where metadata = mkBulkStreamValue "index" indexName mappingName docId
859 where metadata = mkBulkStreamValue "index" indexName mappingName docId
925 blob = encode metadata `mappend` "\n" `mappend` encode value
860 blob = encode metadata `mappend` "\n" `mappend` encode value
926
861
927−encodeBulkOperation (BulkIndexAuto (IndexName indexName)
928− (MappingName mappingName)
929− value) = blob
930− where metadata = mkBulkStreamValueAuto "index" indexName mappingName
931− blob = encode metadata `mappend` "\n" `mappend` encode value
932−
933−encodeBulkOperation (BulkIndexEncodingAuto (IndexName indexName)
934− (MappingName mappingName)
935− encoding) = toLazyByteString blob
936− where metadata = toEncoding (mkBulkStreamValueAuto "index" indexName mappingName)
937− blob = fromEncoding metadata <> "\n" <> fromEncoding encoding
938−
939encodeBulkOperation (BulkCreate (IndexName indexName)
862encodeBulkOperation (BulkCreate (IndexName indexName)
940 (MappingName mappingName)
863 (MappingName mappingName)
941 (DocId docId) value) = blob
864 (DocId docId) value) = blob
@@ -955,12 +878,6 @@ encodeBulkOperation (BulkUpdate (IndexName indexName)
955 doc = object ["doc" .= value]
878 doc = object ["doc" .= value]
956 blob = encode metadata `mappend` "\n" `mappend` encode doc
879 blob = encode metadata `mappend` "\n" `mappend` encode doc
957
880
958−encodeBulkOperation (BulkCreateEncoding (IndexName indexName)
959− (MappingName mappingName)
960− (DocId docId) encoding) = toLazyByteString blob
961− where metadata = toEncoding (mkBulkStreamValue "create" indexName mappingName docId)
962− blob = fromEncoding metadata <> "\n" <> fromEncoding encoding
963−
964-- | 'getDocument' is a straight-forward way to fetch a single document from
881-- | 'getDocument' is a straight-forward way to fetch a single document from
965-- Elasticsearch using a 'Server', 'IndexName', 'MappingName', and a 'DocId'.
882-- Elasticsearch using a 'Server', 'IndexName', 'MappingName', and a 'DocId'.
966-- The 'DocId' is the primary key for your Elasticsearch document.
883-- The 'DocId' is the primary key for your Elasticsearch document.
@@ -1010,15 +927,6 @@ searchByIndex :: MonadBH m => IndexName -> Search -> m Reply
1010searchByIndex (IndexName indexName) = bindM2 dispatchSearch url . return
927searchByIndex (IndexName indexName) = bindM2 dispatchSearch url . return
1011 where url = joinPath [indexName, "_search"]
928 where url = joinPath [indexName, "_search"]
1012
929
1013−-- | 'searchByIndices' is a variant of 'searchByIndex' that executes a
1014−-- 'Search' over many indices. This is much faster than using
1015−-- 'mapM' to 'searchByIndex' over a collection since it only
1016−-- causes a single HTTP request to be emitted.
1017−searchByIndices :: MonadBH m => NonEmpty IndexName -> Search -> m Reply
1018−searchByIndices ixs = bindM2 dispatchSearch url . return
1019− where url = joinPath [renderedIxs, "_search"]
1020− renderedIxs = T.intercalate (T.singleton ',') (map (\(IndexName t) -> t) (toList ixs))
1021−
1022-- | 'searchByType', given a 'Search', 'IndexName', and 'MappingName', will perform that
930-- | 'searchByType', given a 'Search', 'IndexName', and 'MappingName', will perform that
1023-- search against a specific mapping within an index on an Elasticsearch server.
931-- search against a specific mapping within an index on an Elasticsearch server.
1024--
932--
@@ -1035,10 +943,10 @@ searchByType (IndexName indexName)
1035-- search results. Note that the search is put into 'SearchTypeScan'
943-- search results. Note that the search is put into 'SearchTypeScan'
1036-- mode and thus results will not be sorted. Combine this with
944-- mode and thus results will not be sorted. Combine this with
1037-- 'advanceScroll' to efficiently stream through the full result set
945-- 'advanceScroll' to efficiently stream through the full result set
1038−getInitialScroll ::
946+getInitialScroll ::
1039− (FromJSON a, MonadThrow m, MonadBH m) => IndexName ->
947+ (FromJSON a, MonadThrow m, MonadBH m) => IndexName ->
1040− MappingName ->
948+ MappingName ->
1041− Search ->
949+ Search ->
1042 m (Either EsError (SearchResult a))
950 m (Either EsError (SearchResult a))
1043getInitialScroll (IndexName indexName) (MappingName mappingName) search' = do
951getInitialScroll (IndexName indexName) (MappingName mappingName) search' = do
1044 let url = addQuery params <$> joinPath [indexName, mappingName, "_search"]
952 let url = addQuery params <$> joinPath [indexName, mappingName, "_search"]
@@ -1063,7 +971,7 @@ getInitialSortedScroll (IndexName indexName) (MappingName mappingName) search =
1063 resp' <- bindM2 dispatchSearch url (return search)
971 resp' <- bindM2 dispatchSearch url (return search)
1064 parseEsResponse resp'
972 parseEsResponse resp'
1065
973
1066−scroll' :: (FromJSON a, MonadBH m, MonadThrow m) => Maybe ScrollId ->
974+scroll' :: (FromJSON a, MonadBH m, MonadThrow m) => Maybe ScrollId ->
1067 m ([Hit a], Maybe ScrollId)
975 m ([Hit a], Maybe ScrollId)
1068scroll' Nothing = return ([], Nothing)
976scroll' Nothing = return ([], Nothing)
1069scroll' (Just sid) = do
977scroll' (Just sid) = do
@@ -1090,13 +998,13 @@ advanceScroll (ScrollId sid) scroll = do
1090 where scrollTime = showText secs <> "s"
998 where scrollTime = showText secs <> "s"
1091 secs :: Integer
999 secs :: Integer
1092 secs = round scroll
1000 secs = round scroll
1093−
1001+
1094 scrollObject = object [ "scroll" .= scrollTime
1002 scrollObject = object [ "scroll" .= scrollTime
1095 , "scroll_id" .= sid
1003 , "scroll_id" .= sid
1096 ]
1004 ]
1097
1005
1098−simpleAccumulator ::
1006+simpleAccumulator ::
1099− (FromJSON a, MonadBH m, MonadThrow m) =>
1007+ (FromJSON a, MonadBH m, MonadThrow m) =>
1100 [Hit a] ->
1008 [Hit a] ->
1101 ([Hit a], Maybe ScrollId) ->
1009 ([Hit a], Maybe ScrollId) ->
1102 m ([Hit a], Maybe ScrollId)
1010 m ([Hit a], Maybe ScrollId)
@@ -1134,9 +1042,9 @@ scanSearch indexName mappingName search = do
1134--
1042--
1135-- >>> let query = TermQuery (Term "user" "bitemyapp") Nothing
1043-- >>> let query = TermQuery (Term "user" "bitemyapp") Nothing
1136-- >>> mkSearch (Just query) Nothing
1044-- >>> mkSearch (Just query) Nothing
1137−-- Search {queryBody = Just (TermQuery (Term {termField = "user", termValue = "bitemyapp"}) Nothing), filterBody = Nothing, searchAfterKey = Nothing, sortBody = Nothing, aggBody = Nothing, highlight = Nothing, trackSortScores = False, from = From 0, size = Size 10, searchType = SearchTypeQueryThenFetch, fields = Nothing, source = Nothing}
1045+-- Search {queryBody = Just (TermQuery (Term {termField = "user", termValue = "bitemyapp"}) Nothing), filterBody = Nothing, sortBody = Nothing, aggBody = Nothing, highlight = Nothing, trackSortScores = False, from = From 0, size = Size 10, searchType = SearchTypeQueryThenFetch, fields = Nothing, source = Nothing}
1138mkSearch :: Maybe Query -> Maybe Filter -> Search
1046mkSearch :: Maybe Query -> Maybe Filter -> Search
1139−mkSearch query filter = Search query filter Nothing Nothing Nothing False (From 0) (Size 10) SearchTypeQueryThenFetch Nothing Nothing Nothing Nothing Nothing
1047+mkSearch query filter = Search query filter Nothing Nothing Nothing False (From 0) (Size 10) SearchTypeQueryThenFetch Nothing Nothing
1140
1048
1141-- | 'mkAggregateSearch' is a helper function that defaults everything in a 'Search' except for
1049-- | 'mkAggregateSearch' is a helper function that defaults everything in a 'Search' except for
1142-- the 'Query' and the 'Aggregation'.
1050-- the 'Query' and the 'Aggregation'.
@@ -1146,7 +1054,7 @@ mkSearch query filter = Search query filter Nothing Nothing Nothing False (From
1146-- TermsAgg (TermsAggregation {term = Left "user", termInclude = Nothing, termExclude = Nothing, termOrder = Nothing, termMinDocCount = Nothing, termSize = Nothing, termShardSize = Nothing, termCollectMode = Just BreadthFirst, termExecutionHint = Nothing, termAggs = Nothing})
1054-- TermsAgg (TermsAggregation {term = Left "user", termInclude = Nothing, termExclude = Nothing, termOrder = Nothing, termMinDocCount = Nothing, termSize = Nothing, termShardSize = Nothing, termCollectMode = Just BreadthFirst, termExecutionHint = Nothing, termAggs = Nothing})
1147-- >>> let myAggregation = mkAggregateSearch Nothing $ mkAggregations "users" terms
1055-- >>> let myAggregation = mkAggregateSearch Nothing $ mkAggregations "users" terms
1148mkAggregateSearch :: Maybe Query -> Aggregations -> Search
1056mkAggregateSearch :: Maybe Query -> Aggregations -> Search
1149−mkAggregateSearch query mkSearchAggs = Search query Nothing Nothing (Just mkSearchAggs) Nothing False (From 0) (Size 0) SearchTypeQueryThenFetch Nothing Nothing Nothing Nothing Nothing
1057+mkAggregateSearch query mkSearchAggs = Search query Nothing Nothing (Just mkSearchAggs) Nothing False (From 0) (Size 0) SearchTypeQueryThenFetch Nothing Nothing
1150
1058
1151-- | 'mkHighlightSearch' is a helper function that defaults everything in a 'Search' except for
1059-- | 'mkHighlightSearch' is a helper function that defaults everything in a 'Search' except for
1152-- the 'Query' and the 'Aggregation'.
1060-- the 'Query' and the 'Aggregation'.
@@ -1155,7 +1063,7 @@ mkAggregateSearch query mkSearchAggs = Search query Nothing Nothing (Just mkSear
1155-- >>> let testHighlight = Highlights Nothing [FieldHighlight (FieldName "message") Nothing]
1063-- >>> let testHighlight = Highlights Nothing [FieldHighlight (FieldName "message") Nothing]
1156-- >>> let search = mkHighlightSearch (Just query) testHighlight
1064-- >>> let search = mkHighlightSearch (Just query) testHighlight
1157mkHighlightSearch :: Maybe Query -> Highlights -> Search
1065mkHighlightSearch :: Maybe Query -> Highlights -> Search
1158−mkHighlightSearch query searchHighlights = Search query Nothing Nothing Nothing (Just searchHighlights) False (From 0) (Size 10) SearchTypeQueryThenFetch Nothing Nothing Nothing Nothing Nothing
1066+mkHighlightSearch query searchHighlights = Search query Nothing Nothing Nothing (Just searchHighlights) False (From 0) (Size 10) SearchTypeQueryThenFetch Nothing Nothing
1159
1067
1160-- | 'pageSearch' is a helper function that takes a search and assigns the from
1068-- | 'pageSearch' is a helper function that takes a search and assigns the from
1161-- and size fields for the search. The from parameter defines the offset
1069-- and size fields for the search. The from parameter defines the offset
src/Database/V5/Bloodhound/Types.hsnew file+5033
@@ -0,0 +1,5033 @@
1+{-# LANGUAGE DeriveDataTypeable #-}
2+{-# LANGUAGE DeriveGeneric #-}
3+{-# LANGUAGE FlexibleContexts #-}
4+{-# LANGUAGE FlexibleInstances #-}
5+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
6+{-# LANGUAGE MultiParamTypeClasses #-}
7+-- {-# LANGUAGE NoMonomorphismRestriction #-}
8+{-# LANGUAGE NamedFieldPuns #-}
9+{-# LANGUAGE OverloadedStrings #-}
10+{-# LANGUAGE RecordWildCards #-}
11+{-# LANGUAGE UndecidableInstances #-}
12+
13+-------------------------------------------------------------------------------
14+-- |
15+-- Module : Database.Bloodhound.Types
16+-- Copyright : (C) 2014, 2015, 2016 Chris Allen
17+-- License : BSD-style (see the file LICENSE)
18+-- Maintainer : Chris Allen <cma@bitemyapp.com
19+-- Stability : provisional
20+-- Portability : DeriveGeneric, RecordWildCards
21+--
22+-- Data types for describing actions and data structures performed to interact
23+-- with Elasticsearch. The two main buckets your queries against Elasticsearch
24+-- will fall into are 'Query's and 'Filter's. 'Filter's are more like
25+-- traditional database constraints and often have preferable performance
26+-- properties. 'Query's support human-written textual queries, such as fuzzy
27+-- queries.
28+-------------------------------------------------------------------------------
29+
30+
31+
32+module Database.V5.Bloodhound.Types
33+ ( defaultCache
34+ , defaultIndexSettings
35+ , defaultIndexDocumentSettings
36+ , mkSort
37+ , showText
38+ , unpackId
39+ , mkMatchQuery
40+ , mkMultiMatchQuery
41+ , mkBoolQuery
42+ , mkRangeQuery
43+ , mkQueryStringQuery
44+ , mkAggregations
45+ , mkTermsAggregation
46+ , mkTermsScriptAggregation
47+ , mkDateHistogram
48+ , mkCardinalityAggregation
49+ , mkDocVersion
50+ , docVersionNumber
51+ , toMissing
52+ , toTerms
53+ , toDateHistogram
54+ , toTopHits
55+ , omitNulls
56+ , BH(..)
57+ , runBH
58+ , BHEnv
59+ , bhServer
60+ , bhManager
61+ , bhRequestHook
62+ , mkBHEnv
63+ , MonadBH(..)
64+ , Version(..)
65+ , VersionNumber(..)
66+ , MaybeNA(..)
67+ , BuildHash(..)
68+ , Status(..)
69+ , Existence(..)
70+ , NullValue(..)
71+ , IndexSettings(..)
72+ , UpdatableIndexSetting(..)
73+ , IndexSettingsSummary(..)
74+ , AllocationPolicy(..)
75+ , ReplicaBounds(..)
76+ , Bytes(..)
77+ , gigabytes
78+ , megabytes
79+ , kilobytes
80+ , FSType(..)
81+ , InitialShardCount(..)
82+ , NodeAttrFilter(..)
83+ , NodeAttrName(..)
84+ , CompoundFormat(..)
85+ , IndexTemplate(..)
86+ , Server(..)
87+ , Reply
88+ , EsResult(..)
89+ , EsResultFound(..)
90+ , EsError(..)
91+ , EsProtocolException(..)
92+ , IndexAlias(..)
93+ , IndexAliasName(..)
94+ , IndexAliasAction(..)
95+ , IndexAliasCreate(..)
96+ , IndexAliasSummary(..)
97+ , IndexAliasesSummary(..)
98+ , AliasRouting(..)
99+ , SearchAliasRouting(..)
100+ , IndexAliasRouting(..)
101+ , RoutingValue(..)
102+ , DocVersion
103+ , ExternalDocVersion(..)
104+ , VersionControl(..)
105+ , DocumentParent(..)
106+ , IndexDocumentSettings(..)
107+ , Query(..)
108+ , Search(..)
109+ , SearchType(..)
110+ , SearchResult(..)
111+ , ScrollId(..)
112+ , SearchHits(..)
113+ , TrackSortScores
114+ , From(..)
115+ , Size(..)
116+ , Source(..)
117+ , PatternOrPatterns(..)
118+ , Include(..)
119+ , Exclude(..)
120+ , Pattern(..)
121+ , ShardResult(..)
122+ , Hit(..)
123+ , Filter(..)
124+ , Seminearring(..)
125+ , BoolMatch(..)
126+ , Term(..)
127+ , GeoPoint(..)
128+ , GeoBoundingBoxConstraint(..)
129+ , GeoBoundingBox(..)
130+ , GeoFilterType(..)
131+ , Distance(..)
132+ , DistanceUnit(..)
133+ , DistanceType(..)
134+ , DistanceRange(..)
135+ , OptimizeBbox(..)
136+ , LatLon(..)
137+ , RangeValue(..)
138+ , RangeExecution(..)
139+ , LessThan(..)
140+ , LessThanEq(..)
141+ , GreaterThan(..)
142+ , GreaterThanEq(..)
143+ , LessThanD(..)
144+ , LessThanEqD(..)
145+ , GreaterThanD(..)
146+ , GreaterThanEqD(..)
147+ , Regexp(..)
148+ , RegexpFlags(..)
149+ , RegexpFlag(..)
150+ , FieldName(..)
151+ , Script(..)
152+ , IndexName(..)
153+ , IndexSelection(..)
154+ , NodeSelection(..)
155+ , NodeSelector(..)
156+ , ForceMergeIndexSettings(..)
157+ , defaultForceMergeIndexSettings
158+ , TemplateName(..)
159+ , TemplatePattern(..)
160+ , MappingName(..)
161+ , DocId(..)
162+ , CacheName(..)
163+ , CacheKey(..)
164+ , BulkOperation(..)
165+ , ReplicaCount(..)
166+ , ShardCount(..)
167+ , Sort
168+ , SortMode(..)
169+ , SortOrder(..)
170+ , SortSpec(..)
171+ , DefaultSort(..)
172+ , Missing(..)
173+ , OpenCloseIndex(..)
174+ , Method
175+ , Boost(..)
176+ , MatchQuery(..)
177+ , MultiMatchQuery(..)
178+ , BoolQuery(..)
179+ , BoostingQuery(..)
180+ , CommonTermsQuery(..)
181+ , DisMaxQuery(..)
182+ , FuzzyLikeThisQuery(..)
183+ , FuzzyLikeFieldQuery(..)
184+ , FuzzyQuery(..)
185+ , HasChildQuery(..)
186+ , HasParentQuery(..)
187+ , IndicesQuery(..)
188+ , MoreLikeThisQuery(..)
189+ , MoreLikeThisFieldQuery(..)
190+ , NestedQuery(..)
191+ , PrefixQuery(..)
192+ , QueryStringQuery(..)
193+ , SimpleQueryStringQuery(..)
194+ , RangeQuery(..)
195+ , RegexpQuery(..)
196+ , QueryString(..)
197+ , BooleanOperator(..)
198+ , ZeroTermsQuery(..)
199+ , CutoffFrequency(..)
200+ , Analyzer(..)
201+ , MaxExpansions(..)
202+ , Lenient(..)
203+ , MatchQueryType(..)
204+ , MultiMatchQueryType(..)
205+ , Tiebreaker(..)
206+ , MinimumMatch(..)
207+ , DisableCoord(..)
208+ , CommonMinimumMatch(..)
209+ , MinimumMatchHighLow(..)
210+ , PrefixLength(..)
211+ , Fuzziness(..)
212+ , IgnoreTermFrequency(..)
213+ , MaxQueryTerms(..)
214+ , ScoreType(..)
215+ , Score
216+ , Cache
217+ , TypeName(..)
218+ , BoostTerms(..)
219+ , MaxWordLength(..)
220+ , MinWordLength(..)
221+ , MaxDocFrequency(..)
222+ , MinDocFrequency(..)
223+ , PhraseSlop(..)
224+ , StopWord(..)
225+ , QueryPath(..)
226+ , MinimumTermFrequency(..)
227+ , PercentMatch(..)
228+ , FieldDefinition(..)
229+ , MappingField(..)
230+ , Mapping(..)
231+ , AllowLeadingWildcard(..)
232+ , LowercaseExpanded(..)
233+ , GeneratePhraseQueries(..)
234+ , Locale(..)
235+ , AnalyzeWildcard(..)
236+ , EnablePositionIncrements(..)
237+ , SimpleQueryFlag(..)
238+ , FieldOrFields(..)
239+ , Monoid(..)
240+ , ToJSON(..)
241+ , Interval(..)
242+ , TimeInterval(..)
243+ , ExecutionHint(..)
244+ , CollectionMode(..)
245+ , TermOrder(..)
246+ , TermInclusion(..)
247+ , SnapshotRepoSelection(..)
248+ , GenericSnapshotRepo(..)
249+ , SnapshotRepo(..)
250+ , SnapshotRepoConversionError(..)
251+ , SnapshotRepoType(..)
252+ , GenericSnapshotRepoSettings(..)
253+ , SnapshotRepoUpdateSettings(..)
254+ , defaultSnapshotRepoUpdateSettings
255+ , SnapshotRepoName(..)
256+ , SnapshotRepoPattern(..)
257+ , SnapshotVerification(..)
258+ , SnapshotNodeVerification(..)
259+ , FullNodeId(..)
260+ , NodeName(..)
261+ , ClusterName(..)
262+ , NodesInfo(..)
263+ , NodesStats(..)
264+ , NodeStats(..)
265+ , NodeBreakersStats(..)
266+ , NodeBreakerStats(..)
267+ , NodeHTTPStats(..)
268+ , NodeTransportStats(..)
269+ , NodeFSStats(..)
270+ , NodeDataPathStats(..)
271+ , NodeFSTotalStats(..)
272+ , NodeNetworkStats(..)
273+ , NodeThreadPoolsStats(..)
274+ , NodeThreadPoolStats(..)
275+ , NodeJVMStats(..)
276+ , JVMBufferPoolStats(..)
277+ , JVMGCStats(..)
278+ , JVMPoolStats(..)
279+ , NodeProcessStats(..)
280+ , NodeOSStats(..)
281+ , LoadAvgs(..)
282+ , NodeIndicesStats(..)
283+ , EsAddress(..)
284+ , PluginName(..)
285+ , NodeInfo(..)
286+ , NodePluginInfo(..)
287+ , NodeHTTPInfo(..)
288+ , NodeTransportInfo(..)
289+ , BoundTransportAddress(..)
290+ , NodeNetworkInfo(..)
291+ , MacAddress(..)
292+ , NetworkInterfaceName(..)
293+ , NodeNetworkInterface(..)
294+ , NodeThreadPoolsInfo(..)
295+ , NodeThreadPoolInfo(..)
296+ , ThreadPoolSize(..)
297+ , ThreadPoolType(..)
298+ , NodeJVMInfo(..)
299+ , JVMMemoryPool(..)
300+ , JVMGCCollector(..)
301+ , JVMMemoryInfo(..)
302+ , PID(..)
303+ , NodeOSInfo(..)
304+ , CPUInfo(..)
305+ , NodeProcessInfo(..)
306+ , FsSnapshotRepo(..)
307+ , SnapshotCreateSettings(..)
308+ , defaultSnapshotCreateSettings
309+ , SnapshotSelection(..)
310+ , SnapshotPattern(..)
311+ , SnapshotInfo(..)
312+ , SnapshotShardFailure(..)
313+ , ShardId(..)
314+ , SnapshotName(..)
315+ , SnapshotState(..)
316+ , SnapshotRestoreSettings(..)
317+ , defaultSnapshotRestoreSettings
318+ , RestoreRenamePattern(..)
319+ , RestoreRenameToken(..)
320+ , RRGroupRefNum
321+ , rrGroupRefNum
322+ , mkRRGroupRefNum
323+ , RestoreIndexSettings(..)
324+
325+ , Aggregation(..)
326+ , Aggregations
327+ , AggregationResults
328+ , BucketValue(..)
329+ , Bucket(..)
330+ , BucketAggregation(..)
331+ , TermsAggregation(..)
332+ , MissingAggregation(..)
333+ , ValueCountAggregation(..)
334+ , FilterAggregation(..)
335+ , CardinalityAggregation(..)
336+ , DateHistogramAggregation(..)
337+ , DateRangeAggregation(..)
338+ , DateRangeAggRange(..)
339+ , DateMathExpr(..)
340+ , DateMathAnchor(..)
341+ , DateMathModifier(..)
342+ , DateMathUnit(..)
343+ , TopHitsAggregation(..)
344+
345+ , Highlights(..)
346+ , FieldHighlight(..)
347+ , HighlightSettings(..)
348+ , PlainHighlight(..)
349+ , PostingsHighlight(..)
350+ , FastVectorHighlight(..)
351+ , CommonHighlight(..)
352+ , NonPostings(..)
353+ , HighlightEncoder(..)
354+ , HighlightTag(..)
355+ , HitHighlight
356+
357+ , MissingResult(..)
358+ , TermsResult(..)
359+ , DateHistogramResult(..)
360+ , DateRangeResult(..)
361+ , TopHitResult(..)
362+
363+ , EsUsername(..)
364+ , EsPassword(..)
365+ ) where
366+
367+import Control.Applicative as A
368+import Control.Arrow (first)
369+import Control.Monad.Catch
370+import Control.Monad.Except
371+import Control.Monad.Reader (MonadReader (..),
372+ ReaderT (..))
373+import Control.Monad.State (MonadState)
374+import Control.Monad.Writer (MonadWriter)
375+import Data.Aeson
376+import Data.Aeson.Types (Pair, Parser,
377+ emptyObject,
378+ parseEither, parseMaybe)
379+import qualified Data.ByteString.Lazy.Char8 as L
380+import Data.Char
381+import Data.Hashable (Hashable)
382+import qualified Data.HashMap.Strict as HM
383+import Data.List (foldl', intercalate,
384+ nub)
385+import Data.List.NonEmpty (NonEmpty (..), toList)
386+import qualified Data.Map.Strict as M
387+import Data.Maybe
388+import Data.Scientific (Scientific)
389+import Data.Semigroup
390+import Data.Text (Text)
391+import qualified Data.Text as T
392+import Data.Time.Calendar
393+import Data.Time.Clock (NominalDiffTime,
394+ UTCTime)
395+import Data.Time.Clock.POSIX
396+import qualified Data.Traversable as DT
397+import Data.Typeable (Typeable)
398+import qualified Data.Vector as V
399+import qualified Data.Version as Vers
400+import GHC.Enum
401+import GHC.Generics (Generic)
402+import Network.HTTP.Client
403+import qualified Network.HTTP.Types.Method as NHTM
404+import qualified Text.ParserCombinators.ReadP as RP
405+import qualified Text.Read as TR
406+
407+import Database.V5.Bloodhound.Types.Class
408+import Database.V5.Bloodhound.Types.Internal
409+
410+-- $setup
411+-- >>> :set -XOverloadedStrings
412+-- >>> import Data.Aeson
413+-- >>> import Database.V5.Bloodhound
414+-- >>> let testServer = (Server "http://localhost:9200")
415+-- >>> let testIndex = IndexName "twitter"
416+-- >>> let testMapping = MappingName "tweet"
417+-- >>> let defaultIndexSettings = IndexSettings (ShardCount 3) (ReplicaCount 2)
418+
419+-- defaultIndexSettings is exported by Database.Bloodhound as well
420+-- no trailing slashes in servers, library handles building the path.
421+
422+-- | Create a 'BHEnv' with all optional fields defaulted. HTTP hook
423+-- will be a noop. You can use the exported fields to customize it further, e.g.:
424+--
425+-- >> (mkBHEnv myServer myManager) { bhRequestHook = customHook }
426+mkBHEnv :: Server -> Manager -> BHEnv
427+mkBHEnv s m = BHEnv s m return
428+
429+newtype BH m a = BH {
430+ unBH :: ReaderT BHEnv m a
431+ } deriving ( Functor
432+ , A.Applicative
433+ , Monad
434+ , MonadIO
435+ , MonadState s
436+ , MonadWriter w
437+ , MonadError e
438+ , Alternative
439+ , MonadPlus
440+ , MonadFix
441+ , MonadThrow
442+ , MonadCatch
443+ , MonadMask)
444+
445+instance MonadTrans BH where
446+ lift = BH . lift
447+
448+instance (MonadReader r m) => MonadReader r (BH m) where
449+ ask = lift ask
450+ local f (BH (ReaderT m)) = BH $ ReaderT $ \r ->
451+ local f (m r)
452+
453+instance (Functor m, Applicative m, MonadIO m) => MonadBH (BH m) where
454+ getBHEnv = BH getBHEnv
455+
456+runBH :: BHEnv -> BH m a -> m a
457+runBH e f = runReaderT (unBH f) e
458+
459+{-| 'Version' is embedded in 'Status' -}
460+data Version = Version { number :: VersionNumber
461+ , build_hash :: BuildHash
462+ , build_date :: UTCTime
463+ , build_snapshot :: Bool
464+ , lucene_version :: VersionNumber } deriving (Eq, Read, Show, Generic, Typeable)
465+
466+-- | Traditional software versioning number
467+newtype VersionNumber = VersionNumber { versionNumber :: Vers.Version
468+ } deriving (Eq, Read, Show, Generic, Typeable, Ord)
469+
470+{-| 'Status' is a data type for describing the JSON body returned by
471+ Elasticsearch when you query its status. This was deprecated in 1.2.0.
472+
473+ <http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/indices-status.html#indices-status>
474+-}
475+
476+data Status = Status { name :: Text
477+ , cluster_name :: Text
478+ , cluster_uuid :: Text
479+ , version :: Version
480+ , tagline :: Text } deriving (Eq, Read, Show, Generic)
481+
482+{-| 'IndexSettings' is used to configure the shards and replicas when you create
483+ an Elasticsearch Index.
484+
485+ <http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/indices-create-index.html>
486+-}
487+
488+data IndexSettings =
489+ IndexSettings { indexShards :: ShardCount
490+ , indexReplicas :: ReplicaCount } deriving (Eq, Read, Show, Generic, Typeable)
491+
492+{-| 'defaultIndexSettings' is an 'IndexSettings' with 3 shards and 2 replicas. -}
493+defaultIndexSettings :: IndexSettings
494+defaultIndexSettings = IndexSettings (ShardCount 3) (ReplicaCount 2)
495+
496+
497+{-| 'ForceMergeIndexSettings' is used to configure index optimization. See
498+ <https://www.elastic.co/guide/en/elasticsearch/reference/current/indices-forcemerge.html>
499+ for more info.
500+-}
501+data ForceMergeIndexSettings =
502+ ForceMergeIndexSettings { maxNumSegments :: Maybe Int
503+ -- ^ 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.
504+ , onlyExpungeDeletes :: Bool
505+ -- ^ 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.
506+ , flushAfterOptimize :: Bool
507+ -- ^ Should a flush be performed after the optimize.
508+ } deriving (Eq, Show, Generic, Typeable)
509+
510+
511+{-| 'defaultForceMergeIndexSettings' implements the default settings that
512+ ElasticSearch uses for index optimization. 'maxNumSegments' is Nothing,
513+ 'onlyExpungeDeletes' is False, and flushAfterOptimize is True.
514+-}
515+defaultForceMergeIndexSettings :: ForceMergeIndexSettings
516+defaultForceMergeIndexSettings = ForceMergeIndexSettings Nothing False True
517+
518+{-| 'UpdatableIndexSetting' are settings which may be updated after an index is created.
519+
520+ <https://www.elastic.co/guide/en/elasticsearch/reference/current/indices-update-settings.html>
521+-}
522+data UpdatableIndexSetting = NumberOfReplicas ReplicaCount
523+ -- ^ The number of replicas each shard has.
524+ | AutoExpandReplicas ReplicaBounds
525+ | BlocksReadOnly Bool
526+ -- ^ Set to True to have the index read only. False to allow writes and metadata changes.
527+ | BlocksRead Bool
528+ -- ^ Set to True to disable read operations against the index.
529+ | BlocksWrite Bool
530+ -- ^ Set to True to disable write operations against the index.
531+ | BlocksMetaData Bool
532+ -- ^ Set to True to disable metadata operations against the index.
533+ | RefreshInterval NominalDiffTime
534+ -- ^ The async refresh interval of a shard
535+ | IndexConcurrency Int
536+ | FailOnMergeFailure Bool
537+ | TranslogFlushThresholdOps Int
538+ -- ^ When to flush on operations.
539+ | TranslogFlushThresholdSize Bytes
540+ -- ^ When to flush based on translog (bytes) size.
541+ | TranslogFlushThresholdPeriod NominalDiffTime
542+ -- ^ When to flush based on a period of not flushing.
543+ | TranslogDisableFlush Bool
544+ -- ^ Disables flushing. Note, should be set for a short interval and then enabled.
545+ | CacheFilterMaxSize (Maybe Bytes)
546+ -- ^ The maximum size of filter cache (per segment in shard).
547+ | CacheFilterExpire (Maybe NominalDiffTime)
548+ -- ^ The expire after access time for filter cache.
549+ | GatewaySnapshotInterval NominalDiffTime
550+ -- ^ The gateway snapshot interval (only applies to shared gateways).
551+ | RoutingAllocationInclude (NonEmpty NodeAttrFilter)
552+ -- ^ A node matching any rule will be allowed to host shards from the index.
553+ | RoutingAllocationExclude (NonEmpty NodeAttrFilter)
554+ -- ^ A node matching any rule will NOT be allowed to host shards from the index.
555+ | RoutingAllocationRequire (NonEmpty NodeAttrFilter)
556+ -- ^ Only nodes matching all rules will be allowed to host shards from the index.
557+ | RoutingAllocationEnable AllocationPolicy
558+ -- ^ Enables shard allocation for a specific index.
559+ | RoutingAllocationShardsPerNode ShardCount
560+ -- ^ Controls the total number of shards (replicas and primaries) allowed to be allocated on a single node.
561+ | RecoveryInitialShards InitialShardCount
562+ -- ^ When using local gateway a particular shard is recovered only if there can be allocated quorum shards in the cluster.
563+ | GCDeletes NominalDiffTime
564+ | TTLDisablePurge Bool
565+ -- ^ Disables temporarily the purge of expired docs.
566+ | TranslogFSType FSType
567+ | IndexCompoundFormat CompoundFormat
568+ | IndexCompoundOnFlush Bool
569+ | WarmerEnabled Bool
570+ deriving (Eq, Show, Generic, Typeable)
571+
572+data AllocationPolicy = AllocAll
573+ -- ^ Allows shard allocation for all shards.
574+ | AllocPrimaries
575+ -- ^ Allows shard allocation only for primary shards.
576+ | AllocNewPrimaries
577+ -- ^ Allows shard allocation only for primary shards for new indices.
578+ | AllocNone
579+ -- ^ No shard allocation is allowed
580+ deriving (Eq, Read, Show, Generic, Typeable)
581+
582+data ReplicaBounds = ReplicasBounded Int Int
583+ | ReplicasLowerBounded Int
584+ | ReplicasUnbounded
585+ deriving (Eq, Read, Show, Generic, Typeable)
586+
587+-- | A measure of bytes used for various configurations. You may want
588+-- to use smart constructors like 'gigabytes' for larger values.
589+--
590+-- >>> gigabytes 9
591+-- Bytes 9000000000
592+--
593+-- >>> megabytes 9
594+-- Bytes 9000000
595+--
596+-- >>> kilobytes 9
597+-- Bytes 9000
598+newtype Bytes = Bytes Int deriving (Eq, Read, Show, Generic, Typeable, Ord, ToJSON, FromJSON)
599+
600+gigabytes :: Int -> Bytes
601+gigabytes n = megabytes (1000 * n)
602+
603+
604+megabytes :: Int -> Bytes
605+megabytes n = kilobytes (1000 * n)
606+
607+
608+kilobytes :: Int -> Bytes
609+kilobytes n = Bytes (1000 * n)
610+
611+
612+data FSType = FSSimple
613+ | FSBuffered deriving (Eq, Read, Show, Generic, Typeable, Ord)
614+
615+data InitialShardCount = QuorumShards
616+ | QuorumMinus1Shards
617+ | FullShards
618+ | FullMinus1Shards
619+ | ExplicitShards Int
620+ deriving (Eq, Read, Show, Generic, Typeable)
621+
622+data NodeAttrFilter = NodeAttrFilter { nodeAttrFilterName :: NodeAttrName
623+ , nodeAttrFilterValues :: NonEmpty Text}
624+ deriving (Eq, Read, Show, Generic, Ord, Typeable)
625+
626+newtype NodeAttrName = NodeAttrName Text deriving (Eq, Read, Show, Ord, Generic, Typeable)
627+
628+data CompoundFormat = CompoundFileFormat Bool
629+ | MergeSegmentVsTotalIndex Double
630+ -- ^ percentage between 0 and 1 where 0 is false, 1 is true
631+ deriving (Eq, Read, Show, Generic, Typeable)
632+
633+newtype NominalDiffTimeJSON = NominalDiffTimeJSON { ndtJSON :: NominalDiffTime }
634+
635+data IndexSettingsSummary = IndexSettingsSummary { sSummaryIndexName :: IndexName
636+ , sSummaryFixedSettings :: IndexSettings
637+ , sSummaryUpdateable :: [UpdatableIndexSetting]}
638+ deriving (Eq, Show, Generic, Typeable)
639+
640+{-| 'Reply' and 'Method' are type synonyms from 'Network.HTTP.Types.Method.Method' -}
641+type Reply = Network.HTTP.Client.Response L.ByteString
642+type Method = NHTM.Method
643+
644+{-| 'OpenCloseIndex' is a sum type for opening and closing indices.
645+
646+ <http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/indices-open-close.html>
647+-}
648+data OpenCloseIndex = OpenIndex | CloseIndex deriving (Eq, Read, Show, Generic, Typeable)
649+
650+data FieldType = GeoPointType
651+ | GeoShapeType
652+ | FloatType
653+ | IntegerType
654+ | LongType
655+ | ShortType
656+ | ByteType deriving (Eq, Read, Show, Generic, Typeable)
657+
658+data FieldDefinition =
659+ FieldDefinition { fieldType :: FieldType } deriving (Eq, Read, Show, Generic, Typeable)
660+
661+{-| An 'IndexTemplate' defines a template that will automatically be
662+ applied to new indices created. The templates include both
663+ 'IndexSettings' and mappings, and a simple 'TemplatePattern' that
664+ controls if the template will be applied to the index created.
665+ Specify mappings as follows: @[toJSON TweetMapping, ...]@
666+
667+ https://www.elastic.co/guide/en/elasticsearch/reference/1.7/indices-templates.html
668+-}
669+data IndexTemplate =
670+ IndexTemplate { templatePattern :: TemplatePattern
671+ , templateSettings :: Maybe IndexSettings
672+ , templateMappings :: [Value]
673+ }
674+
675+data MappingField =
676+ MappingField { mappingFieldName :: FieldName
677+ , fieldDefinition :: FieldDefinition } deriving (Eq, Read, Show, Generic, Typeable)
678+
679+{-| Support for type reification of 'Mapping's is currently incomplete, for
680+ now the mapping API verbiage expects a 'ToJSON'able blob.
681+
682+ Indexes have mappings, mappings are schemas for the documents contained in the
683+ index. I'd recommend having only one mapping per index, always having a mapping,
684+ and keeping different kinds of documents separated if possible.
685+-}
686+data Mapping = Mapping { typeName :: TypeName
687+ , mappingFields :: [MappingField] } deriving (Eq, Read, Show, Generic, Typeable)
688+
689+{-| 'BulkOperation' is a sum type for expressing the four kinds of bulk
690+ operation index, create, delete, and update. 'BulkIndex' behaves like an
691+ "upsert", 'BulkCreate' will fail if a document already exists at the DocId.
692+
693+ <http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/docs-bulk.html#docs-bulk>
694+-}
695+data BulkOperation =
696+ BulkIndex IndexName MappingName DocId Value
697+ | BulkCreate IndexName MappingName DocId Value
698+ | BulkDelete IndexName MappingName DocId
699+ | BulkUpdate IndexName MappingName DocId Value deriving (Eq, Read, Show, Generic, Typeable)
700+
701+{-| 'EsResult' describes the standard wrapper JSON document that you see in
702+ successful Elasticsearch lookups or lookups that couldn't find the document.
703+-}
704+data EsResult a = EsResult { _index :: Text
705+ , _type :: Text
706+ , _id :: Text
707+ , foundResult :: Maybe (EsResultFound a)} deriving (Eq, Read, Show, Generic, Typeable)
708+
709+{-| 'EsResultFound' contains the document and its metadata inside of an
710+ 'EsResult' when the document was successfully found.
711+-}
712+data EsResultFound a = EsResultFound { _version :: DocVersion
713+ , _source :: a } deriving (Eq, Read, Show, Generic, Typeable)
714+
715+{-| 'EsError' is the generic type that will be returned when there was a
716+ problem. If you can't parse the expected response, its a good idea to
717+ try parsing this.
718+-}
719+data EsError = EsError { errorStatus :: Int
720+ , errorMessage :: Text } deriving (Eq, Read, Show, Generic, Typeable)
721+
722+{-| 'EsProtocolException' will be thrown if Bloodhound cannot parse a response
723+returned by the ElasticSearch server. If you encounter this error, please
724+verify that your domain data types and FromJSON instances are working properly
725+(for example, the 'a' of '[Hit a]' in 'SearchResult.searchHits.hits'). If you're
726+sure that your mappings are correct, then this error may be an indication of an
727+incompatibility between Bloodhound and ElasticSearch. Please open a bug report
728+and be sure to include the exception body.
729+-}
730+data EsProtocolException = EsProtocolException { esProtoExBody :: L.ByteString }
731+ deriving (Eq, Read, Show, Generic, Typeable)
732+
733+instance Exception EsProtocolException
734+
735+data IndexAlias = IndexAlias { srcIndex :: IndexName
736+ , indexAlias :: IndexAliasName } deriving (Eq, Read, Show, Generic, Typeable)
737+
738+newtype IndexAliasName = IndexAliasName { indexAliasName :: IndexName } deriving (Eq, Read, Show, Generic, ToJSON)
739+
740+data IndexAliasAction = AddAlias IndexAlias IndexAliasCreate
741+ | RemoveAlias IndexAlias deriving (Read, Show, Eq, Generic, Typeable)
742+
743+data IndexAliasCreate = IndexAliasCreate { aliasCreateRouting :: Maybe AliasRouting
744+ , aliasCreateFilter :: Maybe Filter}
745+ deriving (Read, Show, Eq, Generic, Typeable)
746+
747+data AliasRouting = AllAliasRouting RoutingValue
748+ | GranularAliasRouting (Maybe SearchAliasRouting) (Maybe IndexAliasRouting)
749+ deriving (Read, Show, Eq, Generic, Typeable)
750+
751+newtype SearchAliasRouting = SearchAliasRouting (NonEmpty RoutingValue) deriving (Read, Show, Eq, Generic, Typeable)
752+
753+newtype IndexAliasRouting = IndexAliasRouting RoutingValue deriving (Read, Show, Eq, Generic, ToJSON, FromJSON, Typeable)
754+
755+newtype RoutingValue = RoutingValue { routingValue :: Text } deriving (Read, Show, Eq, Generic, ToJSON, FromJSON, Typeable)
756+
757+newtype IndexAliasesSummary = IndexAliasesSummary { indexAliasesSummary :: [IndexAliasSummary] } deriving (Read, Show, Eq, Generic, Typeable)
758+
759+{-| 'IndexAliasSummary' is a summary of an index alias configured for a server. -}
760+data IndexAliasSummary = IndexAliasSummary { indexAliasSummaryAlias :: IndexAlias
761+ , indexAliasSummaryCreate :: IndexAliasCreate} deriving (Read, Show, Eq, Generic, Typeable)
762+
763+{-| 'DocVersion' is an integer version number for a document between 1
764+and 9.2e+18 used for <<https://www.elastic.co/guide/en/elasticsearch/guide/current/optimistic-concurrency-control.html optimistic concurrency control>>.
765+-}
766+newtype DocVersion = DocVersion {
767+ docVersionNumber :: Int
768+ } deriving (Eq, Read, Show, Generic, Ord, ToJSON)
769+
770+-- | Smart constructor for in-range doc version
771+mkDocVersion :: Int -> Maybe DocVersion
772+mkDocVersion i
773+ | i >= (docVersionNumber minBound) && i <= (docVersionNumber maxBound) =
774+ Just $ DocVersion i
775+ | otherwise = Nothing
776+
777+
778+{-| 'ExternalDocVersion' is a convenience wrapper if your code uses its
779+own version numbers instead of ones from ES.
780+-}
781+newtype ExternalDocVersion = ExternalDocVersion DocVersion
782+ deriving (Eq, Read, Show, Generic, Ord, Bounded, Enum, ToJSON)
783+
784+{-| 'VersionControl' is specified when indexing documents as a
785+optimistic concurrency control.
786+-}
787+data VersionControl = NoVersionControl
788+ -- ^ Don't send a version. This is a pure overwrite.
789+ | InternalVersion DocVersion
790+ -- ^ Use the default ES versioning scheme. Only
791+ -- index the document if the version is the same
792+ -- as the one specified. Only applicable to
793+ -- updates, as you should be getting Version from
794+ -- a search result.
795+ | ExternalGT ExternalDocVersion
796+ -- ^ Use your own version numbering. Only index
797+ -- the document if the version is strictly higher
798+ -- OR the document doesn't exist. The given
799+ -- version will be used as the new version number
800+ -- for the stored document. N.B. All updates must
801+ -- increment this number, meaning there is some
802+ -- global, external ordering of updates.
803+ | ExternalGTE ExternalDocVersion
804+ -- ^ Use your own version numbering. Only index
805+ -- the document if the version is equal or higher
806+ -- than the stored version. Will succeed if there
807+ -- is no existing document. The given version will
808+ -- be used as the new version number for the
809+ -- stored document. Use with care, as this could
810+ -- result in data loss.
811+ | ForceVersion ExternalDocVersion
812+ -- ^ The document will always be indexed and the
813+ -- given version will be the new version. This is
814+ -- typically used for correcting errors. Use with
815+ -- care, as this could result in data loss.
816+ deriving (Read, Show, Eq, Generic, Ord)
817+
818+{-| 'DocumentParent' is used to specify a parent document.
819+-}
820+newtype DocumentParent = DocumentParent DocId
821+ deriving (Eq, Read, Show, Generic, Typeable)
822+
823+{-| 'IndexDocumentSettings' are special settings supplied when indexing
824+a document. For the best backwards compatiblity when new fields are
825+added, you should probably prefer to start with 'defaultIndexDocumentSettings'
826+-}
827+data IndexDocumentSettings =
828+ IndexDocumentSettings { idsVersionControl :: VersionControl
829+ , idsParent :: Maybe DocumentParent
830+ } deriving (Eq, Read, Show, Generic, Typeable)
831+
832+{-| Reasonable default settings. Chooses no version control and no parent.
833+-}
834+defaultIndexDocumentSettings :: IndexDocumentSettings
835+defaultIndexDocumentSettings = IndexDocumentSettings NoVersionControl Nothing
836+
837+{-| 'Sort' is a synonym for a list of 'SortSpec's. Sort behavior is order
838+ dependent with later sorts acting as tie-breakers for earlier sorts.
839+-}
840+type Sort = [SortSpec]
841+
842+{-| The two main kinds of 'SortSpec' are 'DefaultSortSpec' and
843+ 'GeoDistanceSortSpec'. The latter takes a 'SortOrder', 'GeoPoint', and
844+ 'DistanceUnit' to express "nearness" to a single geographical point as a
845+ sort specification.
846+
847+<http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/search-request-sort.html#search-request-sort>
848+-}
849+data SortSpec = DefaultSortSpec DefaultSort
850+ | GeoDistanceSortSpec SortOrder GeoPoint DistanceUnit deriving (Eq, Read, Show, Generic, Typeable)
851+
852+{-| 'DefaultSort' is usually the kind of 'SortSpec' you'll want. There's a
853+ 'mkSort' convenience function for when you want to specify only the most
854+ common parameters.
855+
856+ The `ignoreUnmapped`, when `Just` field is used to set the elastic 'unmapped_type'
857+
858+<http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/search-request-sort.html#search-request-sort>
859+-}
860+data DefaultSort =
861+ DefaultSort { sortFieldName :: FieldName
862+ , sortOrder :: SortOrder
863+ -- default False
864+ , ignoreUnmapped :: Maybe Text
865+ , sortMode :: Maybe SortMode
866+ , missingSort :: Maybe Missing
867+ , nestedFilter :: Maybe Filter } deriving (Eq, Read, Show, Generic, Typeable)
868+
869+{-| 'SortOrder' is 'Ascending' or 'Descending', as you might expect. These get
870+ encoded into "asc" or "desc" when turned into JSON.
871+
872+<http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/search-request-sort.html#search-request-sort>
873+-}
874+data SortOrder = Ascending
875+ | Descending deriving (Eq, Read, Show, Generic, Typeable)
876+
877+{-| 'Missing' prescribes how to handle missing fields. A missing field can be
878+ sorted last, first, or using a custom value as a substitute.
879+
880+<http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/search-request-sort.html#_missing_values>
881+-}
882+data Missing = LastMissing
883+ | FirstMissing
884+ | CustomMissing Text deriving (Eq, Read, Show, Generic, Typeable)
885+
886+{-| 'SortMode' prescribes how to handle sorting array/multi-valued fields.
887+
888+http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/search-request-sort.html#_sort_mode_option
889+-}
890+data SortMode = SortMin
891+ | SortMax
892+ | SortSum
893+ | SortAvg deriving (Eq, Read, Show, Generic, Typeable)
894+
895+{-| 'mkSort' defaults everything but the 'FieldName' and the 'SortOrder' so
896+ that you can concisely describe the usual kind of 'SortSpec's you want.
897+-}
898+mkSort :: FieldName -> SortOrder -> DefaultSort
899+mkSort fieldName sOrder = DefaultSort fieldName sOrder Nothing Nothing Nothing Nothing
900+
901+{-| 'Cache' is for telling ES whether it should cache a 'Filter' not.
902+ 'Query's cannot be cached.
903+-}
904+type Cache = Bool -- caching on/off
905+defaultCache :: Cache
906+defaultCache = False
907+
908+{-| 'PrefixValue' is used in 'PrefixQuery' as the main query component.
909+-}
910+type PrefixValue = Text
911+
912+{-| 'BooleanOperator' is the usual And/Or operators with an ES compatible
913+ JSON encoding baked in. Used all over the place.
914+-}
915+data BooleanOperator = And | Or deriving (Eq, Read, Show, Generic, Typeable)
916+
917+{-| 'ShardCount' is part of 'IndexSettings'
918+-}
919+newtype ShardCount = ShardCount Int deriving (Eq, Read, Show, Generic, ToJSON, Typeable)
920+
921+{-| 'ReplicaCount' is part of 'IndexSettings'
922+-}
923+newtype ReplicaCount = ReplicaCount Int deriving (Eq, Read, Show, Generic, ToJSON, Typeable)
924+
925+{-| 'IndexName' is used to describe which index to query/create/delete
926+-}
927+newtype IndexName = IndexName Text deriving (Eq, Generic, Read, Show, ToJSON, FromJSON, Typeable)
928+
929+{-| 'IndexSelection' is used for APIs which take a single index, a list of
930+ indexes, or the special @_all@ index.
931+-}
932+--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.
933+data IndexSelection = IndexList (NonEmpty IndexName)
934+ | AllIndexes deriving (Eq, Generic, Show, Typeable)
935+
936+{-| '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.
937+-}
938+data NodeSelection = LocalNode
939+ -- ^ Whatever node receives this request
940+ | NodeList (NonEmpty NodeSelector)
941+ | AllNodes deriving (Eq, Generic, Show, Typeable)
942+
943+
944+-- | An exact match or pattern to identify a node. Note that All of
945+-- these options support wildcarding, so your node name, server, attr
946+-- name can all contain * characters to be a fuzzy match.
947+data NodeSelector = NodeByName NodeName
948+ | NodeByFullNodeId FullNodeId
949+ | NodeByHost Server
950+ -- ^ e.g. 10.0.0.1 or even 10.0.0.*
951+ | NodeByAttribute NodeAttrName Text
952+ -- ^ NodeAttrName can be a pattern, e.g. rack*. The value can too.
953+ deriving (Eq, Generic, Show, Typeable)
954+
955+{-| 'TemplateName' is used to describe which template to query/create/delete
956+-}
957+newtype TemplateName = TemplateName Text deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
958+
959+{-| 'TemplatePattern' represents a pattern which is matched against index names
960+-}
961+newtype TemplatePattern = TemplatePattern Text deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
962+
963+{-| 'MappingName' is part of mappings which are how ES describes and schematizes
964+ the data in the indices.
965+-}
966+newtype MappingName = MappingName Text deriving (Eq, Generic, Read, Show, ToJSON, FromJSON, Typeable)
967+
968+{-| 'DocId' is a generic wrapper value for expressing unique Document IDs.
969+ Can be set by the user or created by ES itself. Often used in client
970+ functions for poking at specific documents.
971+-}
972+newtype DocId = DocId Text deriving (Eq, Generic, Read, Show, ToJSON, FromJSON, Typeable)
973+
974+{-| 'QueryString' is used to wrap query text bodies, be they human written or not.
975+-}
976+newtype QueryString = QueryString Text deriving (Eq, Generic, Read, Show, ToJSON, FromJSON, Typeable)
977+
978+{-| 'FieldName' is used all over the place wherever a specific field within
979+ a document needs to be specified, usually in 'Query's or 'Filter's.
980+-}
981+newtype FieldName = FieldName Text deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
982+
983+
984+{-| 'Script' is often used in place of 'FieldName' to specify more
985+complex ways of extracting a value from a document.
986+-}
987+newtype Script = Script { scriptText :: Text } deriving (Eq, Read, Show, Generic, Typeable)
988+
989+{-| 'CacheName' is used in 'RegexpFilter' for describing the
990+ 'CacheKey' keyed caching behavior.
991+-}
992+newtype CacheName = CacheName Text deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
993+
994+{-| 'CacheKey' is used in 'RegexpFilter' to key regex caching.
995+-}
996+newtype CacheKey =
997+ CacheKey Text deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
998+newtype Existence =
999+ Existence Bool deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1000+newtype NullValue =
1001+ NullValue Bool deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1002+newtype CutoffFrequency =
1003+ CutoffFrequency Double deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1004+newtype Analyzer =
1005+ Analyzer Text deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1006+newtype MaxExpansions =
1007+ MaxExpansions Int deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1008+
1009+{-| 'Lenient', if set to true, will cause format based failures to be
1010+ ignored. I don't know what the bloody default is, Elasticsearch
1011+ documentation didn't say what it was. Let me know if you figure it out.
1012+-}
1013+newtype Lenient =
1014+ Lenient Bool deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1015+newtype Tiebreaker =
1016+ Tiebreaker Double deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1017+newtype Boost =
1018+ Boost Double deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1019+newtype BoostTerms =
1020+ BoostTerms Double deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1021+
1022+{-| 'MinimumMatch' controls how many should clauses in the bool query should
1023+ match. Can be an absolute value (2) or a percentage (30%) or a
1024+ combination of both.
1025+-}
1026+newtype MinimumMatch =
1027+ MinimumMatch Int deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1028+newtype DisableCoord =
1029+ DisableCoord Bool deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1030+newtype IgnoreTermFrequency =
1031+ IgnoreTermFrequency Bool deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1032+newtype MinimumTermFrequency =
1033+ MinimumTermFrequency Int deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1034+newtype MaxQueryTerms =
1035+ MaxQueryTerms Int deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1036+newtype Fuzziness =
1037+ Fuzziness Double deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1038+
1039+{-| 'PrefixLength' is the prefix length used in queries, defaults to 0. -}
1040+newtype PrefixLength =
1041+ PrefixLength Int deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1042+newtype TypeName =
1043+ TypeName Text deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1044+newtype PercentMatch =
1045+ PercentMatch Double deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1046+newtype StopWord =
1047+ StopWord Text deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1048+newtype QueryPath =
1049+ QueryPath Text deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1050+
1051+{-| Allowing a wildcard at the beginning of a word (eg "*ing") is particularly
1052+ heavy, because all terms in the index need to be examined, just in case
1053+ they match. Leading wildcards can be disabled by setting
1054+ 'AllowLeadingWildcard' to false. -}
1055+newtype AllowLeadingWildcard =
1056+ AllowLeadingWildcard Bool deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1057+newtype LowercaseExpanded =
1058+ LowercaseExpanded Bool deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1059+newtype EnablePositionIncrements =
1060+ EnablePositionIncrements Bool deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1061+
1062+{-| By default, wildcard terms in a query are not analyzed.
1063+ Setting 'AnalyzeWildcard' to true enables best-effort analysis.
1064+-}
1065+newtype AnalyzeWildcard = AnalyzeWildcard Bool deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1066+
1067+{-| 'GeneratePhraseQueries' defaults to false.
1068+-}
1069+newtype GeneratePhraseQueries =
1070+ GeneratePhraseQueries Bool deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1071+
1072+{-| 'Locale' is used for string conversions - defaults to ROOT.
1073+-}
1074+newtype Locale = Locale Text deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1075+newtype MaxWordLength = MaxWordLength Int deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1076+newtype MinWordLength = MinWordLength Int deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1077+
1078+{-| 'PhraseSlop' sets the default slop for phrases, 0 means exact
1079+ phrase matches. Default is 0.
1080+-}
1081+newtype PhraseSlop = PhraseSlop Int deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1082+newtype MinDocFrequency = MinDocFrequency Int deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1083+newtype MaxDocFrequency = MaxDocFrequency Int deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1084+
1085+-- | Newtype wrapper to parse ES's concerning tendency to in some APIs return a floating point number of milliseconds since epoch ಠ_ಠ
1086+newtype POSIXMS = POSIXMS { posixMS :: UTCTime }
1087+
1088+{-| 'unpackId' is a silly convenience function that gets used once.
1089+-}
1090+unpackId :: DocId -> Text
1091+unpackId (DocId docId) = docId
1092+
1093+type TrackSortScores = Bool
1094+newtype From = From Int deriving (Eq, Read, Show, Generic, ToJSON)
1095+newtype Size = Size Int deriving (Eq, Read, Show, Generic, ToJSON)
1096+
1097+data Search = Search { queryBody :: Maybe Query
1098+ , filterBody :: Maybe Filter
1099+ , sortBody :: Maybe Sort
1100+ , aggBody :: Maybe Aggregations
1101+ , highlight :: Maybe Highlights
1102+ -- default False
1103+ , trackSortScores :: TrackSortScores
1104+ , from :: From
1105+ , size :: Size
1106+ , searchType :: SearchType
1107+ , fields :: Maybe [FieldName]
1108+ , source :: Maybe Source } deriving (Eq, Read, Show, Generic, Typeable)
1109+
1110+data SearchType = SearchTypeQueryThenFetch
1111+ | SearchTypeDfsQueryThenFetch
1112+ deriving (Eq, Read, Show, Generic, Typeable)
1113+
1114+data Source =
1115+ NoSource
1116+ | SourcePatterns PatternOrPatterns
1117+ | SourceIncludeExclude Include Exclude
1118+ deriving (Read, Show, Eq, Generic, Typeable)
1119+
1120+data PatternOrPatterns = PopPattern Pattern
1121+ | PopPatterns [Pattern] deriving (Eq, Read, Show, Generic, Typeable)
1122+
1123+data Include = Include [Pattern] deriving (Eq, Read, Show, Generic, Typeable)
1124+data Exclude = Exclude [Pattern] deriving (Eq, Read, Show, Generic, Typeable)
1125+
1126+newtype Pattern = Pattern Text deriving (Eq, Read, Show, Generic, Typeable)
1127+
1128+data Highlights = Highlights { globalsettings :: Maybe HighlightSettings
1129+ , highlightFields :: [FieldHighlight]
1130+ } deriving (Read, Show, Eq, Generic, Typeable)
1131+
1132+data FieldHighlight = FieldHighlight FieldName (Maybe HighlightSettings)
1133+ deriving (Read, Show, Eq, Generic, Typeable)
1134+
1135+
1136+data HighlightSettings = Plain PlainHighlight
1137+ | Postings PostingsHighlight
1138+ | FastVector FastVectorHighlight
1139+ deriving (Read, Show, Eq, Generic, Typeable)
1140+data PlainHighlight =
1141+ PlainHighlight { plainCommon :: Maybe CommonHighlight
1142+ , plainNonPost :: Maybe NonPostings } deriving (Read, Show, Eq, Generic, Typeable)
1143+
1144+ -- This requires that index_options are set to 'offset' in the mapping.
1145+data PostingsHighlight = PostingsHighlight (Maybe CommonHighlight) deriving (Read, Show, Eq, Generic, Typeable)
1146+
1147+-- This requires that term_vector is set to 'with_positions_offsets' in the mapping.
1148+data FastVectorHighlight =
1149+ FastVectorHighlight { fvCommon :: Maybe CommonHighlight
1150+ , fvNonPostSettings :: Maybe NonPostings
1151+ , boundaryChars :: Maybe Text
1152+ , boundaryMaxScan :: Maybe Int
1153+ , fragmentOffset :: Maybe Int
1154+ , matchedFields :: [Text]
1155+ , phraseLimit :: Maybe Int
1156+ } deriving (Read, Show, Eq, Generic, Typeable)
1157+
1158+data CommonHighlight =
1159+ CommonHighlight { order :: Maybe Text
1160+ , forceSource :: Maybe Bool
1161+ , tag :: Maybe HighlightTag
1162+ , encoder :: Maybe HighlightEncoder
1163+ , noMatchSize :: Maybe Int
1164+ , highlightQuery :: Maybe Query
1165+ , requireFieldMatch :: Maybe Bool
1166+ } deriving (Read, Show, Eq, Generic, Typeable)
1167+
1168+-- Settings that are only applicable to FastVector and Plain highlighters.
1169+data NonPostings =
1170+ NonPostings { fragmentSize :: Maybe Int
1171+ , numberOfFragments :: Maybe Int} deriving (Read, Show, Eq, Generic, Typeable)
1172+
1173+data HighlightEncoder = DefaultEncoder
1174+ | HTMLEncoder
1175+ deriving (Read, Show, Eq, Generic, Typeable)
1176+
1177+-- NOTE: Should the tags use some kind of HTML type, rather than Text?
1178+data HighlightTag = TagSchema Text
1179+ | CustomTags ([Text], [Text]) -- Only uses more than the first value in the lists if fvh
1180+ deriving (Read, Show, Eq, Generic, Typeable)
1181+
1182+
1183+data Query =
1184+ TermQuery Term (Maybe Boost)
1185+ | TermsQuery Text (NonEmpty Text)
1186+ | QueryMatchQuery MatchQuery
1187+ | QueryMultiMatchQuery MultiMatchQuery
1188+ | QueryBoolQuery BoolQuery
1189+ | QueryBoostingQuery BoostingQuery
1190+ | QueryCommonTermsQuery CommonTermsQuery
1191+ | ConstantScoreQuery Query Boost
1192+ | QueryDisMaxQuery DisMaxQuery
1193+ | QueryFuzzyLikeThisQuery FuzzyLikeThisQuery
1194+ | QueryFuzzyLikeFieldQuery FuzzyLikeFieldQuery
1195+ | QueryFuzzyQuery FuzzyQuery
1196+ | QueryHasChildQuery HasChildQuery
1197+ | QueryHasParentQuery HasParentQuery
1198+ | IdsQuery MappingName [DocId]
1199+ | QueryIndicesQuery IndicesQuery
1200+ | MatchAllQuery (Maybe Boost)
1201+ | QueryMoreLikeThisQuery MoreLikeThisQuery
1202+ | QueryMoreLikeThisFieldQuery MoreLikeThisFieldQuery
1203+ | QueryNestedQuery NestedQuery
1204+ | QueryPrefixQuery PrefixQuery
1205+ | QueryQueryStringQuery QueryStringQuery
1206+ | QuerySimpleQueryStringQuery SimpleQueryStringQuery
1207+ | QueryRangeQuery RangeQuery
1208+ | QueryRegexpQuery RegexpQuery
1209+ | QueryExistsQuery FieldName
1210+ | QueryMatchNoneQuery
1211+ deriving (Eq, Read, Show, Generic, Typeable)
1212+
1213+-- | As of Elastic 2.0, 'Filters' are just 'Queries' housed in a Bool Query, and
1214+-- flagged in a different context.
1215+newtype Filter = Filter { unFilter :: Query }
1216+ deriving (Eq, Read, Show, Generic, Typeable)
1217+
1218+instance ToJSON Filter where
1219+ toJSON = toJSON . unFilter
1220+
1221+instance FromJSON Filter where
1222+ parseJSON v = Filter <$> parseJSON v
1223+
1224+data RegexpQuery =
1225+ RegexpQuery { regexpQueryField :: FieldName
1226+ , regexpQuery :: Regexp
1227+ , regexpQueryFlags :: RegexpFlags
1228+ , regexpQueryBoost :: Maybe Boost
1229+ } deriving (Eq, Read, Show, Generic, Typeable)
1230+
1231+data RangeQuery =
1232+ RangeQuery { rangeQueryField :: FieldName
1233+ , rangeQueryRange :: RangeValue
1234+ , rangeQueryBoost :: Boost } deriving (Eq, Read, Show, Generic, Typeable)
1235+
1236+mkRangeQuery :: FieldName -> RangeValue -> RangeQuery
1237+mkRangeQuery f r = RangeQuery f r (Boost 1.0)
1238+
1239+data SimpleQueryStringQuery =
1240+ SimpleQueryStringQuery
1241+ { simpleQueryStringQuery :: QueryString
1242+ , simpleQueryStringField :: Maybe FieldOrFields
1243+ , simpleQueryStringOperator :: Maybe BooleanOperator
1244+ , simpleQueryStringAnalyzer :: Maybe Analyzer
1245+ , simpleQueryStringFlags :: Maybe (NonEmpty SimpleQueryFlag)
1246+ , simpleQueryStringLowercaseExpanded :: Maybe LowercaseExpanded
1247+ , simpleQueryStringLocale :: Maybe Locale
1248+ } deriving (Eq, Read, Show, Generic, Typeable)
1249+
1250+data SimpleQueryFlag =
1251+ SimpleQueryAll
1252+ | SimpleQueryNone
1253+ | SimpleQueryAnd
1254+ | SimpleQueryOr
1255+ | SimpleQueryPrefix
1256+ | SimpleQueryPhrase
1257+ | SimpleQueryPrecedence
1258+ | SimpleQueryEscape
1259+ | SimpleQueryWhitespace
1260+ | SimpleQueryFuzzy
1261+ | SimpleQueryNear
1262+ | SimpleQuerySlop deriving (Eq, Read, Show, Generic, Typeable)
1263+
1264+-- use_dis_max and tie_breaker when fields are plural?
1265+data QueryStringQuery =
1266+ QueryStringQuery
1267+ { queryStringQuery :: QueryString
1268+ , queryStringDefaultField :: Maybe FieldName
1269+ , queryStringOperator :: Maybe BooleanOperator
1270+ , queryStringAnalyzer :: Maybe Analyzer
1271+ , queryStringAllowLeadingWildcard :: Maybe AllowLeadingWildcard
1272+ , queryStringLowercaseExpanded :: Maybe LowercaseExpanded
1273+ , queryStringEnablePositionIncrements :: Maybe EnablePositionIncrements
1274+ , queryStringFuzzyMaxExpansions :: Maybe MaxExpansions
1275+ , queryStringFuzziness :: Maybe Fuzziness
1276+ , queryStringFuzzyPrefixLength :: Maybe PrefixLength
1277+ , queryStringPhraseSlop :: Maybe PhraseSlop
1278+ , queryStringBoost :: Maybe Boost
1279+ , queryStringAnalyzeWildcard :: Maybe AnalyzeWildcard
1280+ , queryStringGeneratePhraseQueries :: Maybe GeneratePhraseQueries
1281+ , queryStringMinimumShouldMatch :: Maybe MinimumMatch
1282+ , queryStringLenient :: Maybe Lenient
1283+ , queryStringLocale :: Maybe Locale
1284+ } deriving (Eq, Read, Show, Generic, Typeable)
1285+
1286+mkQueryStringQuery :: QueryString -> QueryStringQuery
1287+mkQueryStringQuery qs =
1288+ QueryStringQuery qs Nothing Nothing
1289+ Nothing Nothing Nothing Nothing
1290+ Nothing Nothing Nothing Nothing
1291+ Nothing Nothing Nothing Nothing
1292+ Nothing Nothing
1293+
1294+data FieldOrFields = FofField FieldName
1295+ | FofFields (NonEmpty FieldName) deriving (Eq, Read, Show, Generic, Typeable)
1296+
1297+data PrefixQuery =
1298+ PrefixQuery
1299+ { prefixQueryField :: FieldName
1300+ , prefixQueryPrefixValue :: Text
1301+ , prefixQueryBoost :: Maybe Boost } deriving (Eq, Read, Show, Generic, Typeable)
1302+
1303+data NestedQuery =
1304+ NestedQuery
1305+ { nestedQueryPath :: QueryPath
1306+ , nestedQueryScoreType :: ScoreType
1307+ , nestedQuery :: Query } deriving (Eq, Read, Show, Generic, Typeable)
1308+
1309+data MoreLikeThisFieldQuery =
1310+ MoreLikeThisFieldQuery
1311+ { moreLikeThisFieldText :: Text
1312+ , moreLikeThisFieldFields :: FieldName
1313+ -- default 0.3 (30%)
1314+ , moreLikeThisFieldPercentMatch :: Maybe PercentMatch
1315+ , moreLikeThisFieldMinimumTermFreq :: Maybe MinimumTermFrequency
1316+ , moreLikeThisFieldMaxQueryTerms :: Maybe MaxQueryTerms
1317+ , moreLikeThisFieldStopWords :: Maybe (NonEmpty StopWord)
1318+ , moreLikeThisFieldMinDocFrequency :: Maybe MinDocFrequency
1319+ , moreLikeThisFieldMaxDocFrequency :: Maybe MaxDocFrequency
1320+ , moreLikeThisFieldMinWordLength :: Maybe MinWordLength
1321+ , moreLikeThisFieldMaxWordLength :: Maybe MaxWordLength
1322+ , moreLikeThisFieldBoostTerms :: Maybe BoostTerms
1323+ , moreLikeThisFieldBoost :: Maybe Boost
1324+ , moreLikeThisFieldAnalyzer :: Maybe Analyzer
1325+ } deriving (Eq, Read, Show, Generic, Typeable)
1326+
1327+data MoreLikeThisQuery =
1328+ MoreLikeThisQuery
1329+ { moreLikeThisText :: Text
1330+ , moreLikeThisFields :: Maybe (NonEmpty FieldName)
1331+ -- default 0.3 (30%)
1332+ , moreLikeThisPercentMatch :: Maybe PercentMatch
1333+ , moreLikeThisMinimumTermFreq :: Maybe MinimumTermFrequency
1334+ , moreLikeThisMaxQueryTerms :: Maybe MaxQueryTerms
1335+ , moreLikeThisStopWords :: Maybe (NonEmpty StopWord)
1336+ , moreLikeThisMinDocFrequency :: Maybe MinDocFrequency
1337+ , moreLikeThisMaxDocFrequency :: Maybe MaxDocFrequency
1338+ , moreLikeThisMinWordLength :: Maybe MinWordLength
1339+ , moreLikeThisMaxWordLength :: Maybe MaxWordLength
1340+ , moreLikeThisBoostTerms :: Maybe BoostTerms
1341+ , moreLikeThisBoost :: Maybe Boost
1342+ , moreLikeThisAnalyzer :: Maybe Analyzer
1343+ } deriving (Eq, Read, Show, Generic, Typeable)
1344+
1345+data IndicesQuery =
1346+ IndicesQuery
1347+ { indicesQueryIndices :: [IndexName]
1348+ , indicesQuery :: Query
1349+ -- default "all"
1350+ , indicesQueryNoMatch :: Maybe Query } deriving (Eq, Read, Show, Generic, Typeable)
1351+
1352+data HasParentQuery =
1353+ HasParentQuery
1354+ { hasParentQueryType :: TypeName
1355+ , hasParentQuery :: Query
1356+ , hasParentQueryScoreType :: Maybe ScoreType } deriving (Eq, Read, Show, Generic, Typeable)
1357+
1358+data HasChildQuery =
1359+ HasChildQuery
1360+ { hasChildQueryType :: TypeName
1361+ , hasChildQuery :: Query
1362+ , hasChildQueryScoreType :: Maybe ScoreType } deriving (Eq, Read, Show, Generic, Typeable)
1363+
1364+data ScoreType =
1365+ ScoreTypeMax
1366+ | ScoreTypeSum
1367+ | ScoreTypeAvg
1368+ | ScoreTypeNone deriving (Eq, Read, Show, Generic, Typeable)
1369+
1370+data FuzzyQuery =
1371+ FuzzyQuery { fuzzyQueryField :: FieldName
1372+ , fuzzyQueryValue :: Text
1373+ , fuzzyQueryPrefixLength :: PrefixLength
1374+ , fuzzyQueryMaxExpansions :: MaxExpansions
1375+ , fuzzyQueryFuzziness :: Fuzziness
1376+ , fuzzyQueryBoost :: Maybe Boost
1377+ } deriving (Eq, Read, Show, Generic, Typeable)
1378+
1379+data FuzzyLikeFieldQuery =
1380+ FuzzyLikeFieldQuery
1381+ { fuzzyLikeField :: FieldName
1382+ -- anaphora is good for the soul.
1383+ , fuzzyLikeFieldText :: Text
1384+ , fuzzyLikeFieldMaxQueryTerms :: MaxQueryTerms
1385+ , fuzzyLikeFieldIgnoreTermFrequency :: IgnoreTermFrequency
1386+ , fuzzyLikeFieldFuzziness :: Fuzziness
1387+ , fuzzyLikeFieldPrefixLength :: PrefixLength
1388+ , fuzzyLikeFieldBoost :: Boost
1389+ , fuzzyLikeFieldAnalyzer :: Maybe Analyzer
1390+ } deriving (Eq, Read, Show, Generic, Typeable)
1391+
1392+data FuzzyLikeThisQuery =
1393+ FuzzyLikeThisQuery
1394+ { fuzzyLikeFields :: [FieldName]
1395+ , fuzzyLikeText :: Text
1396+ , fuzzyLikeMaxQueryTerms :: MaxQueryTerms
1397+ , fuzzyLikeIgnoreTermFrequency :: IgnoreTermFrequency
1398+ , fuzzyLikeFuzziness :: Fuzziness
1399+ , fuzzyLikePrefixLength :: PrefixLength
1400+ , fuzzyLikeBoost :: Boost
1401+ , fuzzyLikeAnalyzer :: Maybe Analyzer
1402+ } deriving (Eq, Read, Show, Generic, Typeable)
1403+
1404+data DisMaxQuery =
1405+ DisMaxQuery { disMaxQueries :: [Query]
1406+ -- default 0.0
1407+ , disMaxTiebreaker :: Tiebreaker
1408+ , disMaxBoost :: Maybe Boost
1409+ } deriving (Eq, Read, Show, Generic, Typeable)
1410+
1411+data MatchQuery =
1412+ MatchQuery { matchQueryField :: FieldName
1413+ , matchQueryQueryString :: QueryString
1414+ , matchQueryOperator :: BooleanOperator
1415+ , matchQueryZeroTerms :: ZeroTermsQuery
1416+ , matchQueryCutoffFrequency :: Maybe CutoffFrequency
1417+ , matchQueryMatchType :: Maybe MatchQueryType
1418+ , matchQueryAnalyzer :: Maybe Analyzer
1419+ , matchQueryMaxExpansions :: Maybe MaxExpansions
1420+ , matchQueryLenient :: Maybe Lenient
1421+ , matchQueryBoost :: Maybe Boost } deriving (Eq, Read, Show, Generic, Typeable)
1422+
1423+{-| 'mkMatchQuery' is a convenience function that defaults the less common parameters,
1424+ enabling you to provide only the 'FieldName' and 'QueryString' to make a 'MatchQuery'
1425+-}
1426+mkMatchQuery :: FieldName -> QueryString -> MatchQuery
1427+mkMatchQuery field query = MatchQuery field query Or ZeroTermsNone Nothing Nothing Nothing Nothing Nothing Nothing
1428+
1429+data MatchQueryType =
1430+ MatchPhrase
1431+ | MatchPhrasePrefix deriving (Eq, Read, Show, Generic, Typeable)
1432+
1433+data MultiMatchQuery =
1434+ MultiMatchQuery { multiMatchQueryFields :: [FieldName]
1435+ , multiMatchQueryString :: QueryString
1436+ , multiMatchQueryOperator :: BooleanOperator
1437+ , multiMatchQueryZeroTerms :: ZeroTermsQuery
1438+ , multiMatchQueryTiebreaker :: Maybe Tiebreaker
1439+ , multiMatchQueryType :: Maybe MultiMatchQueryType
1440+ , multiMatchQueryCutoffFrequency :: Maybe CutoffFrequency
1441+ , multiMatchQueryAnalyzer :: Maybe Analyzer
1442+ , multiMatchQueryMaxExpansions :: Maybe MaxExpansions
1443+ , multiMatchQueryLenient :: Maybe Lenient } deriving (Eq, Read, Show, Generic, Typeable)
1444+
1445+{-| 'mkMultiMatchQuery' is a convenience function that defaults the less common parameters,
1446+ enabling you to provide only the list of 'FieldName's and 'QueryString' to
1447+ make a 'MultiMatchQuery'.
1448+-}
1449+
1450+mkMultiMatchQuery :: [FieldName] -> QueryString -> MultiMatchQuery
1451+mkMultiMatchQuery matchFields query =
1452+ MultiMatchQuery matchFields query
1453+ Or ZeroTermsNone Nothing Nothing Nothing Nothing Nothing Nothing
1454+
1455+data MultiMatchQueryType =
1456+ MultiMatchBestFields
1457+ | MultiMatchMostFields
1458+ | MultiMatchCrossFields
1459+ | MultiMatchPhrase
1460+ | MultiMatchPhrasePrefix deriving (Eq, Read, Show, Generic, Typeable)
1461+
1462+data BoolQuery =
1463+ BoolQuery { boolQueryMustMatch :: [Query]
1464+ , boolQueryFilter :: [Filter]
1465+ , boolQueryMustNotMatch :: [Query]
1466+ , boolQueryShouldMatch :: [Query]
1467+ , boolQueryMinimumShouldMatch :: Maybe MinimumMatch
1468+ , boolQueryBoost :: Maybe Boost
1469+ , boolQueryDisableCoord :: Maybe DisableCoord
1470+ } deriving (Eq, Read, Show, Generic, Typeable)
1471+
1472+mkBoolQuery :: [Query] -> [Filter] -> [Query] -> [Query] -> BoolQuery
1473+mkBoolQuery must filt mustNot should =
1474+ BoolQuery must filt mustNot should Nothing Nothing Nothing
1475+
1476+data BoostingQuery =
1477+ BoostingQuery { positiveQuery :: Query
1478+ , negativeQuery :: Query
1479+ , negativeBoost :: Boost } deriving (Eq, Read, Show, Generic, Typeable)
1480+
1481+data CommonTermsQuery =
1482+ CommonTermsQuery { commonField :: FieldName
1483+ , commonQuery :: QueryString
1484+ , commonCutoffFrequency :: CutoffFrequency
1485+ , commonLowFreqOperator :: BooleanOperator
1486+ , commonHighFreqOperator :: BooleanOperator
1487+ , commonMinimumShouldMatch :: Maybe CommonMinimumMatch
1488+ , commonBoost :: Maybe Boost
1489+ , commonAnalyzer :: Maybe Analyzer
1490+ , commonDisableCoord :: Maybe DisableCoord
1491+ } deriving (Eq, Read, Show, Generic, Typeable)
1492+
1493+data CommonMinimumMatch =
1494+ CommonMinimumMatchHighLow MinimumMatchHighLow
1495+ | CommonMinimumMatch MinimumMatch
1496+ deriving (Eq, Read, Show, Generic, Typeable)
1497+
1498+data MinimumMatchHighLow =
1499+ MinimumMatchHighLow { lowFreq :: MinimumMatch
1500+ , highFreq :: MinimumMatch } deriving (Eq, Read, Show, Generic, Typeable)
1501+
1502+data ZeroTermsQuery = ZeroTermsNone
1503+ | ZeroTermsAll deriving (Eq, Read, Show, Generic, Typeable)
1504+
1505+data RangeExecution = RangeExecutionIndex
1506+ | RangeExecutionFielddata deriving (Eq, Read, Show, Generic, Typeable)
1507+
1508+newtype Regexp = Regexp Text deriving (Eq, Read, Show, Generic, Typeable, FromJSON)
1509+
1510+data RegexpFlags = AllRegexpFlags
1511+ | NoRegexpFlags
1512+ | SomeRegexpFlags (NonEmpty RegexpFlag) deriving (Eq, Read, Show, Generic, Typeable)
1513+
1514+data RegexpFlag = AnyString
1515+ | Automaton
1516+ | Complement
1517+ | Empty
1518+ | Intersection
1519+ | Interval deriving (Eq, Read, Show, Generic, Typeable)
1520+
1521+newtype LessThan = LessThan Double deriving (Eq, Read, Show, Generic, Typeable)
1522+newtype LessThanEq = LessThanEq Double deriving (Eq, Read, Show, Generic, Typeable)
1523+newtype GreaterThan = GreaterThan Double deriving (Eq, Read, Show, Generic, Typeable)
1524+newtype GreaterThanEq = GreaterThanEq Double deriving (Eq, Read, Show, Generic, Typeable)
1525+
1526+newtype LessThanD = LessThanD UTCTime deriving (Eq, Read, Show, Generic, Typeable)
1527+newtype LessThanEqD = LessThanEqD UTCTime deriving (Eq, Read, Show, Generic, Typeable)
1528+newtype GreaterThanD = GreaterThanD UTCTime deriving (Eq, Read, Show, Generic, Typeable)
1529+newtype GreaterThanEqD = GreaterThanEqD UTCTime deriving (Eq, Read, Show, Generic, Typeable)
1530+
1531+data RangeValue = RangeDateLte LessThanEqD
1532+ | RangeDateLt LessThanD
1533+ | RangeDateGte GreaterThanEqD
1534+ | RangeDateGt GreaterThanD
1535+ | RangeDateGtLt GreaterThanD LessThanD
1536+ | RangeDateGteLte GreaterThanEqD LessThanEqD
1537+ | RangeDateGteLt GreaterThanEqD LessThanD
1538+ | RangeDateGtLte GreaterThanD LessThanEqD
1539+ | RangeDoubleLte LessThanEq
1540+ | RangeDoubleLt LessThan
1541+ | RangeDoubleGte GreaterThanEq
1542+ | RangeDoubleGt GreaterThan
1543+ | RangeDoubleGtLt GreaterThan LessThan
1544+ | RangeDoubleGteLte GreaterThanEq LessThanEq
1545+ | RangeDoubleGteLt GreaterThanEq LessThan
1546+ | RangeDoubleGtLte GreaterThan LessThanEq
1547+ deriving (Eq, Read, Show, Generic, Typeable)
1548+
1549+rangeValueToPair :: RangeValue -> [Pair]
1550+rangeValueToPair rv = case rv of
1551+ RangeDateLte (LessThanEqD t) -> ["lte" .= t]
1552+ RangeDateGte (GreaterThanEqD t) -> ["gte" .= t]
1553+ RangeDateLt (LessThanD t) -> ["lt" .= t]
1554+ RangeDateGt (GreaterThanD t) -> ["gt" .= t]
1555+ RangeDateGteLte (GreaterThanEqD l) (LessThanEqD g) -> ["gte" .= l, "lte" .= g]
1556+ RangeDateGtLte (GreaterThanD l) (LessThanEqD g) -> ["gt" .= l, "lte" .= g]
1557+ RangeDateGteLt (GreaterThanEqD l) (LessThanD g) -> ["gte" .= l, "lt" .= g]
1558+ RangeDateGtLt (GreaterThanD l) (LessThanD g) -> ["gt" .= l, "lt" .= g]
1559+ RangeDoubleLte (LessThanEq t) -> ["lte" .= t]
1560+ RangeDoubleGte (GreaterThanEq t) -> ["gte" .= t]
1561+ RangeDoubleLt (LessThan t) -> ["lt" .= t]
1562+ RangeDoubleGt (GreaterThan t) -> ["gt" .= t]
1563+ RangeDoubleGteLte (GreaterThanEq l) (LessThanEq g) -> ["gte" .= l, "lte" .= g]
1564+ RangeDoubleGtLte (GreaterThan l) (LessThanEq g) -> ["gt" .= l, "lte" .= g]
1565+ RangeDoubleGteLt (GreaterThanEq l) (LessThan g) -> ["gte" .= l, "lt" .= g]
1566+ RangeDoubleGtLt (GreaterThan l) (LessThan g) -> ["gt" .= l, "lt" .= g]
1567+
1568+data Term = Term { termField :: Text
1569+ , termValue :: Text } deriving (Eq, Read, Show, Generic, Typeable)
1570+
1571+data BoolMatch = MustMatch Term Cache
1572+ | MustNotMatch Term Cache
1573+ | ShouldMatch [Term] Cache deriving (Eq, Read, Show, Generic, Typeable)
1574+
1575+-- "memory" or "indexed"
1576+data GeoFilterType = GeoFilterMemory
1577+ | GeoFilterIndexed deriving (Eq, Read, Show, Generic, Typeable)
1578+
1579+data LatLon = LatLon { lat :: Double
1580+ , lon :: Double } deriving (Eq, Read, Show, Generic, Typeable)
1581+
1582+data GeoBoundingBox =
1583+ GeoBoundingBox { topLeft :: LatLon
1584+ , bottomRight :: LatLon } deriving (Eq, Read, Show, Generic, Typeable)
1585+
1586+data GeoBoundingBoxConstraint =
1587+ GeoBoundingBoxConstraint { geoBBField :: FieldName
1588+ , constraintBox :: GeoBoundingBox
1589+ , bbConstraintcache :: Cache
1590+ , geoType :: GeoFilterType
1591+ } deriving (Eq, Read, Show, Generic, Typeable)
1592+
1593+data GeoPoint =
1594+ GeoPoint { geoField :: FieldName
1595+ , latLon :: LatLon} deriving (Eq, Read, Show, Generic, Typeable)
1596+
1597+data DistanceUnit = Miles
1598+ | Yards
1599+ | Feet
1600+ | Inches
1601+ | Kilometers
1602+ | Meters
1603+ | Centimeters
1604+ | Millimeters
1605+ | NauticalMiles deriving (Eq, Read, Show, Generic, Typeable)
1606+
1607+data DistanceType = Arc
1608+ | SloppyArc -- doesn't exist <1.0
1609+ | Plane deriving (Eq, Read, Show, Generic, Typeable)
1610+
1611+data OptimizeBbox = OptimizeGeoFilterType GeoFilterType
1612+ | NoOptimizeBbox deriving (Eq, Read, Show, Generic, Typeable)
1613+
1614+data Distance =
1615+ Distance { coefficient :: Double
1616+ , unit :: DistanceUnit } deriving (Eq, Read, Show, Generic, Typeable)
1617+
1618+data DistanceRange =
1619+ DistanceRange { distanceFrom :: Distance
1620+ , distanceTo :: Distance } deriving (Eq, Read, Show, Generic, Typeable)
1621+
1622+data SearchResult a =
1623+ SearchResult { took :: Int
1624+ , timedOut :: Bool
1625+ , shards :: ShardResult
1626+ , searchHits :: SearchHits a
1627+ , aggregations :: Maybe AggregationResults
1628+ , scrollId :: Maybe ScrollId } deriving (Eq, Read, Show, Generic, Typeable)
1629+
1630+newtype ScrollId = ScrollId Text deriving (Eq, Read, Show, Generic, Ord, ToJSON, FromJSON)
1631+
1632+type Score = Maybe Double
1633+
1634+data SearchHits a =
1635+ SearchHits { hitsTotal :: Int
1636+ , maxScore :: Score
1637+ , hits :: [Hit a] } deriving (Eq, Read, Show, Generic, Typeable)
1638+
1639+instance Semigroup (SearchHits a) where
1640+ (SearchHits ta ma ha) <> (SearchHits tb mb hb) = SearchHits (ta + tb) (max ma mb) (ha <> hb)
1641+
1642+instance Monoid (SearchHits a) where
1643+ mempty = SearchHits 0 Nothing mempty
1644+ mappend = (<>)
1645+
1646+data Hit a =
1647+ Hit { hitIndex :: IndexName
1648+ , hitType :: MappingName
1649+ , hitDocId :: DocId
1650+ , hitScore :: Score
1651+ , hitSource :: Maybe a
1652+ , hitHighlight :: Maybe HitHighlight } deriving (Eq, Read, Show, Generic, Typeable)
1653+
1654+data ShardResult =
1655+ ShardResult { shardTotal :: Int
1656+ , shardsSuccessful :: Int
1657+ , shardsFailed :: Int } deriving (Eq, Read, Show, Generic, Typeable)
1658+
1659+type HitHighlight = M.Map Text [Text]
1660+
1661+showText :: Show a => a -> Text
1662+showText = T.pack . show
1663+
1664+readMay :: Read a => String -> Maybe a
1665+readMay s = case reads s of
1666+ (a, ""):_ -> Just a
1667+ _ -> Nothing
1668+
1669+parseReadText :: Read a => Text -> Parser a
1670+parseReadText = maybe mzero return . readMay . T.unpack
1671+
1672+type Aggregations = M.Map Text Aggregation
1673+
1674+emptyAggregations :: Aggregations
1675+emptyAggregations = M.empty
1676+
1677+mkAggregations :: Text -> Aggregation -> Aggregations
1678+mkAggregations name aggregation = M.insert name aggregation emptyAggregations
1679+
1680+data TermOrder = TermOrder{ termSortField :: Text
1681+ , termSortOrder :: SortOrder } deriving (Eq, Read, Show, Generic, Typeable)
1682+
1683+data TermInclusion = TermInclusion Text
1684+ | TermPattern Text Text deriving (Eq, Read, Show, Generic, Typeable)
1685+
1686+data CollectionMode = BreadthFirst
1687+ | DepthFirst deriving (Eq, Read, Show, Generic, Typeable)
1688+
1689+data ExecutionHint = Ordinals
1690+ | GlobalOrdinals
1691+ | GlobalOrdinalsHash
1692+ | GlobalOrdinalsLowCardinality
1693+ | Map deriving (Eq, Read, Show, Generic, Typeable)
1694+
1695+data TimeInterval = Weeks
1696+ | Days
1697+ | Hours
1698+ | Minutes
1699+ | Seconds deriving Eq
1700+
1701+data Interval = Year
1702+ | Quarter
1703+ | Month
1704+ | Week
1705+ | Day
1706+ | Hour
1707+ | Minute
1708+ | Second deriving (Eq, Read, Show, Generic, Typeable)
1709+
1710+data Aggregation = TermsAgg TermsAggregation
1711+ | CardinalityAgg CardinalityAggregation
1712+ | DateHistogramAgg DateHistogramAggregation
1713+ | ValueCountAgg ValueCountAggregation
1714+ | FilterAgg FilterAggregation
1715+ | DateRangeAgg DateRangeAggregation
1716+ | MissingAgg MissingAggregation
1717+ | TopHitsAgg TopHitsAggregation
1718+ deriving (Eq, Read, Show, Generic, Typeable)
1719+
1720+data TopHitsAggregation = TopHitsAggregation
1721+ { taFrom :: Maybe From
1722+ , taSize :: Maybe Size
1723+ , taSort :: Maybe Sort
1724+ } deriving (Eq, Read, Show)
1725+
1726+data MissingAggregation = MissingAggregation
1727+ { maField :: Text
1728+ } deriving (Eq, Read, Show, Generic, Typeable)
1729+
1730+data TermsAggregation = TermsAggregation { term :: Either Text Text
1731+ , termInclude :: Maybe TermInclusion
1732+ , termExclude :: Maybe TermInclusion
1733+ , termOrder :: Maybe TermOrder
1734+ , termMinDocCount :: Maybe Int
1735+ , termSize :: Maybe Int
1736+ , termShardSize :: Maybe Int
1737+ , termCollectMode :: Maybe CollectionMode
1738+ , termExecutionHint :: Maybe ExecutionHint
1739+ , termAggs :: Maybe Aggregations
1740+ } deriving (Eq, Read, Show, Generic, Typeable)
1741+
1742+data CardinalityAggregation = CardinalityAggregation { cardinalityField :: FieldName,
1743+ precisionThreshold :: Maybe Int
1744+ } deriving (Eq, Read, Show, Generic, Typeable)
1745+
1746+data DateHistogramAggregation = DateHistogramAggregation { dateField :: FieldName
1747+ , dateInterval :: Interval
1748+ , dateFormat :: Maybe Text
1749+ -- pre and post deprecated in 1.5
1750+ , datePreZone :: Maybe Text
1751+ , datePostZone :: Maybe Text
1752+ , datePreOffset :: Maybe Text
1753+ , datePostOffset :: Maybe Text
1754+ , dateAggs :: Maybe Aggregations
1755+ } deriving (Eq, Read, Show, Generic, Typeable)
1756+
1757+
1758+data DateRangeAggregation = DateRangeAggregation { draField :: FieldName
1759+ , draFormat :: Maybe Text
1760+ , draRanges :: NonEmpty DateRangeAggRange
1761+ } deriving (Eq, Read, Show, Generic, Typeable)
1762+
1763+data DateRangeAggRange = DateRangeFrom DateMathExpr
1764+ | DateRangeTo DateMathExpr
1765+ | DateRangeFromAndTo DateMathExpr DateMathExpr deriving (Eq, Read, Show, Generic, Typeable)
1766+
1767+-- | See <https://www.elastic.co/guide/en/elasticsearch/reference/current/common-options.html#date-math> for more information.
1768+data DateMathExpr = DateMathExpr DateMathAnchor [DateMathModifier] deriving (Eq, Read, Show, Generic, Typeable)
1769+
1770+
1771+-- | Starting point for a date range. This along with the 'DateMathModifiers' gets you the date ES will start from.
1772+data DateMathAnchor = DMNow
1773+ | DMDate Day deriving (Eq, Read, Show, Generic, Typeable)
1774+
1775+data DateMathModifier = AddTime Int DateMathUnit
1776+ | SubtractTime Int DateMathUnit
1777+ | RoundDownTo DateMathUnit deriving (Eq, Read, Show, Generic, Typeable)
1778+
1779+data DateMathUnit = DMYear
1780+ | DMMonth
1781+ | DMWeek
1782+ | DMDay
1783+ | DMHour
1784+ | DMMinute
1785+ | DMSecond deriving (Eq, Read, Show, Generic, Typeable)
1786+
1787+-- | See <https://www.elastic.co/guide/en/elasticsearch/reference/current/search-aggregations-metrics-valuecount-aggregation.html> for more information.
1788+data ValueCountAggregation = FieldValueCount FieldName
1789+ | ScriptValueCount Script deriving (Eq, Read, Show, Generic, Typeable)
1790+
1791+-- | 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.
1792+data FilterAggregation = FilterAggregation { faFilter :: Filter
1793+ , faAggs :: Maybe Aggregations} deriving (Eq, Read, Show, Generic, Typeable)
1794+
1795+mkTermsAggregation :: Text -> TermsAggregation
1796+mkTermsAggregation t = TermsAggregation (Left t) Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing
1797+
1798+mkTermsScriptAggregation :: Text -> TermsAggregation
1799+mkTermsScriptAggregation t = TermsAggregation (Right t) Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing
1800+
1801+mkDateHistogram :: FieldName -> Interval -> DateHistogramAggregation
1802+mkDateHistogram t i = DateHistogramAggregation t i Nothing Nothing Nothing Nothing Nothing Nothing
1803+
1804+mkCardinalityAggregation :: FieldName -> CardinalityAggregation
1805+mkCardinalityAggregation t = CardinalityAggregation t Nothing
1806+
1807+instance ToJSON Version where
1808+ toJSON Version {..} = object ["number" .= number
1809+ ,"build_hash" .= build_hash
1810+ ,"build_date" .= build_date
1811+ ,"build_snapshot" .= build_snapshot
1812+ ,"lucene_version" .= lucene_version]
1813+
1814+instance FromJSON Version where
1815+ parseJSON = withObject "Version" parse
1816+ where parse o = Version
1817+ <$> o .: "number"
1818+ <*> o .: "build_hash"
1819+ <*> o .: "build_date"
1820+ <*> o .: "build_snapshot"
1821+ <*> o .: "lucene_version"
1822+
1823+instance ToJSON VersionNumber where
1824+ toJSON = toJSON . Vers.showVersion . versionNumber
1825+
1826+instance FromJSON VersionNumber where
1827+ parseJSON = withText "VersionNumber" (parse . T.unpack)
1828+ where
1829+ parse s = case filter (null . snd)(RP.readP_to_S Vers.parseVersion s) of
1830+ [(v, _)] -> pure (VersionNumber v)
1831+ [] -> fail ("Invalid version string " ++ s)
1832+ xs -> fail ("Ambiguous version string " ++ s ++ " (" ++ intercalate ", " (Vers.showVersion . fst <$> xs) ++ ")")
1833+
1834+instance ToJSON TermOrder where
1835+ toJSON (TermOrder termSortField termSortOrder) = object [termSortField .= termSortOrder]
1836+
1837+instance ToJSON TermInclusion where
1838+ toJSON (TermInclusion x) = toJSON x
1839+ toJSON (TermPattern pattern flags) = omitNulls [ "pattern" .= pattern,
1840+ "flags" .= flags]
1841+
1842+instance ToJSON CollectionMode where
1843+ toJSON BreadthFirst = "breadth_first"
1844+ toJSON DepthFirst = "depth_first"
1845+
1846+instance ToJSON ExecutionHint where
1847+ toJSON Ordinals = "ordinals"
1848+ toJSON GlobalOrdinals = "global_ordinals"
1849+ toJSON GlobalOrdinalsHash = "global_ordinals_hash"
1850+ toJSON GlobalOrdinalsLowCardinality = "global_ordinals_low_cardinality"
1851+ toJSON Map = "map"
1852+
1853+instance ToJSON Interval where
1854+ toJSON Year = "year"
1855+ toJSON Quarter = "quarter"
1856+ toJSON Month = "month"
1857+ toJSON Week = "week"
1858+ toJSON Day = "day"
1859+ toJSON Hour = "hour"
1860+ toJSON Minute = "minute"
1861+ toJSON Second = "second"
1862+
1863+instance Show TimeInterval where
1864+ show Weeks = "w"
1865+ show Days = "d"
1866+ show Hours = "h"
1867+ show Minutes = "m"
1868+ show Seconds = "s"
1869+
1870+instance Read TimeInterval where
1871+ readPrec = f =<< TR.get
1872+ where
1873+ f 'w' = return Weeks
1874+ f 'd' = return Days
1875+ f 'h' = return Hours
1876+ f 'm' = return Minutes
1877+ f 's' = return Seconds
1878+ f _ = fail "TimeInterval expected one of w, d, h, m, s"
1879+
1880+instance ToJSON Aggregation where
1881+ toJSON (TermsAgg (TermsAggregation term include exclude order minDocCount size shardSize collectMode executionHint termAggs)) =
1882+ omitNulls ["terms" .= omitNulls [ toJSON' term,
1883+ "include" .= include,
1884+ "exclude" .= exclude,
1885+ "order" .= order,
1886+ "min_doc_count" .= minDocCount,
1887+ "size" .= size,
1888+ "shard_size" .= shardSize,
1889+ "collect_mode" .= collectMode,
1890+ "execution_hint" .= executionHint
1891+ ],
1892+ "aggs" .= termAggs ]
1893+ where
1894+ toJSON' x = case x of { Left y -> "field" .= y; Right y -> "script" .= y }
1895+
1896+ toJSON (CardinalityAgg (CardinalityAggregation field precisionThreshold)) =
1897+ object ["cardinality" .= omitNulls [ "field" .= field,
1898+ "precisionThreshold" .= precisionThreshold
1899+ ]
1900+ ]
1901+
1902+ toJSON (DateHistogramAgg (DateHistogramAggregation field interval format preZone postZone preOffset postOffset dateHistoAggs)) =
1903+ omitNulls ["date_histogram" .= omitNulls [ "field" .= field,
1904+ "interval" .= interval,
1905+ "format" .= format,
1906+ "pre_zone" .= preZone,
1907+ "post_zone" .= postZone,
1908+ "pre_offset" .= preOffset,
1909+ "post_offset" .= postOffset
1910+ ],
1911+ "aggs" .= dateHistoAggs ]
1912+ toJSON (ValueCountAgg a) = object ["value_count" .= v]
1913+ where v = case a of
1914+ (FieldValueCount (FieldName n)) -> object ["field" .= n]
1915+ (ScriptValueCount (Script s)) -> object ["script" .= s]
1916+ toJSON (FilterAgg (FilterAggregation filt ags)) =
1917+ omitNulls [ "filter" .= filt
1918+ , "aggs" .= ags]
1919+ toJSON (DateRangeAgg a) = object [ "date_range" .= a
1920+ ]
1921+ toJSON (MissingAgg (MissingAggregation{..})) =
1922+ object ["missing" .= object ["field" .= maField]]
1923+
1924+ toJSON (TopHitsAgg (TopHitsAggregation mfrom msize msort)) =
1925+ omitNulls ["top_hits" .= omitNulls [ "size" .= msize
1926+ , "from" .= mfrom
1927+ , "sort" .= msort
1928+ ]
1929+ ]
1930+
1931+instance ToJSON DateRangeAggregation where
1932+ toJSON DateRangeAggregation {..} =
1933+ omitNulls [ "field" .= draField
1934+ , "format" .= draFormat
1935+ , "ranges" .= toList draRanges
1936+ ]
1937+
1938+instance ToJSON DateRangeAggRange where
1939+ toJSON (DateRangeFrom e) = object [ "from" .= e ]
1940+ toJSON (DateRangeTo e) = object [ "to" .= e ]
1941+ toJSON (DateRangeFromAndTo f t) = object [ "from" .= f, "to" .= t ]
1942+
1943+instance ToJSON DateMathExpr where
1944+ toJSON (DateMathExpr a mods) = String (fmtA a <> mconcat (fmtMod <$> mods))
1945+ where fmtA DMNow = "now"
1946+ fmtA (DMDate date) = (T.pack $ showGregorian date) <> "||"
1947+ fmtMod (AddTime n u) = "+" <> showText n <> fmtU u
1948+ fmtMod (SubtractTime n u) = "-" <> showText n <> fmtU u
1949+ fmtMod (RoundDownTo u) = "/" <> fmtU u
1950+ fmtU DMYear = "y"
1951+ fmtU DMMonth = "M"
1952+ fmtU DMWeek = "w"
1953+ fmtU DMDay = "d"
1954+ fmtU DMHour = "h"
1955+ fmtU DMMinute = "m"
1956+ fmtU DMSecond = "s"
1957+
1958+
1959+type AggregationResults = M.Map Text Value
1960+
1961+class BucketAggregation a where
1962+ key :: a -> BucketValue
1963+ docCount :: a -> Int
1964+ aggs :: a -> Maybe AggregationResults
1965+
1966+
1967+data Bucket a = Bucket { buckets :: [a]} deriving (Read, Show)
1968+
1969+data BucketValue = TextValue Text
1970+ | ScientificValue Scientific
1971+ | BoolValue Bool deriving (Read, Show)
1972+
1973+data MissingResult = MissingResult { missingDocCount :: Int } deriving (Show)
1974+
1975+data TopHitResult a = TopHitResult { tarHits :: (SearchHits a)
1976+ } deriving Show
1977+
1978+data TermsResult = TermsResult { termKey :: BucketValue
1979+ , termsDocCount :: Int
1980+ , termsAggs :: Maybe AggregationResults } deriving (Read, Show)
1981+
1982+data DateHistogramResult = DateHistogramResult { dateKey :: Int
1983+ , dateKeyStr :: Maybe Text
1984+ , dateDocCount :: Int
1985+ , dateHistogramAggs :: Maybe AggregationResults } deriving (Read, Show)
1986+
1987+data DateRangeResult = DateRangeResult { dateRangeKey :: Text
1988+ , dateRangeFrom :: Maybe UTCTime
1989+ , dateRangeFromAsString :: Maybe Text
1990+ , dateRangeTo :: Maybe UTCTime
1991+ , dateRangeToAsString :: Maybe Text
1992+ , dateRangeDocCount :: Int
1993+ , dateRangeAggs :: Maybe AggregationResults } deriving (Read, Show, Eq, Generic, Typeable)
1994+
1995+toTerms :: Text -> AggregationResults -> Maybe (Bucket TermsResult)
1996+toTerms = toAggResult
1997+
1998+toDateHistogram :: Text -> AggregationResults -> Maybe (Bucket DateHistogramResult)
1999+toDateHistogram = toAggResult
2000+
2001+toMissing :: Text -> AggregationResults -> Maybe MissingResult
2002+toMissing = toAggResult
2003+
2004+toTopHits :: (FromJSON a) => Text -> AggregationResults -> Maybe (TopHitResult a)
2005+toTopHits = toAggResult
2006+
2007+toAggResult :: (FromJSON a) => Text -> AggregationResults -> Maybe a
2008+toAggResult t a = M.lookup t a >>= deserialize
2009+ where deserialize = parseMaybe parseJSON
2010+
2011+instance BucketAggregation TermsResult where
2012+ key = termKey
2013+ docCount = termsDocCount
2014+ aggs = termsAggs
2015+
2016+instance BucketAggregation DateHistogramResult where
2017+ key = TextValue . showText . dateKey
2018+ docCount = dateDocCount
2019+ aggs = dateHistogramAggs
2020+
2021+instance BucketAggregation DateRangeResult where
2022+ key = TextValue . dateRangeKey
2023+ docCount = dateRangeDocCount
2024+ aggs = dateRangeAggs
2025+
2026+instance (FromJSON a, BucketAggregation a) => FromJSON (Bucket a) where
2027+ parseJSON (Object v) = Bucket <$>
2028+ v .: "buckets"
2029+ parseJSON _ = mempty
2030+
2031+instance FromJSON BucketValue where
2032+ parseJSON (String t) = return $ TextValue t
2033+ parseJSON (Number s) = return $ ScientificValue s
2034+ parseJSON (Bool b) = return $ BoolValue b
2035+ parseJSON _ = mempty
2036+
2037+instance FromJSON MissingResult where
2038+ parseJSON = withObject "MissingResult" parse
2039+ where parse v = MissingResult <$> v .: "doc_count"
2040+
2041+instance FromJSON TermsResult where
2042+ parseJSON (Object v) = TermsResult <$>
2043+ v .: "key" <*>
2044+ v .: "doc_count" <*>
2045+ (pure $ getNamedSubAgg v ["key", "doc_count"])
2046+ parseJSON _ = mempty
2047+
2048+instance FromJSON DateHistogramResult where
2049+ parseJSON (Object v) = DateHistogramResult <$>
2050+ v .: "key" <*>
2051+ v .:? "key_as_string" <*>
2052+ v .: "doc_count" <*>
2053+ (pure $ getNamedSubAgg v [ "key"
2054+ , "doc_count"
2055+ , "key_as_string"
2056+ ]
2057+ )
2058+ parseJSON _ = mempty
2059+
2060+instance FromJSON DateRangeResult where
2061+ parseJSON = withObject "DateRangeResult" parse
2062+ where parse v = DateRangeResult <$>
2063+ v .: "key" <*>
2064+ (fmap posixMS <$> v .:? "from") <*>
2065+ v .:? "from_as_string" <*>
2066+ (fmap posixMS <$> v .:? "to") <*>
2067+ v .:? "to_as_string" <*>
2068+ v .: "doc_count" <*>
2069+ (pure $ getNamedSubAgg v [ "key"
2070+ , "from"
2071+ , "from_as_string"
2072+ , "to"
2073+ , "to_as_string"
2074+ , "doc_count"
2075+ ]
2076+ )
2077+
2078+instance FromJSON POSIXMS where
2079+ parseJSON = withScientific "POSIXMS" (return . parse)
2080+ where parse n = let n' = truncate n :: Integer
2081+ in POSIXMS (posixSecondsToUTCTime (fromInteger (n' `div` 1000)))
2082+
2083+instance (FromJSON a) => FromJSON (TopHitResult a) where
2084+ parseJSON (Object v) = TopHitResult <$>
2085+ v .: "hits"
2086+ parseJSON _ = fail "Failure in FromJSON (TopHitResult a)"
2087+
2088+fieldTagged :: Monad m => (FieldName -> Object -> m a) -> Object -> m a
2089+fieldTagged f o = case HM.toList o of
2090+ [(k, Object o')] -> f (FieldName k) o'
2091+ _ -> fail "Expected object with 1 field-named key"
2092+
2093+-- Try to get an AggregationResults when we don't know the
2094+-- field name. We filter out the known keys to try to minimize the noise.
2095+getNamedSubAgg :: Object -> [Text] -> Maybe AggregationResults
2096+getNamedSubAgg o knownKeys = maggRes
2097+ where unknownKeys = HM.filterWithKey (\k _ -> k `notElem` knownKeys) o
2098+ maggRes
2099+ | HM.null unknownKeys = Nothing
2100+ | otherwise = Just . M.fromList $ HM.toList unknownKeys
2101+
2102+instance ToJSON GeoPoint where
2103+ toJSON (GeoPoint (FieldName geoPointField) geoPointLatLon) =
2104+ object [ geoPointField .= geoPointLatLon ]
2105+
2106+
2107+instance ToJSON Query where
2108+ toJSON (TermQuery (Term termQueryField termQueryValue) boost) =
2109+ object [ "term" .=
2110+ object [termQueryField .= object merged]]
2111+ where
2112+ base = [ "value" .= termQueryValue ]
2113+ boosted = maybe [] (return . ("boost" .=)) boost
2114+ merged = mappend base boosted
2115+
2116+ toJSON (TermsQuery fieldName terms) =
2117+ object [ "terms" .= object conjoined ]
2118+ where conjoined = [fieldName .= terms]
2119+
2120+ toJSON (IdsQuery idsQueryMappingName docIds) =
2121+ object [ "ids" .= object conjoined ]
2122+ where conjoined = [ "type" .= idsQueryMappingName
2123+ , "values" .= fmap toJSON docIds ]
2124+
2125+ toJSON (QueryQueryStringQuery qQueryStringQuery) =
2126+ object [ "query_string" .= qQueryStringQuery ]
2127+
2128+ toJSON (QueryMatchQuery matchQuery) =
2129+ object [ "match" .= matchQuery ]
2130+
2131+ toJSON (QueryMultiMatchQuery multiMatchQuery) =
2132+ toJSON multiMatchQuery
2133+
2134+ toJSON (QueryBoolQuery boolQuery) =
2135+ object [ "bool" .= boolQuery ]
2136+
2137+ toJSON (QueryBoostingQuery boostingQuery) =
2138+ object [ "boosting" .= boostingQuery ]
2139+
2140+ toJSON (QueryCommonTermsQuery commonTermsQuery) =
2141+ object [ "common" .= commonTermsQuery ]
2142+
2143+ toJSON (ConstantScoreQuery query boost) =
2144+ object ["constant_score" .= object ["query" .= query
2145+ , "boost" .= boost]]
2146+
2147+ toJSON (QueryDisMaxQuery disMaxQuery) =
2148+ object [ "dis_max" .= disMaxQuery ]
2149+
2150+ toJSON (QueryFuzzyLikeThisQuery fuzzyQuery) =
2151+ object [ "fuzzy_like_this" .= fuzzyQuery ]
2152+
2153+ toJSON (QueryFuzzyLikeFieldQuery fuzzyFieldQuery) =
2154+ object [ "fuzzy_like_this_field" .= fuzzyFieldQuery ]
2155+
2156+ toJSON (QueryFuzzyQuery fuzzyQuery) =
2157+ object [ "fuzzy" .= fuzzyQuery ]
2158+
2159+ toJSON (QueryHasChildQuery childQuery) =
2160+ object [ "has_child" .= childQuery ]
2161+
2162+ toJSON (QueryHasParentQuery parentQuery) =
2163+ object [ "has_parent" .= parentQuery ]
2164+
2165+ toJSON (QueryIndicesQuery qIndicesQuery) =
2166+ object [ "indices" .= qIndicesQuery ]
2167+
2168+ toJSON (MatchAllQuery boost) =
2169+ object [ "match_all" .= omitNulls [ "boost" .= boost ] ]
2170+
2171+ toJSON (QueryMoreLikeThisQuery query) =
2172+ object [ "more_like_this" .= query ]
2173+
2174+ toJSON (QueryMoreLikeThisFieldQuery query) =
2175+ object [ "more_like_this_field" .= query ]
2176+
2177+ toJSON (QueryNestedQuery query) =
2178+ object [ "nested" .= query ]
2179+
2180+ toJSON (QueryPrefixQuery query) =
2181+ object [ "prefix" .= query ]
2182+
2183+ toJSON (QueryRangeQuery query) =
2184+ object [ "range" .= query ]
2185+
2186+ toJSON (QueryRegexpQuery query) =
2187+ object [ "regexp" .= query ]
2188+
2189+ toJSON (QuerySimpleQueryStringQuery query) =
2190+ object [ "simple_query_string" .= query ]
2191+
2192+ toJSON (QueryExistsQuery (FieldName fieldName)) =
2193+ object ["exists" .= object
2194+ ["field" .= fieldName]
2195+ ]
2196+ toJSON QueryMatchNoneQuery =
2197+ object ["match_none" .= object []]
2198+
2199+instance FromJSON Query where
2200+ parseJSON v = withObject "Query" parse v
2201+ where parse o = termQuery `taggedWith` "term"
2202+ <|> termsQuery `taggedWith` "terms"
2203+ <|> idsQuery `taggedWith` "ids"
2204+ <|> queryQueryStringQuery `taggedWith` "query_string"
2205+ <|> queryMatchQuery `taggedWith` "match"
2206+ <|> queryMultiMatchQuery
2207+ <|> queryBoolQuery `taggedWith` "bool"
2208+ <|> queryBoostingQuery `taggedWith` "boosting"
2209+ <|> queryCommonTermsQuery `taggedWith` "common"
2210+ <|> constantScoreQuery `taggedWith` "constant_score"
2211+ <|> queryDisMaxQuery `taggedWith` "dis_max"
2212+ <|> queryFuzzyLikeThisQuery `taggedWith` "fuzzy_like_this"
2213+ <|> queryFuzzyLikeFieldQuery `taggedWith` "fuzzy_like_this_field"
2214+ <|> queryFuzzyQuery `taggedWith` "fuzzy"
2215+ <|> queryHasChildQuery `taggedWith` "has_child"
2216+ <|> queryHasParentQuery `taggedWith` "has_parent"
2217+ <|> queryIndicesQuery `taggedWith` "indices"
2218+ <|> matchAllQuery `taggedWith` "match_all"
2219+ <|> queryMoreLikeThisQuery `taggedWith` "more_like_this"
2220+ <|> queryMoreLikeThisFieldQuery `taggedWith` "more_like_this_field"
2221+ <|> queryNestedQuery `taggedWith` "nested"
2222+ <|> queryPrefixQuery `taggedWith` "prefix"
2223+ <|> queryRangeQuery `taggedWith` "range"
2224+ <|> queryRegexpQuery `taggedWith` "regexp"
2225+ <|> querySimpleQueryStringQuery `taggedWith` "simple_query_string"
2226+ where taggedWith parser k = parser =<< o .: k
2227+ termQuery = fieldTagged $ \(FieldName fn) o ->
2228+ TermQuery <$> (Term fn <$> o .: "value") <*> o .:? "boost"
2229+ termsQuery o = case HM.toList o of
2230+ [(fn, vs)] -> do vals <- parseJSON vs
2231+ case vals of
2232+ x:xs -> return (TermsQuery fn (x :| xs))
2233+ _ -> fail "Expected non empty list of values"
2234+ _ -> fail "Expected object with 1 field-named key"
2235+ idsQuery o = IdsQuery <$> o .: "type"
2236+ <*> o .: "values"
2237+ queryQueryStringQuery = pure . QueryQueryStringQuery
2238+ queryMatchQuery = pure . QueryMatchQuery
2239+ queryMultiMatchQuery = QueryMultiMatchQuery <$> parseJSON v
2240+ queryBoolQuery = pure . QueryBoolQuery
2241+ queryBoostingQuery = pure . QueryBoostingQuery
2242+ queryCommonTermsQuery = pure . QueryCommonTermsQuery
2243+ constantScoreQuery o = case HM.lookup "query" o of
2244+ Just x -> ConstantScoreQuery <$> parseJSON x
2245+ <*> o .: "boost"
2246+ _ -> fail "Does not appear to be a ConstantScoreQuery"
2247+ queryDisMaxQuery = pure . QueryDisMaxQuery
2248+ queryFuzzyLikeThisQuery = pure . QueryFuzzyLikeThisQuery
2249+ queryFuzzyLikeFieldQuery = pure . QueryFuzzyLikeFieldQuery
2250+ queryFuzzyQuery = pure . QueryFuzzyQuery
2251+ queryHasChildQuery = pure . QueryHasChildQuery
2252+ queryHasParentQuery = pure . QueryHasParentQuery
2253+ queryIndicesQuery = pure . QueryIndicesQuery
2254+ matchAllQuery o = MatchAllQuery <$> o .:? "boost"
2255+ queryMoreLikeThisQuery = pure . QueryMoreLikeThisQuery
2256+ queryMoreLikeThisFieldQuery = pure . QueryMoreLikeThisFieldQuery
2257+ queryNestedQuery = pure . QueryNestedQuery
2258+ queryPrefixQuery = pure . QueryPrefixQuery
2259+ queryRangeQuery = pure . QueryRangeQuery
2260+ queryRegexpQuery = pure . QueryRegexpQuery
2261+ querySimpleQueryStringQuery = pure . QuerySimpleQueryStringQuery
2262+ queryExistsQuery o = QueryExistsQuery <$> o .: "field"
2263+
2264+
2265+omitNulls :: [(Text, Value)] -> Value
2266+omitNulls = object . filter notNull where
2267+ notNull (_, Null) = False
2268+ notNull (_, Array a) = (not . V.null) a
2269+ notNull _ = True
2270+
2271+instance ToJSON SimpleQueryStringQuery where
2272+ toJSON SimpleQueryStringQuery {..} =
2273+ omitNulls (base ++ maybeAdd)
2274+ where base = [ "query" .= simpleQueryStringQuery ]
2275+ maybeAdd = [ "fields" .= simpleQueryStringField
2276+ , "default_operator" .= simpleQueryStringOperator
2277+ , "analyzer" .= simpleQueryStringAnalyzer
2278+ , "flags" .= simpleQueryStringFlags
2279+ , "lowercase_expanded_terms" .= simpleQueryStringLowercaseExpanded
2280+ , "locale" .= simpleQueryStringLocale ]
2281+
2282+instance FromJSON SimpleQueryStringQuery where
2283+ parseJSON = withObject "SimpleQueryStringQuery" parse
2284+ where parse o = SimpleQueryStringQuery <$> o .: "query"
2285+ <*> o .:? "fields"
2286+ <*> o .:? "default_operator"
2287+ <*> o .:? "analyzer"
2288+ <*> (parseFlags <$> o .:? "flags")
2289+ <*> o .:? "lowercase_expanded_terms"
2290+ <*> o .:? "locale"
2291+ parseFlags (Just (x:xs)) = Just (x :| xs)
2292+ parseFlags _ = Nothing
2293+
2294+instance ToJSON FieldOrFields where
2295+ toJSON (FofField fieldName) =
2296+ toJSON fieldName
2297+ toJSON (FofFields fieldNames) =
2298+ toJSON fieldNames
2299+
2300+instance FromJSON FieldOrFields where
2301+ parseJSON v = FofField <$> parseJSON v
2302+ <|> FofFields <$> (parseNEJSON =<< parseJSON v)
2303+
2304+instance ToJSON SimpleQueryFlag where
2305+ toJSON SimpleQueryAll = "ALL"
2306+ toJSON SimpleQueryNone = "NONE"
2307+ toJSON SimpleQueryAnd = "AND"
2308+ toJSON SimpleQueryOr = "OR"
2309+ toJSON SimpleQueryPrefix = "PREFIX"
2310+ toJSON SimpleQueryPhrase = "PHRASE"
2311+ toJSON SimpleQueryPrecedence = "PRECEDENCE"
2312+ toJSON SimpleQueryEscape = "ESCAPE"
2313+ toJSON SimpleQueryWhitespace = "WHITESPACE"
2314+ toJSON SimpleQueryFuzzy = "FUZZY"
2315+ toJSON SimpleQueryNear = "NEAR"
2316+ toJSON SimpleQuerySlop = "SLOP"
2317+
2318+instance FromJSON SimpleQueryFlag where
2319+ parseJSON = withText "SimpleQueryFlag" parse
2320+ where parse "ALL" = pure SimpleQueryAll
2321+ parse "NONE" = pure SimpleQueryNone
2322+ parse "AND" = pure SimpleQueryAnd
2323+ parse "OR" = pure SimpleQueryOr
2324+ parse "PREFIX" = pure SimpleQueryPrefix
2325+ parse "PHRASE" = pure SimpleQueryPhrase
2326+ parse "PRECEDENCE" = pure SimpleQueryPrecedence
2327+ parse "ESCAPE" = pure SimpleQueryEscape
2328+ parse "WHITESPACE" = pure SimpleQueryWhitespace
2329+ parse "FUZZY" = pure SimpleQueryFuzzy
2330+ parse "NEAR" = pure SimpleQueryNear
2331+ parse "SLOP" = pure SimpleQuerySlop
2332+ parse f = fail ("Unexpected SimpleQueryFlag: " <> show f)
2333+
2334+instance ToJSON RegexpQuery where
2335+ toJSON (RegexpQuery (FieldName rqQueryField)
2336+ (Regexp regexpQueryQuery) rqQueryFlags
2337+ rqQueryBoost) =
2338+ object [ rqQueryField .= omitNulls base ]
2339+ where base = [ "value" .= regexpQueryQuery
2340+ , "flags" .= rqQueryFlags
2341+ , "boost" .= rqQueryBoost ]
2342+
2343+instance FromJSON RegexpQuery where
2344+ parseJSON = withObject "RegexpQuery" parse
2345+ where parse = fieldTagged $ \fn o ->
2346+ RegexpQuery fn
2347+ <$> o .: "value"
2348+ <*> o .: "flags"
2349+ <*> o .:? "boost"
2350+
2351+instance ToJSON QueryStringQuery where
2352+ toJSON (QueryStringQuery qsQueryString
2353+ qsDefaultField qsOperator
2354+ qsAnalyzer qsAllowWildcard
2355+ qsLowercaseExpanded qsEnablePositionIncrements
2356+ qsFuzzyMaxExpansions qsFuzziness
2357+ qsFuzzyPrefixLength qsPhraseSlop
2358+ qsBoost qsAnalyzeWildcard
2359+ qsGeneratePhraseQueries qsMinimumShouldMatch
2360+ qsLenient qsLocale) =
2361+ omitNulls base
2362+ where
2363+ base = [ "query" .= qsQueryString
2364+ , "default_field" .= qsDefaultField
2365+ , "default_operator" .= qsOperator
2366+ , "analyzer" .= qsAnalyzer
2367+ , "allow_leading_wildcard" .= qsAllowWildcard
2368+ , "lowercase_expanded_terms" .= qsLowercaseExpanded
2369+ , "enable_position_increments" .= qsEnablePositionIncrements
2370+ , "fuzzy_max_expansions" .= qsFuzzyMaxExpansions
2371+ , "fuzziness" .= qsFuzziness
2372+ , "fuzzy_prefix_length" .= qsFuzzyPrefixLength
2373+ , "phrase_slop" .= qsPhraseSlop
2374+ , "boost" .= qsBoost
2375+ , "analyze_wildcard" .= qsAnalyzeWildcard
2376+ , "auto_generate_phrase_queries" .= qsGeneratePhraseQueries
2377+ , "minimum_should_match" .= qsMinimumShouldMatch
2378+ , "lenient" .= qsLenient
2379+ , "locale" .= qsLocale ]
2380+
2381+instance FromJSON QueryStringQuery where
2382+ parseJSON = withObject "QueryStringQuery" parse
2383+ where parse o = QueryStringQuery
2384+ <$> o .: "query"
2385+ <*> o .:? "default_field"
2386+ <*> o .:? "default_operator"
2387+ <*> o .:? "analyzer"
2388+ <*> o .:? "allow_leading_wildcard"
2389+ <*> o .:? "lowercase_expanded_terms"
2390+ <*> o .:? "enable_position_increments"
2391+ <*> o .:? "fuzzy_max_expansions"
2392+ <*> o .:? "fuzziness"
2393+ <*> o .:? "fuzzy_prefix_length"
2394+ <*> o .:? "phrase_slop"
2395+ <*> o .:? "boost"
2396+ <*> o .:? "analyze_wildcard"
2397+ <*> o .:? "auto_generate_phrase_queries"
2398+ <*> o .:? "minimum_should_match"
2399+ <*> o .:? "lenient"
2400+ <*> o .:? "locale"
2401+
2402+instance ToJSON RangeQuery where
2403+ toJSON (RangeQuery (FieldName fieldName) range boost) =
2404+ object [ fieldName .= object conjoined ]
2405+ where conjoined = [ "boost" .= boost ] ++ (rangeValueToPair range)
2406+
2407+instance FromJSON RangeQuery where
2408+ parseJSON = withObject "RangeQuery" parse
2409+ where parse = fieldTagged $ \fn o ->
2410+ RangeQuery fn
2411+ <$> parseJSON (Object o)
2412+ <*> o .: "boost"
2413+
2414+instance FromJSON RangeValue where
2415+ parseJSON = withObject "RangeValue" parse
2416+ where parse o = parseDate o
2417+ <|> parseDouble o
2418+ parseDate o = do lt <- o .:? "lt"
2419+ lte <- o .:? "lte"
2420+ gt <- o .:? "gt"
2421+ gte <- o .:? "gte"
2422+ case (lt, lte, gt, gte) of
2423+ (Just a, _, Just b, _) -> return (RangeDateGtLt (GreaterThanD b) (LessThanD a))
2424+ (Just a, _, _, Just b)-> return (RangeDateGteLt (GreaterThanEqD b) (LessThanD a))
2425+ (_, Just a, Just b, _)-> return (RangeDateGtLte (GreaterThanD b) (LessThanEqD a))
2426+ (_, Just a, _, Just b)-> return (RangeDateGteLte (GreaterThanEqD b) (LessThanEqD a))
2427+ (_, _, Just a, _)-> return (RangeDateGt (GreaterThanD a))
2428+ (Just a, _, _, _)-> return (RangeDateLt (LessThanD a))
2429+ (_, _, _, Just a)-> return (RangeDateGte (GreaterThanEqD a))
2430+ (_, Just a, _, _)-> return (RangeDateLte (LessThanEqD a))
2431+ (Nothing, Nothing, Nothing, Nothing) -> mzero
2432+ parseDouble o = do lt <- o .:? "lt"
2433+ lte <- o .:? "lte"
2434+ gt <- o .:? "gt"
2435+ gte <- o .:? "gte"
2436+ case (lt, lte, gt, gte) of
2437+ (Just a, _, Just b, _) -> return (RangeDoubleGtLt (GreaterThan b) (LessThan a))
2438+ (Just a, _, _, Just b)-> return (RangeDoubleGteLt (GreaterThanEq b) (LessThan a))
2439+ (_, Just a, Just b, _)-> return (RangeDoubleGtLte (GreaterThan b) (LessThanEq a))
2440+ (_, Just a, _, Just b)-> return (RangeDoubleGteLte (GreaterThanEq b) (LessThanEq a))
2441+ (_, _, Just a, _)-> return (RangeDoubleGt (GreaterThan a))
2442+ (Just a, _, _, _)-> return (RangeDoubleLt (LessThan a))
2443+ (_, _, _, Just a)-> return (RangeDoubleGte (GreaterThanEq a))
2444+ (_, Just a, _, _)-> return (RangeDoubleLte (LessThanEq a))
2445+ (Nothing, Nothing, Nothing, Nothing) -> mzero
2446+
2447+instance ToJSON PrefixQuery where
2448+ toJSON (PrefixQuery (FieldName fieldName) queryValue boost) =
2449+ object [ fieldName .= omitNulls base ]
2450+ where base = [ "value" .= queryValue
2451+ , "boost" .= boost ]
2452+
2453+instance FromJSON PrefixQuery where
2454+ parseJSON = withObject "PrefixQuery" parse
2455+ where parse = fieldTagged $ \fn o ->
2456+ PrefixQuery fn
2457+ <$> o .: "value"
2458+ <*> o .:? "boost"
2459+
2460+instance ToJSON NestedQuery where
2461+ toJSON (NestedQuery nqPath nqScoreType nqQuery) =
2462+ object [ "path" .= nqPath
2463+ , "score_mode" .= nqScoreType
2464+ , "query" .= nqQuery ]
2465+
2466+instance FromJSON NestedQuery where
2467+ parseJSON = withObject "NestedQuery" parse
2468+ where parse o = NestedQuery
2469+ <$> o .: "path"
2470+ <*> o .: "score_mode"
2471+ <*> o .: "query"
2472+
2473+instance ToJSON MoreLikeThisFieldQuery where
2474+ toJSON (MoreLikeThisFieldQuery text (FieldName fieldName)
2475+ percent mtf mqt stopwords mindf maxdf
2476+ minwl maxwl boostTerms boost analyzer) =
2477+ object [ fieldName .= omitNulls base ]
2478+ where base = [ "like_text" .= text
2479+ , "percent_terms_to_match" .= percent
2480+ , "min_term_freq" .= mtf
2481+ , "max_query_terms" .= mqt
2482+ , "stop_words" .= stopwords
2483+ , "min_doc_freq" .= mindf
2484+ , "max_doc_freq" .= maxdf
2485+ , "min_word_length" .= minwl
2486+ , "max_word_length" .= maxwl
2487+ , "boost_terms" .= boostTerms
2488+ , "boost" .= boost
2489+ , "analyzer" .= analyzer ]
2490+
2491+instance FromJSON MoreLikeThisFieldQuery where
2492+ parseJSON = withObject "MoreLikeThisFieldQuery" parse
2493+ where parse = fieldTagged $ \fn o ->
2494+ MoreLikeThisFieldQuery
2495+ <$> o .: "like_text"
2496+ <*> pure fn
2497+ <*> o .:? "percent_terms_to_match"
2498+ <*> o .:? "min_term_freq"
2499+ <*> o .:? "max_query_terms"
2500+ -- <*> (optionalNE =<< o .:? "stop_words")
2501+ <*> o .:? "stop_words"
2502+ <*> o .:? "min_doc_freq"
2503+ <*> o .:? "max_doc_freq"
2504+ <*> o .:? "min_word_length"
2505+ <*> o .:? "max_word_length"
2506+ <*> o .:? "boost_terms"
2507+ <*> o .:? "boost"
2508+ <*> o .:? "analyzer"
2509+ -- optionalNE = maybe (pure Nothing) (fmap Just . parseNEJSON)
2510+
2511+instance ToJSON MoreLikeThisQuery where
2512+ toJSON (MoreLikeThisQuery text fields percent
2513+ mtf mqt stopwords mindf maxdf
2514+ minwl maxwl boostTerms boost analyzer) =
2515+ omitNulls base
2516+ where base = [ "like_text" .= text
2517+ , "fields" .= fields
2518+ , "percent_terms_to_match" .= percent
2519+ , "min_term_freq" .= mtf
2520+ , "max_query_terms" .= mqt
2521+ , "stop_words" .= stopwords
2522+ , "min_doc_freq" .= mindf
2523+ , "max_doc_freq" .= maxdf
2524+ , "min_word_length" .= minwl
2525+ , "max_word_length" .= maxwl
2526+ , "boost_terms" .= boostTerms
2527+ , "boost" .= boost
2528+ , "analyzer" .= analyzer ]
2529+
2530+instance FromJSON MoreLikeThisQuery where
2531+ parseJSON = withObject "MoreLikeThisQuery" parse
2532+ where parse o = MoreLikeThisQuery
2533+ <$> o .: "like_text"
2534+ -- <*> (optionalNE =<< o .:? "fields")
2535+ <*> o .:? "fields"
2536+ <*> o .:? "percent_terms_to_match"
2537+ <*> o .:? "min_term_freq"
2538+ <*> o .:? "max_query_terms"
2539+ -- <*> (optionalNE =<< o .:? "stop_words")
2540+ <*> o .:? "stop_words"
2541+ <*> o .:? "min_doc_freq"
2542+ <*> o .:? "max_doc_freq"
2543+ <*> o .:? "min_word_length"
2544+ <*> o .:? "max_word_length"
2545+ <*> o .:? "boost_terms"
2546+ <*> o .:? "boost"
2547+ <*> o .:? "analyzer"
2548+ -- optionalNE = maybe (pure Nothing) (fmap Just . parseNEJSON)
2549+
2550+instance ToJSON IndicesQuery where
2551+ toJSON (IndicesQuery indices query noMatch) =
2552+ omitNulls [ "indices" .= indices
2553+ , "no_match_query" .= noMatch
2554+ , "query" .= query ]
2555+
2556+instance FromJSON IndicesQuery where
2557+ parseJSON = withObject "IndicesQuery" parse
2558+ where parse o = IndicesQuery
2559+ <$> o .:? "indices" .!= []
2560+ <*> o .: "query"
2561+ <*> o .:? "no_match_query"
2562+
2563+instance ToJSON HasParentQuery where
2564+ toJSON (HasParentQuery queryType query scoreType) =
2565+ omitNulls [ "parent_type" .= queryType
2566+ , "score_type" .= scoreType
2567+ , "query" .= query ]
2568+
2569+instance FromJSON HasParentQuery where
2570+ parseJSON = withObject "HasParentQuery" parse
2571+ where parse o = HasParentQuery
2572+ <$> o .: "parent_type"
2573+ <*> o .: "query"
2574+ <*> o .:? "score_type"
2575+
2576+instance ToJSON HasChildQuery where
2577+ toJSON (HasChildQuery queryType query scoreType) =
2578+ omitNulls [ "query" .= query
2579+ , "score_type" .= scoreType
2580+ , "type" .= queryType ]
2581+
2582+instance FromJSON HasChildQuery where
2583+ parseJSON = withObject "HasChildQuery" parse
2584+ where parse o = HasChildQuery
2585+ <$> o .: "type"
2586+ <*> o .: "query"
2587+ <*> o .:? "score_type"
2588+
2589+instance ToJSON FuzzyQuery where
2590+ toJSON (FuzzyQuery (FieldName fieldName) queryText
2591+ prefixLength maxEx fuzziness boost) =
2592+ object [ fieldName .= omitNulls base ]
2593+ where base = [ "value" .= queryText
2594+ , "fuzziness" .= fuzziness
2595+ , "prefix_length" .= prefixLength
2596+ , "boost" .= boost
2597+ , "max_expansions" .= maxEx ]
2598+
2599+instance FromJSON FuzzyQuery where
2600+ parseJSON = withObject "FuzzyQuery" parse
2601+ where parse = fieldTagged $ \fn o ->
2602+ FuzzyQuery fn
2603+ <$> o .: "value"
2604+ <*> o .: "prefix_length"
2605+ <*> o .: "max_expansions"
2606+ <*> o .: "fuzziness"
2607+ <*> o .:? "boost"
2608+
2609+instance ToJSON FuzzyLikeFieldQuery where
2610+ toJSON (FuzzyLikeFieldQuery (FieldName fieldName)
2611+ fieldText maxTerms ignoreFreq fuzziness prefixLength
2612+ boost analyzer) =
2613+ object [ fieldName .=
2614+ omitNulls [ "like_text" .= fieldText
2615+ , "max_query_terms" .= maxTerms
2616+ , "ignore_tf" .= ignoreFreq
2617+ , "fuzziness" .= fuzziness
2618+ , "prefix_length" .= prefixLength
2619+ , "analyzer" .= analyzer
2620+ , "boost" .= boost ]]
2621+
2622+instance FromJSON FuzzyLikeFieldQuery where
2623+ parseJSON = withObject "FuzzyLikeFieldQuery" parse
2624+ where parse = fieldTagged $ \fn o ->
2625+ FuzzyLikeFieldQuery fn
2626+ <$> o .: "like_text"
2627+ <*> o .: "max_query_terms"
2628+ <*> o .: "ignore_tf"
2629+ <*> o .: "fuzziness"
2630+ <*> o .: "prefix_length"
2631+ <*> o .: "boost"
2632+ <*> o .:? "analyzer"
2633+
2634+instance ToJSON FuzzyLikeThisQuery where
2635+ toJSON (FuzzyLikeThisQuery fields text maxTerms
2636+ ignoreFreq fuzziness prefixLength boost analyzer) =
2637+ omitNulls base
2638+ where base = [ "fields" .= fields
2639+ , "like_text" .= text
2640+ , "max_query_terms" .= maxTerms
2641+ , "ignore_tf" .= ignoreFreq
2642+ , "fuzziness" .= fuzziness
2643+ , "prefix_length" .= prefixLength
2644+ , "analyzer" .= analyzer
2645+ , "boost" .= boost ]
2646+
2647+instance FromJSON FuzzyLikeThisQuery where
2648+ parseJSON = withObject "FuzzyLikeThisQuery" parse
2649+ where parse o = FuzzyLikeThisQuery
2650+ <$> o .:? "fields" .!= []
2651+ <*> o .: "like_text"
2652+ <*> o .: "max_query_terms"
2653+ <*> o .: "ignore_tf"
2654+ <*> o .: "fuzziness"
2655+ <*> o .: "prefix_length"
2656+ <*> o .: "boost"
2657+ <*> o .:? "analyzer"
2658+
2659+instance ToJSON DisMaxQuery where
2660+ toJSON (DisMaxQuery queries tiebreaker boost) =
2661+ omitNulls base
2662+ where base = [ "queries" .= queries
2663+ , "boost" .= boost
2664+ , "tie_breaker" .= tiebreaker ]
2665+
2666+instance FromJSON DisMaxQuery where
2667+ parseJSON = withObject "DisMaxQuery" parse
2668+ where parse o = DisMaxQuery
2669+ <$> o .:? "queries" .!= []
2670+ <*> o .: "tie_breaker"
2671+ <*> o .:? "boost"
2672+
2673+instance ToJSON CommonTermsQuery where
2674+ toJSON (CommonTermsQuery (FieldName fieldName)
2675+ (QueryString query) cf lfo hfo msm
2676+ boost analyzer disableCoord) =
2677+ object [fieldName .= omitNulls base ]
2678+ where base = [ "query" .= query
2679+ , "cutoff_frequency" .= cf
2680+ , "low_freq_operator" .= lfo
2681+ , "minimum_should_match" .= msm
2682+ , "boost" .= boost
2683+ , "analyzer" .= analyzer
2684+ , "disable_coord" .= disableCoord
2685+ , "high_freq_operator" .= hfo ]
2686+
2687+instance FromJSON CommonTermsQuery where
2688+ parseJSON = withObject "CommonTermsQuery" parse
2689+ where parse = fieldTagged $ \fn o ->
2690+ CommonTermsQuery fn
2691+ <$> o .: "query"
2692+ <*> o .: "cutoff_frequency"
2693+ <*> o .: "low_freq_operator"
2694+ <*> o .: "high_freq_operator"
2695+ <*> o .:? "minimum_should_match"
2696+ <*> o .:? "boost"
2697+ <*> o .:? "analyzer"
2698+ <*> o .:? "disable_coord"
2699+
2700+instance ToJSON CommonMinimumMatch where
2701+ toJSON (CommonMinimumMatch mm) = toJSON mm
2702+ toJSON (CommonMinimumMatchHighLow (MinimumMatchHighLow lowF highF)) =
2703+ object [ "low_freq" .= lowF
2704+ , "high_freq" .= highF ]
2705+
2706+instance FromJSON CommonMinimumMatch where
2707+ parseJSON v = parseMinimum v
2708+ <|> parseMinimumHighLow v
2709+ where parseMinimum = fmap CommonMinimumMatch . parseJSON
2710+ parseMinimumHighLow = fmap CommonMinimumMatchHighLow . withObject "CommonMinimumMatchHighLow" (\o ->
2711+ MinimumMatchHighLow
2712+ <$> o .: "low_freq"
2713+ <*> o .: "high_freq")
2714+
2715+
2716+instance ToJSON BoostingQuery where
2717+ toJSON (BoostingQuery bqPositiveQuery bqNegativeQuery bqNegativeBoost) =
2718+ object [ "positive" .= bqPositiveQuery
2719+ , "negative" .= bqNegativeQuery
2720+ , "negative_boost" .= bqNegativeBoost ]
2721+
2722+instance FromJSON BoostingQuery where
2723+ parseJSON = withObject "BoostingQuery" parse
2724+ where parse o = BoostingQuery
2725+ <$> o .: "positive"
2726+ <*> o .: "negative"
2727+ <*> o .: "negative_boost"
2728+
2729+instance ToJSON BoolQuery where
2730+ toJSON (BoolQuery mustM filterM notM shouldM bqMin boost disableCoord) =
2731+ omitNulls base
2732+ where base = [ "must" .= mustM
2733+ , "filter" .= filterM
2734+ , "must_not" .= notM
2735+ , "should" .= shouldM
2736+ , "minimum_should_match" .= bqMin
2737+ , "boost" .= boost
2738+ , "disable_coord" .= disableCoord ]
2739+
2740+instance FromJSON BoolQuery where
2741+ parseJSON = withObject "BoolQuery" parse
2742+ where parse o = BoolQuery
2743+ <$> o .:? "must" .!= []
2744+ <*> o .:? "filter" .!= []
2745+ <*> o .:? "must_not" .!= []
2746+ <*> o .:? "should" .!= []
2747+ <*> o .:? "minimum_should_match"
2748+ <*> o .:? "boost"
2749+ <*> o .:? "disable_coord"
2750+
2751+instance ToJSON MatchQuery where
2752+ toJSON (MatchQuery (FieldName fieldName)
2753+ (QueryString mqQueryString) booleanOperator
2754+ zeroTermsQuery cutoffFrequency matchQueryType
2755+ analyzer maxExpansions lenient boost) =
2756+ object [ fieldName .= omitNulls base ]
2757+ where base = [ "query" .= mqQueryString
2758+ , "operator" .= booleanOperator
2759+ , "zero_terms_query" .= zeroTermsQuery
2760+ , "cutoff_frequency" .= cutoffFrequency
2761+ , "type" .= matchQueryType
2762+ , "analyzer" .= analyzer
2763+ , "max_expansions" .= maxExpansions
2764+ , "lenient" .= lenient
2765+ , "boost" .= boost ]
2766+
2767+instance FromJSON MatchQuery where
2768+ parseJSON = withObject "MatchQuery" parse
2769+ where parse = fieldTagged $ \fn o ->
2770+ MatchQuery fn
2771+ <$> o .: "query"
2772+ <*> o .: "operator"
2773+ <*> o .: "zero_terms_query"
2774+ <*> o .:? "cutoff_frequency"
2775+ <*> o .:? "type"
2776+ <*> o .:? "analyzer"
2777+ <*> o .:? "max_expansions"
2778+ <*> o .:? "lenient"
2779+ <*> o .:? "boost"
2780+
2781+instance ToJSON MultiMatchQuery where
2782+ toJSON (MultiMatchQuery fields (QueryString query) boolOp
2783+ ztQ tb mmqt cf analyzer maxEx lenient) =
2784+ object ["multi_match" .= omitNulls base]
2785+ where base = [ "fields" .= fmap toJSON fields
2786+ , "query" .= query
2787+ , "operator" .= boolOp
2788+ , "zero_terms_query" .= ztQ
2789+ , "tiebreaker" .= tb
2790+ , "type" .= mmqt
2791+ , "cutoff_frequency" .= cf
2792+ , "analyzer" .= analyzer
2793+ , "max_expansions" .= maxEx
2794+ , "lenient" .= lenient ]
2795+
2796+instance FromJSON MultiMatchQuery where
2797+ parseJSON = withObject "MultiMatchQuery" parse
2798+ where parse raw = do o <- raw .: "multi_match"
2799+ MultiMatchQuery
2800+ <$> o .:? "fields" .!= []
2801+ <*> o .: "query"
2802+ <*> o .: "operator"
2803+ <*> o .: "zero_terms_query"
2804+ <*> o .:? "tiebreaker"
2805+ <*> o .:? "type"
2806+ <*> o .:? "cutoff_frequency"
2807+ <*> o .:? "analyzer"
2808+ <*> o .:? "max_expansions"
2809+ <*> o .:? "lenient"
2810+
2811+instance ToJSON MultiMatchQueryType where
2812+ toJSON MultiMatchBestFields = "best_fields"
2813+ toJSON MultiMatchMostFields = "most_fields"
2814+ toJSON MultiMatchCrossFields = "cross_fields"
2815+ toJSON MultiMatchPhrase = "phrase"
2816+ toJSON MultiMatchPhrasePrefix = "phrase_prefix"
2817+
2818+instance FromJSON MultiMatchQueryType where
2819+ parseJSON = withText "MultiMatchPhrasePrefix" parse
2820+ where parse "best_fields" = pure MultiMatchBestFields
2821+ parse "most_fields" = pure MultiMatchMostFields
2822+ parse "cross_fields" = pure MultiMatchCrossFields
2823+ parse "phrase" = pure MultiMatchPhrase
2824+ parse "phrase_prefix" = pure MultiMatchPhrasePrefix
2825+ parse t = fail ("Unexpected MultiMatchPhrasePrefix: " <> show t)
2826+
2827+instance ToJSON BooleanOperator where
2828+ toJSON And = String "and"
2829+ toJSON Or = String "or"
2830+
2831+instance FromJSON BooleanOperator where
2832+ parseJSON = withText "BooleanOperator" parse
2833+ where parse "and" = pure And
2834+ parse "or" = pure Or
2835+ parse o = fail ("Unexpected BooleanOperator: " <> show o)
2836+
2837+instance ToJSON ZeroTermsQuery where
2838+ toJSON ZeroTermsNone = String "none"
2839+ toJSON ZeroTermsAll = String "all"
2840+
2841+instance FromJSON ZeroTermsQuery where
2842+ parseJSON = withText "ZeroTermsQuery" parse
2843+ where parse "none" = pure ZeroTermsNone
2844+ parse "all" = pure ZeroTermsAll
2845+ parse q = fail ("Unexpected ZeroTermsQuery: " <> show q)
2846+
2847+instance ToJSON MatchQueryType where
2848+ toJSON MatchPhrase = "phrase"
2849+ toJSON MatchPhrasePrefix = "phrase_prefix"
2850+
2851+instance FromJSON MatchQueryType where
2852+ parseJSON = withText "MatchQueryType" parse
2853+ where parse "phrase" = pure MatchPhrase
2854+ parse "phrase_prefix" = pure MatchPhrasePrefix
2855+ parse t = fail ("Unexpected MatchQueryType: " <> show t)
2856+
2857+instance FromJSON Status where
2858+ parseJSON (Object v) = Status <$>
2859+ v .: "name" <*>
2860+ v .: "cluster_name" <*>
2861+ v .: "cluster_uuid" <*>
2862+ v .: "version" <*>
2863+ v .: "tagline"
2864+ parseJSON _ = empty
2865+
2866+
2867+instance ToJSON IndexSettings where
2868+ toJSON (IndexSettings s r) = object ["settings" .=
2869+ object ["index" .=
2870+ object ["number_of_shards" .= s, "number_of_replicas" .= r]
2871+ ]
2872+ ]
2873+
2874+instance FromJSON IndexSettings where
2875+ parseJSON = withObject "IndexSettings" parse
2876+ where parse o = do s <- o .: "settings"
2877+ i <- s .: "index"
2878+ IndexSettings <$> i .: "number_of_shards"
2879+ <*> i .: "number_of_replicas"
2880+
2881+instance ToJSON UpdatableIndexSetting where
2882+ toJSON (NumberOfReplicas x) = oPath ("index" :| ["number_of_replicas"]) x
2883+ toJSON (AutoExpandReplicas x) = oPath ("index" :| ["auto_expand_replicas"]) x
2884+ toJSON (RefreshInterval x) = oPath ("index" :| ["refresh_interval"]) (NominalDiffTimeJSON x)
2885+ toJSON (IndexConcurrency x) = oPath ("index" :| ["concurrency"]) x
2886+ toJSON (FailOnMergeFailure x) = oPath ("index" :| ["fail_on_merge_failure"]) x
2887+ toJSON (TranslogFlushThresholdOps x) = oPath ("index" :| ["translog", "flush_threshold_ops"]) x
2888+ toJSON (TranslogFlushThresholdSize x) = oPath ("index" :| ["translog", "flush_threshold_size"]) x
2889+ toJSON (TranslogFlushThresholdPeriod x) = oPath ("index" :| ["translog", "flush_threshold_period"]) (NominalDiffTimeJSON x)
2890+ toJSON (TranslogDisableFlush x) = oPath ("index" :| ["translog", "disable_flush"]) x
2891+ toJSON (CacheFilterMaxSize x) = oPath ("index" :| ["cache", "filter", "max_size"]) x
2892+ toJSON (CacheFilterExpire x) = oPath ("index" :| ["cache", "filter", "expire"]) (NominalDiffTimeJSON <$> x)
2893+ toJSON (GatewaySnapshotInterval x) = oPath ("index" :| ["gateway", "snapshot_interval"]) (NominalDiffTimeJSON x)
2894+ toJSON (RoutingAllocationInclude fs) = oPath ("index" :| ["routing", "allocation", "include"]) (attrFilterJSON fs)
2895+ toJSON (RoutingAllocationExclude fs) = oPath ("index" :| ["routing", "allocation", "exclude"]) (attrFilterJSON fs)
2896+ toJSON (RoutingAllocationRequire fs) = oPath ("index" :| ["routing", "allocation", "require"]) (attrFilterJSON fs)
2897+ toJSON (RoutingAllocationEnable x) = oPath ("index" :| ["routing", "allocation", "enable"]) x
2898+ toJSON (RoutingAllocationShardsPerNode x) = oPath ("index" :| ["routing", "allocation", "total_shards_per_node"]) x
2899+ toJSON (RecoveryInitialShards x) = oPath ("index" :| ["recovery", "initial_shards"]) x
2900+ toJSON (GCDeletes x) = oPath ("index" :| ["gc_deletes"]) (NominalDiffTimeJSON x)
2901+ toJSON (TTLDisablePurge x) = oPath ("index" :| ["ttl", "disable_purge"]) x
2902+ toJSON (TranslogFSType x) = oPath ("index" :| ["translog", "fs", "type"]) x
2903+ toJSON (IndexCompoundFormat x) = oPath ("index" :| ["compound_format"]) x
2904+ toJSON (IndexCompoundOnFlush x) = oPath ("index" :| ["compound_on_flush"]) x
2905+ toJSON (WarmerEnabled x) = oPath ("index" :| ["warmer", "enabled"]) x
2906+ toJSON (BlocksReadOnly x) = oPath ("blocks" :| ["read_only"]) x
2907+ toJSON (BlocksRead x) = oPath ("blocks" :| ["read"]) x
2908+ toJSON (BlocksWrite x) = oPath ("blocks" :| ["write"]) x
2909+ toJSON (BlocksMetaData x) = oPath ("blocks" :| ["metadata"]) x
2910+
2911+instance FromJSON UpdatableIndexSetting where
2912+ parseJSON = withObject "UpdatableIndexSetting" parse
2913+ where parse o = numberOfReplicas `taggedAt` ["index", "number_of_replicas"]
2914+ <|> autoExpandReplicas `taggedAt` ["index", "auto_expand_replicas"]
2915+ <|> refreshInterval `taggedAt` ["index", "refresh_interval"]
2916+ <|> indexConcurrency `taggedAt` ["index", "concurrency"]
2917+ <|> failOnMergeFailure `taggedAt` ["index", "fail_on_merge_failure"]
2918+ <|> translogFlushThresholdOps `taggedAt` ["index", "translog", "flush_threshold_ops"]
2919+ <|> translogFlushThresholdSize `taggedAt` ["index", "translog", "flush_threshold_size"]
2920+ <|> translogFlushThresholdPeriod `taggedAt` ["index", "translog", "flush_threshold_period"]
2921+ <|> translogDisableFlush `taggedAt` ["index", "translog", "disable_flush"]
2922+ <|> cacheFilterMaxSize `taggedAt` ["index", "cache", "filter", "max_size"]
2923+ <|> cacheFilterExpire `taggedAt` ["index", "cache", "filter", "expire"]
2924+ <|> gatewaySnapshotInterval `taggedAt` ["index", "gateway", "snapshot_interval"]
2925+ <|> routingAllocationInclude `taggedAt` ["index", "routing", "allocation", "include"]
2926+ <|> routingAllocationExclude `taggedAt` ["index", "routing", "allocation", "exclude"]
2927+ <|> routingAllocationRequire `taggedAt` ["index", "routing", "allocation", "require"]
2928+ <|> routingAllocationEnable `taggedAt` ["index", "routing", "allocation", "enable"]
2929+ <|> routingAllocationShardsPerNode `taggedAt` ["index", "routing", "allocation", "total_shards_per_node"]
2930+ <|> recoveryInitialShards `taggedAt` ["index", "recovery", "initial_shards"]
2931+ <|> gcDeletes `taggedAt` ["index", "gc_deletes"]
2932+ <|> ttlDisablePurge `taggedAt` ["index", "ttl", "disable_purge"]
2933+ <|> translogFSType `taggedAt` ["index", "translog", "fs", "type"]
2934+ <|> compoundFormat `taggedAt` ["index", "compound_format"]
2935+ <|> compoundOnFlush `taggedAt` ["index", "compound_on_flush"]
2936+ <|> warmerEnabled `taggedAt` ["index", "warmer", "enabled"]
2937+ <|> blocksReadOnly `taggedAt` ["blocks", "read_only"]
2938+ <|> blocksRead `taggedAt` ["blocks", "read"]
2939+ <|> blocksWrite `taggedAt` ["blocks", "write"]
2940+ <|> blocksMetaData `taggedAt` ["blocks", "metadata"]
2941+ where taggedAt f ks = taggedAt' f (Object o) ks
2942+ taggedAt' f v [] = f =<< (parseJSON v <|> (parseJSON (unStringlyTypeJSON v)))
2943+ taggedAt' f v (k:ks) = withObject "Object" (\o -> do v' <- o .: k
2944+ taggedAt' f v' ks) v
2945+ numberOfReplicas = pure . NumberOfReplicas
2946+ autoExpandReplicas = pure . AutoExpandReplicas
2947+ refreshInterval = pure . RefreshInterval . ndtJSON
2948+ indexConcurrency = pure . IndexConcurrency
2949+ failOnMergeFailure = pure . FailOnMergeFailure
2950+ translogFlushThresholdOps = pure . TranslogFlushThresholdOps
2951+ translogFlushThresholdSize = pure . TranslogFlushThresholdSize
2952+ translogFlushThresholdPeriod = pure . TranslogFlushThresholdPeriod . ndtJSON
2953+ translogDisableFlush = pure . TranslogDisableFlush
2954+ cacheFilterMaxSize = pure . CacheFilterMaxSize
2955+ cacheFilterExpire = pure . CacheFilterExpire . fmap ndtJSON
2956+ gatewaySnapshotInterval = pure . GatewaySnapshotInterval . ndtJSON
2957+ routingAllocationInclude = fmap RoutingAllocationInclude . parseAttrFilter
2958+ routingAllocationExclude = fmap RoutingAllocationExclude . parseAttrFilter
2959+ routingAllocationRequire = fmap RoutingAllocationRequire . parseAttrFilter
2960+ routingAllocationEnable = pure . RoutingAllocationEnable
2961+ routingAllocationShardsPerNode = pure . RoutingAllocationShardsPerNode
2962+ recoveryInitialShards = pure . RecoveryInitialShards
2963+ gcDeletes = pure . GCDeletes . ndtJSON
2964+ ttlDisablePurge = pure . TTLDisablePurge
2965+ translogFSType = pure . TranslogFSType
2966+ compoundFormat = pure . IndexCompoundFormat
2967+ compoundOnFlush = pure . IndexCompoundOnFlush
2968+ warmerEnabled = pure . WarmerEnabled
2969+ blocksReadOnly = pure . BlocksReadOnly
2970+ blocksRead = pure . BlocksRead
2971+ blocksWrite = pure . BlocksWrite
2972+ blocksMetaData = pure . BlocksMetaData
2973+
2974+instance FromJSON IndexSettingsSummary where
2975+ parseJSON = withObject "IndexSettingsSummary" parse
2976+ where parse o = case HM.toList o of
2977+ [(ixn, v@(Object o'))] -> IndexSettingsSummary (IndexName ixn)
2978+ <$> parseJSON v
2979+ <*> (fmap (filter (not . redundant)) . parseSettings =<< o' .: "settings")
2980+ _ -> fail "Expected single-key object with index name"
2981+ redundant (NumberOfReplicas _) = True
2982+ redundant _ = False
2983+
2984+-- | For some reason in several settings APIs, all leaf values get returned
2985+-- as strings. This function attepmts to recover from this for all
2986+-- non-recursive JSON types. If nothing can be done, the value is left alone.
2987+unStringlyTypeJSON :: Value -> Value
2988+unStringlyTypeJSON (String "true") = Bool True
2989+unStringlyTypeJSON (String "false") = Bool False
2990+unStringlyTypeJSON (String "null") = Null
2991+unStringlyTypeJSON v@(String t) = case readMay (T.unpack t) of
2992+ Just n -> Number n
2993+ Nothing -> v
2994+unStringlyTypeJSON v = v
2995+
2996+
2997+parseSettings :: Object -> Parser [UpdatableIndexSetting]
2998+parseSettings o = do
2999+ o' <- o .: "index"
3000+ -- slice the index object into singleton hashmaps and try to parse each
3001+ parses <- forM (HM.toList o') $ \(k, v) -> do
3002+ -- blocks are now nested into the "index" key, which is not how they're serialized
3003+ let atRoot = Object (HM.singleton k v)
3004+ let atIndex = Object (HM.singleton "index" atRoot)
3005+ optional (parseJSON atRoot <|> parseJSON atIndex)
3006+ return (catMaybes parses)
3007+
3008+oPath :: ToJSON a => NonEmpty Text -> a -> Value
3009+oPath (k :| []) v = object [k .= v]
3010+oPath (k:| (h:t)) v = object [k .= oPath (h :| t) v]
3011+
3012+attrFilterJSON :: NonEmpty NodeAttrFilter -> Value
3013+attrFilterJSON fs = object [ n .= T.intercalate "," (toList vs)
3014+ | NodeAttrFilter (NodeAttrName n) vs <- toList fs]
3015+
3016+parseAttrFilter :: Value -> Parser (NonEmpty NodeAttrFilter)
3017+parseAttrFilter = withObject "NonEmpty NodeAttrFilter" parse
3018+ where parse o = case HM.toList o of
3019+ [] -> fail "Expected non-empty list of NodeAttrFilters"
3020+ x:xs -> DT.mapM (uncurry parse') (x :| xs)
3021+ parse' n = withText "Text" $ \t ->
3022+ case T.splitOn "," t of
3023+ fv:fvs -> return (NodeAttrFilter (NodeAttrName n) (fv :| fvs))
3024+ [] -> fail "Expected non-empty list of filter values"
3025+
3026+instance ToJSON ReplicaBounds where
3027+ toJSON (ReplicasBounded a b) = String (showText a <> "-" <> showText b)
3028+ toJSON (ReplicasLowerBounded a) = String (showText a <> "-all")
3029+ toJSON ReplicasUnbounded = Bool False
3030+
3031+instance FromJSON ReplicaBounds where
3032+ parseJSON v = withText "ReplicaBounds" parseText v
3033+ <|> withBool "ReplicaBounds" parseBool v
3034+ where parseText t = case T.splitOn "-" t of
3035+ [a, "all"] -> ReplicasLowerBounded <$> parseReadText a
3036+ [a, b] -> ReplicasBounded <$> parseReadText a
3037+ <*> parseReadText b
3038+ _ -> fail ("Could not parse ReplicaBounds: " <> show t)
3039+ parseBool False = pure ReplicasUnbounded
3040+ parseBool _ = fail "ReplicasUnbounded cannot be represented with True"
3041+
3042+instance ToJSON AllocationPolicy where
3043+ toJSON AllocAll = String "all"
3044+ toJSON AllocPrimaries = String "primaries"
3045+ toJSON AllocNewPrimaries = String "new_primaries"
3046+ toJSON AllocNone = String "none"
3047+
3048+instance FromJSON AllocationPolicy where
3049+ parseJSON = withText "AllocationPolicy" parse
3050+ where parse "all" = pure AllocAll
3051+ parse "primaries" = pure AllocPrimaries
3052+ parse "new_primaries" = pure AllocNewPrimaries
3053+ parse "none" = pure AllocNone
3054+ parse t = fail ("Invlaid AllocationPolicy: " <> show t)
3055+
3056+instance ToJSON InitialShardCount where
3057+ toJSON QuorumShards = String "quorum"
3058+ toJSON QuorumMinus1Shards = String "quorum-1"
3059+ toJSON FullShards = String "full"
3060+ toJSON FullMinus1Shards = String "full-1"
3061+ toJSON (ExplicitShards x) = toJSON x
3062+
3063+instance FromJSON InitialShardCount where
3064+ parseJSON v = withText "InitialShardCount" parseText v
3065+ <|> ExplicitShards <$> parseJSON v
3066+ where parseText "quorum" = pure QuorumShards
3067+ parseText "quorum-1" = pure QuorumMinus1Shards
3068+ parseText "full" = pure FullShards
3069+ parseText "full-1" = pure FullMinus1Shards
3070+ parseText _ = mzero
3071+
3072+instance ToJSON FSType where
3073+ toJSON FSSimple = "simple"
3074+ toJSON FSBuffered = "buffered"
3075+
3076+instance FromJSON FSType where
3077+ parseJSON = withText "FSType" parse
3078+ where parse "simple" = pure FSSimple
3079+ parse "buffered" = pure FSBuffered
3080+ parse t = fail ("Invalid FSType: " <> show t)
3081+
3082+instance ToJSON CompoundFormat where
3083+ toJSON (CompoundFileFormat x) = Bool x
3084+ toJSON (MergeSegmentVsTotalIndex x) = toJSON x
3085+
3086+instance FromJSON CompoundFormat where
3087+ parseJSON v = CompoundFileFormat <$> parseJSON v
3088+ <|> MergeSegmentVsTotalIndex <$> parseJSON v
3089+
3090+instance ToJSON NominalDiffTimeJSON where
3091+ toJSON (NominalDiffTimeJSON t) = String (showText (round t :: Integer) <> "s")
3092+
3093+instance FromJSON NominalDiffTimeJSON where
3094+ parseJSON = withText "NominalDiffTime" parse
3095+ where parse t = case T.takeEnd 1 t of
3096+ "s" -> NominalDiffTimeJSON . fromInteger <$> parseReadText (T.dropEnd 1 t)
3097+ _ -> fail "Invalid or missing NominalDiffTime unit (expected s)"
3098+
3099+instance ToJSON IndexTemplate where
3100+ toJSON (IndexTemplate p s m) = merge
3101+ (object [ "template" .= p
3102+ , "mappings" .= foldl' merge (object []) m
3103+ ])
3104+ (toJSON s)
3105+ where
3106+ merge (Object o1) (Object o2) = toJSON $ HM.union o1 o2
3107+ merge o Null = o
3108+ merge _ _ = undefined
3109+
3110+instance (FromJSON a) => FromJSON (EsResult a) where
3111+ parseJSON jsonVal@(Object v) = do
3112+ found <- v .:? "found" .!= False
3113+ fr <- if found
3114+ then parseJSON jsonVal
3115+ else return Nothing
3116+ EsResult <$> v .: "_index" <*>
3117+ v .: "_type" <*>
3118+ v .: "_id" <*>
3119+ pure fr
3120+ parseJSON _ = empty
3121+
3122+instance (FromJSON a) => FromJSON (EsResultFound a) where
3123+ parseJSON (Object v) = EsResultFound <$>
3124+ v .: "_version" <*>
3125+ v .: "_source"
3126+ parseJSON _ = empty
3127+
3128+instance FromJSON EsError where
3129+ parseJSON (Object v) = EsError <$>
3130+ v .: "status" <*>
3131+ (v .: "error" <|> (v .: "error" >>= (.: "reason")))
3132+ parseJSON _ = empty
3133+
3134+instance FromJSON IndexAliasesSummary where
3135+ parseJSON = withObject "IndexAliasesSummary" parse
3136+ where parse o = IndexAliasesSummary . mconcat <$> mapM (uncurry go) (HM.toList o)
3137+ go ixn = withObject "index aliases" $ \ia -> do
3138+ aliases <- ia .:? "aliases" .!= mempty
3139+ forM (HM.toList aliases) $ \(aName, v) -> do
3140+ let indexAlias = IndexAlias (IndexName ixn) (IndexAliasName (IndexName aName))
3141+ IndexAliasSummary indexAlias <$> parseJSON v
3142+
3143+
3144+instance ToJSON IndexAliasAction where
3145+ toJSON (AddAlias ia opts) = object ["add" .= (iaObj <> optsObj)]
3146+ where Object iaObj = toJSON ia
3147+ Object optsObj = toJSON opts
3148+ toJSON (RemoveAlias ia) = object ["remove" .= iaObj]
3149+ where Object iaObj = toJSON ia
3150+
3151+instance ToJSON IndexAlias where
3152+ toJSON IndexAlias {..} = object ["index" .= srcIndex
3153+ , "alias" .= indexAlias
3154+ ]
3155+
3156+instance ToJSON IndexAliasCreate where
3157+ toJSON IndexAliasCreate {..} = Object (filterObj <> routingObj)
3158+ where filterObj = maybe mempty (HM.singleton "filter" . toJSON) aliasCreateFilter
3159+ Object routingObj = maybe (Object mempty) toJSON aliasCreateRouting
3160+
3161+instance ToJSON AliasRouting where
3162+ toJSON (AllAliasRouting v) = object ["routing" .= v]
3163+ toJSON (GranularAliasRouting srch idx) = object (catMaybes prs)
3164+ where prs = [("search_routing" .=) <$> srch
3165+ ,("index_routing" .=) <$> idx]
3166+
3167+instance FromJSON AliasRouting where
3168+ parseJSON = withObject "AliasRouting" parse
3169+ where parse o = parseAll o <|> parseGranular o
3170+ parseAll o = AllAliasRouting <$> o .: "routing"
3171+ parseGranular o = do
3172+ sr <- o .:? "search_routing"
3173+ ir <- o .:? "index_routing"
3174+ if isNothing sr && isNothing ir
3175+ then fail "Both search_routing and index_routing can't be blank"
3176+ else return (GranularAliasRouting sr ir)
3177+
3178+instance FromJSON IndexAliasCreate where
3179+ parseJSON v = withObject "IndexAliasCreate" parse v
3180+ where parse o = IndexAliasCreate <$> optional (parseJSON v)
3181+ <*> o .:? "filter"
3182+
3183+instance ToJSON SearchAliasRouting where
3184+ toJSON (SearchAliasRouting rvs) = toJSON (T.intercalate "," (routingValue <$> toList rvs))
3185+
3186+instance FromJSON SearchAliasRouting where
3187+ parseJSON = withText "SearchAliasRouting" parse
3188+ where parse t = SearchAliasRouting <$> parseNEJSON (String <$> T.splitOn "," t)
3189+
3190+instance ToJSON Search where
3191+ toJSON (Search mquery sFilter sort searchAggs highlight sTrackSortScores sFrom sSize _ sFields sSource) =
3192+ omitNulls [ "query" .= query'
3193+ , "sort" .= sort
3194+ , "aggregations" .= searchAggs
3195+ , "highlight" .= highlight
3196+ , "from" .= sFrom
3197+ , "size" .= sSize
3198+ , "track_scores" .= sTrackSortScores
3199+ , "fields" .= sFields
3200+ , "_source" .= sSource]
3201+
3202+ where query' = case sFilter of
3203+ Nothing -> mquery
3204+ Just x -> Just . QueryBoolQuery $ mkBoolQuery (maybeToList mquery) [x] [] []
3205+
3206+instance ToJSON Source where
3207+ toJSON NoSource = toJSON False
3208+ toJSON (SourcePatterns patterns) = toJSON patterns
3209+ toJSON (SourceIncludeExclude incl excl) = object [ "includes" .= incl, "excludes" .= excl ]
3210+
3211+instance ToJSON PatternOrPatterns where
3212+ toJSON (PopPattern pattern) = toJSON pattern
3213+ toJSON (PopPatterns patterns) = toJSON patterns
3214+
3215+instance ToJSON Include where
3216+ toJSON (Include patterns) = toJSON patterns
3217+
3218+instance ToJSON Exclude where
3219+ toJSON (Exclude patterns) = toJSON patterns
3220+
3221+instance ToJSON Pattern where
3222+ toJSON (Pattern pattern) = toJSON pattern
3223+
3224+
3225+instance ToJSON FieldHighlight where
3226+ toJSON (FieldHighlight (FieldName fName) (Just fSettings)) =
3227+ object [ fName .= fSettings ]
3228+ toJSON (FieldHighlight (FieldName fName) Nothing) =
3229+ object [ fName .= emptyObject ]
3230+
3231+instance ToJSON Highlights where
3232+ toJSON (Highlights global fields) =
3233+ omitNulls (("fields" .= fields)
3234+ : highlightSettingsPairs global)
3235+
3236+instance ToJSON HighlightSettings where
3237+ toJSON hs = omitNulls (highlightSettingsPairs (Just hs))
3238+
3239+highlightSettingsPairs :: Maybe HighlightSettings -> [Pair]
3240+highlightSettingsPairs Nothing = []
3241+highlightSettingsPairs (Just (Plain plh)) = plainHighPairs (Just plh)
3242+highlightSettingsPairs (Just (Postings ph)) = postHighPairs (Just ph)
3243+highlightSettingsPairs (Just (FastVector fvh)) = fastVectorHighPairs (Just fvh)
3244+
3245+
3246+plainHighPairs :: Maybe PlainHighlight -> [Pair]
3247+plainHighPairs Nothing = []
3248+plainHighPairs (Just (PlainHighlight plCom plNonPost)) =
3249+ [ "type" .= String "plain"]
3250+ ++ commonHighlightPairs plCom
3251+ ++ nonPostingsToPairs plNonPost
3252+
3253+postHighPairs :: Maybe PostingsHighlight -> [Pair]
3254+postHighPairs Nothing = []
3255+postHighPairs (Just (PostingsHighlight pCom)) =
3256+ ("type" .= String "postings")
3257+ : commonHighlightPairs pCom
3258+
3259+fastVectorHighPairs :: Maybe FastVectorHighlight -> [Pair]
3260+fastVectorHighPairs Nothing = []
3261+fastVectorHighPairs (Just
3262+ (FastVectorHighlight fvCom fvNonPostSettings fvBoundChars
3263+ fvBoundMaxScan fvFragOff fvMatchedFields
3264+ fvPhraseLim)) =
3265+ [ "type" .= String "fvh"
3266+ , "boundary_chars" .= fvBoundChars
3267+ , "boundary_max_scan" .= fvBoundMaxScan
3268+ , "fragment_offset" .= fvFragOff
3269+ , "matched_fields" .= fvMatchedFields
3270+ , "phraseLimit" .= fvPhraseLim]
3271+ ++ commonHighlightPairs fvCom
3272+ ++ nonPostingsToPairs fvNonPostSettings
3273+
3274+deleteSeveral :: (Eq k, Hashable k) => [k] -> HM.HashMap k v -> HM.HashMap k v
3275+deleteSeveral ks hm = foldr HM.delete hm ks
3276+
3277+commonHighlightPairs :: Maybe CommonHighlight -> [Pair]
3278+commonHighlightPairs Nothing = []
3279+commonHighlightPairs (Just (CommonHighlight chScore chForceSource chTag chEncoder
3280+ chNoMatchSize chHighlightQuery
3281+ chRequireFieldMatch)) =
3282+ [ "order" .= chScore
3283+ , "force_source" .= chForceSource
3284+ , "encoder" .= chEncoder
3285+ , "no_match_size" .= chNoMatchSize
3286+ , "highlight_query" .= chHighlightQuery
3287+ , "require_fieldMatch" .= chRequireFieldMatch]
3288+ ++ highlightTagToPairs chTag
3289+
3290+
3291+nonPostingsToPairs :: Maybe NonPostings -> [Pair]
3292+nonPostingsToPairs Nothing = []
3293+nonPostingsToPairs (Just (NonPostings npFragSize npNumOfFrags)) =
3294+ [ "fragment_size" .= npFragSize
3295+ , "number_of_fragments" .= npNumOfFrags]
3296+
3297+parseNEJSON :: (FromJSON a) => [Value] -> Parser (NonEmpty a)
3298+parseNEJSON [] = fail "Expected non-empty list"
3299+parseNEJSON (x:xs) = DT.mapM parseJSON (x :| xs)
3300+
3301+
3302+instance ToJSON HighlightEncoder where
3303+ toJSON DefaultEncoder = String "default"
3304+ toJSON HTMLEncoder = String "html"
3305+
3306+highlightTagToPairs :: Maybe HighlightTag -> [Pair]
3307+highlightTagToPairs (Just (TagSchema _)) = [ "scheme" .= String "default"]
3308+highlightTagToPairs (Just (CustomTags (pre, post))) = [ "pre_tags" .= pre
3309+ , "post_tags" .= post]
3310+highlightTagToPairs Nothing = []
3311+
3312+instance ToJSON SortSpec where
3313+ toJSON (DefaultSortSpec
3314+ (DefaultSort (FieldName dsSortFieldName) dsSortOrder dsIgnoreUnmapped
3315+ dsSortMode dsMissingSort dsNestedFilter)) =
3316+ object [dsSortFieldName .= omitNulls base] where
3317+ base = [ "order" .= dsSortOrder
3318+ , "unmapped_type" .= dsIgnoreUnmapped
3319+ , "mode" .= dsSortMode
3320+ , "missing" .= dsMissingSort
3321+ , "nested_filter" .= dsNestedFilter ]
3322+
3323+ toJSON (GeoDistanceSortSpec gdsSortOrder (GeoPoint (FieldName field) gdsLatLon) units) =
3324+ object [ "unit" .= units
3325+ , field .= gdsLatLon
3326+ , "order" .= gdsSortOrder ]
3327+
3328+
3329+instance ToJSON SortOrder where
3330+ toJSON Ascending = String "asc"
3331+ toJSON Descending = String "desc"
3332+
3333+
3334+instance ToJSON SortMode where
3335+ toJSON SortMin = String "min"
3336+ toJSON SortMax = String "max"
3337+ toJSON SortSum = String "sum"
3338+ toJSON SortAvg = String "avg"
3339+
3340+
3341+instance ToJSON Missing where
3342+ toJSON LastMissing = String "_last"
3343+ toJSON FirstMissing = String "_first"
3344+ toJSON (CustomMissing txt) = String txt
3345+
3346+
3347+instance ToJSON ScoreType where
3348+ toJSON ScoreTypeMax = "max"
3349+ toJSON ScoreTypeAvg = "avg"
3350+ toJSON ScoreTypeSum = "sum"
3351+ toJSON ScoreTypeNone = "none"
3352+
3353+instance FromJSON ScoreType where
3354+ parseJSON = withText "ScoreType" parse
3355+ where parse "max" = pure ScoreTypeMax
3356+ parse "avg" = pure ScoreTypeAvg
3357+ parse "sum" = pure ScoreTypeSum
3358+ parse "none" = pure ScoreTypeNone
3359+ parse t = fail ("Unexpected ScoreType: " <> show t)
3360+
3361+instance ToJSON Distance where
3362+ toJSON (Distance dCoefficient dUnit) =
3363+ String boltedTogether where
3364+ coefText = showText dCoefficient
3365+ (String unitText) = toJSON dUnit
3366+ boltedTogether = mappend coefText unitText
3367+
3368+instance FromJSON Distance where
3369+ parseJSON = withText "Distance" parse
3370+ where parse t = Distance <$> parseCoeff nT
3371+ <*> parseJSON (String unitT)
3372+ where (nT, unitT) = T.span validForNumber t
3373+ -- may be a better way to do this
3374+ validForNumber '-' = True
3375+ validForNumber '.' = True
3376+ validForNumber 'e' = True
3377+ validForNumber c = isNumber c
3378+ parseCoeff "" = fail "Empty string cannot be parsed as number"
3379+ parseCoeff s = return (read (T.unpack s))
3380+
3381+instance ToJSON DistanceUnit where
3382+ toJSON Miles = String "mi"
3383+ toJSON Yards = String "yd"
3384+ toJSON Feet = String "ft"
3385+ toJSON Inches = String "in"
3386+ toJSON Kilometers = String "km"
3387+ toJSON Meters = String "m"
3388+ toJSON Centimeters = String "cm"
3389+ toJSON Millimeters = String "mm"
3390+ toJSON NauticalMiles = String "nmi"
3391+
3392+
3393+instance FromJSON DistanceUnit where
3394+ parseJSON = withText "DistanceUnit" parse
3395+ where parse "mi" = pure Miles
3396+ parse "yd" = pure Yards
3397+ parse "ft" = pure Feet
3398+ parse "in" = pure Inches
3399+ parse "km" = pure Kilometers
3400+ parse "m" = pure Meters
3401+ parse "cm" = pure Centimeters
3402+ parse "mm" = pure Millimeters
3403+ parse "nmi" = pure NauticalMiles
3404+ parse u = fail ("Unrecognized DistanceUnit: " <> show u)
3405+
3406+instance ToJSON DistanceType where
3407+ toJSON Arc = String "arc"
3408+ toJSON SloppyArc = String "sloppy_arc"
3409+ toJSON Plane = String "plane"
3410+
3411+instance FromJSON DistanceType where
3412+ parseJSON = withText "DistanceType" parse
3413+ where parse "arc" = pure Arc
3414+ parse "sloppy_arc" = pure SloppyArc
3415+ parse "plane" = pure Plane
3416+ parse t = fail ("Unrecognized DistanceType: " <> show t)
3417+
3418+
3419+instance ToJSON OptimizeBbox where
3420+ toJSON NoOptimizeBbox = String "none"
3421+ toJSON (OptimizeGeoFilterType gft) = toJSON gft
3422+
3423+instance FromJSON OptimizeBbox where
3424+ parseJSON v = withText "NoOptimizeBbox" parseNoOptimize v
3425+ <|> parseOptimize v
3426+ where parseNoOptimize "none" = pure NoOptimizeBbox
3427+ parseNoOptimize _ = mzero
3428+ parseOptimize = fmap OptimizeGeoFilterType . parseJSON
3429+
3430+instance ToJSON GeoBoundingBoxConstraint where
3431+ toJSON (GeoBoundingBoxConstraint
3432+ (FieldName gbbcGeoBBField) gbbcConstraintBox cache type') =
3433+ object [gbbcGeoBBField .= gbbcConstraintBox
3434+ , "_cache" .= cache
3435+ , "type" .= type']
3436+
3437+instance FromJSON GeoBoundingBoxConstraint where
3438+ parseJSON = withObject "GeoBoundingBoxConstraint" parse
3439+ where parse o = case HM.toList (deleteSeveral ["type", "_cache"] o) of
3440+ [(fn, v)] -> GeoBoundingBoxConstraint (FieldName fn)
3441+ <$> parseJSON v
3442+ <*> o .:? "_cache" .!= defaultCache
3443+ <*> o .: "type"
3444+ _ -> fail "Could not find field name for GeoBoundingBoxConstraint"
3445+
3446+instance ToJSON GeoFilterType where
3447+ toJSON GeoFilterMemory = String "memory"
3448+ toJSON GeoFilterIndexed = String "indexed"
3449+
3450+instance FromJSON GeoFilterType where
3451+ parseJSON = withText "GeoFilterType" parse
3452+ where parse "memory" = pure GeoFilterMemory
3453+ parse "indexed" = pure GeoFilterIndexed
3454+ parse t = fail ("Unrecognized GeoFilterType: " <> show t)
3455+
3456+instance ToJSON GeoBoundingBox where
3457+ toJSON (GeoBoundingBox gbbTopLeft gbbBottomRight) =
3458+ object ["top_left" .= gbbTopLeft
3459+ , "bottom_right" .= gbbBottomRight]
3460+
3461+instance FromJSON GeoBoundingBox where
3462+ parseJSON = withObject "GeoBoundingBox" parse
3463+ where parse o = GeoBoundingBox
3464+ <$> o .: "top_left"
3465+ <*> o .: "bottom_right"
3466+
3467+instance ToJSON LatLon where
3468+ toJSON (LatLon lLat lLon) =
3469+ object ["lat" .= lLat
3470+ , "lon" .= lLon]
3471+
3472+instance FromJSON LatLon where
3473+ parseJSON = withObject "LatLon" parse
3474+ where parse o = LatLon <$> o .: "lat"
3475+ <*> o .: "lon"
3476+
3477+-- index for smaller ranges, fielddata for longer ranges
3478+instance ToJSON RangeExecution where
3479+ toJSON RangeExecutionIndex = "index"
3480+ toJSON RangeExecutionFielddata = "fielddata"
3481+
3482+
3483+instance FromJSON RangeExecution where
3484+ parseJSON = withText "RangeExecution" parse
3485+ where parse "index" = pure RangeExecutionIndex
3486+ parse "fielddata" = pure RangeExecutionFielddata
3487+ parse t = error ("Unrecognized RangeExecution " <> show t)
3488+
3489+instance ToJSON RegexpFlags where
3490+ toJSON AllRegexpFlags = String "ALL"
3491+ toJSON NoRegexpFlags = String "NONE"
3492+ toJSON (SomeRegexpFlags (h :| fs)) = String $ T.intercalate "|" flagStrs
3493+ where flagStrs = map flagStr . nub $ h:fs
3494+ flagStr AnyString = "ANYSTRING"
3495+ flagStr Automaton = "AUTOMATON"
3496+ flagStr Complement = "COMPLEMENT"
3497+ flagStr Empty = "EMPTY"
3498+ flagStr Intersection = "INTERSECTION"
3499+ flagStr Interval = "INTERVAL"
3500+
3501+instance FromJSON RegexpFlags where
3502+ parseJSON = withText "RegexpFlags" parse
3503+ where parse "ALL" = pure AllRegexpFlags
3504+ parse "NONE" = pure NoRegexpFlags
3505+ parse t = SomeRegexpFlags <$> parseNEJSON (String <$> T.splitOn "|" t)
3506+
3507+instance FromJSON RegexpFlag where
3508+ parseJSON = withText "RegexpFlag" parse
3509+ where parse "ANYSTRING" = pure AnyString
3510+ parse "AUTOMATON" = pure Automaton
3511+ parse "COMPLEMENT" = pure Complement
3512+ parse "EMPTY" = pure Empty
3513+ parse "INTERSECTION" = pure Intersection
3514+ parse "INTERVAL" = pure Interval
3515+ parse f = fail ("Unknown RegexpFlag: " <> show f)
3516+
3517+instance ToJSON Term where
3518+ toJSON (Term field value) = object ["term" .= object
3519+ [field .= value]]
3520+
3521+instance FromJSON Term where
3522+ parseJSON = withObject "Term" parse
3523+ where parse o = do termObj <- o .: "term"
3524+ case HM.toList termObj of
3525+ [(fn, v)] -> Term fn <$> parseJSON v
3526+ _ -> fail "Expected object with 1 field-named key"
3527+
3528+instance ToJSON BoolMatch where
3529+ toJSON (MustMatch term cache) = object ["must" .= term,
3530+ "_cache" .= cache]
3531+ toJSON (MustNotMatch term cache) = object ["must_not" .= term,
3532+ "_cache" .= cache]
3533+ toJSON (ShouldMatch terms cache) = object ["should" .= fmap toJSON terms,
3534+ "_cache" .= cache]
3535+
3536+instance FromJSON BoolMatch where
3537+ parseJSON = withObject "BoolMatch" parse
3538+ where parse o = mustMatch `taggedWith` "must"
3539+ <|> mustNotMatch `taggedWith` "must_not"
3540+ <|> shouldMatch `taggedWith` "should"
3541+ where taggedWith parser k = parser =<< o .: k
3542+ mustMatch t = MustMatch t <$> o .:? "_cache" .!= defaultCache
3543+ mustNotMatch t = MustNotMatch t <$> o .:? "_cache" .!= defaultCache
3544+ shouldMatch t = ShouldMatch t <$> o .:? "_cache" .!= defaultCache
3545+
3546+instance (FromJSON a) => FromJSON (SearchResult a) where
3547+ parseJSON (Object v) = SearchResult <$>
3548+ v .: "took" <*>
3549+ v .: "timed_out" <*>
3550+ v .: "_shards" <*>
3551+ v .: "hits" <*>
3552+ v .:? "aggregations" <*>
3553+ v .:? "_scroll_id"
3554+ parseJSON _ = empty
3555+
3556+instance (FromJSON a) => FromJSON (SearchHits a) where
3557+ parseJSON (Object v) = SearchHits <$>
3558+ v .: "total" <*>
3559+ v .: "max_score" <*>
3560+ v .: "hits"
3561+ parseJSON _ = empty
3562+
3563+instance (FromJSON a) => FromJSON (Hit a) where
3564+ parseJSON (Object v) = Hit <$>
3565+ v .: "_index" <*>
3566+ v .: "_type" <*>
3567+ v .: "_id" <*>
3568+ v .: "_score" <*>
3569+ v .:? "_source" <*>
3570+ v .:? "highlight"
3571+ parseJSON _ = empty
3572+
3573+instance FromJSON ShardResult where
3574+ parseJSON (Object v) = ShardResult <$>
3575+ v .: "total" <*>
3576+ v .: "successful" <*>
3577+ v .: "failed"
3578+ parseJSON _ = empty
3579+
3580+
3581+instance FromJSON DocVersion where
3582+ parseJSON v = do
3583+ i <- parseJSON v
3584+ maybe (fail "DocVersion out of range") return $ mkDocVersion i
3585+
3586+-- This insanity is because ES *sometimes* returns Replica/Shard counts as strings
3587+instance FromJSON ReplicaCount where
3588+ parseJSON v = parseAsInt v
3589+ <|> parseAsString v
3590+ where parseAsInt = fmap ReplicaCount . parseJSON
3591+ parseAsString = withText "ReplicaCount" (fmap ReplicaCount . parseReadText)
3592+
3593+instance FromJSON ShardCount where
3594+ parseJSON v = parseAsInt v
3595+ <|> parseAsString v
3596+ where parseAsInt = fmap ShardCount . parseJSON
3597+ parseAsString = withText "ShardCount" (fmap ShardCount . parseReadText)
3598+
3599+instance Bounded DocVersion where
3600+ minBound = DocVersion 1
3601+ maxBound = DocVersion 9200000000000000000 -- 9.2e+18
3602+
3603+instance Enum DocVersion where
3604+ succ x
3605+ | x /= maxBound = DocVersion (succ $ docVersionNumber x)
3606+ | otherwise = succError "DocVersion"
3607+ pred x
3608+ | x /= minBound = DocVersion (pred $ docVersionNumber x)
3609+ | otherwise = predError "DocVersion"
3610+ toEnum i =
3611+ fromMaybe (error $ show i ++ " out of DocVersion range") $ mkDocVersion i
3612+ fromEnum = docVersionNumber
3613+ enumFrom = boundedEnumFrom
3614+ enumFromThen = boundedEnumFromThen
3615+
3616+-- | Username type used for HTTP Basic authentication. See 'basicAuthHook'.
3617+newtype EsUsername = EsUsername { esUsername :: Text } deriving (Read, Show, Eq)
3618+
3619+-- | Password type used for HTTP Basic authentication. See 'basicAuthHook'.
3620+newtype EsPassword = EsPassword { esPassword :: Text } deriving (Read, Show, Eq)
3621+
3622+
3623+data SnapshotRepoSelection = SnapshotRepoList (NonEmpty SnapshotRepoPattern)
3624+ | AllSnapshotRepos deriving (Eq, Generic, Show, Typeable)
3625+
3626+
3627+-- | Either specifies an exact repo name or one with globs in it,
3628+-- e.g. @RepoPattern "foo*"@ __NOTE__: Patterns are not supported on ES < 1.7
3629+data SnapshotRepoPattern = ExactRepo SnapshotRepoName
3630+ | RepoPattern Text
3631+ deriving (Eq, Generic, Show, Typeable)
3632+
3633+-- | The unique name of a snapshot repository.
3634+newtype SnapshotRepoName = SnapshotRepoName { snapshotRepoName :: Text }
3635+ deriving (Eq, Ord, Generic, Show, Typeable, ToJSON, FromJSON)
3636+
3637+
3638+-- | A generic representation of a snapshot repo. This is what gets
3639+-- sent to and parsed from the server. For repo types enabled by
3640+-- plugins that aren't exported by this library, consider making a
3641+-- custom type which implements 'SnapshotRepo'. If it is a common repo
3642+-- type, consider submitting a pull request to have it included in the
3643+-- library proper
3644+data GenericSnapshotRepo = GenericSnapshotRepo {
3645+ gSnapshotRepoName :: SnapshotRepoName
3646+ , gSnapshotRepoType :: SnapshotRepoType
3647+ , gSnapshotRepoSettings :: GenericSnapshotRepoSettings
3648+ } deriving (Eq, Generic, Show, Typeable)
3649+
3650+
3651+instance SnapshotRepo GenericSnapshotRepo where
3652+ toGSnapshotRepo = id
3653+ fromGSnapshotRepo = Right
3654+
3655+
3656+newtype SnapshotRepoType = SnapshotRepoType { snapshotRepoType :: Text }
3657+ deriving (Eq, Ord, Generic, Show, Typeable, ToJSON, FromJSON)
3658+
3659+
3660+-- | Opaque representation of snapshot repo settings. Instances of
3661+-- 'SnapshotRepo' will produce this.
3662+newtype GenericSnapshotRepoSettings = GenericSnapshotRepoSettings { gSnapshotRepoSettingsObject :: Object }
3663+ deriving (Eq, Generic, Show, Typeable, ToJSON)
3664+
3665+
3666+ -- Regardless of whether you send strongly typed json, my version of
3667+ -- ES sends back stringly typed json in the settings, e.g. booleans
3668+ -- as strings, so we'll try to convert them.
3669+instance FromJSON GenericSnapshotRepoSettings where
3670+ parseJSON = fmap (GenericSnapshotRepoSettings . fmap unStringlyTypeJSON). parseJSON
3671+
3672+-- | The result of running 'verifySnapshotRepo'.
3673+newtype SnapshotVerification = SnapshotVerification { snapshotNodeVerifications :: [SnapshotNodeVerification] }
3674+ deriving (Eq, Generic, Show, Typeable)
3675+
3676+
3677+instance FromJSON SnapshotVerification where
3678+ parseJSON = withObject "SnapshotVerification" parse
3679+ where
3680+ parse o = do
3681+ o2 <- o .: "nodes"
3682+ SnapshotVerification <$> mapM (uncurry parse') (HM.toList o2)
3683+ parse' rawFullId = withObject "SnapshotNodeVerification" $ \o ->
3684+ SnapshotNodeVerification (FullNodeId rawFullId) <$> o .: "name"
3685+
3686+
3687+-- | A node that has verified a snapshot
3688+data SnapshotNodeVerification = SnapshotNodeVerification {
3689+ snvFullId :: FullNodeId
3690+ , snvNodeName :: NodeName
3691+ } deriving (Eq, Generic, Show, Typeable)
3692+
3693+
3694+-- | Unique, automatically-generated name assigned to nodes that are
3695+-- usually returned in node-oriented APIs.
3696+newtype FullNodeId = FullNodeId { fullNodeId :: Text }
3697+ deriving (Eq, Ord, Generic, Show, Typeable, FromJSON)
3698+
3699+
3700+-- | A human-readable node name that is supplied by the user in the
3701+-- node config or automatically generated by ElasticSearch.
3702+newtype NodeName = NodeName { nodeName :: Text }
3703+ deriving (Eq, Ord, Generic, Show, Typeable, FromJSON)
3704+
3705+newtype ClusterName = ClusterName { clusterName :: Text }
3706+ deriving (Eq, Ord, Generic, Show, Typeable, FromJSON)
3707+
3708+data NodesInfo = NodesInfo {
3709+ nodesInfo :: [NodeInfo]
3710+ , nodesClusterName :: ClusterName
3711+ } deriving (Eq, Show, Generic, Typeable)
3712+
3713+data NodesStats = NodesStats {
3714+ nodesStats :: [NodeStats]
3715+ , nodesStatsClusterName :: ClusterName
3716+ } deriving (Eq, Show, Generic, Typeable)
3717+
3718+data NodeStats = NodeStats {
3719+ nodeStatsName :: NodeName
3720+ , nodeStatsFullId :: FullNodeId
3721+ , nodeStatsBreakersStats :: Maybe NodeBreakersStats
3722+ , nodeStatsHTTP :: NodeHTTPStats
3723+ , nodeStatsTransport :: NodeTransportStats
3724+ , nodeStatsFS :: NodeFSStats
3725+ , nodeStatsNetwork :: Maybe NodeNetworkStats
3726+ , nodeStatsThreadPool :: NodeThreadPoolsStats
3727+ , nodeStatsJVM :: NodeJVMStats
3728+ , nodeStatsProcess :: NodeProcessStats
3729+ , nodeStatsOS :: NodeOSStats
3730+ , nodeStatsIndices :: NodeIndicesStats
3731+ } deriving (Eq, Show, Generic, Typeable)
3732+
3733+data NodeBreakersStats = NodeBreakersStats {
3734+ nodeStatsParentBreaker :: NodeBreakerStats
3735+ , nodeStatsRequestBreaker :: NodeBreakerStats
3736+ , nodeStatsFieldDataBreaker :: NodeBreakerStats
3737+ } deriving (Eq, Show, Generic, Typeable)
3738+
3739+data NodeBreakerStats = NodeBreakerStats {
3740+ nodeBreakersTripped :: Int
3741+ , nodeBreakersOverhead :: Double
3742+ , nodeBreakersEstSize :: Bytes
3743+ , nodeBreakersLimitSize :: Bytes
3744+ } deriving (Eq, Show, Generic, Typeable)
3745+
3746+data NodeHTTPStats = NodeHTTPStats {
3747+ nodeHTTPTotalOpened :: Int
3748+ , nodeHTTPCurrentOpen :: Int
3749+ } deriving (Eq, Show, Generic, Typeable)
3750+
3751+data NodeTransportStats = NodeTransportStats {
3752+ nodeTransportTXSize :: Bytes
3753+ , nodeTransportCount :: Int
3754+ , nodeTransportRXSize :: Bytes
3755+ , nodeTransportRXCount :: Int
3756+ , nodeTransportServerOpen :: Int
3757+ } deriving (Eq, Show, Generic, Typeable)
3758+
3759+data NodeFSStats = NodeFSStats {
3760+ nodeFSDataPaths :: [NodeDataPathStats]
3761+ , nodeFSTotal :: NodeFSTotalStats
3762+ , nodeFSTimestamp :: UTCTime
3763+ } deriving (Eq, Show, Generic, Typeable)
3764+
3765+data NodeDataPathStats = NodeDataPathStats {
3766+ nodeDataPathDiskServiceTime :: Maybe Double
3767+ , nodeDataPathDiskQueue :: Maybe Double
3768+ , nodeDataPathIOSize :: Maybe Bytes
3769+ , nodeDataPathWriteSize :: Maybe Bytes
3770+ , nodeDataPathReadSize :: Maybe Bytes
3771+ , nodeDataPathIOOps :: Maybe Int
3772+ , nodeDataPathWrites :: Maybe Int
3773+ , nodeDataPathReads :: Maybe Int
3774+ , nodeDataPathAvailable :: Bytes
3775+ , nodeDataPathFree :: Bytes
3776+ , nodeDataPathTotal :: Bytes
3777+ , nodeDataPathType :: Maybe Text
3778+ , nodeDataPathDevice :: Maybe Text
3779+ , nodeDataPathMount :: Text
3780+ , nodeDataPathPath :: Text
3781+ } deriving (Eq, Show, Generic, Typeable)
3782+
3783+data NodeFSTotalStats = NodeFSTotalStats {
3784+ nodeFSTotalDiskServiceTime :: Maybe Double
3785+ , nodeFSTotalDiskQueue :: Maybe Double
3786+ , nodeFSTotalIOSize :: Maybe Bytes
3787+ , nodeFSTotalWriteSize :: Maybe Bytes
3788+ , nodeFSTotalReadSize :: Maybe Bytes
3789+ , nodeFSTotalIOOps :: Maybe Int
3790+ , nodeFSTotalWrites :: Maybe Int
3791+ , nodeFSTotalReads :: Maybe Int
3792+ , nodeFSTotalAvailable :: Bytes
3793+ , nodeFSTotalFree :: Bytes
3794+ , nodeFSTotalTotal :: Bytes
3795+ } deriving (Eq, Show, Generic, Typeable)
3796+
3797+data NodeNetworkStats = NodeNetworkStats {
3798+ nodeNetTCPOutRSTs :: Int
3799+ , nodeNetTCPInErrs :: Int
3800+ , nodeNetTCPAttemptFails :: Int
3801+ , nodeNetTCPEstabResets :: Int
3802+ , nodeNetTCPRetransSegs :: Int
3803+ , nodeNetTCPOutSegs :: Int
3804+ , nodeNetTCPInSegs :: Int
3805+ , nodeNetTCPCurrEstab :: Int
3806+ , nodeNetTCPPassiveOpens :: Int
3807+ , nodeNetTCPActiveOpens :: Int
3808+ } deriving (Eq, Show, Generic, Typeable)
3809+
3810+data NodeThreadPoolsStats = NodeThreadPoolsStats {
3811+ nodeThreadPoolsStatsSnapshot :: NodeThreadPoolStats
3812+ , nodeThreadPoolsStatsBulk :: NodeThreadPoolStats
3813+ , nodeThreadPoolsStatsMerge :: NodeThreadPoolStats
3814+ , nodeThreadPoolsStatsGet :: NodeThreadPoolStats
3815+ , nodeThreadPoolsStatsManagement :: NodeThreadPoolStats
3816+ , nodeThreadPoolsStatsFetchShardStore :: Maybe NodeThreadPoolStats
3817+ , nodeThreadPoolsStatsOptimize :: Maybe NodeThreadPoolStats
3818+ , nodeThreadPoolsStatsFlush :: NodeThreadPoolStats
3819+ , nodeThreadPoolsStatsSearch :: NodeThreadPoolStats
3820+ , nodeThreadPoolsStatsWarmer :: NodeThreadPoolStats
3821+ , nodeThreadPoolsStatsGeneric :: NodeThreadPoolStats
3822+ , nodeThreadPoolsStatsSuggest :: Maybe NodeThreadPoolStats
3823+ , nodeThreadPoolsStatsRefresh :: NodeThreadPoolStats
3824+ , nodeThreadPoolsStatsIndex :: NodeThreadPoolStats
3825+ , nodeThreadPoolsStatsListener :: Maybe NodeThreadPoolStats
3826+ , nodeThreadPoolsStatsFetchShardStarted :: Maybe NodeThreadPoolStats
3827+ , nodeThreadPoolsStatsPercolate :: Maybe NodeThreadPoolStats
3828+ } deriving (Eq, Show, Generic, Typeable)
3829+
3830+data NodeThreadPoolStats = NodeThreadPoolStats {
3831+ nodeThreadPoolCompleted :: Int
3832+ , nodeThreadPoolLargest :: Int
3833+ , nodeThreadPoolRejected :: Int
3834+ , nodeThreadPoolActive :: Int
3835+ , nodeThreadPoolQueue :: Int
3836+ , nodeThreadPoolThreads :: Int
3837+ } deriving (Eq, Show, Generic, Typeable)
3838+
3839+data NodeJVMStats = NodeJVMStats {
3840+ nodeJVMStatsMappedBufferPool :: JVMBufferPoolStats
3841+ , nodeJVMStatsDirectBufferPool :: JVMBufferPoolStats
3842+ , nodeJVMStatsGCOldCollector :: JVMGCStats
3843+ , nodeJVMStatsGCYoungCollector :: JVMGCStats
3844+ , nodeJVMStatsPeakThreadsCount :: Int
3845+ , nodeJVMStatsThreadsCount :: Int
3846+ , nodeJVMStatsOldPool :: JVMPoolStats
3847+ , nodeJVMStatsSurvivorPool :: JVMPoolStats
3848+ , nodeJVMStatsYoungPool :: JVMPoolStats
3849+ , nodeJVMStatsNonHeapCommitted :: Bytes
3850+ , nodeJVMStatsNonHeapUsed :: Bytes
3851+ , nodeJVMStatsHeapMax :: Bytes
3852+ , nodeJVMStatsHeapCommitted :: Bytes
3853+ , nodeJVMStatsHeapUsedPercent :: Int
3854+ , nodeJVMStatsHeapUsed :: Bytes
3855+ , nodeJVMStatsUptime :: NominalDiffTime
3856+ , nodeJVMStatsTimestamp :: UTCTime
3857+ } deriving (Eq, Show, Generic, Typeable)
3858+
3859+data JVMBufferPoolStats = JVMBufferPoolStats {
3860+ jvmBufferPoolStatsTotalCapacity :: Bytes
3861+ , jvmBufferPoolStatsUsed :: Bytes
3862+ , jvmBufferPoolStatsCount :: Int
3863+ } deriving (Eq, Show, Generic, Typeable)
3864+
3865+data JVMGCStats = JVMGCStats {
3866+ jvmGCStatsCollectionTime :: NominalDiffTime
3867+ , jvmGCStatsCollectionCount :: Int
3868+ } deriving (Eq, Show, Generic, Typeable)
3869+
3870+data JVMPoolStats = JVMPoolStats {
3871+ jvmPoolStatsPeakMax :: Bytes
3872+ , jvmPoolStatsPeakUsed :: Bytes
3873+ , jvmPoolStatsMax :: Bytes
3874+ , jvmPoolStatsUsed :: Bytes
3875+ } deriving (Eq, Show, Generic, Typeable)
3876+
3877+data NodeProcessStats = NodeProcessStats {
3878+ nodeProcessTimestamp :: UTCTime
3879+ , nodeProcessOpenFDs :: Int
3880+ , nodeProcessMaxFDs :: Int
3881+ , nodeProcessCPUPercent :: Int
3882+ , nodeProcessCPUTotal :: NominalDiffTime
3883+ , nodeProcessMemTotalVirtual :: Bytes
3884+ } deriving (Eq, Show, Generic, Typeable)
3885+
3886+data NodeOSStats = NodeOSStats {
3887+ nodeOSTimestamp :: UTCTime
3888+ , nodeOSCPUPercent :: Int
3889+ , nodeOSLoad :: Maybe LoadAvgs
3890+ , nodeOSMemTotal :: Bytes
3891+ , nodeOSMemFree :: Bytes
3892+ , nodeOSMemFreePercent :: Int
3893+ , nodeOSMemUsed :: Bytes
3894+ , nodeOSMemUsedPercent :: Int
3895+ , nodeOSSwapTotal :: Bytes
3896+ , nodeOSSwapFree :: Bytes
3897+ , nodeOSSwapUsed :: Bytes
3898+ } deriving (Eq, Show, Generic, Typeable)
3899+
3900+data LoadAvgs = LoadAvgs {
3901+ loadAvg1Min :: Double
3902+ , loadAvg5Min :: Double
3903+ , loadAvg15Min :: Double
3904+ } deriving (Eq, Show, Generic, Typeable)
3905+
3906+data NodeIndicesStats = NodeIndicesStats {
3907+ nodeIndicesStatsRecoveryThrottleTime :: Maybe NominalDiffTime
3908+ , nodeIndicesStatsRecoveryCurrentAsTarget :: Maybe Int
3909+ , nodeIndicesStatsRecoveryCurrentAsSource :: Maybe Int
3910+ , nodeIndicesStatsQueryCacheMisses :: Maybe Int
3911+ , nodeIndicesStatsQueryCacheHits :: Maybe Int
3912+ , nodeIndicesStatsQueryCacheEvictions :: Maybe Int
3913+ , nodeIndicesStatsQueryCacheSize :: Maybe Bytes
3914+ , nodeIndicesStatsSuggestCurrent :: Maybe Int
3915+ , nodeIndicesStatsSuggestTime :: Maybe NominalDiffTime
3916+ , nodeIndicesStatsSuggestTotal :: Maybe Int
3917+ , nodeIndicesStatsTranslogSize :: Bytes
3918+ , nodeIndicesStatsTranslogOps :: Int
3919+ , nodeIndicesStatsSegFixedBitSetMemory :: Maybe Bytes
3920+ , nodeIndicesStatsSegVersionMapMemory :: Bytes
3921+ , nodeIndicesStatsSegIndexWriterMaxMemory :: Maybe Bytes
3922+ , nodeIndicesStatsSegIndexWriterMemory :: Bytes
3923+ , nodeIndicesStatsSegMemory :: Bytes
3924+ , nodeIndicesStatsSegCount :: Int
3925+ , nodeIndicesStatsCompletionSize :: Bytes
3926+ , nodeIndicesStatsPercolateQueries :: Maybe Int
3927+ , nodeIndicesStatsPercolateMemory :: Maybe Bytes
3928+ , nodeIndicesStatsPercolateCurrent :: Maybe Int
3929+ , nodeIndicesStatsPercolateTime :: Maybe NominalDiffTime
3930+ , nodeIndicesStatsPercolateTotal :: Maybe Int
3931+ , nodeIndicesStatsFieldDataEvictions :: Int
3932+ , nodeIndicesStatsFieldDataMemory :: Bytes
3933+ , nodeIndicesStatsWarmerTotalTime :: NominalDiffTime
3934+ , nodeIndicesStatsWarmerTotal :: Int
3935+ , nodeIndicesStatsWarmerCurrent :: Int
3936+ , nodeIndicesStatsFlushTotalTime :: NominalDiffTime
3937+ , nodeIndicesStatsFlushTotal :: Int
3938+ , nodeIndicesStatsRefreshTotalTime :: NominalDiffTime
3939+ , nodeIndicesStatsRefreshTotal :: Int
3940+ , nodeIndicesStatsMergesTotalSize :: Bytes
3941+ , nodeIndicesStatsMergesTotalDocs :: Int
3942+ , nodeIndicesStatsMergesTotalTime :: NominalDiffTime
3943+ , nodeIndicesStatsMergesTotal :: Int
3944+ , nodeIndicesStatsMergesCurrentSize :: Bytes
3945+ , nodeIndicesStatsMergesCurrentDocs :: Int
3946+ , nodeIndicesStatsMergesCurrent :: Int
3947+ , nodeIndicesStatsSearchFetchCurrent :: Int
3948+ , nodeIndicesStatsSearchFetchTime :: NominalDiffTime
3949+ , nodeIndicesStatsSearchFetchTotal :: Int
3950+ , nodeIndicesStatsSearchQueryCurrent :: Int
3951+ , nodeIndicesStatsSearchQueryTime :: NominalDiffTime
3952+ , nodeIndicesStatsSearchQueryTotal :: Int
3953+ , nodeIndicesStatsSearchOpenContexts :: Int
3954+ , nodeIndicesStatsGetCurrent :: Int
3955+ , nodeIndicesStatsGetMissingTime :: NominalDiffTime
3956+ , nodeIndicesStatsGetMissingTotal :: Int
3957+ , nodeIndicesStatsGetExistsTime :: NominalDiffTime
3958+ , nodeIndicesStatsGetExistsTotal :: Int
3959+ , nodeIndicesStatsGetTime :: NominalDiffTime
3960+ , nodeIndicesStatsGetTotal :: Int
3961+ , nodeIndicesStatsIndexingThrottleTime :: Maybe NominalDiffTime
3962+ , nodeIndicesStatsIndexingIsThrottled :: Maybe Bool
3963+ , nodeIndicesStatsIndexingNoopUpdateTotal :: Maybe Int
3964+ , nodeIndicesStatsIndexingDeleteCurrent :: Int
3965+ , nodeIndicesStatsIndexingDeleteTime :: NominalDiffTime
3966+ , nodeIndicesStatsIndexingDeleteTotal :: Int
3967+ , nodeIndicesStatsIndexingIndexCurrent :: Int
3968+ , nodeIndicesStatsIndexingIndexTime :: NominalDiffTime
3969+ , nodeIndicesStatsIndexingTotal :: Int
3970+ , nodeIndicesStatsStoreThrottleTime :: NominalDiffTime
3971+ , nodeIndicesStatsStoreSize :: Bytes
3972+ , nodeIndicesStatsDocsDeleted :: Int
3973+ , nodeIndicesStatsDocsCount :: Int
3974+ } deriving (Eq, Show, Generic, Typeable)
3975+
3976+-- | A quirky address format used throughout ElasticSearch. An example
3977+-- would be inet[/1.1.1.1:9200]. inet may be a placeholder for a
3978+-- <https://en.wikipedia.org/wiki/Fully_qualified_domain_name FQDN>.
3979+newtype EsAddress = EsAddress { esAddress :: Text }
3980+ deriving (Eq, Ord, Generic, Show, Typeable, FromJSON)
3981+
3982+-- | Typically a 7 character hex string.
3983+newtype BuildHash = BuildHash { buildHash :: Text }
3984+ deriving (Eq, Ord, Generic, Read, Show, Typeable, FromJSON, ToJSON)
3985+
3986+newtype PluginName = PluginName { pluginName :: Text }
3987+ deriving (Eq, Ord, Generic, Show, Typeable, FromJSON)
3988+
3989+data NodeInfo = NodeInfo {
3990+ nodeInfoHTTPAddress :: Maybe EsAddress
3991+ , nodeInfoBuild :: BuildHash
3992+ , nodeInfoESVersion :: VersionNumber
3993+ , nodeInfoIP :: Server
3994+ , nodeInfoHost :: Server
3995+ , nodeInfoTransportAddress :: EsAddress
3996+ , nodeInfoName :: NodeName
3997+ , nodeInfoFullId :: FullNodeId
3998+ , nodeInfoPlugins :: [NodePluginInfo]
3999+ , nodeInfoHTTP :: NodeHTTPInfo
4000+ , nodeInfoTransport :: NodeTransportInfo
4001+ , nodeInfoNetwork :: Maybe NodeNetworkInfo
4002+ , nodeInfoThreadPool :: NodeThreadPoolsInfo
4003+ , nodeInfoJVM :: NodeJVMInfo
4004+ , nodeInfoProcess :: NodeProcessInfo
4005+ , nodeInfoOS :: NodeOSInfo
4006+ , nodeInfoSettings :: Object
4007+ -- ^ The members of the settings objects are not consistent,
4008+ -- dependent on plugins, etc.
4009+ } deriving (Eq, Show, Generic, Typeable)
4010+
4011+data NodePluginInfo = NodePluginInfo {
4012+ nodePluginSite :: Maybe Bool
4013+ -- ^ Is this a site plugin?
4014+ , nodePluginJVM :: Maybe Bool
4015+ -- ^ Is this plugin running on the JVM
4016+ , nodePluginDescription :: Text
4017+ , nodePluginVersion :: MaybeNA VersionNumber
4018+ , nodePluginName :: PluginName
4019+ } deriving (Eq, Show, Generic, Typeable)
4020+
4021+data NodeHTTPInfo = NodeHTTPInfo {
4022+ nodeHTTPMaxContentLength :: Bytes
4023+ , nodeHTTPTransportAddress :: BoundTransportAddress
4024+ } deriving (Eq, Show, Generic, Typeable)
4025+
4026+data NodeTransportInfo = NodeTransportInfo {
4027+ nodeTransportProfiles :: [BoundTransportAddress]
4028+ , nodeTransportAddress :: BoundTransportAddress
4029+ } deriving (Eq, Show, Generic, Typeable)
4030+
4031+data BoundTransportAddress = BoundTransportAddress {
4032+ publishAddress :: EsAddress
4033+ , boundAddress :: [EsAddress]
4034+ } deriving (Eq, Show, Generic, Typeable)
4035+
4036+data NodeNetworkInfo = NodeNetworkInfo {
4037+ nodeNetworkPrimaryInterface :: NodeNetworkInterface
4038+ , nodeNetworkRefreshInterval :: NominalDiffTime
4039+ } deriving (Eq, Show, Generic, Typeable)
4040+
4041+newtype MacAddress = MacAddress { macAddress :: Text }
4042+ deriving (Eq, Ord, Generic, Show, Typeable, FromJSON)
4043+
4044+newtype NetworkInterfaceName = NetworkInterfaceName { networkInterfaceName :: Text }
4045+ deriving (Eq, Ord, Generic, Show, Typeable, FromJSON)
4046+
4047+data NodeNetworkInterface = NodeNetworkInterface {
4048+ nodeNetIfaceMacAddress :: MacAddress
4049+ , nodeNetIfaceName :: NetworkInterfaceName
4050+ , nodeNetIfaceAddress :: Server
4051+ } deriving (Eq, Show, Generic, Typeable)
4052+
4053+data NodeThreadPoolsInfo = NodeThreadPoolsInfo {
4054+ nodeThreadPoolsRefresh :: NodeThreadPoolInfo
4055+ , nodeThreadPoolsManagement :: NodeThreadPoolInfo
4056+ , nodeThreadPoolsPercolate :: Maybe NodeThreadPoolInfo
4057+ , nodeThreadPoolsListener :: Maybe NodeThreadPoolInfo
4058+ , nodeThreadPoolsFetchShardStarted :: Maybe NodeThreadPoolInfo
4059+ , nodeThreadPoolsSearch :: NodeThreadPoolInfo
4060+ , nodeThreadPoolsFlush :: NodeThreadPoolInfo
4061+ , nodeThreadPoolsWarmer :: NodeThreadPoolInfo
4062+ , nodeThreadPoolsOptimize :: Maybe NodeThreadPoolInfo
4063+ , nodeThreadPoolsBulk :: NodeThreadPoolInfo
4064+ , nodeThreadPoolsSuggest :: Maybe NodeThreadPoolInfo
4065+ , nodeThreadPoolsMerge :: NodeThreadPoolInfo
4066+ , nodeThreadPoolsSnapshot :: NodeThreadPoolInfo
4067+ , nodeThreadPoolsGet :: NodeThreadPoolInfo
4068+ , nodeThreadPoolsFetchShardStore :: Maybe NodeThreadPoolInfo
4069+ , nodeThreadPoolsIndex :: NodeThreadPoolInfo
4070+ , nodeThreadPoolsGeneric :: NodeThreadPoolInfo
4071+ } deriving (Eq, Show, Generic, Typeable)
4072+
4073+data NodeThreadPoolInfo = NodeThreadPoolInfo {
4074+ nodeThreadPoolQueueSize :: ThreadPoolSize
4075+ , nodeThreadPoolKeepalive :: Maybe NominalDiffTime
4076+ , nodeThreadPoolMin :: Maybe Int
4077+ , nodeThreadPoolMax :: Maybe Int
4078+ , nodeThreadPoolType :: ThreadPoolType
4079+ } deriving (Eq, Show, Generic, Typeable)
4080+
4081+data ThreadPoolSize = ThreadPoolBounded Int
4082+ | ThreadPoolUnbounded
4083+ deriving (Eq, Show, Generic, Typeable)
4084+
4085+data ThreadPoolType = ThreadPoolScaling
4086+ | ThreadPoolFixed
4087+ | ThreadPoolCached
4088+ deriving (Eq, Show, Generic, Typeable)
4089+
4090+data NodeJVMInfo = NodeJVMInfo {
4091+ nodeJVMInfoMemoryPools :: [JVMMemoryPool]
4092+ , nodeJVMInfoMemoryPoolsGCCollectors :: [JVMGCCollector]
4093+ , nodeJVMInfoMemoryInfo :: JVMMemoryInfo
4094+ , nodeJVMInfoStartTime :: UTCTime
4095+ , nodeJVMInfoVMVendor :: Text
4096+ , nodeJVMVMVersion :: VersionNumber
4097+ -- ^ JVM doesn't seme to follow normal version conventions
4098+ , nodeJVMVMName :: Text
4099+ , nodeJVMVersion :: VersionNumber
4100+ , nodeJVMPID :: PID
4101+ } deriving (Eq, Show, Generic, Typeable)
4102+
4103+-- | Handles quirks in the way JVM versions are rendered (1.7.0_101 -> 1.7.0.101)
4104+newtype JVMVersion = JVMVersion { unJVMVersion :: VersionNumber }
4105+
4106+data JVMMemoryInfo = JVMMemoryInfo {
4107+ jvmMemoryInfoDirectMax :: Bytes
4108+ , jvmMemoryInfoNonHeapMax :: Bytes
4109+ , jvmMemoryInfoNonHeapInit :: Bytes
4110+ , jvmMemoryInfoHeapMax :: Bytes
4111+ , jvmMemoryInfoHeapInit :: Bytes
4112+ } deriving (Eq, Show, Generic, Typeable)
4113+
4114+newtype JVMMemoryPool = JVMMemoryPool {
4115+ jvmMemoryPool :: Text
4116+ } deriving (Eq, Show, Generic, Typeable, FromJSON)
4117+
4118+newtype JVMGCCollector = JVMGCCollector {
4119+ jvmGCCollector :: Text
4120+ } deriving (Eq, Show, Generic, Typeable, FromJSON)
4121+
4122+newtype PID = PID {
4123+ pid :: Int
4124+ } deriving (Eq, Show, Generic, Typeable, FromJSON)
4125+
4126+data NodeOSInfo = NodeOSInfo {
4127+ nodeOSRefreshInterval :: NominalDiffTime
4128+ , nodeOSName :: Text
4129+ , nodeOSArch :: Text
4130+ , nodeOSVersion :: VersionNumber
4131+ , nodeOSAvailableProcessors :: Int
4132+ , nodeOSAllocatedProcessors :: Int
4133+ } deriving (Eq, Show, Generic, Typeable)
4134+
4135+data CPUInfo = CPUInfo {
4136+ cpuCacheSize :: Bytes
4137+ , cpuCoresPerSocket :: Int
4138+ , cpuTotalSockets :: Int
4139+ , cpuTotalCores :: Int
4140+ , cpuMHZ :: Int
4141+ , cpuModel :: Text
4142+ , cpuVendor :: Text
4143+ } deriving (Eq, Show, Generic, Typeable)
4144+
4145+data NodeProcessInfo = NodeProcessInfo {
4146+ nodeProcessMLockAll :: Bool
4147+ -- ^ See <https://www.elastic.co/guide/en/elasticsearch/reference/current/setup-configuration.html>
4148+ , nodeProcessMaxFileDescriptors :: Maybe Int
4149+ , nodeProcessId :: PID
4150+ , nodeProcessRefreshInterval :: NominalDiffTime
4151+ } deriving (Eq, Show, Generic, Typeable)
4152+
4153+data SnapshotRepoUpdateSettings = SnapshotRepoUpdateSettings {
4154+ repoUpdateVerify :: Bool
4155+ -- ^ After creation/update, synchronously check that nodes can
4156+ -- write to this repo. Defaults to True. You may use False if you
4157+ -- need a faster response and plan on verifying manually later
4158+ -- with 'verifySnapshotRepo'.
4159+ } deriving (Eq, Show, Generic, Typeable)
4160+
4161+
4162+-- | Reasonable defaults for repo creation/update
4163+--
4164+-- * repoUpdateVerify True
4165+defaultSnapshotRepoUpdateSettings :: SnapshotRepoUpdateSettings
4166+defaultSnapshotRepoUpdateSettings = SnapshotRepoUpdateSettings True
4167+
4168+
4169+-- | A filesystem-based snapshot repo that ships with
4170+-- ElasticSearch. This is an instance of 'SnapshotRepo' so it can be
4171+-- used with 'updateSnapshotRepo'
4172+data FsSnapshotRepo = FsSnapshotRepo {
4173+ fsrName :: SnapshotRepoName
4174+ , fsrLocation :: FilePath
4175+ , fsrCompressMetadata :: Bool
4176+ , fsrChunkSize :: Maybe Bytes
4177+ -- ^ Size by which to split large files during snapshotting.
4178+ , fsrMaxRestoreBytesPerSec :: Maybe Bytes
4179+ -- ^ Throttle node restore rate. If not supplied, defaults to 40mb/sec
4180+ , fsrMaxSnapshotBytesPerSec :: Maybe Bytes
4181+ -- ^ Throttle node snapshot rate. If not supplied, defaults to 40mb/sec
4182+ } deriving (Eq, Generic, Show, Typeable)
4183+
4184+
4185+instance SnapshotRepo FsSnapshotRepo where
4186+ toGSnapshotRepo FsSnapshotRepo {..} =
4187+ GenericSnapshotRepo fsrName fsRepoType (GenericSnapshotRepoSettings settings)
4188+ where
4189+ Object settings = object $ [ "location" .= fsrLocation
4190+ , "compress" .= fsrCompressMetadata
4191+ ] ++ optionalPairs
4192+ optionalPairs = catMaybes [ ("chunk_size" .=) <$> fsrChunkSize
4193+ , ("max_restore_bytes_per_sec" .=) <$> fsrMaxRestoreBytesPerSec
4194+ , ("max_snapshot_bytes_per_sec" .=) <$> fsrMaxSnapshotBytesPerSec
4195+ ]
4196+ fromGSnapshotRepo GenericSnapshotRepo {..}
4197+ | gSnapshotRepoType == fsRepoType = do
4198+ let o = gSnapshotRepoSettingsObject gSnapshotRepoSettings
4199+ parseRepo $ do
4200+ FsSnapshotRepo gSnapshotRepoName <$> o .: "location"
4201+ <*> o .:? "compress" .!= False
4202+ <*> o .:? "chunk_size"
4203+ <*> o .:? "max_restore_bytes_per_sec"
4204+ <*> o .:? "max_snapshot_bytes_per_sec"
4205+ | otherwise = Left (RepoTypeMismatch fsRepoType gSnapshotRepoType)
4206+
4207+
4208+parseRepo :: Parser a -> Either SnapshotRepoConversionError a
4209+parseRepo parser = case parseEither (const parser) () of
4210+ Left e -> Left (OtherRepoConversionError (T.pack e))
4211+ Right a -> Right a
4212+
4213+
4214+fsRepoType :: SnapshotRepoType
4215+fsRepoType = SnapshotRepoType "fs"
4216+
4217+-- | Law: fromGSnapshotRepo (toGSnapshotRepo r) == Right r
4218+class SnapshotRepo r where
4219+ toGSnapshotRepo :: r -> GenericSnapshotRepo
4220+ fromGSnapshotRepo :: GenericSnapshotRepo -> Either SnapshotRepoConversionError r
4221+
4222+
4223+data SnapshotRepoConversionError = RepoTypeMismatch SnapshotRepoType SnapshotRepoType
4224+ -- ^ Expected type and actual type
4225+ | OtherRepoConversionError Text
4226+ deriving (Show, Eq, Generic, Typeable)
4227+
4228+
4229+instance Exception SnapshotRepoConversionError
4230+
4231+
4232+data SnapshotCreateSettings = SnapshotCreateSettings {
4233+ snapWaitForCompletion :: Bool
4234+ -- ^ Should the API call return immediately after initializing
4235+ -- the snapshot or wait until completed? Note that if this is
4236+ -- enabled it could wait a long time, so you should adjust your
4237+ -- 'ManagerSettings' accordingly to set long timeouts or
4238+ -- explicitly handle timeouts.
4239+ , snapIndices :: Maybe IndexSelection
4240+ -- ^ Nothing will snapshot all indices. Just [] is permissable and
4241+ -- will essentially be a no-op snapshot.
4242+ , snapIgnoreUnavailable :: Bool
4243+ -- ^ If set to True, any matched indices that don't exist will be
4244+ -- ignored. Otherwise it will be an error and fail.
4245+ , snapIncludeGlobalState :: Bool
4246+ , snapPartial :: Bool
4247+ -- ^ If some indices failed to snapshot (e.g. if not all primary
4248+ -- shards are available), should the process proceed?
4249+ } deriving (Eq, Generic, Show, Typeable)
4250+
4251+
4252+-- | Reasonable defaults for snapshot creation
4253+--
4254+-- * snapWaitForCompletion False
4255+-- * snapIndices Nothing
4256+-- * snapIgnoreUnavailable False
4257+-- * snapIncludeGlobalState True
4258+-- * snapPartial False
4259+defaultSnapshotCreateSettings :: SnapshotCreateSettings
4260+defaultSnapshotCreateSettings = SnapshotCreateSettings {
4261+ snapWaitForCompletion = False
4262+ , snapIndices = Nothing
4263+ , snapIgnoreUnavailable = False
4264+ , snapIncludeGlobalState = True
4265+ , snapPartial = False
4266+ }
4267+
4268+
4269+data SnapshotSelection = SnapshotList (NonEmpty SnapshotPattern)
4270+ | AllSnapshots deriving (Eq, Generic, Show, Typeable)
4271+
4272+
4273+-- | Either specifies an exact snapshot name or one with globs in it,
4274+-- e.g. @SnapPattern "foo*"@ __NOTE__: Patterns are not supported on
4275+-- ES < 1.7
4276+data SnapshotPattern = ExactSnap SnapshotName
4277+ | SnapPattern Text
4278+ deriving (Eq, Generic, Show, Typeable)
4279+
4280+
4281+-- | General information about the state of a snapshot. Has some
4282+-- redundancies with 'SnapshotStatus'
4283+data SnapshotInfo = SnapshotInfo {
4284+ snapInfoShards :: ShardResult
4285+ , snapInfoFailures :: [SnapshotShardFailure]
4286+ , snapInfoDuration :: NominalDiffTime
4287+ , snapInfoEndTime :: UTCTime
4288+ , snapInfoStartTime :: UTCTime
4289+ , snapInfoState :: SnapshotState
4290+ , snapInfoIndices :: [IndexName]
4291+ , snapInfoName :: SnapshotName
4292+ } deriving (Eq, Generic, Show, Typeable)
4293+
4294+
4295+instance FromJSON SnapshotInfo where
4296+ parseJSON = withObject "SnapshotInfo" parse
4297+ where
4298+ parse o = SnapshotInfo <$> o .: "shards"
4299+ <*> o .: "failures"
4300+ <*> (unMS <$> o .: "duration_in_millis")
4301+ <*> (posixMS <$> o .: "end_time_in_millis")
4302+ <*> (posixMS <$> o .: "start_time_in_millis")
4303+ <*> o .: "state"
4304+ <*> o .: "indices"
4305+ <*> o .: "snapshot"
4306+
4307+data SnapshotShardFailure = SnapshotShardFailure {
4308+ snapShardFailureIndex :: IndexName
4309+ , snapShardFailureNodeId :: Maybe NodeName -- I'm not 100% sure this isn't actually 'FullNodeId'
4310+ , snapShardFailureReason :: Text
4311+ , snapShardFailureShardId :: ShardId
4312+ } deriving (Eq, Show, Generic, Typeable)
4313+
4314+
4315+instance FromJSON SnapshotShardFailure where
4316+ parseJSON = withObject "SnapshotShardFailure" parse
4317+ where
4318+ parse o = SnapshotShardFailure <$> o .: "index"
4319+ <*> o .:? "node_id"
4320+ <*> o .: "reason"
4321+ <*> o .: "shard_id"
4322+
4323+
4324+newtype ShardId = ShardId { shardId :: Int }
4325+ deriving (Eq, Show, Generic, Typeable, FromJSON)
4326+
4327+-- | Milliseconds
4328+newtype MS = MS NominalDiffTime
4329+
4330+
4331+-- keeps the unexported constructor warnings at bay
4332+unMS :: MS -> NominalDiffTime
4333+unMS (MS t) = t
4334+
4335+
4336+instance FromJSON MS where
4337+ parseJSON = withScientific "MS" (return . MS . parse)
4338+ where
4339+ parse n = fromInteger ((truncate n) * 1000)
4340+
4341+
4342+data SnapshotState = SnapshotInit
4343+ | SnapshotStarted
4344+ | SnapshotSuccess
4345+ | SnapshotFailed
4346+ | SnapshotAborted
4347+ | SnapshotMissing
4348+ | SnapshotWaiting
4349+ deriving (Show, Eq, Generic, Typeable)
4350+
4351+instance FromJSON SnapshotState where
4352+ parseJSON = withText "SnapshotState" parse
4353+ where
4354+ parse "INIT" = return SnapshotInit
4355+ parse "STARTED" = return SnapshotStarted
4356+ parse "SUCCESS" = return SnapshotSuccess
4357+ parse "FAILED" = return SnapshotFailed
4358+ parse "ABORTED" = return SnapshotAborted
4359+ parse "MISSING" = return SnapshotMissing
4360+ parse "WAITING" = return SnapshotWaiting
4361+ parse t = fail ("Invalid snapshot state " <> T.unpack t)
4362+
4363+
4364+newtype SnapshotName = SnapshotName { snapshotName :: Text }
4365+ deriving (Show, Eq, Ord, Generic, Typeable, ToJSON, FromJSON)
4366+
4367+
4368+data SnapshotRestoreSettings = SnapshotRestoreSettings {
4369+ snapRestoreWaitForCompletion :: Bool
4370+ -- ^ Should the API call return immediately after initializing
4371+ -- the restore or wait until completed? Note that if this is
4372+ -- enabled, it could wait a long time, so you should adjust your
4373+ -- 'ManagerSettings' accordingly to set long timeouts or
4374+ -- explicitly handle timeouts.
4375+ , snapRestoreIndices :: Maybe IndexSelection
4376+ -- ^ Nothing will restore all indices in the snapshot. Just [] is
4377+ -- permissable and will essentially be a no-op restore.
4378+ , snapRestoreIgnoreUnavailable :: Bool
4379+ -- ^ If set to True, any indices that do not exist will be ignored
4380+ -- during snapshot rather than failing the restore.
4381+ , snapRestoreIncludeGlobalState :: Bool
4382+ -- ^ If set to false, will ignore any global state in the snapshot
4383+ -- and will not restore it.
4384+ , snapRestoreRenamePattern :: Maybe RestoreRenamePattern
4385+ -- ^ A regex pattern for matching indices. Used with
4386+ -- 'snapRestoreRenameReplacement', the restore can reference the
4387+ -- matched index and create a new index name upon restore.
4388+ , snapRestoreRenameReplacement :: Maybe (NonEmpty RestoreRenameToken)
4389+ -- ^ Expression of how index renames should be constructed.
4390+ , snapRestorePartial :: Bool
4391+ -- ^ If some indices fail to restore, should the process proceed?
4392+ , snapRestoreIncludeAliases :: Bool
4393+ -- ^ Should the restore also restore the aliases captured in the
4394+ -- snapshot.
4395+ , snapRestoreIndexSettingsOverrides :: Maybe RestoreIndexSettings
4396+ -- ^ Settings to apply during the restore process. __NOTE:__ This
4397+ -- option is not supported in ES < 1.5 and should be set to
4398+ -- Nothing in that case.
4399+ , snapRestoreIgnoreIndexSettings :: Maybe (NonEmpty Text)
4400+ -- ^ This type could be more rich but it isn't clear which
4401+ -- settings are allowed to be ignored during restore, so we're
4402+ -- going with including this feature in a basic form rather than
4403+ -- omitting it. One example here would be
4404+ -- "index.refresh_interval". Any setting specified here will
4405+ -- revert back to the server default during the restore process.
4406+ } deriving (Eq, Generic, Show, Typeable)
4407+
4408+-- | Regex-stype pattern, e.g. "index_(.+)" to match index names
4409+newtype RestoreRenamePattern = RestoreRenamePattern { rrPattern :: Text }
4410+ deriving (Show, Eq, Generic, Typeable, Ord, ToJSON)
4411+
4412+
4413+-- | A single token in a index renaming scheme for a restore. These
4414+-- are concatenated into a string before being sent to
4415+-- ElasticSearch. Check out these Java
4416+-- <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.
4417+data RestoreRenameToken = RRTLit Text
4418+ -- ^ Just a literal string of characters
4419+ | RRSubWholeMatch
4420+ -- ^ Equivalent to $0. The entire matched pattern, not any subgroup
4421+ | RRSubGroup RRGroupRefNum
4422+ -- ^ A specific reference to a group number
4423+ deriving (Show, Eq, Generic, Typeable)
4424+
4425+
4426+-- | A group number for regex matching. Only values from 1-9 are
4427+-- supported. Construct with 'mkRRGroupRefNum'
4428+newtype RRGroupRefNum = RRGroupRefNum { rrGroupRefNum :: Int }
4429+ deriving (Show, Eq, Generic, Typeable, Ord)
4430+
4431+instance Bounded RRGroupRefNum where
4432+ minBound = RRGroupRefNum 1
4433+ maxBound = RRGroupRefNum 9
4434+
4435+
4436+-- | Only allows valid group number references (1-9).
4437+mkRRGroupRefNum :: Int -> Maybe RRGroupRefNum
4438+mkRRGroupRefNum i
4439+ | i >= (rrGroupRefNum minBound) && i <= (rrGroupRefNum maxBound) =
4440+ Just $ RRGroupRefNum i
4441+ | otherwise = Nothing
4442+
4443+
4444+-- | Reasonable defaults for snapshot restores
4445+--
4446+-- * snapRestoreWaitForCompletion False
4447+-- * snapRestoreIndices Nothing
4448+-- * snapRestoreIgnoreUnavailable False
4449+-- * snapRestoreIncludeGlobalState True
4450+-- * snapRestoreRenamePattern Nothing
4451+-- * snapRestoreRenameReplacement Nothing
4452+-- * snapRestorePartial False
4453+-- * snapRestoreIncludeAliases True
4454+-- * snapRestoreIndexSettingsOverrides Nothing
4455+-- * snapRestoreIgnoreIndexSettings Nothing
4456+defaultSnapshotRestoreSettings :: SnapshotRestoreSettings
4457+defaultSnapshotRestoreSettings = SnapshotRestoreSettings {
4458+ snapRestoreWaitForCompletion = False
4459+ , snapRestoreIndices = Nothing
4460+ , snapRestoreIgnoreUnavailable = False
4461+ , snapRestoreIncludeGlobalState = True
4462+ , snapRestoreRenamePattern = Nothing
4463+ , snapRestoreRenameReplacement = Nothing
4464+ , snapRestorePartial = False
4465+ , snapRestoreIncludeAliases = True
4466+ , snapRestoreIndexSettingsOverrides = Nothing
4467+ , snapRestoreIgnoreIndexSettings = Nothing
4468+ }
4469+
4470+
4471+-- | Index settings that can be overridden. The docs only mention you
4472+-- can update number of replicas, but there may be more. You
4473+-- definitely cannot override shard count.
4474+data RestoreIndexSettings = RestoreIndexSettings {
4475+ restoreOverrideReplicas :: Maybe ReplicaCount
4476+ } deriving (Show, Eq, Generic, Typeable)
4477+
4478+
4479+instance ToJSON RestoreIndexSettings where
4480+ toJSON RestoreIndexSettings {..} = object prs
4481+ where
4482+ prs = catMaybes [("index.number_of_replicas" .=) <$> restoreOverrideReplicas]
4483+
4484+
4485+instance FromJSON NodesInfo where
4486+ parseJSON = withObject "NodesInfo" parse
4487+ where
4488+ parse o = do
4489+ nodes <- o .: "nodes"
4490+ infos <- forM (HM.toList nodes) $ \(fullNID, v) -> do
4491+ node <- parseJSON v
4492+ parseNodeInfo (FullNodeId fullNID) node
4493+ cn <- o .: "cluster_name"
4494+ return (NodesInfo infos cn)
4495+
4496+instance FromJSON NodesStats where
4497+ parseJSON = withObject "NodesStats" parse
4498+ where
4499+ parse o = do
4500+ nodes <- o .: "nodes"
4501+ stats <- forM (HM.toList nodes) $ \(fullNID, v) -> do
4502+ node <- parseJSON v
4503+ parseNodeStats (FullNodeId fullNID) node
4504+ cn <- o .: "cluster_name"
4505+ return (NodesStats stats cn)
4506+
4507+instance FromJSON NodeBreakerStats where
4508+ parseJSON = withObject "NodeBreakerStats" parse
4509+ where
4510+ parse o = NodeBreakerStats <$> o .: "tripped"
4511+ <*> o .: "overhead"
4512+ <*> o .: "estimated_size_in_bytes"
4513+ <*> o .: "limit_size_in_bytes"
4514+
4515+instance FromJSON NodeHTTPStats where
4516+ parseJSON = withObject "NodeHTTPStats" parse
4517+ where
4518+ parse o = NodeHTTPStats <$> o .: "total_opened"
4519+ <*> o .: "current_open"
4520+
4521+instance FromJSON NodeTransportStats where
4522+ parseJSON = withObject "NodeTransportStats" parse
4523+ where
4524+ parse o = NodeTransportStats <$> o .: "tx_size_in_bytes"
4525+ <*> o .: "tx_count"
4526+ <*> o .: "rx_size_in_bytes"
4527+ <*> o .: "rx_count"
4528+ <*> o .: "server_open"
4529+
4530+instance FromJSON NodeFSStats where
4531+ parseJSON = withObject "NodeFSStats" parse
4532+ where
4533+ parse o = NodeFSStats <$> o .: "data"
4534+ <*> o .: "total"
4535+ <*> (posixMS <$> o .: "timestamp")
4536+
4537+instance FromJSON NodeDataPathStats where
4538+ parseJSON = withObject "NodeDataPathStats" parse
4539+ where
4540+ parse o =
4541+ NodeDataPathStats <$> (fmap unStringlyTypedDouble <$> o .:? "disk_service_time")
4542+ <*> (fmap unStringlyTypedDouble <$> o .:? "disk_queue")
4543+ <*> o .:? "disk_io_size_in_bytes"
4544+ <*> o .:? "disk_write_size_in_bytes"
4545+ <*> o .:? "disk_read_size_in_bytes"
4546+ <*> o .:? "disk_io_op"
4547+ <*> o .:? "disk_writes"
4548+ <*> o .:? "disk_reads"
4549+ <*> o .: "available_in_bytes"
4550+ <*> o .: "free_in_bytes"
4551+ <*> o .: "total_in_bytes"
4552+ <*> o .:? "type"
4553+ <*> o .:? "dev"
4554+ <*> o .: "mount"
4555+ <*> o .: "path"
4556+
4557+newtype StringlyTypedDouble = StringlyTypedDouble { unStringlyTypedDouble :: Double }
4558+
4559+
4560+instance FromJSON StringlyTypedDouble where
4561+ parseJSON = fmap StringlyTypedDouble . parseJSON . unStringlyTypeJSON
4562+
4563+
4564+instance FromJSON NodeFSTotalStats where
4565+ parseJSON = withObject "NodeFSTotalStats" parse
4566+ where
4567+ parse o = NodeFSTotalStats <$> (fmap unStringlyTypedDouble <$> o .:? "disk_service_time")
4568+ <*> (fmap unStringlyTypedDouble <$> o .:? "disk_queue")
4569+ <*> o .:? "disk_io_size_in_bytes"
4570+ <*> o .:? "disk_write_size_in_bytes"
4571+ <*> o .:? "disk_read_size_in_bytes"
4572+ <*> o .:? "disk_io_op"
4573+ <*> o .:? "disk_writes"
4574+ <*> o .:? "disk_reads"
4575+ <*> o .: "available_in_bytes"
4576+ <*> o .: "free_in_bytes"
4577+ <*> o .: "total_in_bytes"
4578+
4579+instance FromJSON NodeNetworkStats where
4580+ parseJSON = withObject "NodeNetworkStats" parse
4581+ where
4582+ parse o = do
4583+ tcp <- o .: "tcp"
4584+ NodeNetworkStats <$> tcp .: "out_rsts"
4585+ <*> tcp .: "in_errs"
4586+ <*> tcp .: "attempt_fails"
4587+ <*> tcp .: "estab_resets"
4588+ <*> tcp .: "retrans_segs"
4589+ <*> tcp .: "out_segs"
4590+ <*> tcp .: "in_segs"
4591+ <*> tcp .: "curr_estab"
4592+ <*> tcp .: "passive_opens"
4593+ <*> tcp .: "active_opens"
4594+
4595+instance FromJSON NodeThreadPoolsStats where
4596+ parseJSON = withObject "NodeThreadPoolsStats" parse
4597+ where
4598+ parse o = NodeThreadPoolsStats <$> o .: "snapshot"
4599+ <*> o .: "bulk"
4600+ <*> o .: "force_merge"
4601+ <*> o .: "get"
4602+ <*> o .: "management"
4603+ <*> o .:? "fetch_shard_store"
4604+ <*> o .:? "optimize"
4605+ <*> o .: "flush"
4606+ <*> o .: "search"
4607+ <*> o .: "warmer"
4608+ <*> o .: "generic"
4609+ <*> o .:? "suggest"
4610+ <*> o .: "refresh"
4611+ <*> o .: "index"
4612+ <*> o .:? "listener"
4613+ <*> o .:? "fetch_shard_started"
4614+ <*> o .:? "percolate"
4615+instance FromJSON NodeThreadPoolStats where
4616+ parseJSON = withObject "NodeThreadPoolStats" parse
4617+ where
4618+ parse o = NodeThreadPoolStats <$> o .: "completed"
4619+ <*> o .: "largest"
4620+ <*> o .: "rejected"
4621+ <*> o .: "active"
4622+ <*> o .: "queue"
4623+ <*> o .: "threads"
4624+
4625+instance FromJSON NodeJVMStats where
4626+ parseJSON = withObject "NodeJVMStats" parse
4627+ where
4628+ parse o = do
4629+ bufferPools <- o .: "buffer_pools"
4630+ mapped <- bufferPools .: "mapped"
4631+ direct <- bufferPools .: "direct"
4632+ gc <- o .: "gc"
4633+ collectors <- gc .: "collectors"
4634+ oldC <- collectors .: "old"
4635+ youngC <- collectors .: "young"
4636+ threads <- o .: "threads"
4637+ mem <- o .: "mem"
4638+ pools <- mem .: "pools"
4639+ oldM <- pools .: "old"
4640+ survivorM <- pools .: "survivor"
4641+ youngM <- pools .: "young"
4642+ NodeJVMStats <$> pure mapped
4643+ <*> pure direct
4644+ <*> pure oldC
4645+ <*> pure youngC
4646+ <*> threads .: "peak_count"
4647+ <*> threads .: "count"
4648+ <*> pure oldM
4649+ <*> pure survivorM
4650+ <*> pure youngM
4651+ <*> mem .: "non_heap_committed_in_bytes"
4652+ <*> mem .: "non_heap_used_in_bytes"
4653+ <*> mem .: "heap_max_in_bytes"
4654+ <*> mem .: "heap_committed_in_bytes"
4655+ <*> mem .: "heap_used_percent"
4656+ <*> mem .: "heap_used_in_bytes"
4657+ <*> (unMS <$> o .: "uptime_in_millis")
4658+ <*> (posixMS <$> o .: "timestamp")
4659+
4660+instance FromJSON JVMBufferPoolStats where
4661+ parseJSON = withObject "JVMBufferPoolStats" parse
4662+ where
4663+ parse o = JVMBufferPoolStats <$> o .: "total_capacity_in_bytes"
4664+ <*> o .: "used_in_bytes"
4665+ <*> o .: "count"
4666+
4667+instance FromJSON JVMGCStats where
4668+ parseJSON = withObject "JVMGCStats" parse
4669+ where
4670+ parse o = JVMGCStats <$> (unMS <$> o .: "collection_time_in_millis")
4671+ <*> o .: "collection_count"
4672+
4673+instance FromJSON JVMPoolStats where
4674+ parseJSON = withObject "JVMPoolStats" parse
4675+ where
4676+ parse o = JVMPoolStats <$> o .: "peak_max_in_bytes"
4677+ <*> o .: "peak_used_in_bytes"
4678+ <*> o .: "max_in_bytes"
4679+ <*> o .: "used_in_bytes"
4680+
4681+instance FromJSON NodeProcessStats where
4682+ parseJSON = withObject "NodeProcessStats" parse
4683+ where
4684+ parse o = do
4685+ mem <- o .: "mem"
4686+ cpu <- o .: "cpu"
4687+ NodeProcessStats <$> (posixMS <$> o .: "timestamp")
4688+ <*> o .: "open_file_descriptors"
4689+ <*> o .: "max_file_descriptors"
4690+ <*> cpu .: "percent"
4691+ <*> (unMS <$> cpu .: "total_in_millis")
4692+ <*> mem .: "total_virtual_in_bytes"
4693+
4694+instance FromJSON NodeOSStats where
4695+ parseJSON = withObject "NodeOSStats" parse
4696+ where
4697+ parse o = do
4698+ swap <- o .: "swap"
4699+ mem <- o .: "mem"
4700+ cpu <- o .: "cpu"
4701+ load <- o .:? "load_average"
4702+ NodeOSStats <$> (posixMS <$> o .: "timestamp")
4703+ <*> cpu .: "percent"
4704+ <*> pure load
4705+ <*> mem .: "total_in_bytes"
4706+ <*> mem .: "free_in_bytes"
4707+ <*> mem .: "free_percent"
4708+ <*> mem .: "used_in_bytes"
4709+ <*> mem .: "used_percent"
4710+ <*> swap .: "total_in_bytes"
4711+ <*> swap .: "free_in_bytes"
4712+ <*> swap .: "used_in_bytes"
4713+
4714+instance FromJSON LoadAvgs where
4715+ parseJSON = withArray "LoadAvgs" parse
4716+ where
4717+ parse v = case V.toList v of
4718+ [one, five, fifteen] -> LoadAvgs <$> parseJSON one
4719+ <*> parseJSON five
4720+ <*> parseJSON fifteen
4721+ _ -> fail "Expecting a triple of Doubles"
4722+
4723+instance FromJSON NodeIndicesStats where
4724+ parseJSON = withObject "NodeIndicesStats" parse
4725+ where
4726+ parse o = do
4727+ let (.::) mv k = case mv of
4728+ Just v -> Just <$> v .: k
4729+ Nothing -> pure Nothing
4730+ mRecovery <- o .:? "recovery"
4731+ mQueryCache <- o .:? "query_cache"
4732+ mSuggest <- o .:? "suggest"
4733+ translog <- o .: "translog"
4734+ segments <- o .: "segments"
4735+ completion <- o .: "completion"
4736+ mPercolate <- o .:? "percolate"
4737+ fielddata <- o .: "fielddata"
4738+ warmer <- o .: "warmer"
4739+ flush <- o .: "flush"
4740+ refresh <- o .: "refresh"
4741+ merges <- o .: "merges"
4742+ search <- o .: "search"
4743+ getStats <- o .: "get"
4744+ indexing <- o .: "indexing"
4745+ store <- o .: "store"
4746+ docs <- o .: "docs"
4747+ NodeIndicesStats <$> (fmap unMS <$> mRecovery .:: "throttle_time_in_millis")
4748+ <*> mRecovery .:: "current_as_target"
4749+ <*> mRecovery .:: "current_as_source"
4750+ <*> mQueryCache .:: "miss_count"
4751+ <*> mQueryCache .:: "hit_count"
4752+ <*> mQueryCache .:: "evictions"
4753+ <*> mQueryCache .:: "memory_size_in_bytes"
4754+ <*> mSuggest .:: "current"
4755+ <*> (fmap unMS <$> mSuggest .:: "time_in_millis")
4756+ <*> mSuggest .:: "total"
4757+ <*> translog .: "size_in_bytes"
4758+ <*> translog .: "operations"
4759+ <*> segments .:? "fixed_bit_set_memory_in_bytes"
4760+ <*> segments .: "version_map_memory_in_bytes"
4761+ <*> segments .:? "index_writer_max_memory_in_bytes"
4762+ <*> segments .: "index_writer_memory_in_bytes"
4763+ <*> segments .: "memory_in_bytes"
4764+ <*> segments .: "count"
4765+ <*> completion .: "size_in_bytes"
4766+ <*> mPercolate .:: "queries"
4767+ <*> mPercolate .:: "memory_size_in_bytes"
4768+ <*> mPercolate .:: "current"
4769+ <*> (fmap unMS <$> mPercolate .:: "time_in_millis")
4770+ <*> mPercolate .:: "total"
4771+ <*> fielddata .: "evictions"
4772+ <*> fielddata .: "memory_size_in_bytes"
4773+ <*> (unMS <$> warmer .: "total_time_in_millis")
4774+ <*> warmer .: "total"
4775+ <*> warmer .: "current"
4776+ <*> (unMS <$> flush .: "total_time_in_millis")
4777+ <*> flush .: "total"
4778+ <*> (unMS <$> refresh .: "total_time_in_millis")
4779+ <*> refresh .: "total"
4780+ <*> merges .: "total_size_in_bytes"
4781+ <*> merges .: "total_docs"
4782+ <*> (unMS <$> merges .: "total_time_in_millis")
4783+ <*> merges .: "total"
4784+ <*> merges .: "current_size_in_bytes"
4785+ <*> merges .: "current_docs"
4786+ <*> merges .: "current"
4787+ <*> search .: "fetch_current"
4788+ <*> (unMS <$> search .: "fetch_time_in_millis")
4789+ <*> search .: "fetch_total"
4790+ <*> search .: "query_current"
4791+ <*> (unMS <$> search .: "query_time_in_millis")
4792+ <*> search .: "query_total"
4793+ <*> search .: "open_contexts"
4794+ <*> getStats .: "current"
4795+ <*> (unMS <$> getStats .: "missing_time_in_millis")
4796+ <*> getStats .: "missing_total"
4797+ <*> (unMS <$> getStats .: "exists_time_in_millis")
4798+ <*> getStats .: "exists_total"
4799+ <*> (unMS <$> getStats .: "time_in_millis")
4800+ <*> getStats .: "total"
4801+ <*> (fmap unMS <$> indexing .:? "throttle_time_in_millis")
4802+ <*> indexing .:? "is_throttled"
4803+ <*> indexing .:? "noop_update_total"
4804+ <*> indexing .: "delete_current"
4805+ <*> (unMS <$> indexing .: "delete_time_in_millis")
4806+ <*> indexing .: "delete_total"
4807+ <*> indexing .: "index_current"
4808+ <*> (unMS <$> indexing .: "index_time_in_millis")
4809+ <*> indexing .: "index_total"
4810+ <*> (unMS <$> store .: "throttle_time_in_millis")
4811+ <*> store .: "size_in_bytes"
4812+ <*> docs .: "deleted"
4813+ <*> docs .: "count"
4814+
4815+instance FromJSON NodeBreakersStats where
4816+ parseJSON = withObject "NodeBreakersStats" parse
4817+ where
4818+ parse o = NodeBreakersStats <$> o .: "parent"
4819+ <*> o .: "request"
4820+ <*> o .: "fielddata"
4821+
4822+parseNodeStats :: FullNodeId -> Object -> Parser NodeStats
4823+parseNodeStats fnid o = do
4824+ NodeStats <$> o .: "name"
4825+ <*> pure fnid
4826+ <*> o .:? "breakers"
4827+ <*> o .: "http"
4828+ <*> o .: "transport"
4829+ <*> o .: "fs"
4830+ <*> o .:? "network"
4831+ <*> o .: "thread_pool"
4832+ <*> o .: "jvm"
4833+ <*> o .: "process"
4834+ <*> o .: "os"
4835+ <*> o .: "indices"
4836+
4837+parseNodeInfo :: FullNodeId -> Object -> Parser NodeInfo
4838+parseNodeInfo nid o =
4839+ NodeInfo <$> o .:? "http_address"
4840+ <*> o .: "build_hash"
4841+ <*> o .: "version"
4842+ <*> o .: "ip"
4843+ <*> o .: "host"
4844+ <*> o .: "transport_address"
4845+ <*> o .: "name"
4846+ <*> pure nid
4847+ <*> o .: "plugins"
4848+ <*> o .: "http"
4849+ <*> o .: "transport"
4850+ <*> o .:? "network"
4851+ <*> o .: "thread_pool"
4852+ <*> o .: "jvm"
4853+ <*> o .: "process"
4854+ <*> o .: "os"
4855+ <*> o .: "settings"
4856+
4857+instance FromJSON NodePluginInfo where
4858+ parseJSON = withObject "NodePluginInfo" parse
4859+ where
4860+ parse o = NodePluginInfo <$> o .:? "site"
4861+ <*> o .:? "jvm"
4862+ <*> o .: "description"
4863+ <*> o .: "version"
4864+ <*> o .: "name"
4865+
4866+instance FromJSON NodeHTTPInfo where
4867+ parseJSON = withObject "NodeHTTPInfo" parse
4868+ where
4869+ parse o = NodeHTTPInfo <$> o .: "max_content_length_in_bytes"
4870+ <*> parseJSON (Object o)
4871+
4872+instance FromJSON BoundTransportAddress where
4873+ parseJSON = withObject "BoundTransportAddress" parse
4874+ where
4875+ parse o = BoundTransportAddress <$> o .: "publish_address"
4876+ <*> o .: "bound_address"
4877+
4878+instance FromJSON NodeOSInfo where
4879+ parseJSON = withObject "NodeOSInfo" parse
4880+ where
4881+ parse o = do
4882+ NodeOSInfo <$> (unMS <$> o .: "refresh_interval_in_millis")
4883+ <*> o .: "name"
4884+ <*> o .: "arch"
4885+ <*> o .: "version"
4886+ <*> o .: "available_processors"
4887+ <*> o .: "allocated_processors"
4888+
4889+
4890+instance FromJSON CPUInfo where
4891+ parseJSON = withObject "CPUInfo" parse
4892+ where
4893+ parse o = CPUInfo <$> o .: "cache_size_in_bytes"
4894+ <*> o .: "cores_per_socket"
4895+ <*> o .: "total_sockets"
4896+ <*> o .: "total_cores"
4897+ <*> o .: "mhz"
4898+ <*> o .: "model"
4899+ <*> o .: "vendor"
4900+
4901+instance FromJSON NodeProcessInfo where
4902+ parseJSON = withObject "NodeProcessInfo" parse
4903+ where
4904+ parse o = NodeProcessInfo <$> o .: "mlockall"
4905+ <*> o .:? "max_file_descriptors"
4906+ <*> o .: "id"
4907+ <*> (unMS <$> o .: "refresh_interval_in_millis")
4908+
4909+instance FromJSON NodeJVMInfo where
4910+ parseJSON = withObject "NodeJVMInfo" parse
4911+ where
4912+ parse o = NodeJVMInfo <$> o .: "memory_pools"
4913+ <*> o .: "gc_collectors"
4914+ <*> o .: "mem"
4915+ <*> (posixMS <$> o .: "start_time_in_millis")
4916+ <*> o .: "vm_vendor"
4917+ <*> o .: "vm_version"
4918+ <*> o .: "vm_name"
4919+ <*> (unJVMVersion <$> o .: "version")
4920+ <*> o .: "pid"
4921+
4922+instance FromJSON JVMVersion where
4923+ parseJSON (String t) =
4924+ JVMVersion <$> parseJSON (String (T.replace "_" "." t))
4925+ parseJSON v = JVMVersion <$> parseJSON v
4926+
4927+instance FromJSON JVMMemoryInfo where
4928+ parseJSON = withObject "JVMMemoryInfo" parse
4929+ where
4930+ parse o = JVMMemoryInfo <$> o .: "direct_max_in_bytes"
4931+ <*> o .: "non_heap_max_in_bytes"
4932+ <*> o .: "non_heap_init_in_bytes"
4933+ <*> o .: "heap_max_in_bytes"
4934+ <*> o .: "heap_init_in_bytes"
4935+
4936+instance FromJSON NodeThreadPoolsInfo where
4937+ parseJSON = withObject "NodeThreadPoolsInfo" parse
4938+ where
4939+ parse o = NodeThreadPoolsInfo <$> o .: "refresh"
4940+ <*> o .: "management"
4941+ <*> o .:? "percolate"
4942+ <*> o .:? "listener"
4943+ <*> o .:? "fetch_shard_started"
4944+ <*> o .: "search"
4945+ <*> o .: "flush"
4946+ <*> o .: "warmer"
4947+ <*> o .:? "optimize"
4948+ <*> o .: "bulk"
4949+ <*> o .:? "suggest"
4950+ <*> o .: "force_merge"
4951+ <*> o .: "snapshot"
4952+ <*> o .: "get"
4953+ <*> o .:? "fetch_shard_store"
4954+ <*> o .: "index"
4955+ <*> o .: "generic"
4956+
4957+instance FromJSON NodeThreadPoolInfo where
4958+ parseJSON = withObject "NodeThreadPoolInfo" parse
4959+ where
4960+ parse o = do
4961+ ka <- maybe (return Nothing) (fmap Just . parseStringInterval) =<< o .:? "keep_alive"
4962+ NodeThreadPoolInfo <$> (parseJSON . unStringlyTypeJSON =<< o .: "queue_size")
4963+ <*> pure ka
4964+ <*> o .:? "min"
4965+ <*> o .:? "max"
4966+ <*> o .: "type"
4967+
4968+parseStringInterval :: (Monad m) => String -> m NominalDiffTime
4969+parseStringInterval s = case span isNumber s of
4970+ ("", _) -> fail "Invalid interval"
4971+ (nS, unitS) -> case (readMay nS, readMay unitS) of
4972+ (Just n, Just unit) -> return (fromInteger (n * unitNDT unit))
4973+ (Nothing, _) -> fail "Invalid interval number"
4974+ (_, Nothing) -> fail "Invalid interval unit"
4975+ where
4976+ unitNDT Seconds = 1
4977+ unitNDT Minutes = 60
4978+ unitNDT Hours = 60 * 60
4979+ unitNDT Days = 24 * 60 * 60
4980+ unitNDT Weeks = 7 * 24 * 60 * 60
4981+
4982+instance FromJSON ThreadPoolSize where
4983+ parseJSON v = parseAsNumber v <|> parseAsString v
4984+ where
4985+ parseAsNumber = parseAsInt <=< parseJSON
4986+ parseAsInt (-1) = return ThreadPoolUnbounded
4987+ parseAsInt n
4988+ | n >= 0 = return (ThreadPoolBounded n)
4989+ | otherwise = fail "Thread pool size must be >= -1."
4990+ parseAsString = withText "ThreadPoolSize" $ \t ->
4991+ case first (readMay . T.unpack) (T.span isNumber t) of
4992+ (Just n, "k") -> return (ThreadPoolBounded (n * 1000))
4993+ (Just n, "") -> return (ThreadPoolBounded n)
4994+ _ -> fail ("Invalid thread pool size " <> T.unpack t)
4995+
4996+instance FromJSON ThreadPoolType where
4997+ parseJSON = withText "ThreadPoolType" parse
4998+ where
4999+ parse "scaling" = return ThreadPoolScaling
5000+ parse "fixed" = return ThreadPoolFixed
5001+ parse "cached" = return ThreadPoolCached
5002+ parse e = fail ("Unexpected thread pool type" <> T.unpack e)
5003+
5004+instance FromJSON NodeTransportInfo where
5005+ parseJSON = withObject "NodeTransportInfo" parse
5006+ where
5007+ parse o = NodeTransportInfo <$> (maybe (return mempty) parseProfiles =<< o .:? "profiles")
5008+ <*> parseJSON (Object o)
5009+ parseProfiles (Object o) | HM.null o = return []
5010+ parseProfiles v@(Array _) = parseJSON v
5011+ parseProfiles Null = return []
5012+ parseProfiles _ = fail "Could not parse profiles"
5013+
5014+instance FromJSON NodeNetworkInfo where
5015+ parseJSON = withObject "NodeNetworkInfo" parse
5016+ where
5017+ parse o = NodeNetworkInfo <$> o .: "primary_interface"
5018+ <*> (unMS <$> o .: "refresh_interval_in_millis")
5019+
5020+
5021+instance FromJSON NodeNetworkInterface where
5022+ parseJSON = withObject "NodeNetworkInterface" parse
5023+ where
5024+ parse o = NodeNetworkInterface <$> o .: "mac_address"
5025+ <*> o .: "name"
5026+ <*> o .: "address"
5027+
5028+newtype MaybeNA a = MaybeNA { unMaybeNA :: Maybe a }
5029+ deriving (Show, Eq)
5030+
5031+instance FromJSON a => FromJSON (MaybeNA a) where
5032+ parseJSON (String "NA") = pure $ MaybeNA Nothing
5033+ parseJSON o = MaybeNA . Just <$> parseJSON o
src/Database/V5/Bloodhound/Types/Class.hsnew file+17
@@ -0,0 +1,17 @@
1+{-# LANGUAGE CPP #-}
2+module Database.V5.Bloodhound.Types.Class
3+ ( Seminearring(..) )
4+ where
5+
6+#if !MIN_VERSION_base(4,8,0)
7+import Data.Monoid
8+#endif
9+
10+class Monoid a => Seminearring a where
11+ -- 0, +, *
12+ (<||>) :: a -> a -> a
13+ (<&&>) :: a -> a -> a
14+ (<&&>) = mappend
15+
16+infixr 5 <||>
17+infixr 5 <&&>
src/Database/V5/Bloodhound/Types/Internal.hsnew file+57
@@ -0,0 +1,57 @@
1+{-# LANGUAGE DeriveDataTypeable #-}
2+{-# LANGUAGE DeriveGeneric #-}
3+{-# LANGUAGE FlexibleInstances #-}
4+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
5+
6+-------------------------------------------------------------------------------
7+-- |
8+-- Module : Database.Bloodhound.Types.Internal
9+-- Copyright : (C) 2014 Chris Allen
10+-- License : BSD-style (see the file LICENSE)
11+-- Maintainer : Chris Allen <cma@bitemyapp.com>
12+-- Stability : provisional
13+-- Portability : DeriveGeneric, RecordWildCards
14+--
15+-- Internal data types for Bloodhound. These types may change without
16+-- notice so import at your own risk.
17+-------------------------------------------------------------------------------
18+module Database.V5.Bloodhound.Types.Internal
19+ ( BHEnv(..)
20+ , Server(..)
21+ , MonadBH(..)
22+ ) where
23+
24+
25+import Control.Applicative as A
26+import Control.Monad.Reader
27+import Data.Aeson
28+import Data.Text (Text)
29+import Data.Typeable (Typeable)
30+import GHC.Generics (Generic)
31+import Network.HTTP.Client
32+
33+{-| Common environment for Elasticsearch calls. Connections will be
34+ pipelined according to the provided HTTP connection manager.
35+-}
36+data BHEnv = BHEnv { bhServer :: Server
37+ , bhManager :: Manager
38+ , bhRequestHook :: Request -> IO Request
39+ -- ^ Low-level hook that is run before every request is sent. Used to implement custom authentication strategies. Defaults to 'return' with 'mkBHEnv'.
40+ }
41+
42+instance (Functor m, Applicative m, MonadIO m) => MonadBH (ReaderT BHEnv m) where
43+ getBHEnv = ask
44+
45+{-| 'Server' is used with the client functions to point at the ES instance
46+-}
47+newtype Server = Server Text deriving (Eq, Show, Generic, Typeable, FromJSON)
48+
49+{-| All API calls to Elasticsearch operate within
50+ MonadBH
51+ . The idea is that it can be easily embedded in your
52+ own monad transformer stack. A default instance for a ReaderT and
53+ alias 'BH' is provided for the simple case.
54+-}
55+class (Functor m, A.Applicative m, MonadIO m) => MonadBH m where
56+ getBHEnv :: m BHEnv
57+
stack-7.10.yamlnew file+17
@@ -0,0 +1,17 @@
1+flags:
2+ bloodhound-examples:
3+ werror: true
4+packages:
5+- '.'
6+- './examples'
7+extra-deps:
8+- http-client-0.5.0
9+- aeson-0.11.1.0
10+- fail-4.9.0.0
11+- http-types-0.9
12+- attoparsec-0.13.0.1
13+- quickcheck-properties-0.1
14+- semigroups-0.18.0.1
15+- uri-bytestring-0.1.9
16+- temporary-resourcet-0.1.0.0
17+resolver: lts-6.12
stack-7.8.yamlnew file+21
@@ -0,0 +1,21 @@
1+flags:
2+ aeson:
3+ old-locale: true
4+ bloodhound-examples:
5+ werror: true
6+packages:
7+- '.'
8+- './examples'
9+extra-deps:
10+- aeson-0.11.1.0
11+- fail-4.9.0.0
12+- http-types-0.9
13+- http-client-0.5.0
14+- attoparsec-0.13.0.1
15+- quickcheck-properties-0.1
16+- semigroups-0.18.0.1
17+- tagged-0.8.3
18+- uri-bytestring-0.1.9
19+- void-0.7.1
20+- generics-sop-0.2.2.0
21+resolver: lts-2.18
stack-8.0.yamldeleted−12
@@ -1,12 +0,0 @@
1−flags:
2− bloodhound-examples:
3− werror: true
4−
5−packages:
6−- '.'
7−- './examples'
8−extra-deps:
9− - quickcheck-properties-0.1
10− - quickcheck-arbitrary-template-0.2.0.0
11−
12−resolver: lts-8.14
stack-8.2.yamldeleted−15
@@ -1,15 +0,0 @@
1−flags:
2− bloodhound-examples:
3− werror: true
4−
5−packages:
6− - '.'
7− - './examples'
8−
9−extra-deps:
10− - aeson-1.3.0.0
11− - http-types-0.12.1
12− - quickcheck-arbitrary-template-0.2.0.0
13− - quickcheck-properties-0.1
14−
15−resolver: lts-11.6
stack-8.2.yaml.lockdeleted−40
@@ -1,40 +0,0 @@
1−# This file was autogenerated by Stack.
2−# You should not edit this file by hand.
3−# For more information, please see the documentation at:
4−# https://docs.haskellstack.org/en/stable/lock_files
5−
6−packages:
7−- completed:
8− hackage: aeson-1.3.0.0@sha256:23c353da98033eab7dca65d496df6c79c929f8d1413119648d1de01e703fbd3b,6539
9− pantry-tree:
10− size: 39767
11− sha256: 68512381071165c48e123cf515c1098ee455ec75b56724e31f6d570d3c865c47
12− original:
13− hackage: aeson-1.3.0.0
14−- completed:
15− hackage: http-types-0.12.1@sha256:12ce2fc081fde3cf219b630c2fb3815183a64eee236ba7aa735f666eab949610,2035
16− pantry-tree:
17− size: 832
18− sha256: c66c35b8f4f1b8b82f99cf8de3711027b5d0cc64bd031ab84375100038f81310
19− original:
20− hackage: http-types-0.12.1
21−- completed:
22− hackage: quickcheck-arbitrary-template-0.2.0.0@sha256:c8afad9c6e1f2a1d9813bb6c94158a99f7d6edeae8bb696b29d6c450f67811ec,2025
23− pantry-tree:
24− size: 625
25− sha256: 64262d8f3365305c35babbb2f5727ea3287c3fad61d3b66c3a2c68185fe92c5a
26− original:
27− hackage: quickcheck-arbitrary-template-0.2.0.0
28−- completed:
29− hackage: quickcheck-properties-0.1@sha256:3bd0890e84ec4cf1c1e6e475152c2c0d7c85915a051cf4e8bf9ec70c32df735c,1268
30− pantry-tree:
31− size: 550
32− sha256: 12264d8a89883b42e78c313792f8cba9af51c8fda915fce34e9780ff6972cf7e
33− original:
34− hackage: quickcheck-properties-0.1
35−snapshots:
36−- completed:
37− size: 507208
38− url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/11/6.yaml
39− sha256: 99d52f009dc5a53ac61ffc4e6044f910ca7b28b4596b6962135a48e8c7d3d093
40− original: lts-11.6
stack-8.4.yamldeleted−15
@@ -1,15 +0,0 @@
1−flags:
2− bloodhound-examples:
3− werror: true
4−
5−packages:
6− - '.'
7− - './examples'
8−
9−# extra-deps:
10−# - aeson-1.3.0.0
11−# - http-types-0.12.1
12−# - quickcheck-arbitrary-template-0.2.0.0
13−# - quickcheck-properties-0.1
14−
15−resolver: lts-12.6
stack-8.4.yaml.lockdeleted−12
@@ -1,12 +0,0 @@
1−# This file was autogenerated by Stack.
2−# You should not edit this file by hand.
3−# For more information, please see the documentation at:
4−# https://docs.haskellstack.org/en/stable/lock_files
5−
6−packages: []
7−snapshots:
8−- completed:
9− size: 502349
10− url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/12/6.yaml
11− sha256: fbce9f11b2f1c637855eb29fe952f3ac16c35d46836df0dee0cc54a85e1e33d6
12− original: lts-12.6
stack-8.6.yamldeleted−14
@@ -1,14 +0,0 @@
1−flags:
2− bloodhound-examples:
3− werror: true
4−
5−packages:
6− - '.'
7− - './examples'
8−
9−extra-deps:
10− - git: https://github.com/bitemyapp/quickcheck-arbitrary-template.git
11− commit: bf9cee96a88ecce2ff920ce74c166a38712e5ed2
12− - quickcheck-properties-0.1
13−
14−resolver: lts-13.30
stack-8.6.yaml.lockdeleted−33
@@ -1,33 +0,0 @@
1−# This file was autogenerated by Stack.
2−# You should not edit this file by hand.
3−# For more information, please see the documentation at:
4−# https://docs.haskellstack.org/en/stable/lock_files
5−
6−packages:
7−- completed:
8− cabal-file:
9− size: 2026
10− sha256: d340ae2f3fd0b54b2f899d482072be24f41eddac8ea081f11d9db260b14264c8
11− name: quickcheck-arbitrary-template
12− version: 0.2.0.0
13− git: https://github.com/bitemyapp/quickcheck-arbitrary-template.git
14− pantry-tree:
15− size: 859
16− sha256: a6c70780465af154ada9481c0a5ffcda1b069d249522634c578218c3c390cbf1
17− commit: bf9cee96a88ecce2ff920ce74c166a38712e5ed2
18− original:
19− git: https://github.com/bitemyapp/quickcheck-arbitrary-template.git
20− commit: bf9cee96a88ecce2ff920ce74c166a38712e5ed2
21−- completed:
22− hackage: quickcheck-properties-0.1@sha256:3bd0890e84ec4cf1c1e6e475152c2c0d7c85915a051cf4e8bf9ec70c32df735c,1268
23− pantry-tree:
24− size: 550
25− sha256: 12264d8a89883b42e78c313792f8cba9af51c8fda915fce34e9780ff6972cf7e
26− original:
27− hackage: quickcheck-properties-0.1
28−snapshots:
29−- completed:
30− size: 500539
31− url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/13/30.yaml
32− sha256: 59ad6b944c9903847fecdc1d4815e8500c1f9999d80fd1b4d2d66e408faec44b
33− original: lts-13.30
stack.yamlmode 120000 → 100644+13−1
@@ -1 +0,0 @@
1−stack-8.6.yaml
@@ -0,0 +1,13 @@
1+flags:
2+ bloodhound-examples:
3+ werror: true
4+packages:
5+- '.'
6+- './examples'
7+extra-deps:
8+- hspec-2.4.1
9+- hspec-core-2.4.1
10+- hspec-discover-2.4.1
11+- quickcheck-properties-0.1
12+- vector-0.12.0.0
13+resolver: nightly-2017-01-30
stack.yaml.lockdeleted−12
@@ -1,12 +0,0 @@
1−# This file was autogenerated by Stack.
2−# You should not edit this file by hand.
3−# For more information, please see the documentation at:
4−# https://docs.haskellstack.org/en/stable/lock_files
5−
6−packages: []
7−snapshots:
8−- completed:
9− size: 500539
10− url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/13/30.yaml
11− sha256: 59ad6b944c9903847fecdc1d4815e8500c1f9999d80fd1b4d2d66e408faec44b
12− original: lts-13.30
tests/Test/Aggregation.hsdeleted−147
@@ -1,147 +0,0 @@
1−{-# LANGUAGE OverloadedStrings #-}
2−
3−module Test.Aggregation (spec) where
4−
5−import Test.Common
6−import Test.Import
7−
8−import Control.Error (fmapL, note)
9−import qualified Data.Map as M
10−import qualified Database.Bloodhound
11−
12−spec :: Spec
13−spec =
14− describe "Aggregation API" $ do
15− it "returns term aggregation results" $ withTestEnv $ do
16− _ <- insertData
17− let terms = TermsAgg $ mkTermsAggregation "user"
18− let search = mkAggregateSearch Nothing $ mkAggregations "users" terms
19− searchExpectAggs search
20− searchValidBucketAgg search "users" toTerms
21−
22− it "return sub-aggregation results" $ withTestEnv $ do
23− _ <- insertData
24− let subaggs = mkAggregations "age_agg" . TermsAgg $ mkTermsAggregation "age"
25− agg = TermsAgg $ (mkTermsAggregation "user") { termAggs = Just subaggs}
26− search = mkAggregateSearch Nothing $ mkAggregations "users" agg
27− reply <- searchByIndex testIndex search
28− let result = decode (responseBody reply) :: Maybe (SearchResult Tweet)
29− usersAggResults = result >>= aggregations >>= toTerms "users"
30− subAggResults = usersAggResults >>= (listToMaybe . buckets) >>= termsAggs >>= toTerms "age_agg"
31− subAddResultsExists = isJust subAggResults
32− liftIO $ subAddResultsExists `shouldBe` True
33−
34− it "returns cardinality aggregation results" $ withTestEnv $ do
35− _ <- insertData
36− let cardinality = CardinalityAgg $ mkCardinalityAggregation $ FieldName "user"
37− let search = mkAggregateSearch Nothing $ mkAggregations "users" cardinality
38− let search' = search { Database.Bloodhound.from = From 0, size = Size 0 }
39− searchExpectAggs search'
40− let docCountPair k n = (k, object ["value" .= Number n])
41− res <- searchTweets search'
42− liftIO $
43− fmap aggregations res `shouldBe` Right (Just (M.fromList [ docCountPair "users" 1]))
44−
45− it "returns stats aggregation results" $ withTestEnv $ do
46− _ <- insertData
47− let stats = StatsAgg $ mkStatsAggregation $ FieldName "age"
48− let search = mkAggregateSearch Nothing $ mkAggregations "users" stats
49− let search' = search { Database.Bloodhound.from = From 0, size = Size 0 }
50− searchExpectAggs search'
51− let statsAggRes k n = (k, object [ "max" .= Number n
52− , "avg" .= Number n
53− , "count" .= Number 1
54− , "min" .= Number n
55− , "sum" .= Number n])
56− res <- searchTweets search'
57− liftIO $
58− fmap aggregations res `shouldBe` Right (Just (M.fromList [ statsAggRes "users" 10000]))
59−
60− it "can give collection hint parameters to term aggregations" $ when' (atleast es13) $ withTestEnv $ do
61− _ <- insertData
62− let terms = TermsAgg $ (mkTermsAggregation "user") { termCollectMode = Just BreadthFirst }
63− let search = mkAggregateSearch Nothing $ mkAggregations "users" terms
64− searchExpectAggs search
65− searchValidBucketAgg search "users" toTerms
66−
67− -- One of these fails with 1.7.3
68− it "can give execution hint parameters to term aggregations" $ when' (atmost es11) $ withTestEnv $ do
69− _ <- insertData
70− searchTermsAggHint [Map, Ordinals]
71−
72− it "can give execution hint parameters to term aggregations" $ when' (is es12) $ withTestEnv $ do
73− _ <- insertData
74− searchTermsAggHint [GlobalOrdinals, GlobalOrdinalsHash, GlobalOrdinalsLowCardinality, Map, Ordinals]
75−
76− it "can give execution hint parameters to term aggregations" $ when' (atleast es12) $ withTestEnv $ do
77− _ <- insertData
78− searchTermsAggHint [GlobalOrdinals, GlobalOrdinalsHash, GlobalOrdinalsLowCardinality, Map]
79− -- One of the above.
80−
81− it "can execute value_count aggregations" $ withTestEnv $ do
82− _ <- insertData
83− _ <- insertOther
84− let ags = mkAggregations "user_count" (ValueCountAgg (FieldValueCount (FieldName "user"))) <>
85− mkAggregations "bogus_count" (ValueCountAgg (FieldValueCount (FieldName "bogus")))
86− let search = mkAggregateSearch Nothing ags
87− let docCountPair k n = (k, object ["value" .= Number n])
88− res <- searchTweets search
89− liftIO $
90− fmap aggregations res `shouldBe` Right (Just (M.fromList [ docCountPair "user_count" 2
91− , docCountPair "bogus_count" 0
92− ]))
93−
94− it "can execute date_range aggregations" $ withTestEnv $ do
95− let now = fromGregorian 2015 3 14
96− let ltAMonthAgo = UTCTime (fromGregorian 2015 3 1) 0
97− let ltAWeekAgo = UTCTime (fromGregorian 2015 3 10) 0
98− let oldDoc = exampleTweet { postDate = ltAMonthAgo }
99− let newDoc = exampleTweet { postDate = ltAWeekAgo }
100− _ <- indexDocument testIndex testMapping defaultIndexDocumentSettings oldDoc (DocId "1")
101− _ <- indexDocument testIndex testMapping defaultIndexDocumentSettings newDoc (DocId "2")
102− _ <- refreshIndex testIndex
103− let thisMonth = DateRangeFrom (DateMathExpr (DMDate now) [SubtractTime 1 DMMonth])
104− let thisWeek = DateRangeFrom (DateMathExpr (DMDate now) [SubtractTime 1 DMWeek])
105− let agg = DateRangeAggregation (FieldName "postDate") Nothing (thisMonth :| [thisWeek])
106− let ags = mkAggregations "date_ranges" (DateRangeAgg agg)
107− let search = mkAggregateSearch Nothing ags
108− res <- searchTweets search
109− liftIO $ hitsTotal . searchHits <$> res `shouldBe` Right 2
110− let bucks = do magrs <- fmapL show (aggregations <$> res)
111− agrs <- note "no aggregations returned" magrs
112− rawBucks <- note "no date_ranges aggregation" $ M.lookup "date_ranges" agrs
113− parseEither parseJSON rawBucks
114− let fromMonthT = UTCTime (fromGregorian 2015 2 14) 0
115− let fromWeekT = UTCTime (fromGregorian 2015 3 7) 0
116− liftIO $ buckets <$> bucks `shouldBe` Right [ DateRangeResult "2015-02-14T00:00:00.000Z-*"
117− (Just fromMonthT)
118− (Just "2015-02-14T00:00:00.000Z")
119− Nothing
120− Nothing
121− 2
122− Nothing
123− , DateRangeResult "2015-03-07T00:00:00.000Z-*"
124− (Just fromWeekT)
125− (Just "2015-03-07T00:00:00.000Z")
126− Nothing
127− Nothing
128− 1
129− Nothing
130− ]
131−
132− it "returns date histogram aggregation results" $ withTestEnv $ do
133− _ <- insertData
134− let histogram = DateHistogramAgg $ mkDateHistogram (FieldName "postDate") Minute
135− let search = mkAggregateSearch Nothing (mkAggregations "byDate" histogram)
136− searchExpectAggs search
137− searchValidBucketAgg search "byDate" toDateHistogram
138−
139− it "can execute missing aggregations" $ withTestEnv $ do
140− _ <- insertData
141− _ <- insertExtra
142− let ags = mkAggregations "missing_agg" (MissingAgg (MissingAggregation "extra"))
143− let search = mkAggregateSearch Nothing ags
144− let docCountPair k n = (k, object ["doc_count" .= Number n])
145− res <- searchTweets search
146− liftIO $
147− fmap aggregations res `shouldBe` Right (Just (M.fromList [docCountPair "missing_agg" 1]))
tests/Test/ApproxEq.hsdeleted−63
@@ -1,63 +0,0 @@
1−{-# LANGUAGE DefaultSignatures #-}
2−{-# LANGUAGE OverloadedStrings #-}
3−
4−module Test.ApproxEq where
5−
6−import Database.Bloodhound
7−
8−import Test.Import
9−
10−import qualified Data.List.NonEmpty as NE
11−
12−-- | Typeclass for "equal where it matters". Use this to specify
13−-- less-strict equivalence for things such as lists that can wind up
14−-- in an unpredictable order
15−class ApproxEq a where
16− (=~) :: a -> a -> Bool
17−
18− showApproxEq :: a -> String
19− default showApproxEq :: (Show a) => a -> String
20− showApproxEq = show
21−
22−(==~) :: (ApproxEq a) => a -> a -> Property
23−a ==~ b = counterexample (showApproxEq a ++ " !=~ " ++ showApproxEq b) (a =~ b)
24−
25−instance ApproxEq NominalDiffTime where (=~) = (==)
26−instance ApproxEq Bool where (=~) = (==)
27−instance ApproxEq Int where (=~) = (==)
28−instance (Eq a, Show a) => ApproxEq (Maybe a) where (=~) = (==)
29−instance ApproxEq Char where
30− (=~) = (==)
31−
32−instance ApproxEq NodeAttrFilter where (=~) = (==)
33−instance ApproxEq NodeAttrName where (=~) = (==)
34−instance (Eq a, Show a) => ApproxEq (NonEmpty a) where (=~) = (==)
35−instance (ApproxEq l, Show l, ApproxEq r, Show r) => ApproxEq (Either l r) where
36− Left a =~ Left b = a =~ b
37− Right a =~ Right b = a =~ b
38− _ =~ _ = False
39− showApproxEq (Left x) = "Left " <> showApproxEq x
40− showApproxEq (Right x) = "Right " <> showApproxEq x
41−instance (ApproxEq a, Show a) => ApproxEq [a] where
42− as =~ bs = and (zipWith (=~) as bs)
43−instance ApproxEq ReplicaCount where (=~) = (==)
44−instance ApproxEq ReplicaBounds where (=~) = (==)
45−instance ApproxEq Bytes where (=~) = (==)
46−instance ApproxEq AllocationPolicy where (=~) = (==)
47−instance ApproxEq InitialShardCount where (=~) = (==)
48−instance ApproxEq FSType where (=~) = (==)
49−
50−-- | Due to the way nodeattrfilters get serialized here, they may come
51−-- out in a different order, but they are morally equivalent
52−instance ApproxEq UpdatableIndexSetting where
53− RoutingAllocationInclude a =~ RoutingAllocationInclude b =
54− NE.sort a =~ NE.sort b
55− RoutingAllocationExclude a =~ RoutingAllocationExclude b =
56− NE.sort a =~ NE.sort b
57− RoutingAllocationRequire a =~ RoutingAllocationRequire b =
58− NE.sort a =~ NE.sort b
59− a =~ b = a == b
60− showApproxEq (RoutingAllocationInclude xs) = show (RoutingAllocationInclude (NE.sort xs))
61− showApproxEq (RoutingAllocationExclude xs) = show (RoutingAllocationExclude (NE.sort xs))
62− showApproxEq (RoutingAllocationRequire xs) = show (RoutingAllocationRequire (NE.sort xs))
63− showApproxEq x = show x
tests/Test/BulkAPI.hsdeleted−95
@@ -1,95 +0,0 @@
1−{-# LANGUAGE OverloadedStrings #-}
2−
3−module Test.BulkAPI (spec) where
4−
5−import Test.Common
6−import Test.Import
7−
8−import qualified Data.Vector as V
9−import qualified Lens.Micro.Aeson as LMA
10−
11−newtype BulkTest =
12− BulkTest Text
13− deriving (Eq, Show)
14−
15−instance ToJSON BulkTest where
16− toJSON (BulkTest name') =
17− object ["name" .= name']
18−
19−instance FromJSON BulkTest where
20− parseJSON = withObject "BulkTest" parse
21− where
22− parse o = do
23− t <- o .: "name"
24− BulkTest <$> parseJSON t
25−
26−spec :: Spec
27−spec =
28− describe "Bulk API" $
29− it "inserts all documents we request" $ withTestEnv $ do
30− _ <- insertData
31− let firstTest = BulkTest "blah"
32− let secondTest = BulkTest "bloo"
33− let thirdTest = BulkTest "graffle"
34− let fourthTest = BulkTest "garabadoo"
35− let fifthTest = BulkTest "serenity"
36− let firstDoc = BulkIndex testIndex
37− testMapping (DocId "2") (toJSON firstTest)
38− let secondDoc = BulkCreate testIndex
39− testMapping (DocId "3") (toJSON secondTest)
40− let thirdDoc = BulkCreateEncoding testIndex
41− testMapping (DocId "4") (toEncoding thirdTest)
42− let fourthDoc = BulkIndexAuto testIndex
43− testMapping (toJSON fourthTest)
44− let fifthDoc = BulkIndexEncodingAuto testIndex
45− testMapping (toEncoding fifthTest)
46− let stream = V.fromList [firstDoc, secondDoc, thirdDoc, fourthDoc, fifthDoc]
47− _ <- bulk stream
48− -- liftIO $ pPrint bulkResp
49− _ <- refreshIndex testIndex
50− -- liftIO $ pPrint refreshResp
51− fDoc <- getDocument testIndex testMapping (DocId "2")
52− sDoc <- getDocument testIndex testMapping (DocId "3")
53− tDoc <- getDocument testIndex testMapping (DocId "4")
54− -- note that we cannot query for fourthDoc and fifthDoc since we
55− -- do not know their autogenerated ids.
56− let maybeFirst =
57− eitherDecode
58− $ responseBody fDoc
59− :: Either String (EsResult BulkTest)
60− let maybeSecond =
61− eitherDecode
62− $ responseBody sDoc
63− :: Either String (EsResult BulkTest)
64− let maybeThird =
65− eitherDecode
66− $ responseBody tDoc
67− :: Either String (EsResult BulkTest)
68− -- liftIO $ pPrint [maybeFirst, maybeSecond, maybeThird]
69− liftIO $ do
70− fmap getSource maybeFirst `shouldBe` Right (Just firstTest)
71− fmap getSource maybeSecond `shouldBe` Right (Just secondTest)
72− fmap getSource maybeThird `shouldBe` Right (Just thirdTest)
73− -- Since we can't get the docs by doc id, we check for their existence in
74− -- a match all query.
75− let query = MatchAllQuery Nothing
76− let search = mkSearch (Just query) Nothing
77− resp <- searchByIndex testIndex search
78− parsed <- parseEsResponse resp :: BH IO (Either EsError (SearchResult Value))
79− case parsed of
80− Left e ->
81− liftIO $ expectationFailure ("Expected a script-transformed result but got: " <> show e)
82− (Right sr) -> do
83− liftIO $
84− hitsTotal (searchHits sr) `shouldBe` 6
85− let nameList :: [Text]
86− nameList =
87− hits (searchHits sr)
88− ^.. traverse
89− . to hitSource
90− . _Just
91− . LMA.key "name"
92− . _String
93− liftIO $
94− nameList
95− `shouldBe` ["blah","bloo","graffle","garabadoo","serenity"]
tests/Test/Common.hsdeleted−292
@@ -1,292 +0,0 @@
1−{-# LANGUAGE OverloadedStrings #-}
2−{-# LANGUAGE TemplateHaskell #-}
3−
4−module Test.Common where
5−
6−import Test.Import
7−
8−import qualified Data.Map as M
9−import qualified Data.SemVer as SemVer
10−import qualified Network.HTTP.Types.Status as NHTS
11−
12−testServer :: Server
13−testServer = Server "http://localhost:9200"
14−testIndex :: IndexName
15−testIndex = IndexName "bloodhound-tests-twitter-1"
16−testMapping :: MappingName
17−testMapping = MappingName "tweet"
18−
19−withTestEnv :: BH IO a -> IO a
20−withTestEnv = withBH defaultManagerSettings testServer
21−
22−data Location = Location { lat :: Double
23− , lon :: Double } deriving (Eq, Show)
24−
25−data Tweet = Tweet { user :: Text
26− , postDate :: UTCTime
27− , message :: Text
28− , age :: Int
29− , location :: Location
30− , extra :: Maybe Text }
31− deriving (Eq, Show)
32−
33−$(deriveJSON defaultOptions ''Location)
34−$(deriveJSON defaultOptions ''Tweet)
35−
36−data ParentMapping = ParentMapping deriving (Eq, Show)
37−
38−instance ToJSON ParentMapping where
39− toJSON ParentMapping =
40− object ["properties" .=
41− object [ "user" .= object ["type" .= ("string" :: Text)
42− , "fielddata" .= True
43− ]
44− -- Serializing the date as a date is breaking other tests, mysteriously.
45− -- , "postDate" .= object [ "type" .= ("date" :: Text)
46− -- , "format" .= ("YYYY-MM-dd`T`HH:mm:ss.SSSZZ" :: Text)]
47− , "message" .= object ["type" .= ("string" :: Text)]
48− , "age" .= object ["type" .= ("integer" :: Text)]
49− , "location" .= object ["type" .= ("geo_point" :: Text)]
50− , "extra" .= object ["type" .= ("keyword" :: Text)]
51− ]]
52−
53−es11 :: SemVer.Version
54−es11 = SemVer.version 1 1 0 [] []
55−
56−es13 :: SemVer.Version
57−es13 = SemVer.version 1 3 0 [] []
58−
59−es12 :: SemVer.Version
60−es12 = SemVer.version 1 2 0 [] []
61−
62−es14 :: SemVer.Version
63−es14 = SemVer.version 1 4 0 [] []
64−
65−es15 :: SemVer.Version
66−es15 = SemVer.version 1 5 0 [] []
67−
68−es16 :: SemVer.Version
69−es16 = SemVer.version 1 6 0 [] []
70−
71−es20 :: SemVer.Version
72−es20 = SemVer.version 2 0 0 [] []
73−
74−es50 :: SemVer.Version
75−es50 = SemVer.version 5 0 0 [] []
76−
77−getServerVersion :: IO (Maybe SemVer.Version)
78−getServerVersion = fmap extractVersion <$> withTestEnv getStatus
79− where
80− extractVersion = versionNumber . number . version
81−
82−createExampleIndex :: (MonadBH m) => m Reply
83−createExampleIndex =
84− createIndex (IndexSettings (ShardCount 1) (ReplicaCount 0)) testIndex
85−
86−deleteExampleIndex :: (MonadBH m) => m Reply
87−deleteExampleIndex =
88− deleteIndex testIndex
89−
90−validateStatus :: Show body => Response body -> Int -> Expectation
91−validateStatus resp expected =
92− if actual == expected
93− then return ()
94− else expectationFailure ("Expected " <> show expected <> " but got " <> show actual <> ": " <> show body)
95− where
96− actual = NHTS.statusCode (responseStatus resp)
97− body = responseBody resp
98−
99−data ChildMapping = ChildMapping deriving (Eq, Show)
100−
101−instance ToJSON ChildMapping where
102− toJSON ChildMapping =
103− object ["_parent" .= object ["type" .= ("parent" :: Text)]
104− , "properties" .=
105− object [ "user" .= object ["type" .= ("string" :: Text)
106− , "fielddata" .= True
107− ]
108− -- Serializing the date as a date is breaking other tests, mysteriously.
109− -- , "postDate" .= object [ "type" .= ("date" :: Text)
110− -- , "format" .= ("YYYY-MM-dd`T`HH:mm:ss.SSSZZ" :: Text)]
111− , "message" .= object ["type" .= ("string" :: Text)]
112− , "age" .= object ["type" .= ("integer" :: Text)]
113− , "location" .= object ["type" .= ("geo_point" :: Text)]
114− , "extra" .= object ["type" .= ("keyword" :: Text)]
115− ]]
116−
117−data TweetMapping = TweetMapping deriving (Eq, Show)
118−
119−instance ToJSON TweetMapping where
120− toJSON TweetMapping =
121− object ["tweet" .=
122− object ["properties" .=
123− object [ "user" .= object [ "type" .= ("string" :: Text)
124− , "fielddata" .= True
125− ]
126− -- Serializing the date as a date is breaking other tests, mysteriously.
127− -- , "postDate" .= object [ "type" .= ("date" :: Text)
128− -- , "format" .= ("YYYY-MM-dd`T`HH:mm:ss.SSSZZ" :: Text)]
129− , "message" .= object ["type" .= ("string" :: Text)]
130− , "age" .= object ["type" .= ("integer" :: Text)]
131− , "location" .= object ["type" .= ("geo_point" :: Text)]
132− , "extra" .= object ["type" .= ("keyword" :: Text)]
133− ]]]
134−
135−exampleTweet :: Tweet
136−exampleTweet = Tweet { user = "bitemyapp"
137− , postDate = UTCTime
138− (ModifiedJulianDay 55000)
139− (secondsToDiffTime 10)
140− , message = "Use haskell!"
141− , age = 10000
142− , location = Location 40.12 (-71.34)
143− , extra = Nothing }
144−
145−tweetWithExtra :: Tweet
146−tweetWithExtra = Tweet { user = "bitemyapp"
147− , postDate = UTCTime
148− (ModifiedJulianDay 55000)
149− (secondsToDiffTime 10)
150− , message = "Use haskell!"
151− , age = 10000
152− , location = Location 40.12 (-71.34)
153− , extra = Just "blah blah" }
154−
155−newAge :: Int
156−newAge = 31337
157−
158−newUser :: Text
159−newUser = "someotherapp"
160−
161−tweetPatch :: Value
162−tweetPatch =
163− object [ "age" .= newAge
164− , "user" .= newUser
165− ]
166−
167−patchedTweet :: Tweet
168−patchedTweet = exampleTweet{age = newAge, user = newUser}
169−
170−otherTweet :: Tweet
171−otherTweet = Tweet { user = "notmyapp"
172− , postDate = UTCTime
173− (ModifiedJulianDay 55000)
174− (secondsToDiffTime 11)
175− , message = "Use haskell!"
176− , age = 1000
177− , location = Location 40.12 (-71.34)
178− , extra = Nothing }
179−
180−resetIndex :: BH IO ()
181−resetIndex = do
182− _ <- deleteExampleIndex
183− _ <- createExampleIndex
184− _ <- putMapping testIndex testMapping TweetMapping
185− return ()
186−
187−insertData :: BH IO Reply
188−insertData = do
189− resetIndex
190− insertData' defaultIndexDocumentSettings
191−
192−insertData' :: IndexDocumentSettings -> BH IO Reply
193−insertData' ids = do
194− r <- indexDocument testIndex testMapping ids exampleTweet (DocId "1")
195− _ <- refreshIndex testIndex
196− return r
197−
198−updateData :: BH IO Reply
199−updateData = do
200− r <- updateDocument testIndex testMapping defaultIndexDocumentSettings tweetPatch (DocId "1")
201− _ <- refreshIndex testIndex
202− return r
203−
204−insertOther :: BH IO ()
205−insertOther = do
206− _ <- indexDocument testIndex testMapping defaultIndexDocumentSettings otherTweet (DocId "2")
207− _ <- refreshIndex testIndex
208− return ()
209−
210−insertExtra :: BH IO ()
211−insertExtra = do
212− _ <- indexDocument testIndex testMapping defaultIndexDocumentSettings tweetWithExtra (DocId "4")
213− _ <- refreshIndex testIndex
214− return ()
215−
216−insertWithSpaceInId :: BH IO ()
217−insertWithSpaceInId = do
218− _ <- indexDocument testIndex testMapping defaultIndexDocumentSettings exampleTweet (DocId "Hello World")
219− _ <- refreshIndex testIndex
220− return ()
221−
222−searchTweet :: Search -> BH IO (Either EsError Tweet)
223−searchTweet search = do
224− result <- searchTweets search
225− let myTweet :: Either EsError Tweet
226− myTweet = grabFirst result
227− return myTweet
228−
229−searchTweets :: Search -> BH IO (Either EsError (SearchResult Tweet))
230−searchTweets search = parseEsResponse =<< searchByIndex testIndex search
231−
232−searchExpectNoResults :: Search -> BH IO ()
233−searchExpectNoResults search = do
234− result <- searchTweets search
235− let emptyHits = fmap (hits . searchHits) result
236− liftIO $
237− emptyHits `shouldBe` Right []
238−
239−searchExpectAggs :: Search -> BH IO ()
240−searchExpectAggs search = do
241− reply <- searchByIndex testIndex search
242− let isEmpty x = return (M.null x)
243− let result = decode (responseBody reply) :: Maybe (SearchResult Tweet)
244− liftIO $
245− (result >>= aggregations >>= isEmpty) `shouldBe` Just False
246−
247−searchValidBucketAgg :: (BucketAggregation a, FromJSON a, Show a) =>
248− Search -> Text -> (Text -> AggregationResults -> Maybe (Bucket a)) -> BH IO ()
249−searchValidBucketAgg search aggKey extractor = do
250− reply <- searchByIndex testIndex search
251− let bucketDocs = docCount . head . buckets
252− let result = decode (responseBody reply) :: Maybe (SearchResult Tweet)
253− let count = result >>= aggregations >>= extractor aggKey >>= \x -> return (bucketDocs x)
254− liftIO $
255− count `shouldBe` Just 1
256−
257−searchTermsAggHint :: [ExecutionHint] -> BH IO ()
258−searchTermsAggHint hints = do
259− let terms hint = TermsAgg $ (mkTermsAggregation "user") { termExecutionHint = Just hint }
260− let search hint = mkAggregateSearch Nothing $ mkAggregations "users" $ terms hint
261− forM_ hints $ searchExpectAggs . search
262− forM_ hints (\x -> searchValidBucketAgg (search x) "users" toTerms)
263−
264−searchTweetHighlight :: Search
265− -> BH IO (Either EsError (Maybe HitHighlight))
266−searchTweetHighlight search = do
267− result <- searchTweets search
268− let tweetHit :: Either EsError (Maybe (Hit Tweet))
269− tweetHit = fmap (headMay . hits . searchHits) result
270− myHighlight :: Either EsError (Maybe HitHighlight)
271− myHighlight = (join . fmap hitHighlight) <$> tweetHit
272− return myHighlight
273−
274−searchExpectSource :: Source -> Either EsError Value -> BH IO ()
275−searchExpectSource src expected = do
276− _ <- insertData
277− let query = QueryMatchQuery $ mkMatchQuery (FieldName "_all") (QueryString "haskell")
278− let search = (mkSearch (Just query) Nothing) { source = Just src }
279− reply <- searchByIndex testIndex search
280− result <- parseEsResponse reply
281− let value = grabFirst result
282− liftIO $
283− value `shouldBe` expected
284−
285−atleast :: SemVer.Version -> IO Bool
286−atleast v = getServerVersion >>= \x -> return $ x >= Just v
287−
288−atmost :: SemVer.Version -> IO Bool
289−atmost v = getServerVersion >>= \x -> return $ x <= Just v
290−
291−is :: SemVer.Version -> IO Bool
292−is v = getServerVersion >>= \x -> return $ x == Just v
tests/Test/Documents.hsdeleted−51

This diff is too big to show here.

tests/Test/Generators.hsdeleted−563

This diff is too big to show here.

tests/Test/Highlights.hsdeleted−32

This diff is too big to show here.

tests/Test/Import.hsdeleted−58

This diff is too big to show here.

tests/Test/Indices.hsdeleted−173

This diff is too big to show here.

tests/Test/JSON.hsdeleted−213

This diff is too big to show here.

tests/Test/Query.hsdeleted−132

This diff is too big to show here.

tests/Test/Script.hsdeleted−36

This diff is too big to show here.

tests/Test/Snapshots.hsdeleted−201

This diff is too big to show here.

tests/Test/Sorting.hsdeleted−22

This diff is too big to show here.

tests/Test/SourceFiltering.hsdeleted−38

This diff is too big to show here.

tests/Test/Suggest.hsdeleted−23

This diff is too big to show here.

tests/Test/Templates.hsdeleted−26

This diff is too big to show here.

tests/V1/tests.hsnew file+1880

This diff is too big to show here.

tests/V5/tests.hsnew file+1649

This diff is too big to show here.

tests/tests.hsdeleted−136

This diff is too big to show here.