git.iko.soy/typeable/bloodhound
on master help sign in
.gitignore+2
since splitsnapshots
unifiedsplit
@@ -18,3 +18,5 @@ bloodhound.iml
18.hgignore
18.hgignore
19examples/bloodhound-examples.cabal
19examples/bloodhound-examples.cabal
20/.ghc.environment.*
20/.ghc.environment.*
21+.hspec-failures
22+bloodhound.cabal
.hlint.yamlnew file+66
@@ -0,0 +1,66 @@
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+9−16
@@ -1,31 +1,24 @@
1sudo: false
1sudo: false
2language: generic
2language: generic
3
3
4+jdk:
5+ - oraclejdk11
6+
4addons:
7addons:
5 apt:
8 apt:
6 packages:
9 packages:
7 - libgmp-dev
10 - libgmp-dev
8− - oracle-java8-installer
9
11
10env:
12env:
11− global:
12− - JAVA_HOME=/usr/lib/jvm/java-8-oracle
13− matrix:
13+ matrix:
14− - GHCVER=7.8 ESVER=1.3.6 STACK_YAML=stack-7.8.yaml ESFLAG=ES1 DLINK=https://download.elastic.co/elasticsearch/elasticsearch/elasticsearch
15− - GHCVER=7.8 ESVER=1.4.1 STACK_YAML=stack-7.8.yaml ESFLAG=ES1 DLINK=https://download.elastic.co/elasticsearch/elasticsearch/elasticsearch
16− - GHCVER=7.10 ESVER=1.5.2 STACK_YAML=stack-7.10.yaml ESFLAG=ES1 DLINK=https://download.elastic.co/elasticsearch/elasticsearch/elasticsearch
17− - GHCVER=7.10 ESVER=1.6.0 STACK_YAML=stack-7.10.yaml ESFLAG=ES1 DLINK=https://download.elastic.co/elasticsearch/elasticsearch/elasticsearch
18− - GHCVER=7.10 ESVER=1.7.6 STACK_YAML=stack-7.10.yaml ESFLAG=ES1 DLINK=https://download.elastic.co/elasticsearch/elasticsearch/elasticsearch
19− - GHCVER=8.0 ESVER=1.7.6 STACK_YAML=stack.yaml ESFLAG=ES1 DLINK=https://download.elastic.co/elasticsearch/elasticsearch/elasticsearch
20− - 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"
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"
21
15
22install:
16install:
23 # stack
17 # stack
24 - mkdir -p ~/.local/bin
18 - mkdir -p ~/.local/bin
25− - travis_retry curl -L https://github.com/commercialhaskell/stack/releases/download/v1.4.0/stack-1.4.0-linux-x86_64.tar.gz | tar xz --wildcards --strip-components=1 -C ~/.local/bin '*/stack'
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'
26 - export PATH=~/.local/bin:$PATH
20 - export PATH=~/.local/bin:$PATH
27 - stack --no-terminal --version
21 - stack --no-terminal --version
28−
29 # elasticsearch
22 # elasticsearch
30 - wget --no-check-certificate $DLINK-$ESVER.tar.gz
23 - wget --no-check-certificate $DLINK-$ESVER.tar.gz
31 - tar xzf elasticsearch-$ESVER.tar.gz
24 - tar xzf elasticsearch-$ESVER.tar.gz
@@ -37,11 +30,11 @@ script:
37 - stack setup --no-terminal
30 - stack setup --no-terminal
38 - stack update --no-terminal
31 - stack update --no-terminal
39 - stack build -j2 --fast --no-terminal
32 - stack build -j2 --fast --no-terminal
40− - travis_wait 45 sleep 1800 &
33+ - travis_wait 60 sleep 1800 &
41− - stack test --fast --no-terminal bloodhound:tests --test-arguments="--qc-max-success 500" --flag bloodhound:$ESFLAG
34+ - stack test --fast --no-terminal bloodhound:bloodhound-tests --test-arguments="--qc-max-success 500"
42
35
43cache:
36cache:
44− timeout: 2000
37+ timeout: 1500
45 directories:
38 directories:
46 - $HOME/.cabal
39 - $HOME/.cabal
47 - $HOME/.ghc
40 - $HOME/.ghc
DSL.org+1−1
@@ -1,4 +1,4 @@
1−* ElasticSearch DSL
1+* Elasticsearch DSL
2
2
3** Grouping
3** Grouping
4
4
Makefile+109−31
@@ -1,51 +1,129 @@
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
1build:
20build:
2− stack build
21+ $(stack) $(build)
3
22
23+## build with validation options (Wall, Werror)
4−mod-build:
24+build-validate:
5− stack build --ghc-options '+RTS -A128M -RTS'
25+ $(stack) build --fast --ghc-options '-Wall -Werror +RTS -A128M -RTS'
6
26
7−echo-warn:
27+## run ghci
8− echo "Make certain you have an elasticsearch instance on localhost:9200 !"
28+ghci:
29+ $(stack) $(ghci)
9
30
31+## run tests
10test: echo-warn
32test: echo-warn
11− stack test
33+ $(stack) $(test)
12
34
13−7.8-build:
35+## run tests with forced re-run via "-r"
14− STACK_YAML="stack-7.8.yaml" stack build
36+test-rerun: echo-warn
37+ $(stack) $(test) --test-arguments "-r"
15
38
16−7.8-test: echo-warn
39+## run ghci with test stanza
17− STACK_YAML="stack-7.8.yaml" stack test
40+test-ghci:
41+ $(stack) $(ghci) bloodhound:test:bloodhound-tests
18
42
19−7.10-build:
43+## run ghcid
20− STACK_YAML="stack-7.10.yaml" stack build
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"
21
46
22−7.10-test: echo-warn
47+## run ghcid with validate options (Werror, etc.)
23− STACK_YAML="stack-7.10.yaml" stack test
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"
24
50
25−7.10-test-ES1:
51+## run weeder
26− STACK_YAML="stack-7.10.yaml" stack test --fast bloodhound:tests --test-arguments="--qc-max-success 500" --flag bloodhound:ES1
52+weeder:
53+ weeder . --build
27
54
28−7.10-test-ES5:
55+## run hlint
29− STACK_YAML="stack-7.10.yaml" stack test --fast bloodhound:tests --test-arguments="--qc-max-success 500" --flag bloodhound:ES5
56+hlint:
57+ hlint .
30
58
31−8.0-test-ES1:
59+## hlint watch with `sos`
32− STACK_YAML="stack.yaml" stack test --fast bloodhound:tests --test-arguments="--qc-max-success 500" --flag bloodhound:ES1
60+hlint-watch:
61+ sos src/ -c "hlint ." -p "src/(.*)\.hs"
33
62
34−8.0-test-ES5:
63+# mod-build:
35− STACK_YAML="stack-8.0.yaml" stack test --fast bloodhound:tests --test-arguments="--qc-max-success 500" --flag bloodhound:ES5
64+# stack build --ghc-options '+RTS -A128M -RTS'
36
65
37−8.0-build:
66+echo-warn:
38− STACK_YAML="stack-8.0.yaml" stack build
67+ @echo "Make certain you have an elasticsearch instance on localhost:9200 !"
39
68
40−8.2-build:
69+## Test with GHC 8.0 and ES 5.x
70+test-8.0:
41− STACK_YAML="stack-8.2.yaml" stack build
71+ STACK_YAML="stack-8.0.yaml" stack test --fast bloodhound:test:bloodhound-tests --test-arguments="--qc-max-success 500"
42
72
43−module-touch:
73+## Test with GHC 8.2 and ES 5.x
44− touch src/Database/V1/Bloodhound/Types.hs
74+test-8.2:
45− touch src/Database/V5/Bloodhound/Types.hs
75+ STACK_YAML="stack.yaml" stack test --fast bloodhound:test:bloodhound-tests --test-arguments="--qc-max-success 500"
46
76
47−ghci:
77+## Build with the GHC 8.0 Stack YAML
78+build-8.0:
48− stack ghci
79+ $(stack-8.0) $(build)
80+
81+## Build with the GHC 8.2 Stack YAML
82+build-8.2:
83+ $(stack-8.2) $(build)
49
84
85+## Build with the GHC 8.4 Stack YAML
86+build-8.4:
87+ $(stack-8.4) $(build)
88+
89+## Build with the GHC 8.6 Stack YAML
90+build-8.6:
91+ $(stack-8.6) $(build)
92+
93+## Upload the package to Hackage
50upload:
94upload:
51 stack upload --no-signature .
95 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.cabaldeleted−97
@@ -1,97 +0,0 @@
1−name: bloodhound
2−version: 0.15.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: False
26−
27−Flag ES5
28− Description: Run the test suite against an Elasticsearch 5.x server
29− Default: True
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.3,
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.9,
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(ES1)
71− hs-source-dirs: tests/V1
72− else
73− hs-source-dirs: tests/V5
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.4,
92− errors,
93− exceptions,
94− temporary,
95− unix-compat,
96− network-uri
97− default-language: Haskell2010
changelog.md+52
@@ -1,3 +1,55 @@
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+
10.15.0.0
530.15.0.0
2===================
54===================
3
55
docker-compose.ymlnew file+35
@@ -0,0 +1,35 @@
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/Dockerfilenew file+3
@@ -0,0 +1,3 @@
1+FROM docker.elastic.co/elasticsearch/elasticsearch:5.6.0
2+
3+COPY config /usr/share/elasticsearch/config/
elasticsearch/config/elasticsearch.ymlnew file+3
@@ -0,0 +1,3 @@
1+xpack.security.enabled: false
2+cluster.name: "docker-cluster"
3+network.host: 0.0.0.0
examples/README.md+1−1
@@ -1,6 +1,6 @@
1# Bloodhound Examples
1# Bloodhound Examples
2
2
3These examples can be built via `stack build`.
3These examples can be built via `stack build`.
4−To run them start an ElasticSearch 5.x server at `localhost:9200`
4+To run them start an Elasticsearch 5.x server at `localhost:9200`
5
5
6Run with `stack exec tweet-example`
6Run with `stack exec tweet-example`
examples/Tweet.hs+3−6
@@ -5,7 +5,6 @@ module Main
5 ) where
5 ) where
6
6
7
7
8−-------------------------------------------------------------------------------
9import Control.Monad.IO.Class (liftIO)
8import Control.Monad.IO.Class (liftIO)
10import Data.Aeson (FromJSON (..), defaultOptions,
9import Data.Aeson (FromJSON (..), defaultOptions,
11 genericParseJSON, genericToJSON,
10 genericParseJSON, genericToJSON,
@@ -15,10 +14,9 @@ import Data.Text (Text)
15import Data.Time.Calendar (Day (..))
14import Data.Time.Calendar (Day (..))
16import Data.Time.Clock (UTCTime (..), secondsToDiffTime)
15import Data.Time.Clock (UTCTime (..), secondsToDiffTime)
17import qualified Data.Vector as V
16import qualified Data.Vector as V
18−import Database.V5.Bloodhound
17+import Database.Bloodhound
19import GHC.Generics (Generic)
18import GHC.Generics (Generic)
20import Network.HTTP.Client (defaultManagerSettings)
19import Network.HTTP.Client (defaultManagerSettings)
21−-------------------------------------------------------------------------------
22
20
23
21
24data TweetMapping = TweetMapping deriving (Eq, Show)
22data TweetMapping = TweetMapping deriving (Eq, Show)
@@ -29,7 +27,7 @@ instance ToJSON TweetMapping where
29 [ "properties" .=
27 [ "properties" .=
30 object ["location" .= object ["type" .= ("geo_point" :: Text)]]
28 object ["location" .= object ["type" .= ("geo_point" :: Text)]]
31 ]
29 ]
32−-------------------------------------------------------------------------------
30+
33data Tweet = Tweet
31data Tweet = Tweet
34 { user :: Text
32 { user :: Text
35 , postDate :: UTCTime
33 , postDate :: UTCTime
@@ -39,7 +37,6 @@ data Tweet = Tweet
39 } deriving (Eq, Generic, Show)
37 } deriving (Eq, Generic, Show)
40
38
41
39
42−-------------------------------------------------------------------------------
43exampleTweet :: Tweet
40exampleTweet :: Tweet
44exampleTweet =
41exampleTweet =
45 Tweet
42 Tweet
@@ -86,7 +83,7 @@ main = runBH' $ do
86 True <- indexExists aliasName
83 True <- indexExists aliasName
87
84
88 -- 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.
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.
89− let idxTpl = IndexTemplate (TemplatePattern "tweet-*") (Just (IndexSettings (ShardCount 1) (ReplicaCount 1))) [toJSON TweetMapping]
86+ let idxTpl = IndexTemplate (TemplatePattern "tweet-*") (Just (IndexSettings (ShardCount 1) (ReplicaCount 1))) [object ["tweet" .= toJSON TweetMapping]]
90 let templateName = TemplateName "tweet-tpl"
87 let templateName = TemplateName "tweet-tpl"
91 _ <- putTemplate idxTpl templateName
88 _ <- putTemplate idxTpl templateName
92 True <- templateExists templateName
89 True <- templateExists templateName
examples/package.yaml−1
@@ -17,7 +17,6 @@ dependencies:
17- http-client
17- http-client
18- vector
18- vector
19- semigroups
19- semigroups
20−- transformers
21ghc-options:
20ghc-options:
22- -Wall
21- -Wall
23- -threaded
22- -threaded
package.yamlnew file+74
@@ -0,0 +1,74 @@
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.hsnew file+85
@@ -0,0 +1,85 @@
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.hsnew file+10
@@ -0,0 +1,10 @@
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/V5/Bloodhound/Client.hs → src/Database/Bloodhound/Client.hsrenamed+124−53
@@ -5,7 +5,7 @@
5-------------------------------------------------------------------------------
5-------------------------------------------------------------------------------
6-- |
6-- |
7-- Module : Database.Bloodhound.Client
7-- Module : Database.Bloodhound.Client
8−-- Copyright : (C) 2014 Chris Allen
8+-- Copyright : (C) 2014, 2018 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
@@ -15,7 +15,7 @@
15--
15--
16-------------------------------------------------------------------------------
16-------------------------------------------------------------------------------
17
17
18−module Database.V5.Bloodhound.Client
18+module Database.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,6 +25,8 @@ module Database.V5.Bloodhound.Client
25 withBH
25 withBH
26 -- ** Indices
26 -- ** Indices
27 , createIndex
27 , createIndex
28+ , createIndexWith
29+ , flushIndex
28 , deleteIndex
30 , deleteIndex
29 , updateIndexSettings
31 , updateIndexSettings
30 , getIndexSettings
32 , getIndexSettings
@@ -53,6 +55,7 @@ module Database.V5.Bloodhound.Client
53 -- ** Searching
55 -- ** Searching
54 , searchAll
56 , searchAll
55 , searchByIndex
57 , searchByIndex
58+ , searchByIndices
56 , searchByType
59 , searchByType
57 , scanSearch
60 , scanSearch
58 , getInitialScroll
61 , getInitialScroll
@@ -122,12 +125,12 @@ import qualified Network.HTTP.Types.URI as NHTU
122import qualified Network.URI as URI
125import qualified Network.URI as URI
123import Prelude hiding (filter, head)
126import Prelude hiding (filter, head)
124
127
125−import Database.V5.Bloodhound.Types
128+import Database.Bloodhound.Types
126
129
127-- $setup
130-- $setup
128-- >>> :set -XOverloadedStrings
131-- >>> :set -XOverloadedStrings
129-- >>> :set -XDeriveGeneric
132-- >>> :set -XDeriveGeneric
130−-- >>> import Database.V5.Bloodhound
133+-- >>> import Database.Bloodhound
131-- >>> import Network.HTTP.Client
134-- >>> import Network.HTTP.Client
132-- >>> let testServer = (Server "http://localhost:9200")
135-- >>> let testServer = (Server "http://localhost:9200")
133-- >>> let runBH' = withBH defaultManagerSettings testServer
136-- >>> let runBH' = withBH defaultManagerSettings testServer
@@ -214,6 +217,7 @@ dispatch dMethod url body = do
214 $ setRequestIgnoreStatus
217 $ setRequestIgnoreStatus
215 $ initReq { method = dMethod
218 $ initReq { method = dMethod
216 , requestHeaders =
219 , requestHeaders =
220+ -- "application/x-ndjson" for bulk
217 ("Content-Type", "application/json") : requestHeaders initReq
221 ("Content-Type", "application/json") : requestHeaders initReq
218 , requestBody = reqBody }
222 , requestBody = reqBody }
219 -- req <- liftIO $ reqHook $ setRequestIgnoreStatus $ initReq { method = dMethod
223 -- req <- liftIO $ reqHook $ setRequestIgnoreStatus $ initReq { method = dMethod
@@ -314,7 +318,7 @@ instance FromJSON GSRs where
314 parseJSON = withObject "Collection of GenericSnapshotRepo" parse
318 parseJSON = withObject "Collection of GenericSnapshotRepo" parse
315 where
319 where
316 parse = fmap GSRs . mapM (uncurry go) . HM.toList
320 parse = fmap GSRs . mapM (uncurry go) . HM.toList
317− go rawName = withObject "GenericSnapshotRepo" $ \o -> do
321+ go rawName = withObject "GenericSnapshotRepo" $ \o ->
318 GenericSnapshotRepo (SnapshotRepoName rawName) <$> o .: "type"
322 GenericSnapshotRepo (SnapshotRepoName rawName) <$> o .: "type"
319 <*> o .: "settings"
323 <*> o .: "settings"
320
324
@@ -343,7 +347,7 @@ updateSnapshotRepo SnapshotRepoUpdateSettings {..} repo =
343
347
344
348
345-- | Verify if a snapshot repo is working. __NOTE:__ this API did not
349-- | Verify if a snapshot repo is working. __NOTE:__ this API did not
346−-- make it into ElasticSearch until 1.4. If you use an older version,
350+-- make it into Elasticsearch until 1.4. If you use an older version,
347-- you will get an error here.
351-- you will get an error here.
348verifySnapshotRepo
352verifySnapshotRepo
349 :: ( MonadBH m
353 :: ( MonadBH m
@@ -512,8 +516,32 @@ createIndex indexSettings (IndexName indexName) =
512 where url = joinPath [indexName]
516 where url = joinPath [indexName]
513 body = Just $ encode indexSettings
517 body = Just $ encode indexSettings
514
518
515−
519+-- | Create an index, providing it with any number of settings. This
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+
516−-- | 'deleteIndex' will delete an index given a 'Server', and an 'IndexName'.
544+-- | 'deleteIndex' will delete an index given a 'Server' and an 'IndexName'.
517--
545--
518-- >>> _ <- runBH' $ createIndex defaultIndexSettings (IndexName "didimakeanindex")
546-- >>> _ <- runBH' $ createIndex defaultIndexSettings (IndexName "didimakeanindex")
519-- >>> response <- runBH' $ deleteIndex (IndexName "didimakeanindex")
547-- >>> response <- runBH' $ deleteIndex (IndexName "didimakeanindex")
@@ -534,20 +562,21 @@ deleteIndex (IndexName indexName) =
534updateIndexSettings :: MonadBH m => NonEmpty UpdatableIndexSetting -> IndexName -> m Reply
562updateIndexSettings :: MonadBH m => NonEmpty UpdatableIndexSetting -> IndexName -> m Reply
535updateIndexSettings updates (IndexName indexName) =
563updateIndexSettings updates (IndexName indexName) =
536 bindM2 put url (return body)
564 bindM2 put url (return body)
565+ where
537− where url = joinPath [indexName, "_settings"]
566+ url = joinPath [indexName, "_settings"]
538− body = Just (encode jsonBody)
567+ body = Just (encode jsonBody)
539− jsonBody = Object (deepMerge [u | Object u <- toJSON <$> toList updates])
568+ jsonBody = Object (deepMerge [u | Object u <- toJSON <$> toList updates])
540
569
541
570
542getIndexSettings :: (MonadBH m, MonadThrow m) => IndexName
571getIndexSettings :: (MonadBH m, MonadThrow m) => IndexName
543 -> m (Either EsError IndexSettingsSummary)
572 -> m (Either EsError IndexSettingsSummary)
544−getIndexSettings (IndexName indexName) = do
573+getIndexSettings (IndexName indexName) =
545 parseEsResponse =<< get =<< url
574 parseEsResponse =<< get =<< url
575+ where
546− where url = joinPath [indexName, "_settings"]
576+ url = joinPath [indexName, "_settings"]
547−
548
577
549−-- | 'forceMergeIndex'
578+-- | 'forceMergeIndex'
550−--
579+--
551-- The force merge API allows to force merging of one or more indices through
580-- The force merge API allows to force merging of one or more indices through
552-- an API. The merge relates to the number of segments a Lucene index holds
581-- an API. The merge relates to the number of segments a Lucene index holds
553-- within each shard. The force merge operation allows to reduce the number of
582-- within each shard. The force merge operation allows to reduce the number of
@@ -609,20 +638,25 @@ existentialQuery url = do
609-- responses from elasticsearch should fall into these two
638-- responses from elasticsearch should fall into these two
610-- categories. If they don't, a 'EsProtocolException' will be
639-- categories. If they don't, a 'EsProtocolException' will be
611-- thrown. If you encounter this, please report the full body it
640-- thrown. If you encounter this, please report the full body it
612−-- reports along with your ElasticSearch verison.
641+-- reports along with your Elasticsearch verison.
613−parseEsResponse :: (MonadThrow m, FromJSON a) => Reply
642+parseEsResponse :: ( MonadThrow m
643+ , FromJSON a
644+ )
645+ => Reply
614 -> m (Either EsError a)
646 -> m (Either EsError a)
615parseEsResponse reply
647parseEsResponse reply
616 | respIsTwoHunna reply = case eitherDecode body of
648 | respIsTwoHunna reply = case eitherDecode body of
617 Right a -> return (Right a)
649 Right a -> return (Right a)
650+ Left err ->
618− Left _ -> tryParseError
651+ tryParseError err
619− | otherwise = tryParseError
652+ | otherwise = tryParseError "Non-200 status code"
620 where body = responseBody reply
653 where body = responseBody reply
654+ tryParseError originalError
621− tryParseError = case eitherDecode body of
655+ = case eitherDecode body of
622− Right e -> return (Left e)
656+ Right e -> return (Left e)
623− -- this case should not be possible
657+ -- Failed to parse the error message.
624− Left _ -> explode
658+ Left err -> explode ("Original error was: " <> originalError <> " Error parse failure was: " <> err)
625− explode = throwM (EsProtocolException body)
659+ explode errorMsg = throwM (EsProtocolException (T.pack errorMsg) body)
626
660
627-- | 'indexExists' enables you to check if an index exists. Returns 'Bool'
661-- | 'indexExists' enables you to check if an index exists. Returns 'Bool'
628-- in IO
662-- in IO
@@ -681,14 +715,16 @@ listIndices :: (MonadThrow m, MonadBH m) => m [IndexName]
681listIndices =
715listIndices =
682 parse . responseBody =<< get =<< url
716 parse . responseBody =<< get =<< url
683 where
717 where
684− url = joinPath ["_cat/indices?v"]
718+ url = joinPath ["_cat/indices?format=json"]
685− -- parses the tabular format the indices api provides
719+ parse body = either (\msg -> (throwM (EsProtocolException (T.pack msg) body))) return $ do
686− parse body = case T.lines (T.decodeUtf8 (L.toStrict body)) of
720+ vals <- eitherDecode body
687− (hdr:rows) -> let ks = T.words hdr
721+ forM vals $ \val ->
688− keyedRows = [ HM.fromList (zip ks (T.words row)) | row <- rows ]
722+ case val of
723+ Object obj ->
689− names = catMaybes (HM.lookup "index" <$> keyedRows)
724+ case HM.lookup "index" obj of
690− in return (IndexName <$> names)
725+ (Just (String txt)) -> Right (IndexName txt)
691− [] -> throwM (EsProtocolException body)
726+ v -> Left $ "indexVal in listIndices failed on non-string, was: " <> show v
727+ v -> Left $ "One of the values parsed in listIndices wasn't an object, it was: " <> show v
692
728
693-- | 'updateIndexAliases' updates the server's index alias
729-- | 'updateIndexAliases' updates the server's index alias
694-- table. Operations are atomic. Explained in further detail at
730-- table. Operations are atomic. Explained in further detail at
@@ -787,7 +823,10 @@ versionCtlParams cfg =
787-- | 'indexDocument' is the primary way to save a single document in
823-- | 'indexDocument' is the primary way to save a single document in
788-- Elasticsearch. The document itself is simply something we can
824-- Elasticsearch. The document itself is simply something we can
789-- convert into a JSON 'Value'. The 'DocId' will function as the
825-- convert into a JSON 'Value'. The 'DocId' will function as the
790−-- primary key for the document.
826+-- primary key for the document. You are encouraged to generate
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
791--
830--
792-- >>> resp <- runBH' $ indexDocument testIndex testMapping defaultIndexDocumentSettings exampleTweet (DocId "1")
831-- >>> resp <- runBH' $ indexDocument testIndex testMapping defaultIndexDocumentSettings exampleTweet (DocId "1")
793-- >>> print resp
832-- >>> print resp
@@ -835,9 +874,11 @@ deleteDocument (IndexName indexName)
835-- >>> _ <- runBH' $ bulk stream
874-- >>> _ <- runBH' $ bulk stream
836-- >>> _ <- runBH' $ refreshIndex testIndex
875-- >>> _ <- runBH' $ refreshIndex testIndex
837bulk :: MonadBH m => V.Vector BulkOperation -> m Reply
876bulk :: MonadBH m => V.Vector BulkOperation -> m Reply
877+bulk bulkOps =
838−bulk bulkOps = bindM2 post url (return body)
878+ bindM2 post url (return body)
879+ where
839− where url = joinPath ["_bulk"]
880+ url = joinPath ["_bulk"]
840− body = Just $ encodeBulkOperations bulkOps
881+ body = Just $ encodeBulkOperations bulkOps
841
882
842-- | 'encodeBulkOperations' is a convenience function for dumping a vector of 'BulkOperation'
883-- | 'encodeBulkOperations' is a convenience function for dumping a vector of 'BulkOperation'
843-- into an 'L.ByteString'
884-- into an 'L.ByteString'
@@ -847,12 +888,15 @@ bulk bulkOps = bindM2 post url (return body)
847-- "\n{\"index\":{\"_type\":\"tweet\",\"_id\":\"2\",\"_index\":\"twitter\"}}\n{\"name\":\"blah\"}\n"
888-- "\n{\"index\":{\"_type\":\"tweet\",\"_id\":\"2\",\"_index\":\"twitter\"}}\n{\"name\":\"blah\"}\n"
848encodeBulkOperations :: V.Vector BulkOperation -> L.ByteString
889encodeBulkOperations :: V.Vector BulkOperation -> L.ByteString
849encodeBulkOperations stream = collapsed where
890encodeBulkOperations stream = collapsed where
891+ blobs =
850− blobs = fmap encodeBulkOperation stream
892+ fmap encodeBulkOperation stream
893+ mashedTaters =
851− mashedTaters = mash (mempty :: Builder) blobs
894+ mash (mempty :: Builder) blobs
895+ collapsed =
852− collapsed = toLazyByteString $ mappend mashedTaters (byteString "\n")
896+ toLazyByteString $ mappend mashedTaters (byteString "\n")
853
897
854mash :: Builder -> V.Vector L.ByteString -> Builder
898mash :: Builder -> V.Vector L.ByteString -> Builder
855−mash = V.foldl' (\b x -> b `mappend` (byteString "\n") `mappend` (lazyByteString x))
899+mash = V.foldl' (\b x -> b <> byteString "\n" <> lazyByteString x)
856
900
857mkBulkStreamValue :: Text -> Text -> Text -> Text -> Value
901mkBulkStreamValue :: Text -> Text -> Text -> Text -> Value
858mkBulkStreamValue operation indexName mappingName docId =
902mkBulkStreamValue operation indexName mappingName docId =
@@ -861,6 +905,12 @@ mkBulkStreamValue operation indexName mappingName docId =
861 , "_type" .= mappingName
905 , "_type" .= mappingName
862 , "_id" .= docId]]
906 , "_id" .= docId]]
863
907
908+mkBulkStreamValueAuto :: Text -> Text -> Text -> Value
909+mkBulkStreamValueAuto operation indexName mappingName =
910+ object [operation .=
911+ object [ "_index" .= indexName
912+ , "_type" .= mappingName]]
913+
864-- | 'encodeBulkOperation' is a convenience function for dumping a single 'BulkOperation'
914-- | 'encodeBulkOperation' is a convenience function for dumping a single 'BulkOperation'
865-- into an 'L.ByteString'
915-- into an 'L.ByteString'
866--
916--
@@ -874,6 +924,18 @@ encodeBulkOperation (BulkIndex (IndexName indexName)
874 where metadata = mkBulkStreamValue "index" indexName mappingName docId
924 where metadata = mkBulkStreamValue "index" indexName mappingName docId
875 blob = encode metadata `mappend` "\n" `mappend` encode value
925 blob = encode metadata `mappend` "\n" `mappend` encode value
876
926
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+
877encodeBulkOperation (BulkCreate (IndexName indexName)
939encodeBulkOperation (BulkCreate (IndexName indexName)
878 (MappingName mappingName)
940 (MappingName mappingName)
879 (DocId docId) value) = blob
941 (DocId docId) value) = blob
@@ -948,6 +1010,15 @@ searchByIndex :: MonadBH m => IndexName -> Search -> m Reply
948searchByIndex (IndexName indexName) = bindM2 dispatchSearch url . return
1010searchByIndex (IndexName indexName) = bindM2 dispatchSearch url . return
949 where url = joinPath [indexName, "_search"]
1011 where url = joinPath [indexName, "_search"]
950
1012
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+
951-- | 'searchByType', given a 'Search', 'IndexName', and 'MappingName', will perform that
1022-- | 'searchByType', given a 'Search', 'IndexName', and 'MappingName', will perform that
952-- search against a specific mapping within an index on an Elasticsearch server.
1023-- search against a specific mapping within an index on an Elasticsearch server.
953--
1024--
@@ -964,10 +1035,10 @@ searchByType (IndexName indexName)
964-- search results. Note that the search is put into 'SearchTypeScan'
1035-- search results. Note that the search is put into 'SearchTypeScan'
965-- mode and thus results will not be sorted. Combine this with
1036-- mode and thus results will not be sorted. Combine this with
966-- 'advanceScroll' to efficiently stream through the full result set
1037-- 'advanceScroll' to efficiently stream through the full result set
967−getInitialScroll ::
1038+getInitialScroll ::
968− (FromJSON a, MonadThrow m, MonadBH m) => IndexName ->
1039+ (FromJSON a, MonadThrow m, MonadBH m) => IndexName ->
969− MappingName ->
1040+ MappingName ->
970− Search ->
1041+ Search ->
971 m (Either EsError (SearchResult a))
1042 m (Either EsError (SearchResult a))
972getInitialScroll (IndexName indexName) (MappingName mappingName) search' = do
1043getInitialScroll (IndexName indexName) (MappingName mappingName) search' = do
973 let url = addQuery params <$> joinPath [indexName, mappingName, "_search"]
1044 let url = addQuery params <$> joinPath [indexName, mappingName, "_search"]
@@ -992,7 +1063,7 @@ getInitialSortedScroll (IndexName indexName) (MappingName mappingName) search =
992 resp' <- bindM2 dispatchSearch url (return search)
1063 resp' <- bindM2 dispatchSearch url (return search)
993 parseEsResponse resp'
1064 parseEsResponse resp'
994
1065
995−scroll' :: (FromJSON a, MonadBH m, MonadThrow m) => Maybe ScrollId ->
1066+scroll' :: (FromJSON a, MonadBH m, MonadThrow m) => Maybe ScrollId ->
996 m ([Hit a], Maybe ScrollId)
1067 m ([Hit a], Maybe ScrollId)
997scroll' Nothing = return ([], Nothing)
1068scroll' Nothing = return ([], Nothing)
998scroll' (Just sid) = do
1069scroll' (Just sid) = do
@@ -1019,13 +1090,13 @@ advanceScroll (ScrollId sid) scroll = do
1019 where scrollTime = showText secs <> "s"
1090 where scrollTime = showText secs <> "s"
1020 secs :: Integer
1091 secs :: Integer
1021 secs = round scroll
1092 secs = round scroll
1022−
1093+
1023 scrollObject = object [ "scroll" .= scrollTime
1094 scrollObject = object [ "scroll" .= scrollTime
1024 , "scroll_id" .= sid
1095 , "scroll_id" .= sid
1025 ]
1096 ]
1026
1097
1027−simpleAccumulator ::
1098+simpleAccumulator ::
1028− (FromJSON a, MonadBH m, MonadThrow m) =>
1099+ (FromJSON a, MonadBH m, MonadThrow m) =>
1029 [Hit a] ->
1100 [Hit a] ->
1030 ([Hit a], Maybe ScrollId) ->
1101 ([Hit a], Maybe ScrollId) ->
1031 m ([Hit a], Maybe ScrollId)
1102 m ([Hit a], Maybe ScrollId)
@@ -1063,9 +1134,9 @@ scanSearch indexName mappingName search = do
1063--
1134--
1064-- >>> let query = TermQuery (Term "user" "bitemyapp") Nothing
1135-- >>> let query = TermQuery (Term "user" "bitemyapp") Nothing
1065-- >>> mkSearch (Just query) Nothing
1136-- >>> mkSearch (Just query) Nothing
1066−-- 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}
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}
1067mkSearch :: Maybe Query -> Maybe Filter -> Search
1138mkSearch :: Maybe Query -> Maybe Filter -> Search
1068−mkSearch query filter = Search query filter Nothing Nothing Nothing False (From 0) (Size 10) SearchTypeQueryThenFetch Nothing Nothing Nothing
1139+mkSearch query filter = Search query filter Nothing Nothing Nothing False (From 0) (Size 10) SearchTypeQueryThenFetch Nothing Nothing Nothing Nothing Nothing
1069
1140
1070-- | 'mkAggregateSearch' is a helper function that defaults everything in a 'Search' except for
1141-- | 'mkAggregateSearch' is a helper function that defaults everything in a 'Search' except for
1071-- the 'Query' and the 'Aggregation'.
1142-- the 'Query' and the 'Aggregation'.
@@ -1075,7 +1146,7 @@ mkSearch query filter = Search query filter Nothing Nothing Nothing False (From
1075-- TermsAgg (TermsAggregation {term = Left "user", termInclude = Nothing, termExclude = Nothing, termOrder = Nothing, termMinDocCount = Nothing, termSize = Nothing, termShardSize = Nothing, termCollectMode = Just BreadthFirst, termExecutionHint = Nothing, termAggs = Nothing})
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})
1076-- >>> let myAggregation = mkAggregateSearch Nothing $ mkAggregations "users" terms
1147-- >>> let myAggregation = mkAggregateSearch Nothing $ mkAggregations "users" terms
1077mkAggregateSearch :: Maybe Query -> Aggregations -> Search
1148mkAggregateSearch :: Maybe Query -> Aggregations -> Search
1078−mkAggregateSearch query mkSearchAggs = Search query Nothing Nothing (Just mkSearchAggs) Nothing False (From 0) (Size 0) SearchTypeQueryThenFetch Nothing Nothing Nothing
1149+mkAggregateSearch query mkSearchAggs = Search query Nothing Nothing (Just mkSearchAggs) Nothing False (From 0) (Size 0) SearchTypeQueryThenFetch Nothing Nothing Nothing Nothing Nothing
1079
1150
1080-- | 'mkHighlightSearch' is a helper function that defaults everything in a 'Search' except for
1151-- | 'mkHighlightSearch' is a helper function that defaults everything in a 'Search' except for
1081-- the 'Query' and the 'Aggregation'.
1152-- the 'Query' and the 'Aggregation'.
@@ -1084,7 +1155,7 @@ mkAggregateSearch query mkSearchAggs = Search query Nothing Nothing (Just mkSear
1084-- >>> let testHighlight = Highlights Nothing [FieldHighlight (FieldName "message") Nothing]
1155-- >>> let testHighlight = Highlights Nothing [FieldHighlight (FieldName "message") Nothing]
1085-- >>> let search = mkHighlightSearch (Just query) testHighlight
1156-- >>> let search = mkHighlightSearch (Just query) testHighlight
1086mkHighlightSearch :: Maybe Query -> Highlights -> Search
1157mkHighlightSearch :: Maybe Query -> Highlights -> Search
1087−mkHighlightSearch query searchHighlights = Search query Nothing Nothing Nothing (Just searchHighlights) False (From 0) (Size 10) SearchTypeQueryThenFetch Nothing Nothing Nothing
1158+mkHighlightSearch query searchHighlights = Search query Nothing Nothing Nothing (Just searchHighlights) False (From 0) (Size 10) SearchTypeQueryThenFetch Nothing Nothing Nothing Nothing Nothing
1088
1159
1089-- | 'pageSearch' is a helper function that takes a search and assigns the from
1160-- | 'pageSearch' is a helper function that takes a search and assigns the from
1090-- and size fields for the search. The from parameter defines the offset
1161-- and size fields for the search. The from parameter defines the offset
src/Database/Bloodhound/Common/Script.hsnew file+220
@@ -0,0 +1,220 @@
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.hsnew file+479
@@ -0,0 +1,479 @@
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.hsnew file+379
@@ -0,0 +1,379 @@
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.hsnew file+2431
@@ -0,0 +1,2431 @@
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.hsnew file+164
@@ -0,0 +1,164 @@
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.hsnew file+237
@@ -0,0 +1,237 @@
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.hsnew file+1640
@@ -0,0 +1,1640 @@
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.hsnew file+107
@@ -0,0 +1,107 @@
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.hsnew file+51
@@ -0,0 +1,51 @@
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.hsnew file+270
@@ -0,0 +1,270 @@
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.hsnew file+542
@@ -0,0 +1,542 @@
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.hsdeleted−10
@@ -1,10 +0,0 @@
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.hsdeleted−920
@@ -1,920 +0,0 @@
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
155− $ reqHook
156− $ setRequestIgnoreStatus
157− $ initReq { method = dMethod
158− , requestBody = reqBody }
159− mgr <- bhManager <$> getBHEnv
160− liftIO $ httpLbs req mgr
161−
162−joinPath' :: [Text] -> Text
163−joinPath' = T.intercalate "/"
164−
165−joinPath :: MonadBH m => [Text] -> m Text
166−joinPath ps = do
167− Server s <- bhServer <$> getBHEnv
168− return $ joinPath' (s:ps)
169−
170−appendSearchTypeParam :: Text -> SearchType -> Text
171−appendSearchTypeParam originalUrl st = addQuery params originalUrl
172− where stText = "search_type"
173− params
174− | st == SearchTypeDfsQueryThenFetch = [(stText, Just "dfs_query_then_fetch")]
175− | st == SearchTypeCount = [(stText, Just "count")]
176− | st == SearchTypeScan = [(stText, Just "scan"), ("scroll", Just "1m")]
177− | st == SearchTypeQueryAndFetch = [(stText, Just "query_and_fetch")]
178− | st == SearchTypeDfsQueryAndFetch = [(stText, Just "dfs_query_and_fetch")]
179− -- used to catch 'SearchTypeQueryThenFetch', which is also the default
180− | otherwise = [(stText, Just "query_then_fetch")]
181−
182−-- | Severely dumbed down query renderer. Assumes your data doesn't
183−-- need any encoding
184−addQuery :: [(Text, Maybe Text)] -> Text -> Text
185−addQuery q u = u <> rendered
186− where
187− rendered =
188− T.decodeUtf8 $ BB.toByteString $ NHTU.renderQueryText prependQuestionMark q
189− prependQuestionMark = True
190−
191−bindM2 :: (Applicative m, Monad m) => (a -> b -> m c) -> m a -> m b -> m c
192−bindM2 f ma mb = join (f <$> ma <*> mb)
193−
194−-- | Convenience function that sets up a manager and BHEnv and runs
195−-- the given set of bloodhound operations. Connections will be
196−-- pipelined automatically in accordance with the given manager
197−-- settings in IO. If you've got your own monad transformer stack, you
198−-- should use 'runBH' directly.
199−withBH :: ManagerSettings -> Server -> BH IO a -> IO a
200−withBH ms s f = do
201− mgr <- newManager ms
202− let env = mkBHEnv s mgr
203− runBH env f
204−
205−-- Shortcut functions for HTTP methods
206−delete :: MonadBH m => Text -> m Reply
207−delete = flip (dispatch NHTM.methodDelete) Nothing
208−get :: MonadBH m => Text -> m Reply
209−get = flip (dispatch NHTM.methodGet) Nothing
210−head :: MonadBH m => Text -> m Reply
211−head = flip (dispatch NHTM.methodHead) Nothing
212−put :: MonadBH m => Text -> Maybe L.ByteString -> m Reply
213−put = dispatch NHTM.methodPut
214−post :: MonadBH m => Text -> Maybe L.ByteString -> m Reply
215−post = dispatch NHTM.methodPost
216−
217−-- indexDocument s ix name doc = put (root </> s </> ix </> name </> doc) (Just encode doc)
218−-- http://hackage.haskell.org/package/http-client-lens-0.1.0/docs/Network-HTTP-Client-Lens.html
219−-- https://github.com/supki/libjenkins/blob/master/src/Jenkins/Rest/Internal.hs
220−
221−-- | 'getStatus' fetches the 'Status' of a 'Server'
222−getStatus :: MonadBH m => m (Maybe Status)
223−getStatus = do
224− response <- get =<< url
225− return $ decode (responseBody response)
226− where url = joinPath []
227−
228−-- | 'getSnapshotRepos' gets the definitions of a subset of the
229−-- defined snapshot repos.
230−getSnapshotRepos
231− :: ( MonadBH m
232− , MonadThrow m
233− )
234− => SnapshotRepoSelection
235− -> m (Either EsError [GenericSnapshotRepo])
236−getSnapshotRepos sel = fmap (fmap unGSRs) . parseEsResponse =<< get =<< url
237− where
238− url = joinPath ["_snapshot", selectorSeg]
239− selectorSeg = case sel of
240− AllSnapshotRepos -> "_all"
241− SnapshotRepoList (p :| ps) -> T.intercalate "," (renderPat <$> (p:ps))
242− renderPat (RepoPattern t) = t
243− renderPat (ExactRepo (SnapshotRepoName t)) = t
244−
245−
246−-- | Wrapper to extract the list of 'GenericSnapshotRepo' in the
247−-- format they're returned in
248−newtype GSRs = GSRs { unGSRs :: [GenericSnapshotRepo] }
249−
250−
251−instance FromJSON GSRs where
252− parseJSON = withObject "Collection of GenericSnapshotRepo" parse
253− where
254− parse = fmap GSRs . mapM (uncurry go) . HM.toList
255− go rawName = withObject "GenericSnapshotRepo" $ \o -> do
256− GenericSnapshotRepo (SnapshotRepoName rawName) <$> o .: "type"
257− <*> o .: "settings"
258−
259−
260−-- | Create or update a snapshot repo
261−updateSnapshotRepo
262− :: ( MonadBH m
263− , SnapshotRepo repo
264− )
265− => SnapshotRepoUpdateSettings
266− -- ^ Use 'defaultSnapshotRepoUpdateSettings' if unsure
267− -> repo
268− -> m Reply
269−updateSnapshotRepo SnapshotRepoUpdateSettings {..} repo =
270− bindM2 put url (return (Just body))
271− where
272− url = addQuery params <$> joinPath ["_snapshot", snapshotRepoName gSnapshotRepoName]
273− params
274− | repoUpdateVerify = []
275− | otherwise = [("verify", Just "false")]
276− body = encode $ object [ "type" .= gSnapshotRepoType
277− , "settings" .= gSnapshotRepoSettings
278− ]
279− GenericSnapshotRepo {..} = toGSnapshotRepo repo
280−
281−
282−
283−-- | Verify if a snapshot repo is working. __NOTE:__ this API did not
284−-- make it into ElasticSearch until 1.4. If you use an older version,
285−-- you will get an error here.
286−verifySnapshotRepo
287− :: ( MonadBH m
288− , MonadThrow m
289− )
290− => SnapshotRepoName
291− -> m (Either EsError SnapshotVerification)
292−verifySnapshotRepo (SnapshotRepoName n) =
293− parseEsResponse =<< bindM2 post url (return Nothing)
294− where
295− url = joinPath ["_snapshot", n, "_verify"]
296−
297−
298−deleteSnapshotRepo :: MonadBH m => SnapshotRepoName -> m Reply
299−deleteSnapshotRepo (SnapshotRepoName n) = delete =<< url
300− where
301− url = joinPath ["_snapshot", n]
302−
303−
304−-- | Create and start a snapshot
305−createSnapshot
306− :: (MonadBH m)
307− => SnapshotRepoName
308− -> SnapshotName
309− -> SnapshotCreateSettings
310− -> m Reply
311−createSnapshot (SnapshotRepoName repoName)
312− (SnapshotName snapName)
313− SnapshotCreateSettings {..} =
314− bindM2 put url (return (Just body))
315− where
316− url = addQuery params <$> joinPath ["_snapshot", repoName, snapName]
317− params = [("wait_for_completion", Just (boolQP snapWaitForCompletion))]
318− body = encode $ object prs
319− prs = catMaybes [ ("indices" .=) . indexSelectionName <$> snapIndices
320− , Just ("ignore_unavailable" .= snapIgnoreUnavailable)
321− , Just ("ignore_global_state" .= snapIncludeGlobalState)
322− , Just ("partial" .= snapPartial)
323− ]
324−
325−
326−indexSelectionName :: IndexSelection -> Text
327−indexSelectionName AllIndexes = "_all"
328−indexSelectionName (IndexList (i :| is)) = T.intercalate "," (renderIndex <$> (i:is))
329− where
330− renderIndex (IndexName n) = n
331−
332−
333−-- | Get info about known snapshots given a pattern and repo name.
334−getSnapshots
335− :: ( MonadBH m
336− , MonadThrow m
337− )
338− => SnapshotRepoName
339− -> SnapshotSelection
340− -> m (Either EsError [SnapshotInfo])
341−getSnapshots (SnapshotRepoName repoName) sel =
342− fmap (fmap unSIs) . parseEsResponse =<< get =<< url
343− where
344− url = joinPath ["_snapshot", repoName, snapPath]
345− snapPath = case sel of
346− AllSnapshots -> "_all"
347− SnapshotList (s :| ss) -> T.intercalate "," (renderPath <$> (s:ss))
348− renderPath (SnapPattern t) = t
349− renderPath (ExactSnap (SnapshotName t)) = t
350−
351−
352−newtype SIs = SIs { unSIs :: [SnapshotInfo] }
353−
354−
355−instance FromJSON SIs where
356− parseJSON = withObject "Collection of SnapshotInfo" parse
357− where
358− parse o = SIs <$> o .: "snapshots"
359−
360−
361−-- | Delete a snapshot. Cancels if it is running.
362−deleteSnapshot :: MonadBH m => SnapshotRepoName -> SnapshotName -> m Reply
363−deleteSnapshot (SnapshotRepoName repoName) (SnapshotName snapName) =
364− delete =<< url
365− where
366− url = joinPath ["_snapshot", repoName, snapName]
367−
368−
369−-- | Restore a snapshot to the cluster See
370−-- <https://www.elastic.co/guide/en/elasticsearch/reference/1.7/modules-snapshots.html#_restore>
371−-- for more details.
372−restoreSnapshot
373− :: MonadBH m
374− => SnapshotRepoName
375− -> SnapshotName
376− -> SnapshotRestoreSettings
377− -- ^ Start with 'defaultSnapshotRestoreSettings' and customize
378− -- from there for reasonable defaults.
379− -> m Reply
380−restoreSnapshot (SnapshotRepoName repoName)
381− (SnapshotName snapName)
382− SnapshotRestoreSettings {..} = bindM2 post url (return (Just body))
383− where
384− url = addQuery params <$> joinPath ["_snapshot", repoName, snapName, "_restore"]
385− params = [("wait_for_completion", Just (boolQP snapRestoreWaitForCompletion))]
386− body = encode (object prs)
387−
388−
389− prs = catMaybes [ ("indices" .=) . indexSelectionName <$> snapRestoreIndices
390− , Just ("ignore_unavailable" .= snapRestoreIgnoreUnavailable)
391− , Just ("include_global_state" .= snapRestoreIncludeGlobalState)
392− , ("rename_pattern" .=) <$> snapRestoreRenamePattern
393− , ("rename_replacement" .=) . renderTokens <$> snapRestoreRenameReplacement
394− , Just ("include_aliases" .= snapRestoreIncludeAliases)
395− , ("index_settings" .= ) <$> snapRestoreIndexSettingsOverrides
396− , ("ignore_index_settings" .= ) <$> snapRestoreIgnoreIndexSettings
397− ]
398− renderTokens (t :| ts) = mconcat (renderToken <$> (t:ts))
399− renderToken (RRTLit t) = t
400− renderToken RRSubWholeMatch = "$0"
401− renderToken (RRSubGroup g) = T.pack (show (rrGroupRefNum g))
402−
403−
404−getNodesInfo
405− :: ( MonadBH m
406− , MonadThrow m
407− )
408− => NodeSelection
409− -> m (Either EsError NodesInfo)
410−getNodesInfo sel = parseEsResponse =<< get =<< url
411− where
412− url = joinPath ["_nodes", selectionSeg]
413− selectionSeg = case sel of
414− LocalNode -> "_local"
415− NodeList (l :| ls) -> T.intercalate "," (selToSeg <$> (l:ls))
416− AllNodes -> "_all"
417− selToSeg (NodeByName (NodeName n)) = n
418− selToSeg (NodeByFullNodeId (FullNodeId i)) = i
419− selToSeg (NodeByHost (Server s)) = s
420− selToSeg (NodeByAttribute (NodeAttrName a) v) = a <> ":" <> v
421−
422−getNodesStats
423− :: ( MonadBH m
424− , MonadThrow m
425− )
426− => NodeSelection
427− -> m (Either EsError NodesStats)
428−getNodesStats sel = parseEsResponse =<< get =<< url
429− where
430− url = joinPath ["_nodes", selectionSeg, "stats"]
431− selectionSeg = case sel of
432− LocalNode -> "_local"
433− NodeList (l :| ls) -> T.intercalate "," (selToSeg <$> (l:ls))
434− AllNodes -> "_all"
435− selToSeg (NodeByName (NodeName n)) = n
436− selToSeg (NodeByFullNodeId (FullNodeId i)) = i
437− selToSeg (NodeByHost (Server s)) = s
438− selToSeg (NodeByAttribute (NodeAttrName a) v) = a <> ":" <> v
439−
440−-- | 'createIndex' will create an index given a 'Server', 'IndexSettings', and an 'IndexName'.
441−createIndex :: MonadBH m => IndexSettings -> IndexName -> m Reply
442−createIndex indexSettings (IndexName indexName) =
443− bindM2 put url (return body)
444− where url = joinPath [indexName]
445− body = Just $ encode indexSettings
446−
447−
448−-- | 'deleteIndex' will delete an index given a 'Server', and an 'IndexName'.
449−deleteIndex :: MonadBH m => IndexName -> m Reply
450−deleteIndex (IndexName indexName) =
451− delete =<< joinPath [indexName]
452−
453−-- | 'updateIndexSettings' will apply a non-empty list of setting updates to an index
454−updateIndexSettings :: MonadBH m => NonEmpty UpdatableIndexSetting -> IndexName -> m Reply
455−updateIndexSettings updates (IndexName indexName) =
456− bindM2 put url (return body)
457− where url = joinPath [indexName, "_settings"]
458− body = Just (encode jsonBody)
459− jsonBody = Object (deepMerge [u | Object u <- toJSON <$> toList updates])
460−
461−
462−getIndexSettings :: (MonadBH m, MonadThrow m) => IndexName
463− -> m (Either EsError IndexSettingsSummary)
464−getIndexSettings (IndexName indexName) = do
465− parseEsResponse =<< get =<< url
466− where url = joinPath [indexName, "_settings"]
467−
468−
469−-- | 'optimizeIndex' will optimize a single index, list of indexes or
470−-- all indexes. Note that this call will block until finishing but
471−-- will continue even if the request times out. Concurrent requests to
472−-- optimize an index while another is performing will block until the
473−-- previous one finishes. For more information see
474−-- <https://www.elastic.co/guide/en/elasticsearch/reference/1.7/indices-optimize.html>. Nothing
475−-- worthwhile comes back in the reply body, so matching on the status
476−-- should suffice.
477−--
478−-- 'optimizeIndex' with a maxNumSegments of 1 and onlyExpungeDeletes
479−-- to True is the main way to release disk space back to the OS being
480−-- held by deleted documents.
481−--
482−-- Note that this API was deprecated in ElasticSearch 2.1 for the
483−-- almost completely identical forcemerge API. Adding support to that
484−-- API would be trivial but due to the significant breaking changes,
485−-- this library cannot currently be used with >= 2.0, so that feature was omitted.
486−optimizeIndex :: MonadBH m => IndexSelection -> IndexOptimizationSettings -> m Reply
487−optimizeIndex ixs IndexOptimizationSettings {..} =
488− bindM2 post url (return body)
489− where url = addQuery params <$> joinPath [indexName, "_optimize"]
490− params = catMaybes [ ("max_num_segments",) . Just . showText <$> maxNumSegments
491− , Just ("only_expunge_deletes", Just (boolQP onlyExpungeDeletes))
492− , Just ("flush", Just (boolQP flushAfterOptimize))
493− ]
494− indexName = indexSelectionName ixs
495− body = Nothing
496−
497−
498−deepMerge :: [Object] -> Object
499−deepMerge = LS.foldl' go mempty
500− where go acc = LS.foldl' go' acc . HM.toList
501− go' acc (k, v) = HM.insertWith merge k v acc
502− merge (Object a) (Object b) = Object (deepMerge [a, b])
503− merge _ b = b
504−
505−
506−statusCodeIs :: (Int, Int) -> Reply -> Bool
507−statusCodeIs r resp = inRange r $ NHTS.statusCode (responseStatus resp)
508−
509−respIsTwoHunna :: Reply -> Bool
510−respIsTwoHunna = statusCodeIs (200, 299)
511−
512−existentialQuery :: MonadBH m => Text -> m (Reply, Bool)
513−existentialQuery url = do
514− reply <- head url
515− return (reply, respIsTwoHunna reply)
516−
517−
518−-- | Tries to parse a response body as the expected type @a@ and
519−-- failing that tries to parse it as an EsError. All well-formed, JSON
520−-- responses from elasticsearch should fall into these two
521−-- categories. If they don't, a 'EsProtocolException' will be
522−-- thrown. If you encounter this, please report the full body it
523−-- reports along with your ElasticSearch verison.
524−parseEsResponse :: (MonadThrow m, FromJSON a) => Reply
525− -> m (Either EsError a)
526−parseEsResponse reply
527− | respIsTwoHunna reply = case eitherDecode body of
528− Right a -> return (Right a)
529− Left _ -> tryParseError
530− | otherwise = tryParseError
531− where body = responseBody reply
532− tryParseError = case eitherDecode body of
533− Right e -> return (Left e)
534− -- this case should not be possible
535− Left _ -> explode
536− explode = throwM (EsProtocolException body)
537−
538−-- | 'indexExists' enables you to check if an index exists. Returns 'Bool'
539−-- in IO
540−indexExists :: MonadBH m => IndexName -> m Bool
541−indexExists (IndexName indexName) = do
542− (_, exists) <- existentialQuery =<< joinPath [indexName]
543− return exists
544−
545−-- | 'refreshIndex' will force a refresh on an index. You must
546−-- do this if you want to read what you wrote.
547−refreshIndex :: MonadBH m => IndexName -> m Reply
548−refreshIndex (IndexName indexName) =
549− bindM2 post url (return Nothing)
550− where url = joinPath [indexName, "_refresh"]
551−
552−-- | Block until the index becomes available for indexing
553−-- documents. This is useful for integration tests in which
554−-- indices are rapidly created and deleted.
555−waitForYellowIndex :: MonadBH m => IndexName -> m Reply
556−waitForYellowIndex (IndexName indexName) = get =<< url
557− where url = addQuery q <$> joinPath ["_cluster","health",indexName]
558− q = [("wait_for_status",Just "yellow"),("timeout",Just "10s")]
559−
560−stringifyOCIndex :: OpenCloseIndex -> Text
561−stringifyOCIndex oci = case oci of
562− OpenIndex -> "_open"
563− CloseIndex -> "_close"
564−
565−openOrCloseIndexes :: MonadBH m => OpenCloseIndex -> IndexName -> m Reply
566−openOrCloseIndexes oci (IndexName indexName) =
567− bindM2 post url (return Nothing)
568− where ociString = stringifyOCIndex oci
569− url = joinPath [indexName, ociString]
570−
571−-- | 'openIndex' opens an index given a 'Server' and an 'IndexName'. Explained in further detail at
572−-- <http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/indices-open-close.html>
573−openIndex :: MonadBH m => IndexName -> m Reply
574−openIndex = openOrCloseIndexes OpenIndex
575−
576−-- | 'closeIndex' closes an index given a 'Server' and an 'IndexName'. Explained in further detail at
577−-- <http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/indices-open-close.html>
578−closeIndex :: MonadBH m => IndexName -> m Reply
579−closeIndex = openOrCloseIndexes CloseIndex
580−
581−-- | 'listIndices' returns a list of all index names on a given 'Server'
582−listIndices :: (MonadThrow m, MonadBH m) => m [IndexName]
583−listIndices =
584− parse . responseBody =<< get =<< url
585− where
586− url = joinPath ["_cat/indices?v"]
587− -- parses the tabular format the indices api provides
588− parse body = case T.lines (T.decodeUtf8 (L.toStrict body)) of
589− (hdr:rows) -> let ks = T.words hdr
590− keyedRows = [ HM.fromList (zip ks (T.words row)) | row <- rows ]
591− names = catMaybes (HM.lookup "index" <$> keyedRows)
592− in return (IndexName <$> names)
593− [] -> throwM (EsProtocolException body)
594−
595−-- | 'updateIndexAliases' updates the server's index alias
596−-- table. Operations are atomic. Explained in further detail at
597−-- <https://www.elastic.co/guide/en/elasticsearch/reference/current/indices-aliases.html>
598−updateIndexAliases :: MonadBH m => NonEmpty IndexAliasAction -> m Reply
599−updateIndexAliases actions = bindM2 post url (return body)
600− where url = joinPath ["_aliases"]
601− body = Just (encode bodyJSON)
602− bodyJSON = object [ "actions" .= toList actions]
603−
604−-- | Get all aliases configured on the server.
605−getIndexAliases :: (MonadBH m, MonadThrow m)
606− => m (Either EsError IndexAliasesSummary)
607−getIndexAliases = parseEsResponse =<< get =<< url
608− where url = joinPath ["_aliases"]
609−
610−-- | 'putTemplate' creates a template given an 'IndexTemplate' and a 'TemplateName'.
611−-- Explained in further detail at
612−-- <https://www.elastic.co/guide/en/elasticsearch/reference/1.7/indices-templates.html>
613−putTemplate :: MonadBH m => IndexTemplate -> TemplateName -> m Reply
614−putTemplate indexTemplate (TemplateName templateName) =
615− bindM2 put url (return body)
616− where url = joinPath ["_template", templateName]
617− body = Just $ encode indexTemplate
618−
619−-- | 'templateExists' checks to see if a template exists.
620−templateExists :: MonadBH m => TemplateName -> m Bool
621−templateExists (TemplateName templateName) = do
622− (_, exists) <- existentialQuery =<< joinPath ["_template", templateName]
623− return exists
624−
625−-- | 'deleteTemplate' is an HTTP DELETE and deletes a template.
626−deleteTemplate :: MonadBH m => TemplateName -> m Reply
627−deleteTemplate (TemplateName templateName) =
628− delete =<< joinPath ["_template", templateName]
629−
630−-- | 'putMapping' is an HTTP PUT and has upsert semantics. Mappings are schemas
631−-- for documents in indexes.
632−putMapping :: (MonadBH m, ToJSON a) => IndexName
633− -> MappingName -> a -> m Reply
634−putMapping (IndexName indexName) (MappingName mappingName) mapping =
635− bindM2 put url (return body)
636− where url = joinPath [indexName, "_mapping", mappingName]
637− -- "_mapping" and mappingName above were originally transposed
638− -- erroneously. The correct API call is: "/INDEX/_mapping/MAPPING_NAME"
639− body = Just $ encode mapping
640−
641−-- | 'deleteMapping' is an HTTP DELETE and deletes a mapping for a given index.
642−-- Mappings are schemas for documents in indexes.
643−deleteMapping :: MonadBH m => IndexName -> MappingName -> m Reply
644−deleteMapping (IndexName indexName)
645− (MappingName mappingName) =
646− -- "_mapping" and mappingName below were originally transposed
647− -- erroneously. The correct API call is: "/INDEX/_mapping/MAPPING_NAME"
648− delete =<< joinPath [indexName, "_mapping", mappingName]
649−
650−versionCtlParams :: IndexDocumentSettings -> [(Text, Maybe Text)]
651−versionCtlParams cfg =
652− case idsVersionControl cfg of
653− NoVersionControl -> []
654− InternalVersion v -> versionParams v "internal"
655− ExternalGT (ExternalDocVersion v) -> versionParams v "external_gt"
656− ExternalGTE (ExternalDocVersion v) -> versionParams v "external_gte"
657− ForceVersion (ExternalDocVersion v) -> versionParams v "force"
658− where
659− vt = showText . docVersionNumber
660− versionParams v t = [ ("version", Just $ vt v)
661− , ("version_type", Just t)
662− ]
663−
664−-- | 'indexDocument' is the primary way to save a single document in
665−-- Elasticsearch. The document itself is simply something we can
666−-- convert into a JSON 'Value'. The 'DocId' will function as the
667−-- primary key for the document.
668−indexDocument :: (ToJSON doc, MonadBH m) => IndexName -> MappingName
669− -> IndexDocumentSettings -> doc -> DocId -> m Reply
670−indexDocument (IndexName indexName)
671− (MappingName mappingName) cfg document (DocId docId) =
672− bindM2 put url (return body)
673− where url = addQuery params <$> joinPath [indexName, mappingName, docId]
674− parentParams = case idsParent cfg of
675− Nothing -> []
676− Just (DocumentParent (DocId p)) -> [ ("parent", Just p) ]
677− params = versionCtlParams cfg ++ parentParams
678− body = Just (encode document)
679−
680−-- | 'updateDocument' provides a way to perform an partial update of a
681−-- an already indexed document.
682−updateDocument :: (ToJSON patch, MonadBH m) => IndexName -> MappingName
683− -> IndexDocumentSettings -> patch -> DocId -> m Reply
684−updateDocument (IndexName indexName)
685− (MappingName mappingName) cfg patch (DocId docId) =
686− bindM2 post url (return body)
687− where url = addQuery (versionCtlParams cfg) <$>
688− joinPath [indexName, mappingName, docId, "_update"]
689− body = Just (encode $ object ["doc" .= toJSON patch])
690−
691−-- | 'deleteDocument' is the primary way to delete a single document.
692−deleteDocument :: MonadBH m => IndexName -> MappingName
693− -> DocId -> m Reply
694−deleteDocument (IndexName indexName)
695− (MappingName mappingName) (DocId docId) =
696− delete =<< joinPath [indexName, mappingName, docId]
697−
698−-- | 'bulk' uses
699−-- <http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/docs-bulk.html Elasticsearch's bulk API>
700−-- to perform bulk operations. The 'BulkOperation' data type encodes the
701−-- index\/update\/delete\/create operations. You pass a 'V.Vector' of 'BulkOperation's
702−-- and a 'Server' to 'bulk' in order to send those operations up to your Elasticsearch
703−-- server to be performed. I changed from [BulkOperation] to a Vector due to memory overhead.
704−bulk :: MonadBH m => V.Vector BulkOperation -> m Reply
705−bulk bulkOps = bindM2 post url (return body)
706− where url = joinPath ["_bulk"]
707− body = Just $ encodeBulkOperations bulkOps
708−
709−-- | 'encodeBulkOperations' is a convenience function for dumping a vector of 'BulkOperation'
710−-- into an 'L.ByteString'
711−encodeBulkOperations :: V.Vector BulkOperation -> L.ByteString
712−encodeBulkOperations stream = collapsed where
713− blobs = fmap encodeBulkOperation stream
714− mashedTaters = mash (mempty :: Builder) blobs
715− collapsed = toLazyByteString $ mappend mashedTaters (byteString "\n")
716−
717−mash :: Builder -> V.Vector L.ByteString -> Builder
718−mash = V.foldl' (\b x -> b `mappend` (byteString "\n") `mappend` (lazyByteString x))
719−
720−mkBulkStreamValue :: Text -> Text -> Text -> Text -> Value
721−mkBulkStreamValue operation indexName mappingName docId =
722− object [operation .=
723− object [ "_index" .= indexName
724− , "_type" .= mappingName
725− , "_id" .= docId]]
726−
727−-- | 'encodeBulkOperation' is a convenience function for dumping a single 'BulkOperation'
728−-- into an 'L.ByteString'
729−encodeBulkOperation :: BulkOperation -> L.ByteString
730−encodeBulkOperation (BulkIndex (IndexName indexName)
731− (MappingName mappingName)
732− (DocId docId) value) = blob
733− where metadata = mkBulkStreamValue "index" indexName mappingName docId
734− blob = encode metadata `mappend` "\n" `mappend` encode value
735−
736−encodeBulkOperation (BulkCreate (IndexName indexName)
737− (MappingName mappingName)
738− (DocId docId) value) = blob
739− where metadata = mkBulkStreamValue "create" indexName mappingName docId
740− blob = encode metadata `mappend` "\n" `mappend` encode value
741−
742−encodeBulkOperation (BulkDelete (IndexName indexName)
743− (MappingName mappingName)
744− (DocId docId)) = blob
745− where metadata = mkBulkStreamValue "delete" indexName mappingName docId
746− blob = encode metadata
747−
748−encodeBulkOperation (BulkUpdate (IndexName indexName)
749− (MappingName mappingName)
750− (DocId docId) value) = blob
751− where metadata = mkBulkStreamValue "update" indexName mappingName docId
752− doc = object ["doc" .= value]
753− blob = encode metadata `mappend` "\n" `mappend` encode doc
754−
755−-- | 'getDocument' is a straight-forward way to fetch a single document from
756−-- Elasticsearch using a 'Server', 'IndexName', 'MappingName', and a 'DocId'.
757−-- The 'DocId' is the primary key for your Elasticsearch document.
758−getDocument :: MonadBH m => IndexName -> MappingName
759− -> DocId -> m Reply
760−getDocument (IndexName indexName)
761− (MappingName mappingName) (DocId docId) =
762− get =<< joinPath [indexName, mappingName, docId]
763−
764−-- | 'documentExists' enables you to check if a document exists. Returns 'Bool'
765−-- in IO
766−documentExists :: MonadBH m => IndexName -> MappingName
767− -> Maybe DocumentParent -> DocId -> m Bool
768−documentExists (IndexName indexName) (MappingName mappingName)
769− parent (DocId docId) = do
770− (_, exists) <- existentialQuery =<< url
771− return exists
772− where url = addQuery params <$> joinPath [indexName, mappingName, docId]
773− parentParam = fmap (\(DocumentParent (DocId p)) -> p) parent
774− params = LS.filter (\(_, v) -> isJust v) [("parent", parentParam)]
775−
776−dispatchSearch :: MonadBH m => Text -> Search -> m Reply
777−dispatchSearch url search = post url' (Just (encode search))
778− where url' = appendSearchTypeParam url (searchType search)
779−
780−-- | 'searchAll', given a 'Search', will perform that search against all indexes
781−-- on an Elasticsearch server. Try to avoid doing this if it can be helped.
782−searchAll :: MonadBH m => Search -> m Reply
783−searchAll = bindM2 dispatchSearch url . return
784− where url = joinPath ["_search"]
785−
786−-- | 'searchByIndex', given a 'Search' and an 'IndexName', will perform that search
787−-- against all mappings within an index on an Elasticsearch server.
788−searchByIndex :: MonadBH m => IndexName -> Search -> m Reply
789−searchByIndex (IndexName indexName) = bindM2 dispatchSearch url . return
790− where url = joinPath [indexName, "_search"]
791−
792−-- | 'searchByType', given a 'Search', 'IndexName', and 'MappingName', will perform that
793−-- search against a specific mapping within an index on an Elasticsearch server.
794−searchByType :: MonadBH m => IndexName -> MappingName -> Search
795− -> m Reply
796−searchByType (IndexName indexName)
797− (MappingName mappingName) = bindM2 dispatchSearch url . return
798− where url = joinPath [indexName, mappingName, "_search"]
799−
800−-- | For a given search, request a scroll for efficient streaming of
801−-- search results. Note that the search is put into 'SearchTypeScan'
802−-- mode and thus results will not be sorted. Combine this with
803−-- 'advanceScroll' to efficiently stream through the full result set
804−getInitialScroll :: MonadBH m => IndexName -> MappingName -> Search -> m (Maybe ScrollId)
805−getInitialScroll (IndexName indexName) (MappingName mappingName) search = do
806− let url = joinPath [indexName, mappingName, "_search"]
807− search' = search { searchType = SearchTypeScan }
808− resp' <- bindM2 dispatchSearch url (return search')
809− let msr = decode' $ responseBody resp' :: Maybe (SearchResult ())
810− msid = maybe Nothing scrollId msr
811− return msid
812−
813−scroll' :: (FromJSON a, MonadBH m, MonadThrow m) => Maybe ScrollId -> m ([Hit a], Maybe ScrollId)
814−scroll' Nothing = return ([], Nothing)
815−scroll' (Just sid) = do
816− res <- advanceScroll sid 60
817− case res of
818− Right SearchResult {..} -> return (hits searchHits, scrollId)
819− Left _ -> return ([], Nothing)
820−
821−-- | Use the given scroll to fetch the next page of documents. If there are no
822−-- further pages, 'SearchResult.searchHits.hits' will be '[]'.
823−advanceScroll
824− :: ( FromJSON a
825− , MonadBH m
826− , MonadThrow m
827− )
828− => ScrollId
829− -> NominalDiffTime
830− -- ^ 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.
831− -> m (Either EsError (SearchResult a))
832−advanceScroll (ScrollId sid) scroll = do
833− url <- joinPath ["_search/scroll?scroll=" <> scrollTime]
834− parseEsResponse =<< post url (Just . L.fromStrict $ T.encodeUtf8 sid)
835− where scrollTime = showText secs <> "s"
836− secs :: Integer
837− secs = round scroll
838−
839−simpleAccumulator :: (FromJSON a, MonadBH m, MonadThrow m) => [Hit a] -> ([Hit a], Maybe ScrollId) -> m ([Hit a], Maybe ScrollId)
840−simpleAccumulator oldHits (newHits, Nothing) = return (oldHits ++ newHits, Nothing)
841−simpleAccumulator oldHits ([], _) = return (oldHits, Nothing)
842−simpleAccumulator oldHits (newHits, msid) = do
843− (newHits', msid') <- scroll' msid
844− simpleAccumulator (oldHits ++ newHits) (newHits', msid')
845−
846−-- | 'scanSearch' uses the 'scan&scroll' API of elastic,
847−-- for a given 'IndexName' and 'MappingName'. Note that this will
848−-- consume the entire search result set and will be doing O(n) list
849−-- appends so this may not be suitable for large result sets. In that
850−-- case, 'getInitialScroll' and 'advanceScroll' are good low level
851−-- tools. You should be able to hook them up trivially to conduit,
852−-- pipes, or your favorite streaming IO abstraction of choice. Note
853−-- that ordering on the search would destroy performance and thus is
854−-- ignored.
855−scanSearch :: (FromJSON a, MonadBH m, MonadThrow m) => IndexName -> MappingName -> Search -> m [Hit a]
856−scanSearch indexName mappingName search = do
857− msid <- getInitialScroll indexName mappingName search
858− (hits, msid') <- scroll' msid
859− (totalHits, _) <- simpleAccumulator [] (hits, msid')
860− return totalHits
861−
862−-- | 'mkSearch' is a helper function for defaulting additional fields of a 'Search'
863−-- to Nothing in case you only care about your 'Query' and 'Filter'. Use record update
864−-- syntax if you want to add things like aggregations or highlights while still using
865−-- this helper function.
866−mkSearch :: Maybe Query -> Maybe Filter -> Search
867−mkSearch query filter = Search query filter Nothing Nothing Nothing False (From 0) (Size 10) SearchTypeQueryThenFetch Nothing Nothing Nothing
868−
869−-- | 'mkAggregateSearch' is a helper function that defaults everything in a 'Search' except for
870−-- the 'Query' and the 'Aggregation'.
871−mkAggregateSearch :: Maybe Query -> Aggregations -> Search
872−mkAggregateSearch query mkSearchAggs = Search query Nothing Nothing (Just mkSearchAggs) Nothing False (From 0) (Size 0) SearchTypeQueryThenFetch Nothing Nothing Nothing
873−
874−-- | 'mkHighlightSearch' is a helper function that defaults everything in a 'Search' except for
875−-- the 'Query' and the 'Aggregation'.
876−mkHighlightSearch :: Maybe Query -> Highlights -> Search
877−mkHighlightSearch query searchHighlights = Search query Nothing Nothing Nothing (Just searchHighlights) False (From 0) (Size 10) SearchTypeQueryThenFetch Nothing Nothing Nothing
878−
879−-- | 'pageSearch' is a helper function that takes a search and assigns the from
880−-- and size fields for the search. The from parameter defines the offset
881−-- from the first result you want to fetch. The size parameter allows you to
882−-- configure the maximum amount of hits to be returned.
883−pageSearch :: From -- ^ The result offset
884− -> Size -- ^ The number of results to return
885− -> Search -- ^ The current seach
886− -> Search -- ^ The paged search
887−pageSearch resultOffset pageSize search = search { from = resultOffset, size = pageSize }
888−
889−parseUrl' :: MonadThrow m => Text -> m Request
890−parseUrl' t = parseRequest (URI.escapeURIString URI.isAllowedInURI (T.unpack t))
891−
892−-- | Was there an optimistic concurrency control conflict when
893−-- indexing a document?
894−isVersionConflict :: Reply -> Bool
895−isVersionConflict = statusCheck (== 409)
896−
897−isSuccess :: Reply -> Bool
898−isSuccess = statusCheck (inRange (200, 299))
899−
900−isCreated :: Reply -> Bool
901−isCreated = statusCheck (== 201)
902−
903−statusCheck :: (Int -> Bool) -> Reply -> Bool
904−statusCheck prd = prd . NHTS.statusCode . responseStatus
905−
906−-- | This is a hook that can be set via the 'bhRequestHook' function
907−-- that will authenticate all requests using an HTTP Basic
908−-- Authentication header. Note that it is *strongly* recommended that
909−-- this option only be used over an SSL connection.
910−--
911−-- >> (mkBHEnv myServer myManager) { bhRequestHook = basicAuthHook (EsUsername "myuser") (EsPassword "mypass") }
912−basicAuthHook :: Monad m => EsUsername -> EsPassword -> Request -> m Request
913−basicAuthHook (EsUsername u) (EsPassword p) = return . applyBasicAuth u' p'
914− where u' = T.encodeUtf8 u
915− p' = T.encodeUtf8 p
916−
917−
918−boolQP :: Bool -> Text
919−boolQP True = "true"
920−boolQP False = "false"
src/Database/V1/Bloodhound/Types.hsdeleted−5509
@@ -1,5509 +0,0 @@
1−{-# LANGUAGE DeriveDataTypeable #-}
2−{-# LANGUAGE DeriveGeneric #-}
3−{-# LANGUAGE FlexibleContexts #-}
4−{-# LANGUAGE FlexibleInstances #-}
5−{-# LANGUAGE GeneralizedNewtypeDeriving #-}
6−{-# LANGUAGE MultiParamTypeClasses #-}
7−-- {-# LANGUAGE NoMonomorphismRestriction #-}
8−{-# LANGUAGE NamedFieldPuns #-}
9−{-# LANGUAGE OverloadedStrings #-}
10−{-# LANGUAGE RecordWildCards #-}
11−{-# LANGUAGE UndecidableInstances #-}
12−
13−-------------------------------------------------------------------------------
14−-- |
15−-- Module : Database.Bloodhound.Types
16−-- Copyright : (C) 2014, 2015, 2016 Chris Allen
17−-- License : BSD-style (see the file LICENSE)
18−-- Maintainer : Chris Allen <cma@bitemyapp.com
19−-- Stability : provisional
20−-- Portability : DeriveGeneric, RecordWildCards
21−--
22−-- Data types for describing actions and data structures performed to interact
23−-- with Elasticsearch. The two main buckets your queries against Elasticsearch
24−-- will fall into are 'Query's and 'Filter's. 'Filter's are more like
25−-- traditional database constraints and often have preferable performance
26−-- properties. 'Query's support human-written textual queries, such as fuzzy
27−-- queries.
28−-------------------------------------------------------------------------------
29−
30−
31−
32−module Database.V1.Bloodhound.Types
33− ( defaultCache
34− , defaultIndexSettings
35− , defaultIndexDocumentSettings
36− , mkSort
37− , showText
38− , unpackId
39− , mkMatchQuery
40− , mkMultiMatchQuery
41− , mkBoolQuery
42− , mkRangeQuery
43− , mkQueryStringQuery
44− , mkAggregations
45− , mkTermsAggregation
46− , mkTermsScriptAggregation
47− , mkDateHistogram
48− , mkCardinalityAggregation
49− , mkDocVersion
50− , docVersionNumber
51− , toMissing
52− , toTerms
53− , toDateHistogram
54− , toTopHits
55− , omitNulls
56− , BH(..)
57− , runBH
58− , BHEnv
59− , bhServer
60− , bhManager
61− , bhRequestHook
62− , mkBHEnv
63− , MonadBH(..)
64− , Version(..)
65− , VersionNumber(..)
66− , MaybeNA(..)
67− , BuildHash(..)
68− , Status(..)
69− , Existence(..)
70− , NullValue(..)
71− , IndexSettings(..)
72− , UpdatableIndexSetting(..)
73− , IndexSettingsSummary(..)
74− , AllocationPolicy(..)
75− , ReplicaBounds(..)
76− , Bytes(..)
77− , gigabytes
78− , megabytes
79− , kilobytes
80− , FSType(..)
81− , InitialShardCount(..)
82− , NodeAttrFilter(..)
83− , NodeAttrName(..)
84− , CompoundFormat(..)
85− , IndexTemplate(..)
86− , Server(..)
87− , Reply
88− , EsResult(..)
89− , EsResultFound(..)
90− , EsError(..)
91− , EsProtocolException(..)
92− , IndexAlias(..)
93− , IndexAliasName(..)
94− , IndexAliasAction(..)
95− , IndexAliasCreate(..)
96− , IndexAliasSummary(..)
97− , IndexAliasesSummary(..)
98− , AliasRouting(..)
99− , SearchAliasRouting(..)
100− , IndexAliasRouting(..)
101− , RoutingValue(..)
102− , DocVersion
103− , ExternalDocVersion(..)
104− , VersionControl(..)
105− , DocumentParent(..)
106− , IndexDocumentSettings(..)
107− , Query(..)
108− , Search(..)
109− , SearchType(..)
110− , SearchResult(..)
111− , ScrollId(..)
112− , SearchHits(..)
113− , TrackSortScores
114− , From(..)
115− , Size(..)
116− , Source(..)
117− , PatternOrPatterns(..)
118− , Include(..)
119− , Exclude(..)
120− , Pattern(..)
121− , ShardResult(..)
122− , Hit(..)
123− , Filter(..)
124− , Seminearring(..)
125− , BoolMatch(..)
126− , Term(..)
127− , GeoPoint(..)
128− , GeoBoundingBoxConstraint(..)
129− , GeoBoundingBox(..)
130− , GeoFilterType(..)
131− , Distance(..)
132− , DistanceUnit(..)
133− , DistanceType(..)
134− , DistanceRange(..)
135− , OptimizeBbox(..)
136− , LatLon(..)
137− , RangeValue(..)
138− , RangeExecution(..)
139− , LessThan(..)
140− , LessThanEq(..)
141− , GreaterThan(..)
142− , GreaterThanEq(..)
143− , LessThanD(..)
144− , LessThanEqD(..)
145− , GreaterThanD(..)
146− , GreaterThanEqD(..)
147− , Regexp(..)
148− , RegexpFlags(..)
149− , RegexpFlag(..)
150− , FieldName(..)
151− , Script(..)
152− , IndexName(..)
153− , IndexSelection(..)
154− , NodeSelection(..)
155− , NodeSelector(..)
156− , IndexOptimizationSettings(..)
157− , defaultIndexOptimizationSettings
158− , TemplateName(..)
159− , TemplatePattern(..)
160− , MappingName(..)
161− , DocId(..)
162− , CacheName(..)
163− , CacheKey(..)
164− , BulkOperation(..)
165− , ReplicaCount(..)
166− , ShardCount(..)
167− , Sort
168− , SortMode(..)
169− , SortOrder(..)
170− , SortSpec(..)
171− , DefaultSort(..)
172− , Missing(..)
173− , OpenCloseIndex(..)
174− , Method
175− , Boost(..)
176− , MatchQuery(..)
177− , MultiMatchQuery(..)
178− , BoolQuery(..)
179− , BoostingQuery(..)
180− , CommonTermsQuery(..)
181− , DisMaxQuery(..)
182− , FilteredQuery(..)
183− , FuzzyLikeThisQuery(..)
184− , FuzzyLikeFieldQuery(..)
185− , FuzzyQuery(..)
186− , HasChildQuery(..)
187− , HasParentQuery(..)
188− , IndicesQuery(..)
189− , MoreLikeThisQuery(..)
190− , MoreLikeThisFieldQuery(..)
191− , NestedQuery(..)
192− , PrefixQuery(..)
193− , QueryStringQuery(..)
194− , SimpleQueryStringQuery(..)
195− , RangeQuery(..)
196− , RegexpQuery(..)
197− , QueryString(..)
198− , TemplateQueryInline(..)
199− , TemplateQueryKeyValuePairs(..)
200− , BooleanOperator(..)
201− , ZeroTermsQuery(..)
202− , CutoffFrequency(..)
203− , Analyzer(..)
204− , MaxExpansions(..)
205− , Lenient(..)
206− , MatchQueryType(..)
207− , MultiMatchQueryType(..)
208− , Tiebreaker(..)
209− , MinimumMatch(..)
210− , DisableCoord(..)
211− , CommonMinimumMatch(..)
212− , MinimumMatchHighLow(..)
213− , PrefixLength(..)
214− , Fuzziness(..)
215− , IgnoreTermFrequency(..)
216− , MaxQueryTerms(..)
217− , ScoreType(..)
218− , Score
219− , Cache
220− , TypeName(..)
221− , BoostTerms(..)
222− , MaxWordLength(..)
223− , MinWordLength(..)
224− , MaxDocFrequency(..)
225− , MinDocFrequency(..)
226− , PhraseSlop(..)
227− , StopWord(..)
228− , QueryPath(..)
229− , MinimumTermFrequency(..)
230− , PercentMatch(..)
231− , FieldDefinition(..)
232− , MappingField(..)
233− , Mapping(..)
234− , AllowLeadingWildcard(..)
235− , LowercaseExpanded(..)
236− , GeneratePhraseQueries(..)
237− , Locale(..)
238− , AnalyzeWildcard(..)
239− , EnablePositionIncrements(..)
240− , SimpleQueryFlag(..)
241− , FieldOrFields(..)
242− , Monoid(..)
243− , ToJSON(..)
244− , Interval(..)
245− , TimeInterval(..)
246− , ExecutionHint(..)
247− , CollectionMode(..)
248− , TermOrder(..)
249− , TermInclusion(..)
250− , SnapshotRepoSelection(..)
251− , GenericSnapshotRepo(..)
252− , SnapshotRepo(..)
253− , SnapshotRepoConversionError(..)
254− , SnapshotRepoType(..)
255− , GenericSnapshotRepoSettings(..)
256− , SnapshotRepoUpdateSettings(..)
257− , defaultSnapshotRepoUpdateSettings
258− , SnapshotRepoName(..)
259− , SnapshotRepoPattern(..)
260− , SnapshotVerification(..)
261− , SnapshotNodeVerification(..)
262− , FullNodeId(..)
263− , NodeName(..)
264− , ClusterName(..)
265− , NodesInfo(..)
266− , NodesStats(..)
267− , NodeStats(..)
268− , NodeBreakersStats(..)
269− , NodeBreakerStats(..)
270− , NodeHTTPStats(..)
271− , NodeTransportStats(..)
272− , NodeFSStats(..)
273− , NodeDataPathStats(..)
274− , NodeFSTotalStats(..)
275− , NodeNetworkStats(..)
276− , NodeThreadPoolsStats(..)
277− , NodeThreadPoolStats(..)
278− , NodeJVMStats(..)
279− , JVMBufferPoolStats(..)
280− , JVMGCStats(..)
281− , JVMPoolStats(..)
282− , NodeProcessStats(..)
283− , NodeOSStats(..)
284− , LoadAvgs(..)
285− , NodeIndicesStats(..)
286− , EsAddress(..)
287− , PluginName(..)
288− , NodeInfo(..)
289− , NodePluginInfo(..)
290− , NodeHTTPInfo(..)
291− , NodeTransportInfo(..)
292− , BoundTransportAddress(..)
293− , NodeNetworkInfo(..)
294− , MacAddress(..)
295− , NetworkInterfaceName(..)
296− , NodeNetworkInterface(..)
297− , NodeThreadPoolsInfo(..)
298− , NodeThreadPoolInfo(..)
299− , ThreadPoolSize(..)
300− , ThreadPoolType(..)
301− , NodeJVMInfo(..)
302− , JVMMemoryPool(..)
303− , JVMGCCollector(..)
304− , JVMMemoryInfo(..)
305− , PID(..)
306− , NodeOSInfo(..)
307− , CPUInfo(..)
308− , NodeProcessInfo(..)
309− , FsSnapshotRepo(..)
310− , SnapshotCreateSettings(..)
311− , defaultSnapshotCreateSettings
312− , SnapshotSelection(..)
313− , SnapshotPattern(..)
314− , SnapshotInfo(..)
315− , SnapshotShardFailure(..)
316− , ShardId(..)
317− , SnapshotName(..)
318− , SnapshotState(..)
319− , SnapshotRestoreSettings(..)
320− , defaultSnapshotRestoreSettings
321− , RestoreRenamePattern(..)
322− , RestoreRenameToken(..)
323− , RRGroupRefNum
324− , rrGroupRefNum
325− , mkRRGroupRefNum
326− , RestoreIndexSettings(..)
327− , Suggest(..)
328− , SuggestType(..)
329− , PhraseSuggester(..)
330− , PhraseSuggesterHighlighter(..)
331− , PhraseSuggesterCollate(..)
332− , mkPhraseSuggester
333− , SuggestOptions(..)
334− , SuggestResponse(..)
335− , NamedSuggestionResponse(..)
336−
337− , Aggregation(..)
338− , Aggregations
339− , AggregationResults
340− , BucketValue(..)
341− , Bucket(..)
342− , BucketAggregation(..)
343− , TermsAggregation(..)
344− , MissingAggregation(..)
345− , ValueCountAggregation(..)
346− , FilterAggregation(..)
347− , CardinalityAggregation(..)
348− , DateHistogramAggregation(..)
349− , DateRangeAggregation(..)
350− , DateRangeAggRange(..)
351− , DateMathExpr(..)
352− , DateMathAnchor(..)
353− , DateMathModifier(..)
354− , DateMathUnit(..)
355− , TopHitsAggregation(..)
356−
357− , Highlights(..)
358− , FieldHighlight(..)
359− , HighlightSettings(..)
360− , PlainHighlight(..)
361− , PostingsHighlight(..)
362− , FastVectorHighlight(..)
363− , CommonHighlight(..)
364− , NonPostings(..)
365− , HighlightEncoder(..)
366− , HighlightTag(..)
367− , HitHighlight
368−
369− , MissingResult(..)
370− , TermsResult(..)
371− , DateHistogramResult(..)
372− , DateRangeResult(..)
373− , TopHitResult(..)
374−
375− , EsUsername(..)
376− , EsPassword(..)
377− ) where
378−
379−import Control.Applicative as A
380−import Control.Arrow (first)
381−import Control.Monad.Catch
382−import Control.Monad.Except
383−import Control.Monad.Reader (MonadReader (..),
384− ReaderT (..))
385−import Control.Monad.State (MonadState)
386−import Control.Monad.Writer (MonadWriter)
387−import Data.Aeson
388−import Data.Aeson.Types (Pair, Parser,
389− emptyObject,
390− parseEither, parseMaybe,
391− typeMismatch)
392−import qualified Data.ByteString.Lazy.Char8 as L
393−import Data.Char
394−import Data.Hashable (Hashable)
395−import qualified Data.HashMap.Strict as HM
396−import Data.List (foldl', intercalate,
397− nub)
398−import Data.List.NonEmpty (NonEmpty (..), toList)
399−import qualified Data.Map.Strict as M
400−import Data.Maybe
401−import Data.Scientific (Scientific)
402−import Data.Semigroup
403−import Data.Text (Text)
404−import qualified Data.Text as T
405−import Data.Time.Calendar
406−import Data.Time.Clock (NominalDiffTime,
407− UTCTime)
408−import Data.Time.Clock.POSIX
409−import qualified Data.Traversable as DT
410−import Data.Typeable (Typeable)
411−import qualified Data.Vector as V
412−import qualified Data.Version as Vers
413−import GHC.Enum
414−import GHC.Generics (Generic)
415−import Network.HTTP.Client
416−import qualified Network.HTTP.Types.Method as NHTM
417−import qualified Text.ParserCombinators.ReadP as RP
418−import qualified Text.Read as TR
419−
420−import Database.V1.Bloodhound.Types.Class
421−import Database.V1.Bloodhound.Types.Internal
422−
423−-- $setup
424−-- >>> :set -XOverloadedStrings
425−-- >>> import Data.Aeson
426−-- >>> import Database.V1.Bloodhound
427−-- >>> let testServer = (Server "http://localhost:9200")
428−-- >>> let testIndex = IndexName "twitter"
429−-- >>> let testMapping = MappingName "tweet"
430−-- >>> let defaultIndexSettings = IndexSettings (ShardCount 3) (ReplicaCount 2)
431−
432−-- defaultIndexSettings is exported by Database.Bloodhound as well
433−-- no trailing slashes in servers, library handles building the path.
434−
435−-- | Create a 'BHEnv' with all optional fields defaulted. HTTP hook
436−-- will be a noop. You can use the exported fields to customize it further, e.g.:
437−--
438−-- >> (mkBHEnv myServer myManager) { bhRequestHook = customHook }
439−mkBHEnv :: Server -> Manager -> BHEnv
440−mkBHEnv s m = BHEnv s m return
441−
442−newtype BH m a = BH {
443− unBH :: ReaderT BHEnv m a
444− } deriving ( Functor
445− , A.Applicative
446− , Monad
447− , MonadIO
448− , MonadState s
449− , MonadWriter w
450− , MonadError e
451− , Alternative
452− , MonadPlus
453− , MonadFix
454− , MonadThrow
455− , MonadCatch
456− , MonadMask)
457−
458−instance MonadTrans BH where
459− lift = BH . lift
460−
461−instance (MonadReader r m) => MonadReader r (BH m) where
462− ask = lift ask
463− local f (BH (ReaderT m)) = BH $ ReaderT $ \r ->
464− local f (m r)
465−
466−instance (Functor m, Applicative m, MonadIO m) => MonadBH (BH m) where
467− getBHEnv = BH getBHEnv
468−
469−runBH :: BHEnv -> BH m a -> m a
470−runBH e f = runReaderT (unBH f) e
471−
472−{-| 'Version' is embedded in 'Status' -}
473−data Version = Version { number :: VersionNumber
474− , build_hash :: BuildHash
475− , build_timestamp :: UTCTime
476− , build_snapshot :: Bool
477− , lucene_version :: VersionNumber } deriving (Eq, Read, Show, Generic, Typeable)
478−
479−-- | Traditional software versioning number
480−newtype VersionNumber = VersionNumber { versionNumber :: Vers.Version
481− } deriving (Eq, Read, Show, Generic, Typeable, Ord)
482−
483−{-| 'Status' is a data type for describing the JSON body returned by
484− Elasticsearch when you query its status. This was deprecated in 1.2.0.
485−
486− <http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/indices-status.html#indices-status>
487−-}
488−
489−data Status = Status { ok :: Maybe Bool
490− , status :: Int
491− , name :: Text
492− , version :: Version
493− , tagline :: Text } deriving (Eq, Read, Show, Generic)
494−
495−{-| 'IndexSettings' is used to configure the shards and replicas when you create
496− an Elasticsearch Index.
497−
498− <http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/indices-create-index.html>
499−-}
500−
501−data IndexSettings =
502− IndexSettings { indexShards :: ShardCount
503− , indexReplicas :: ReplicaCount } deriving (Eq, Read, Show, Generic, Typeable)
504−
505−{-| 'defaultIndexSettings' is an 'IndexSettings' with 3 shards and 2 replicas. -}
506−defaultIndexSettings :: IndexSettings
507−defaultIndexSettings = IndexSettings (ShardCount 3) (ReplicaCount 2)
508−
509−
510−{-| 'IndexOptimizationSettings' is used to configure index optimization. See
511− <https://www.elastic.co/guide/en/elasticsearch/reference/1.7/indices-optimize.html>
512− for more info.
513−-}
514−data IndexOptimizationSettings =
515− IndexOptimizationSettings { maxNumSegments :: Maybe Int
516− -- ^ Number of segments to optimize to. 1 will fully optimize the index. If omitted, the default behavior is to only optimize if the server deems it necessary.
517− , onlyExpungeDeletes :: Bool
518− -- ^ Should the optimize process only expunge segments with deletes in them? If the purpose of the optimization is to free disk space, this should be set to True.
519− , flushAfterOptimize :: Bool
520− -- ^ Should a flush be performed after the optimize.
521− } deriving (Eq, Show, Generic, Typeable)
522−
523−
524−{-| 'defaultIndexOptimizationSettings' implements the default settings that
525− ElasticSearch uses for index optimization. 'maxNumSegments' is Nothing,
526− 'onlyExpungeDeletes' is False, and flushAfterOptimize is True.
527−-}
528−defaultIndexOptimizationSettings :: IndexOptimizationSettings
529−defaultIndexOptimizationSettings = IndexOptimizationSettings Nothing False True
530−
531−{-| 'UpdatableIndexSetting' are settings which may be updated after an index is created.
532−
533− <https://www.elastic.co/guide/en/elasticsearch/reference/current/indices-update-settings.html>
534−-}
535−data UpdatableIndexSetting = NumberOfReplicas ReplicaCount
536− -- ^ The number of replicas each shard has.
537− | AutoExpandReplicas ReplicaBounds
538− | BlocksReadOnly Bool
539− -- ^ Set to True to have the index read only. False to allow writes and metadata changes.
540− | BlocksRead Bool
541− -- ^ Set to True to disable read operations against the index.
542− | BlocksWrite Bool
543− -- ^ Set to True to disable write operations against the index.
544− | BlocksMetaData Bool
545− -- ^ Set to True to disable metadata operations against the index.
546− | RefreshInterval NominalDiffTime
547− -- ^ The async refresh interval of a shard
548− | IndexConcurrency Int
549− | FailOnMergeFailure Bool
550− | TranslogFlushThresholdOps Int
551− -- ^ When to flush on operations.
552− | TranslogFlushThresholdSize Bytes
553− -- ^ When to flush based on translog (bytes) size.
554− | TranslogFlushThresholdPeriod NominalDiffTime
555− -- ^ When to flush based on a period of not flushing.
556− | TranslogDisableFlush Bool
557− -- ^ Disables flushing. Note, should be set for a short interval and then enabled.
558− | CacheFilterMaxSize (Maybe Bytes)
559− -- ^ The maximum size of filter cache (per segment in shard).
560− | CacheFilterExpire (Maybe NominalDiffTime)
561− -- ^ The expire after access time for filter cache.
562− | GatewaySnapshotInterval NominalDiffTime
563− -- ^ The gateway snapshot interval (only applies to shared gateways).
564− | RoutingAllocationInclude (NonEmpty NodeAttrFilter)
565− -- ^ A node matching any rule will be allowed to host shards from the index.
566− | RoutingAllocationExclude (NonEmpty NodeAttrFilter)
567− -- ^ A node matching any rule will NOT be allowed to host shards from the index.
568− | RoutingAllocationRequire (NonEmpty NodeAttrFilter)
569− -- ^ Only nodes matching all rules will be allowed to host shards from the index.
570− | RoutingAllocationEnable AllocationPolicy
571− -- ^ Enables shard allocation for a specific index.
572− | RoutingAllocationShardsPerNode ShardCount
573− -- ^ Controls the total number of shards (replicas and primaries) allowed to be allocated on a single node.
574− | RecoveryInitialShards InitialShardCount
575− -- ^ When using local gateway a particular shard is recovered only if there can be allocated quorum shards in the cluster.
576− | GCDeletes NominalDiffTime
577− | TTLDisablePurge Bool
578− -- ^ Disables temporarily the purge of expired docs.
579− | TranslogFSType FSType
580− | IndexCompoundFormat CompoundFormat
581− | IndexCompoundOnFlush Bool
582− | WarmerEnabled Bool
583− deriving (Eq, Show, Generic, Typeable)
584−
585−data AllocationPolicy = AllocAll
586− -- ^ Allows shard allocation for all shards.
587− | AllocPrimaries
588− -- ^ Allows shard allocation only for primary shards.
589− | AllocNewPrimaries
590− -- ^ Allows shard allocation only for primary shards for new indices.
591− | AllocNone
592− -- ^ No shard allocation is allowed
593− deriving (Eq, Read, Show, Generic, Typeable)
594−
595−data ReplicaBounds = ReplicasBounded Int Int
596− | ReplicasLowerBounded Int
597− | ReplicasUnbounded
598− deriving (Eq, Read, Show, Generic, Typeable)
599−
600−-- | A measure of bytes used for various configurations. You may want
601−-- to use smart constructors like 'gigabytes' for larger values.
602−--
603−-- >>> gigabytes 9
604−-- Bytes 9000000000
605−--
606−-- >>> megabytes 9
607−-- Bytes 9000000
608−--
609−-- >>> kilobytes 9
610−-- Bytes 9000
611−newtype Bytes = Bytes Int deriving (Eq, Read, Show, Generic, Typeable, Ord, ToJSON, FromJSON)
612−
613−gigabytes :: Int -> Bytes
614−gigabytes n = megabytes (1000 * n)
615−
616−
617−megabytes :: Int -> Bytes
618−megabytes n = kilobytes (1000 * n)
619−
620−
621−kilobytes :: Int -> Bytes
622−kilobytes n = Bytes (1000 * n)
623−
624−
625−data FSType = FSSimple
626− | FSBuffered deriving (Eq, Read, Show, Generic, Typeable, Ord)
627−
628−data InitialShardCount = QuorumShards
629− | QuorumMinus1Shards
630− | FullShards
631− | FullMinus1Shards
632− | ExplicitShards Int
633− deriving (Eq, Read, Show, Generic, Typeable)
634−
635−data NodeAttrFilter = NodeAttrFilter { nodeAttrFilterName :: NodeAttrName
636− , nodeAttrFilterValues :: NonEmpty Text}
637− deriving (Eq, Read, Show, Generic, Ord, Typeable)
638−
639−newtype NodeAttrName = NodeAttrName Text deriving (Eq, Read, Show, Ord, Generic, Typeable)
640−
641−data CompoundFormat = CompoundFileFormat Bool
642− | MergeSegmentVsTotalIndex Double
643− -- ^ percentage between 0 and 1 where 0 is false, 1 is true
644− deriving (Eq, Read, Show, Generic, Typeable)
645−
646−newtype NominalDiffTimeJSON = NominalDiffTimeJSON { ndtJSON :: NominalDiffTime }
647−
648−data IndexSettingsSummary = IndexSettingsSummary { sSummaryIndexName :: IndexName
649− , sSummaryFixedSettings :: IndexSettings
650− , sSummaryUpdateable :: [UpdatableIndexSetting]}
651− deriving (Eq, Show, Generic, Typeable)
652−
653−{-| 'Reply' and 'Method' are type synonyms from 'Network.HTTP.Types.Method.Method' -}
654−type Reply = Network.HTTP.Client.Response L.ByteString
655−type Method = NHTM.Method
656−
657−{-| 'OpenCloseIndex' is a sum type for opening and closing indices.
658−
659− <http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/indices-open-close.html>
660−-}
661−data OpenCloseIndex = OpenIndex | CloseIndex deriving (Eq, Read, Show, Generic, Typeable)
662−
663−data FieldType = GeoPointType
664− | GeoShapeType
665− | FloatType
666− | IntegerType
667− | LongType
668− | ShortType
669− | ByteType deriving (Eq, Read, Show, Generic, Typeable)
670−
671−data FieldDefinition =
672− FieldDefinition { fieldType :: FieldType } deriving (Eq, Read, Show, Generic, Typeable)
673−
674−{-| An 'IndexTemplate' defines a template that will automatically be
675− applied to new indices created. The templates include both
676− 'IndexSettings' and mappings, and a simple 'TemplatePattern' that
677− controls if the template will be applied to the index created.
678− Specify mappings as follows: @[toJSON TweetMapping, ...]@
679−
680− https://www.elastic.co/guide/en/elasticsearch/reference/1.7/indices-templates.html
681−-}
682−data IndexTemplate =
683− IndexTemplate { templatePattern :: TemplatePattern
684− , templateSettings :: Maybe IndexSettings
685− , templateMappings :: [Value]
686− }
687−
688−data MappingField =
689− MappingField { mappingFieldName :: FieldName
690− , fieldDefinition :: FieldDefinition } deriving (Eq, Read, Show, Generic, Typeable)
691−
692−{-| Support for type reification of 'Mapping's is currently incomplete, for
693− now the mapping API verbiage expects a 'ToJSON'able blob.
694−
695− Indexes have mappings, mappings are schemas for the documents contained in the
696− index. I'd recommend having only one mapping per index, always having a mapping,
697− and keeping different kinds of documents separated if possible.
698−-}
699−data Mapping = Mapping { typeName :: TypeName
700− , mappingFields :: [MappingField] } deriving (Eq, Read, Show, Generic, Typeable)
701−
702−{-| 'BulkOperation' is a sum type for expressing the four kinds of bulk
703− operation index, create, delete, and update. 'BulkIndex' behaves like an
704− "upsert", 'BulkCreate' will fail if a document already exists at the DocId.
705−
706− <http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/docs-bulk.html#docs-bulk>
707−-}
708−data BulkOperation =
709− BulkIndex IndexName MappingName DocId Value
710− | BulkCreate IndexName MappingName DocId Value
711− | BulkDelete IndexName MappingName DocId
712− | BulkUpdate IndexName MappingName DocId Value deriving (Eq, Read, Show, Generic, Typeable)
713−
714−{-| 'EsResult' describes the standard wrapper JSON document that you see in
715− successful Elasticsearch lookups or lookups that couldn't find the document.
716−-}
717−data EsResult a = EsResult { _index :: Text
718− , _type :: Text
719− , _id :: Text
720− , foundResult :: Maybe (EsResultFound a)} deriving (Eq, Read, Show, Generic, Typeable)
721−
722−{-| 'EsResultFound' contains the document and its metadata inside of an
723− 'EsResult' when the document was successfully found.
724−-}
725−data EsResultFound a = EsResultFound { _version :: DocVersion
726− , _source :: a } deriving (Eq, Read, Show, Generic, Typeable)
727−
728−{-| 'EsError' is the generic type that will be returned when there was a
729− problem. If you can't parse the expected response, its a good idea to
730− try parsing this.
731−-}
732−data EsError = EsError { errorStatus :: Int
733− , errorMessage :: Text } deriving (Eq, Read, Show, Generic, Typeable)
734−
735−{-| 'EsProtocolException' will be thrown if Bloodhound cannot parse a response
736−returned by the ElasticSearch server. If you encounter this error, please
737−verify that your domain data types and FromJSON instances are working properly
738−(for example, the 'a' of '[Hit a]' in 'SearchResult.searchHits.hits'). If you're
739−sure that your mappings are correct, then this error may be an indication of an
740−incompatibility between Bloodhound and ElasticSearch. Please open a bug report
741−and be sure to include the exception body.
742−-}
743−data EsProtocolException = EsProtocolException { esProtoExBody :: L.ByteString }
744− deriving (Eq, Read, Show, Generic, Typeable)
745−
746−instance Exception EsProtocolException
747−
748−data IndexAlias = IndexAlias { srcIndex :: IndexName
749− , indexAlias :: IndexAliasName } deriving (Eq, Read, Show, Generic, Typeable)
750−
751−newtype IndexAliasName = IndexAliasName { indexAliasName :: IndexName } deriving (Eq, Read, Show, Generic, ToJSON)
752−
753−data IndexAliasAction = AddAlias IndexAlias IndexAliasCreate
754− | RemoveAlias IndexAlias deriving (Read, Show, Eq, Generic, Typeable)
755−
756−data IndexAliasCreate = IndexAliasCreate { aliasCreateRouting :: Maybe AliasRouting
757− , aliasCreateFilter :: Maybe Filter}
758− deriving (Read, Show, Eq, Generic, Typeable)
759−
760−data AliasRouting = AllAliasRouting RoutingValue
761− | GranularAliasRouting (Maybe SearchAliasRouting) (Maybe IndexAliasRouting)
762− deriving (Read, Show, Eq, Generic, Typeable)
763−
764−newtype SearchAliasRouting = SearchAliasRouting (NonEmpty RoutingValue) deriving (Read, Show, Eq, Generic, Typeable)
765−
766−newtype IndexAliasRouting = IndexAliasRouting RoutingValue deriving (Read, Show, Eq, Generic, ToJSON, FromJSON, Typeable)
767−
768−newtype RoutingValue = RoutingValue { routingValue :: Text } deriving (Read, Show, Eq, Generic, ToJSON, FromJSON, Typeable)
769−
770−newtype IndexAliasesSummary = IndexAliasesSummary { indexAliasesSummary :: [IndexAliasSummary] } deriving (Read, Show, Eq, Generic, Typeable)
771−
772−{-| 'IndexAliasSummary' is a summary of an index alias configured for a server. -}
773−data IndexAliasSummary = IndexAliasSummary { indexAliasSummaryAlias :: IndexAlias
774− , indexAliasSummaryCreate :: IndexAliasCreate} deriving (Read, Show, Eq, Generic, Typeable)
775−
776−{-| 'DocVersion' is an integer version number for a document between 1
777−and 9.2e+18 used for <<https://www.elastic.co/guide/en/elasticsearch/guide/current/optimistic-concurrency-control.html optimistic concurrency control>>.
778−-}
779−newtype DocVersion = DocVersion {
780− docVersionNumber :: Int
781− } deriving (Eq, Read, Show, Generic, Ord, ToJSON)
782−
783−-- | Smart constructor for in-range doc version
784−mkDocVersion :: Int -> Maybe DocVersion
785−mkDocVersion i
786− | i >= (docVersionNumber minBound) && i <= (docVersionNumber maxBound) =
787− Just $ DocVersion i
788− | otherwise = Nothing
789−
790−
791−{-| 'ExternalDocVersion' is a convenience wrapper if your code uses its
792−own version numbers instead of ones from ES.
793−-}
794−newtype ExternalDocVersion = ExternalDocVersion DocVersion
795− deriving (Eq, Read, Show, Generic, Ord, Bounded, Enum, ToJSON)
796−
797−{-| 'VersionControl' is specified when indexing documents as a
798−optimistic concurrency control.
799−-}
800−data VersionControl = NoVersionControl
801− -- ^ Don't send a version. This is a pure overwrite.
802− | InternalVersion DocVersion
803− -- ^ Use the default ES versioning scheme. Only
804− -- index the document if the version is the same
805− -- as the one specified. Only applicable to
806− -- updates, as you should be getting Version from
807− -- a search result.
808− | ExternalGT ExternalDocVersion
809− -- ^ Use your own version numbering. Only index
810− -- the document if the version is strictly higher
811− -- OR the document doesn't exist. The given
812− -- version will be used as the new version number
813− -- for the stored document. N.B. All updates must
814− -- increment this number, meaning there is some
815− -- global, external ordering of updates.
816− | ExternalGTE ExternalDocVersion
817− -- ^ Use your own version numbering. Only index
818− -- the document if the version is equal or higher
819− -- than the stored version. Will succeed if there
820− -- is no existing document. The given version will
821− -- be used as the new version number for the
822− -- stored document. Use with care, as this could
823− -- result in data loss.
824− | ForceVersion ExternalDocVersion
825− -- ^ The document will always be indexed and the
826− -- given version will be the new version. This is
827− -- typically used for correcting errors. Use with
828− -- care, as this could result in data loss.
829− deriving (Read, Show, Eq, Generic, Ord)
830−
831−{-| 'DocumentParent' is used to specify a parent document.
832−-}
833−newtype DocumentParent = DocumentParent DocId
834− deriving (Eq, Read, Show, Generic, Typeable)
835−
836−{-| 'IndexDocumentSettings' are special settings supplied when indexing
837−a document. For the best backwards compatiblity when new fields are
838−added, you should probably prefer to start with 'defaultIndexDocumentSettings'
839−-}
840−data IndexDocumentSettings =
841− IndexDocumentSettings { idsVersionControl :: VersionControl
842− , idsParent :: Maybe DocumentParent
843− } deriving (Eq, Read, Show, Generic, Typeable)
844−
845−{-| Reasonable default settings. Chooses no version control and no parent.
846−-}
847−defaultIndexDocumentSettings :: IndexDocumentSettings
848−defaultIndexDocumentSettings = IndexDocumentSettings NoVersionControl Nothing
849−
850−{-| 'Sort' is a synonym for a list of 'SortSpec's. Sort behavior is order
851− dependent with later sorts acting as tie-breakers for earlier sorts.
852−-}
853−type Sort = [SortSpec]
854−
855−{-| The two main kinds of 'SortSpec' are 'DefaultSortSpec' and
856− 'GeoDistanceSortSpec'. The latter takes a 'SortOrder', 'GeoPoint', and
857− 'DistanceUnit' to express "nearness" to a single geographical point as a
858− sort specification.
859−
860−<http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/search-request-sort.html#search-request-sort>
861−-}
862−data SortSpec = DefaultSortSpec DefaultSort
863− | GeoDistanceSortSpec SortOrder GeoPoint DistanceUnit deriving (Eq, Read, Show, Generic, Typeable)
864−
865−{-| 'DefaultSort' is usually the kind of 'SortSpec' you'll want. There's a
866− 'mkSort' convenience function for when you want to specify only the most
867− common parameters.
868−
869−<http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/search-request-sort.html#search-request-sort>
870−-}
871−data DefaultSort =
872− DefaultSort { sortFieldName :: FieldName
873− , sortOrder :: SortOrder
874− -- default False
875− , ignoreUnmapped :: Bool
876− , sortMode :: Maybe SortMode
877− , missingSort :: Maybe Missing
878− , nestedFilter :: Maybe Filter } deriving (Eq, Read, Show, Generic, Typeable)
879−
880−{-| 'SortOrder' is 'Ascending' or 'Descending', as you might expect. These get
881− encoded into "asc" or "desc" when turned into JSON.
882−
883−<http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/search-request-sort.html#search-request-sort>
884−-}
885−data SortOrder = Ascending
886− | Descending deriving (Eq, Read, Show, Generic, Typeable)
887−
888−{-| 'Missing' prescribes how to handle missing fields. A missing field can be
889− sorted last, first, or using a custom value as a substitute.
890−
891−<http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/search-request-sort.html#_missing_values>
892−-}
893−data Missing = LastMissing
894− | FirstMissing
895− | CustomMissing Text deriving (Eq, Read, Show, Generic, Typeable)
896−
897−{-| 'SortMode' prescribes how to handle sorting array/multi-valued fields.
898−
899−http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/search-request-sort.html#_sort_mode_option
900−-}
901−data SortMode = SortMin
902− | SortMax
903− | SortSum
904− | SortAvg deriving (Eq, Read, Show, Generic, Typeable)
905−
906−{-| 'mkSort' defaults everything but the 'FieldName' and the 'SortOrder' so
907− that you can concisely describe the usual kind of 'SortSpec's you want.
908−-}
909−mkSort :: FieldName -> SortOrder -> DefaultSort
910−mkSort fieldName sOrder = DefaultSort fieldName sOrder False Nothing Nothing Nothing
911−
912−{-| 'Cache' is for telling ES whether it should cache a 'Filter' not.
913− 'Query's cannot be cached.
914−-}
915−type Cache = Bool -- caching on/off
916−defaultCache :: Cache
917−defaultCache = False
918−
919−{-| 'PrefixValue' is used in 'PrefixQuery' as the main query component.
920−-}
921−type PrefixValue = Text
922−
923−{-| 'BooleanOperator' is the usual And/Or operators with an ES compatible
924− JSON encoding baked in. Used all over the place.
925−-}
926−data BooleanOperator = And | Or deriving (Eq, Read, Show, Generic, Typeable)
927−
928−{-| 'ShardCount' is part of 'IndexSettings'
929−-}
930−newtype ShardCount = ShardCount Int deriving (Eq, Read, Show, Generic, ToJSON, Typeable)
931−
932−{-| 'ReplicaCount' is part of 'IndexSettings'
933−-}
934−newtype ReplicaCount = ReplicaCount Int deriving (Eq, Read, Show, Generic, ToJSON, Typeable)
935−
936−{-| 'IndexName' is used to describe which index to query/create/delete
937−-}
938−newtype IndexName = IndexName Text deriving (Eq, Generic, Read, Show, ToJSON, FromJSON, Typeable)
939−
940−{-| 'IndexSelection' is used for APIs which take a single index, a list of
941− indexes, or the special @_all@ index.
942−-}
943−--TODO: this does not fully support <https://www.elastic.co/guide/en/elasticsearch/reference/1.7/multi-index.html multi-index syntax>. It wouldn't be too hard to implement but you'd have to add the optional parameters (ignore_unavailable, allow_no_indices, expand_wildcards) to any APIs using it. Also would be a breaking API.
944−data IndexSelection = IndexList (NonEmpty IndexName)
945− | AllIndexes deriving (Eq, Generic, Show, Typeable)
946−
947−{-| 'NodeSelection' is used for most cluster APIs. See <https://www.elastic.co/guide/en/elasticsearch/reference/current/cluster.html#cluster-nodes here> for more details.
948−-}
949−data NodeSelection = LocalNode
950− -- ^ Whatever node receives this request
951− | NodeList (NonEmpty NodeSelector)
952− | AllNodes deriving (Eq, Generic, Show, Typeable)
953−
954−
955−-- | An exact match or pattern to identify a node. Note that All of
956−-- these options support wildcarding, so your node name, server, attr
957−-- name can all contain * characters to be a fuzzy match.
958−data NodeSelector = NodeByName NodeName
959− | NodeByFullNodeId FullNodeId
960− | NodeByHost Server
961− -- ^ e.g. 10.0.0.1 or even 10.0.0.*
962− | NodeByAttribute NodeAttrName Text
963− -- ^ NodeAttrName can be a pattern, e.g. rack*. The value can too.
964− deriving (Eq, Generic, Show, Typeable)
965−
966−{-| 'TemplateName' is used to describe which template to query/create/delete
967−-}
968−newtype TemplateName = TemplateName Text deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
969−
970−{-| 'TemplatePattern' represents a pattern which is matched against index names
971−-}
972−newtype TemplatePattern = TemplatePattern Text deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
973−
974−{-| 'MappingName' is part of mappings which are how ES describes and schematizes
975− the data in the indices.
976−-}
977−newtype MappingName = MappingName Text deriving (Eq, Generic, Read, Show, ToJSON, FromJSON, Typeable)
978−
979−{-| 'DocId' is a generic wrapper value for expressing unique Document IDs.
980− Can be set by the user or created by ES itself. Often used in client
981− functions for poking at specific documents.
982−-}
983−newtype DocId = DocId Text deriving (Eq, Generic, Read, Show, ToJSON, FromJSON, Typeable)
984−
985−{-| 'QueryString' is used to wrap query text bodies, be they human written or not.
986−-}
987−newtype QueryString = QueryString Text deriving (Eq, Generic, Read, Show, ToJSON, FromJSON, Typeable)
988−
989−{-| 'FieldName' is used all over the place wherever a specific field within
990− a document needs to be specified, usually in 'Query's or 'Filter's.
991−-}
992−newtype FieldName = FieldName Text deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
993−
994−
995−{-| 'Script' is often used in place of 'FieldName' to specify more
996−complex ways of extracting a value from a document.
997−-}
998−newtype Script = Script { scriptText :: Text } deriving (Eq, Read, Show, Generic, Typeable)
999−
1000−{-| 'CacheName' is used in 'RegexpFilter' for describing the
1001− 'CacheKey' keyed caching behavior.
1002−-}
1003−newtype CacheName = CacheName Text deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1004−
1005−{-| 'CacheKey' is used in 'RegexpFilter' to key regex caching.
1006−-}
1007−newtype CacheKey =
1008− CacheKey Text deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1009−newtype Existence =
1010− Existence Bool deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1011−newtype NullValue =
1012− NullValue Bool deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1013−newtype CutoffFrequency =
1014− CutoffFrequency Double deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1015−newtype Analyzer =
1016− Analyzer Text deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1017−newtype MaxExpansions =
1018− MaxExpansions Int deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1019−
1020−{-| 'Lenient', if set to true, will cause format based failures to be
1021− ignored. I don't know what the bloody default is, Elasticsearch
1022− documentation didn't say what it was. Let me know if you figure it out.
1023−-}
1024−newtype Lenient =
1025− Lenient Bool deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1026−newtype Tiebreaker =
1027− Tiebreaker Double deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1028−newtype Boost =
1029− Boost Double deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1030−newtype BoostTerms =
1031− BoostTerms Double deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1032−
1033−{-| 'MinimumMatch' controls how many should clauses in the bool query should
1034− match. Can be an absolute value (2) or a percentage (30%) or a
1035− combination of both.
1036−-}
1037−newtype MinimumMatch =
1038− MinimumMatch Int deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1039−newtype DisableCoord =
1040− DisableCoord Bool deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1041−newtype IgnoreTermFrequency =
1042− IgnoreTermFrequency Bool deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1043−newtype MinimumTermFrequency =
1044− MinimumTermFrequency Int deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1045−newtype MaxQueryTerms =
1046− MaxQueryTerms Int deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1047−newtype Fuzziness =
1048− Fuzziness Double deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1049−
1050−{-| 'PrefixLength' is the prefix length used in queries, defaults to 0. -}
1051−newtype PrefixLength =
1052− PrefixLength Int deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1053−newtype TypeName =
1054− TypeName Text deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1055−newtype PercentMatch =
1056− PercentMatch Double deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1057−newtype StopWord =
1058− StopWord Text deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1059−newtype QueryPath =
1060− QueryPath Text deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1061−
1062−{-| Allowing a wildcard at the beginning of a word (eg "*ing") is particularly
1063− heavy, because all terms in the index need to be examined, just in case
1064− they match. Leading wildcards can be disabled by setting
1065− 'AllowLeadingWildcard' to false. -}
1066−newtype AllowLeadingWildcard =
1067− AllowLeadingWildcard Bool deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1068−newtype LowercaseExpanded =
1069− LowercaseExpanded Bool deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1070−newtype EnablePositionIncrements =
1071− EnablePositionIncrements Bool deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1072−
1073−{-| By default, wildcard terms in a query are not analyzed.
1074− Setting 'AnalyzeWildcard' to true enables best-effort analysis.
1075−-}
1076−newtype AnalyzeWildcard = AnalyzeWildcard Bool deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1077−
1078−{-| 'GeneratePhraseQueries' defaults to false.
1079−-}
1080−newtype GeneratePhraseQueries =
1081− GeneratePhraseQueries Bool deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1082−
1083−{-| 'Locale' is used for string conversions - defaults to ROOT.
1084−-}
1085−newtype Locale = Locale Text deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1086−newtype MaxWordLength = MaxWordLength Int deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1087−newtype MinWordLength = MinWordLength Int deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1088−
1089−{-| 'PhraseSlop' sets the default slop for phrases, 0 means exact
1090− phrase matches. Default is 0.
1091−-}
1092−newtype PhraseSlop = PhraseSlop Int deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1093−newtype MinDocFrequency = MinDocFrequency Int deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1094−newtype MaxDocFrequency = MaxDocFrequency Int deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1095−
1096−-- | Newtype wrapper to parse ES's concerning tendency to in some APIs return a floating point number of milliseconds since epoch ಠ_ಠ
1097−newtype POSIXMS = POSIXMS { posixMS :: UTCTime }
1098−
1099−{-| 'unpackId' is a silly convenience function that gets used once.
1100−-}
1101−unpackId :: DocId -> Text
1102−unpackId (DocId docId) = docId
1103−
1104−type TrackSortScores = Bool
1105−newtype From = From Int deriving (Eq, Read, Show, Generic, ToJSON)
1106−newtype Size = Size Int deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1107−
1108−data Search = Search { queryBody :: Maybe Query
1109− , filterBody :: Maybe Filter
1110− , sortBody :: Maybe Sort
1111− , aggBody :: Maybe Aggregations
1112− , highlight :: Maybe Highlights
1113− -- default False
1114− , trackSortScores :: TrackSortScores
1115− , from :: From
1116− , size :: Size
1117− , searchType :: SearchType
1118− , fields :: Maybe [FieldName]
1119− , source :: Maybe Source
1120− , suggestBody :: Maybe Suggest -- ^ Only one Suggestion request / response per Search is supported.
1121− } deriving (Eq, Read, Show, Generic, Typeable)
1122−
1123−data SearchType = SearchTypeQueryThenFetch
1124− | SearchTypeDfsQueryThenFetch
1125− | SearchTypeCount
1126− | SearchTypeScan
1127− | SearchTypeQueryAndFetch
1128− | SearchTypeDfsQueryAndFetch
1129− deriving (Eq, Read, Show, Generic, Typeable)
1130−
1131−data Source =
1132− NoSource
1133− | SourcePatterns PatternOrPatterns
1134− | SourceIncludeExclude Include Exclude
1135− deriving (Read, Show, Eq, Generic, Typeable)
1136−
1137−data PatternOrPatterns = PopPattern Pattern
1138− | PopPatterns [Pattern] deriving (Eq, Read, Show, Generic, Typeable)
1139−
1140−data Include = Include [Pattern] deriving (Eq, Read, Show, Generic, Typeable)
1141−data Exclude = Exclude [Pattern] deriving (Eq, Read, Show, Generic, Typeable)
1142−
1143−newtype Pattern = Pattern Text deriving (Eq, Read, Show, Generic, Typeable)
1144−
1145−data Highlights = Highlights { globalsettings :: Maybe HighlightSettings
1146− , highlightFields :: [FieldHighlight]
1147− } deriving (Read, Show, Eq, Generic, Typeable)
1148−
1149−data FieldHighlight = FieldHighlight FieldName (Maybe HighlightSettings)
1150− deriving (Read, Show, Eq, Generic, Typeable)
1151−
1152−
1153−data HighlightSettings = Plain PlainHighlight
1154− | Postings PostingsHighlight
1155− | FastVector FastVectorHighlight
1156− deriving (Read, Show, Eq, Generic, Typeable)
1157−data PlainHighlight =
1158− PlainHighlight { plainCommon :: Maybe CommonHighlight
1159− , plainNonPost :: Maybe NonPostings } deriving (Read, Show, Eq, Generic, Typeable)
1160−
1161− -- This requires that index_options are set to 'offset' in the mapping.
1162−data PostingsHighlight = PostingsHighlight (Maybe CommonHighlight) deriving (Read, Show, Eq, Generic, Typeable)
1163−
1164−-- This requires that term_vector is set to 'with_positions_offsets' in the mapping.
1165−data FastVectorHighlight =
1166− FastVectorHighlight { fvCommon :: Maybe CommonHighlight
1167− , fvNonPostSettings :: Maybe NonPostings
1168− , boundaryChars :: Maybe Text
1169− , boundaryMaxScan :: Maybe Int
1170− , fragmentOffset :: Maybe Int
1171− , matchedFields :: [Text]
1172− , phraseLimit :: Maybe Int
1173− } deriving (Read, Show, Eq, Generic, Typeable)
1174−
1175−data CommonHighlight =
1176− CommonHighlight { order :: Maybe Text
1177− , forceSource :: Maybe Bool
1178− , tag :: Maybe HighlightTag
1179− , encoder :: Maybe HighlightEncoder
1180− , noMatchSize :: Maybe Int
1181− , highlightQuery :: Maybe Query
1182− , requireFieldMatch :: Maybe Bool
1183− } deriving (Read, Show, Eq, Generic, Typeable)
1184−
1185−-- Settings that are only applicable to FastVector and Plain highlighters.
1186−data NonPostings =
1187− NonPostings { fragmentSize :: Maybe Int
1188− , numberOfFragments :: Maybe Int} deriving (Read, Show, Eq, Generic, Typeable)
1189−
1190−data HighlightEncoder = DefaultEncoder
1191− | HTMLEncoder
1192− deriving (Read, Show, Eq, Generic, Typeable)
1193−
1194−-- NOTE: Should the tags use some kind of HTML type, rather than Text?
1195−data HighlightTag = TagSchema Text
1196− | CustomTags ([Text], [Text]) -- Only uses more than the first value in the lists if fvh
1197− deriving (Read, Show, Eq, Generic, Typeable)
1198−
1199−
1200−data Query =
1201− TermQuery Term (Maybe Boost)
1202− | TermsQuery Text (NonEmpty Text)
1203− | QueryMatchQuery MatchQuery
1204− | QueryMultiMatchQuery MultiMatchQuery
1205− | QueryBoolQuery BoolQuery
1206− | QueryBoostingQuery BoostingQuery
1207− | QueryCommonTermsQuery CommonTermsQuery
1208− | ConstantScoreFilter Filter Boost
1209− | ConstantScoreQuery Query Boost
1210− | QueryDisMaxQuery DisMaxQuery
1211− | QueryFilteredQuery FilteredQuery
1212− | QueryFuzzyLikeThisQuery FuzzyLikeThisQuery
1213− | QueryFuzzyLikeFieldQuery FuzzyLikeFieldQuery
1214− | QueryFuzzyQuery FuzzyQuery
1215− | QueryHasChildQuery HasChildQuery
1216− | QueryHasParentQuery HasParentQuery
1217− | IdsQuery MappingName [DocId]
1218− | QueryIndicesQuery IndicesQuery
1219− | MatchAllQuery (Maybe Boost)
1220− | QueryMoreLikeThisQuery MoreLikeThisQuery
1221− | QueryMoreLikeThisFieldQuery MoreLikeThisFieldQuery
1222− | QueryNestedQuery NestedQuery
1223− | QueryPrefixQuery PrefixQuery
1224− | QueryQueryStringQuery QueryStringQuery
1225− | QuerySimpleQueryStringQuery SimpleQueryStringQuery
1226− | QueryRangeQuery RangeQuery
1227− | QueryRegexpQuery RegexpQuery
1228− | QueryTemplateQueryInline TemplateQueryInline
1229− deriving (Eq, Read, Show, Generic, Typeable)
1230−
1231−data RegexpQuery =
1232− RegexpQuery { regexpQueryField :: FieldName
1233− , regexpQuery :: Regexp
1234− , regexpQueryFlags :: RegexpFlags
1235− , regexpQueryBoost :: Maybe Boost
1236− } deriving (Eq, Read, Show, Generic, Typeable)
1237−
1238−data RangeQuery =
1239− RangeQuery { rangeQueryField :: FieldName
1240− , rangeQueryRange :: RangeValue
1241− , rangeQueryBoost :: Boost } deriving (Eq, Read, Show, Generic, Typeable)
1242−
1243−mkRangeQuery :: FieldName -> RangeValue -> RangeQuery
1244−mkRangeQuery f r = RangeQuery f r (Boost 1.0)
1245−
1246−data SimpleQueryStringQuery =
1247− SimpleQueryStringQuery
1248− { simpleQueryStringQuery :: QueryString
1249− , simpleQueryStringField :: Maybe FieldOrFields
1250− , simpleQueryStringOperator :: Maybe BooleanOperator
1251− , simpleQueryStringAnalyzer :: Maybe Analyzer
1252− , simpleQueryStringFlags :: Maybe (NonEmpty SimpleQueryFlag)
1253− , simpleQueryStringLowercaseExpanded :: Maybe LowercaseExpanded
1254− , simpleQueryStringLocale :: Maybe Locale
1255− } deriving (Eq, Read, Show, Generic, Typeable)
1256−
1257−data SimpleQueryFlag =
1258− SimpleQueryAll
1259− | SimpleQueryNone
1260− | SimpleQueryAnd
1261− | SimpleQueryOr
1262− | SimpleQueryPrefix
1263− | SimpleQueryPhrase
1264− | SimpleQueryPrecedence
1265− | SimpleQueryEscape
1266− | SimpleQueryWhitespace
1267− | SimpleQueryFuzzy
1268− | SimpleQueryNear
1269− | SimpleQuerySlop deriving (Eq, Read, Show, Generic, Typeable)
1270−
1271−-- use_dis_max and tie_breaker when fields are plural?
1272−data QueryStringQuery =
1273− QueryStringQuery
1274− { queryStringQuery :: QueryString
1275− , queryStringDefaultField :: Maybe FieldName
1276− , queryStringOperator :: Maybe BooleanOperator
1277− , queryStringAnalyzer :: Maybe Analyzer
1278− , queryStringAllowLeadingWildcard :: Maybe AllowLeadingWildcard
1279− , queryStringLowercaseExpanded :: Maybe LowercaseExpanded
1280− , queryStringEnablePositionIncrements :: Maybe EnablePositionIncrements
1281− , queryStringFuzzyMaxExpansions :: Maybe MaxExpansions
1282− , queryStringFuzziness :: Maybe Fuzziness
1283− , queryStringFuzzyPrefixLength :: Maybe PrefixLength
1284− , queryStringPhraseSlop :: Maybe PhraseSlop
1285− , queryStringBoost :: Maybe Boost
1286− , queryStringAnalyzeWildcard :: Maybe AnalyzeWildcard
1287− , queryStringGeneratePhraseQueries :: Maybe GeneratePhraseQueries
1288− , queryStringMinimumShouldMatch :: Maybe MinimumMatch
1289− , queryStringLenient :: Maybe Lenient
1290− , queryStringLocale :: Maybe Locale
1291− } deriving (Eq, Read, Show, Generic, Typeable)
1292−
1293−mkQueryStringQuery :: QueryString -> QueryStringQuery
1294−mkQueryStringQuery qs =
1295− QueryStringQuery qs Nothing Nothing
1296− Nothing Nothing Nothing Nothing
1297− Nothing Nothing Nothing Nothing
1298− Nothing Nothing Nothing Nothing
1299− Nothing Nothing
1300−
1301−data FieldOrFields = FofField FieldName
1302− | FofFields (NonEmpty FieldName) deriving (Eq, Read, Show, Generic, Typeable)
1303−
1304−data PrefixQuery =
1305− PrefixQuery
1306− { prefixQueryField :: FieldName
1307− , prefixQueryPrefixValue :: Text
1308− , prefixQueryBoost :: Maybe Boost } deriving (Eq, Read, Show, Generic, Typeable)
1309−
1310−data NestedQuery =
1311− NestedQuery
1312− { nestedQueryPath :: QueryPath
1313− , nestedQueryScoreType :: ScoreType
1314− , nestedQuery :: Query } deriving (Eq, Read, Show, Generic, Typeable)
1315−
1316−data MoreLikeThisFieldQuery =
1317− MoreLikeThisFieldQuery
1318− { moreLikeThisFieldText :: Text
1319− , moreLikeThisFieldFields :: FieldName
1320− -- default 0.3 (30%)
1321− , moreLikeThisFieldPercentMatch :: Maybe PercentMatch
1322− , moreLikeThisFieldMinimumTermFreq :: Maybe MinimumTermFrequency
1323− , moreLikeThisFieldMaxQueryTerms :: Maybe MaxQueryTerms
1324− , moreLikeThisFieldStopWords :: Maybe (NonEmpty StopWord)
1325− , moreLikeThisFieldMinDocFrequency :: Maybe MinDocFrequency
1326− , moreLikeThisFieldMaxDocFrequency :: Maybe MaxDocFrequency
1327− , moreLikeThisFieldMinWordLength :: Maybe MinWordLength
1328− , moreLikeThisFieldMaxWordLength :: Maybe MaxWordLength
1329− , moreLikeThisFieldBoostTerms :: Maybe BoostTerms
1330− , moreLikeThisFieldBoost :: Maybe Boost
1331− , moreLikeThisFieldAnalyzer :: Maybe Analyzer
1332− } deriving (Eq, Read, Show, Generic, Typeable)
1333−
1334−data MoreLikeThisQuery =
1335− MoreLikeThisQuery
1336− { moreLikeThisText :: Text
1337− , moreLikeThisFields :: Maybe (NonEmpty FieldName)
1338− -- default 0.3 (30%)
1339− , moreLikeThisPercentMatch :: Maybe PercentMatch
1340− , moreLikeThisMinimumTermFreq :: Maybe MinimumTermFrequency
1341− , moreLikeThisMaxQueryTerms :: Maybe MaxQueryTerms
1342− , moreLikeThisStopWords :: Maybe (NonEmpty StopWord)
1343− , moreLikeThisMinDocFrequency :: Maybe MinDocFrequency
1344− , moreLikeThisMaxDocFrequency :: Maybe MaxDocFrequency
1345− , moreLikeThisMinWordLength :: Maybe MinWordLength
1346− , moreLikeThisMaxWordLength :: Maybe MaxWordLength
1347− , moreLikeThisBoostTerms :: Maybe BoostTerms
1348− , moreLikeThisBoost :: Maybe Boost
1349− , moreLikeThisAnalyzer :: Maybe Analyzer
1350− } deriving (Eq, Read, Show, Generic, Typeable)
1351−
1352−data IndicesQuery =
1353− IndicesQuery
1354− { indicesQueryIndices :: [IndexName]
1355− , indicesQuery :: Query
1356− -- default "all"
1357− , indicesQueryNoMatch :: Maybe Query } deriving (Eq, Read, Show, Generic, Typeable)
1358−
1359−data HasParentQuery =
1360− HasParentQuery
1361− { hasParentQueryType :: TypeName
1362− , hasParentQuery :: Query
1363− , hasParentQueryScoreType :: Maybe ScoreType } deriving (Eq, Read, Show, Generic, Typeable)
1364−
1365−data HasChildQuery =
1366− HasChildQuery
1367− { hasChildQueryType :: TypeName
1368− , hasChildQuery :: Query
1369− , hasChildQueryScoreType :: Maybe ScoreType } deriving (Eq, Read, Show, Generic, Typeable)
1370−
1371−data ScoreType =
1372− ScoreTypeMax
1373− | ScoreTypeSum
1374− | ScoreTypeAvg
1375− | ScoreTypeNone deriving (Eq, Read, Show, Generic, Typeable)
1376−
1377−data FuzzyQuery =
1378− FuzzyQuery { fuzzyQueryField :: FieldName
1379− , fuzzyQueryValue :: Text
1380− , fuzzyQueryPrefixLength :: PrefixLength
1381− , fuzzyQueryMaxExpansions :: MaxExpansions
1382− , fuzzyQueryFuzziness :: Fuzziness
1383− , fuzzyQueryBoost :: Maybe Boost
1384− } deriving (Eq, Read, Show, Generic, Typeable)
1385−
1386−data FuzzyLikeFieldQuery =
1387− FuzzyLikeFieldQuery
1388− { fuzzyLikeField :: FieldName
1389− -- anaphora is good for the soul.
1390− , fuzzyLikeFieldText :: Text
1391− , fuzzyLikeFieldMaxQueryTerms :: MaxQueryTerms
1392− , fuzzyLikeFieldIgnoreTermFrequency :: IgnoreTermFrequency
1393− , fuzzyLikeFieldFuzziness :: Fuzziness
1394− , fuzzyLikeFieldPrefixLength :: PrefixLength
1395− , fuzzyLikeFieldBoost :: Boost
1396− , fuzzyLikeFieldAnalyzer :: Maybe Analyzer
1397− } deriving (Eq, Read, Show, Generic, Typeable)
1398−
1399−data FuzzyLikeThisQuery =
1400− FuzzyLikeThisQuery
1401− { fuzzyLikeFields :: [FieldName]
1402− , fuzzyLikeText :: Text
1403− , fuzzyLikeMaxQueryTerms :: MaxQueryTerms
1404− , fuzzyLikeIgnoreTermFrequency :: IgnoreTermFrequency
1405− , fuzzyLikeFuzziness :: Fuzziness
1406− , fuzzyLikePrefixLength :: PrefixLength
1407− , fuzzyLikeBoost :: Boost
1408− , fuzzyLikeAnalyzer :: Maybe Analyzer
1409− } deriving (Eq, Read, Show, Generic, Typeable)
1410−
1411−data FilteredQuery =
1412− FilteredQuery
1413− { filteredQuery :: Query
1414− , filteredFilter :: Filter } deriving (Eq, Read, Show, Generic, Typeable)
1415−
1416−data DisMaxQuery =
1417− DisMaxQuery { disMaxQueries :: [Query]
1418− -- default 0.0
1419− , disMaxTiebreaker :: Tiebreaker
1420− , disMaxBoost :: Maybe Boost
1421− } deriving (Eq, Read, Show, Generic, Typeable)
1422−
1423−data MatchQuery =
1424− MatchQuery { matchQueryField :: FieldName
1425− , matchQueryQueryString :: QueryString
1426− , matchQueryOperator :: BooleanOperator
1427− , matchQueryZeroTerms :: ZeroTermsQuery
1428− , matchQueryCutoffFrequency :: Maybe CutoffFrequency
1429− , matchQueryMatchType :: Maybe MatchQueryType
1430− , matchQueryAnalyzer :: Maybe Analyzer
1431− , matchQueryMaxExpansions :: Maybe MaxExpansions
1432− , matchQueryLenient :: Maybe Lenient
1433− , matchQueryBoost :: Maybe Boost } deriving (Eq, Read, Show, Generic, Typeable)
1434−
1435−{-| 'mkMatchQuery' is a convenience function that defaults the less common parameters,
1436− enabling you to provide only the 'FieldName' and 'QueryString' to make a 'MatchQuery'
1437−-}
1438−mkMatchQuery :: FieldName -> QueryString -> MatchQuery
1439−mkMatchQuery field query = MatchQuery field query Or ZeroTermsNone Nothing Nothing Nothing Nothing Nothing Nothing
1440−
1441−data MatchQueryType =
1442− MatchPhrase
1443− | MatchPhrasePrefix deriving (Eq, Read, Show, Generic, Typeable)
1444−
1445−data MultiMatchQuery =
1446− MultiMatchQuery { multiMatchQueryFields :: [FieldName]
1447− , multiMatchQueryString :: QueryString
1448− , multiMatchQueryOperator :: BooleanOperator
1449− , multiMatchQueryZeroTerms :: ZeroTermsQuery
1450− , multiMatchQueryTiebreaker :: Maybe Tiebreaker
1451− , multiMatchQueryType :: Maybe MultiMatchQueryType
1452− , multiMatchQueryCutoffFrequency :: Maybe CutoffFrequency
1453− , multiMatchQueryAnalyzer :: Maybe Analyzer
1454− , multiMatchQueryMaxExpansions :: Maybe MaxExpansions
1455− , multiMatchQueryLenient :: Maybe Lenient } deriving (Eq, Read, Show, Generic, Typeable)
1456−
1457−{-| 'mkMultiMatchQuery' is a convenience function that defaults the less common parameters,
1458− enabling you to provide only the list of 'FieldName's and 'QueryString' to
1459− make a 'MultiMatchQuery'.
1460−-}
1461−
1462−mkMultiMatchQuery :: [FieldName] -> QueryString -> MultiMatchQuery
1463−mkMultiMatchQuery matchFields query =
1464− MultiMatchQuery matchFields query
1465− Or ZeroTermsNone Nothing Nothing Nothing Nothing Nothing Nothing
1466−
1467−data MultiMatchQueryType =
1468− MultiMatchBestFields
1469− | MultiMatchMostFields
1470− | MultiMatchCrossFields
1471− | MultiMatchPhrase
1472− | MultiMatchPhrasePrefix deriving (Eq, Read, Show, Generic, Typeable)
1473−
1474−data BoolQuery =
1475− BoolQuery { boolQueryMustMatch :: [Query]
1476− , boolQueryMustNotMatch :: [Query]
1477− , boolQueryShouldMatch :: [Query]
1478− , boolQueryMinimumShouldMatch :: Maybe MinimumMatch
1479− , boolQueryBoost :: Maybe Boost
1480− , boolQueryDisableCoord :: Maybe DisableCoord
1481− } deriving (Eq, Read, Show, Generic, Typeable)
1482−
1483−mkBoolQuery :: [Query] -> [Query] -> [Query] -> BoolQuery
1484−mkBoolQuery must mustNot should =
1485− BoolQuery must mustNot should Nothing Nothing Nothing
1486−
1487−data BoostingQuery =
1488− BoostingQuery { positiveQuery :: Query
1489− , negativeQuery :: Query
1490− , negativeBoost :: Boost } deriving (Eq, Read, Show, Generic, Typeable)
1491−
1492−data CommonTermsQuery =
1493− CommonTermsQuery { commonField :: FieldName
1494− , commonQuery :: QueryString
1495− , commonCutoffFrequency :: CutoffFrequency
1496− , commonLowFreqOperator :: BooleanOperator
1497− , commonHighFreqOperator :: BooleanOperator
1498− , commonMinimumShouldMatch :: Maybe CommonMinimumMatch
1499− , commonBoost :: Maybe Boost
1500− , commonAnalyzer :: Maybe Analyzer
1501− , commonDisableCoord :: Maybe DisableCoord
1502− } deriving (Eq, Read, Show, Generic, Typeable)
1503−
1504−data CommonMinimumMatch =
1505− CommonMinimumMatchHighLow MinimumMatchHighLow
1506− | CommonMinimumMatch MinimumMatch
1507− deriving (Eq, Read, Show, Generic, Typeable)
1508−
1509−data MinimumMatchHighLow =
1510− MinimumMatchHighLow { lowFreq :: MinimumMatch
1511− , highFreq :: MinimumMatch } deriving (Eq, Read, Show, Generic, Typeable)
1512−
1513−data Filter = AndFilter [Filter] Cache
1514− | OrFilter [Filter] Cache
1515− | NotFilter Filter Cache
1516− | IdentityFilter
1517− | BoolFilter BoolMatch
1518− | ExistsFilter FieldName -- always cached
1519− | GeoBoundingBoxFilter GeoBoundingBoxConstraint
1520− | GeoDistanceFilter GeoPoint Distance DistanceType OptimizeBbox Cache
1521− | GeoDistanceRangeFilter GeoPoint DistanceRange
1522− | GeoPolygonFilter FieldName [LatLon]
1523− | IdsFilter MappingName [DocId]
1524− | LimitFilter Int
1525− | MissingFilter FieldName Existence NullValue
1526− | PrefixFilter FieldName PrefixValue Cache
1527− | QueryFilter Query Cache
1528− | RangeFilter FieldName RangeValue RangeExecution Cache
1529− | RegexpFilter FieldName Regexp RegexpFlags CacheName Cache CacheKey
1530− | TermFilter Term Cache
1531− deriving (Eq, Read, Show, Generic, Typeable)
1532−
1533−data ZeroTermsQuery = ZeroTermsNone
1534− | ZeroTermsAll deriving (Eq, Read, Show, Generic, Typeable)
1535−
1536−data RangeExecution = RangeExecutionIndex
1537− | RangeExecutionFielddata deriving (Eq, Read, Show, Generic, Typeable)
1538−
1539−newtype Regexp = Regexp Text deriving (Eq, Read, Show, Generic, Typeable, FromJSON)
1540−
1541−data RegexpFlags = AllRegexpFlags
1542− | NoRegexpFlags
1543− | SomeRegexpFlags (NonEmpty RegexpFlag) deriving (Eq, Read, Show, Generic, Typeable)
1544−
1545−data RegexpFlag = AnyString
1546− | Automaton
1547− | Complement
1548− | Empty
1549− | Intersection
1550− | Interval deriving (Eq, Read, Show, Generic, Typeable)
1551−
1552−newtype LessThan = LessThan Double deriving (Eq, Read, Show, Generic, Typeable)
1553−newtype LessThanEq = LessThanEq Double deriving (Eq, Read, Show, Generic, Typeable)
1554−newtype GreaterThan = GreaterThan Double deriving (Eq, Read, Show, Generic, Typeable)
1555−newtype GreaterThanEq = GreaterThanEq Double deriving (Eq, Read, Show, Generic, Typeable)
1556−
1557−newtype LessThanD = LessThanD UTCTime deriving (Eq, Read, Show, Generic, Typeable)
1558−newtype LessThanEqD = LessThanEqD UTCTime deriving (Eq, Read, Show, Generic, Typeable)
1559−newtype GreaterThanD = GreaterThanD UTCTime deriving (Eq, Read, Show, Generic, Typeable)
1560−newtype GreaterThanEqD = GreaterThanEqD UTCTime deriving (Eq, Read, Show, Generic, Typeable)
1561−
1562−data RangeValue = RangeDateLte LessThanEqD
1563− | RangeDateLt LessThanD
1564− | RangeDateGte GreaterThanEqD
1565− | RangeDateGt GreaterThanD
1566− | RangeDateGtLt GreaterThanD LessThanD
1567− | RangeDateGteLte GreaterThanEqD LessThanEqD
1568− | RangeDateGteLt GreaterThanEqD LessThanD
1569− | RangeDateGtLte GreaterThanD LessThanEqD
1570− | RangeDoubleLte LessThanEq
1571− | RangeDoubleLt LessThan
1572− | RangeDoubleGte GreaterThanEq
1573− | RangeDoubleGt GreaterThan
1574− | RangeDoubleGtLt GreaterThan LessThan
1575− | RangeDoubleGteLte GreaterThanEq LessThanEq
1576− | RangeDoubleGteLt GreaterThanEq LessThan
1577− | RangeDoubleGtLte GreaterThan LessThanEq
1578− deriving (Eq, Read, Show, Generic, Typeable)
1579−
1580−rangeValueToPair :: RangeValue -> [Pair]
1581−rangeValueToPair rv = case rv of
1582− RangeDateLte (LessThanEqD t) -> ["lte" .= t]
1583− RangeDateGte (GreaterThanEqD t) -> ["gte" .= t]
1584− RangeDateLt (LessThanD t) -> ["lt" .= t]
1585− RangeDateGt (GreaterThanD t) -> ["gt" .= t]
1586− RangeDateGteLte (GreaterThanEqD l) (LessThanEqD g) -> ["gte" .= l, "lte" .= g]
1587− RangeDateGtLte (GreaterThanD l) (LessThanEqD g) -> ["gt" .= l, "lte" .= g]
1588− RangeDateGteLt (GreaterThanEqD l) (LessThanD g) -> ["gte" .= l, "lt" .= g]
1589− RangeDateGtLt (GreaterThanD l) (LessThanD g) -> ["gt" .= l, "lt" .= g]
1590− RangeDoubleLte (LessThanEq t) -> ["lte" .= t]
1591− RangeDoubleGte (GreaterThanEq t) -> ["gte" .= t]
1592− RangeDoubleLt (LessThan t) -> ["lt" .= t]
1593− RangeDoubleGt (GreaterThan t) -> ["gt" .= t]
1594− RangeDoubleGteLte (GreaterThanEq l) (LessThanEq g) -> ["gte" .= l, "lte" .= g]
1595− RangeDoubleGtLte (GreaterThan l) (LessThanEq g) -> ["gt" .= l, "lte" .= g]
1596− RangeDoubleGteLt (GreaterThanEq l) (LessThan g) -> ["gte" .= l, "lt" .= g]
1597− RangeDoubleGtLt (GreaterThan l) (LessThan g) -> ["gt" .= l, "lt" .= g]
1598−
1599−data Term = Term { termField :: Text
1600− , termValue :: Text } deriving (Eq, Read, Show, Generic, Typeable)
1601−
1602−data BoolMatch = MustMatch Term Cache
1603− | MustNotMatch Term Cache
1604− | ShouldMatch [Term] Cache deriving (Eq, Read, Show, Generic, Typeable)
1605−
1606−-- "memory" or "indexed"
1607−data GeoFilterType = GeoFilterMemory
1608− | GeoFilterIndexed deriving (Eq, Read, Show, Generic, Typeable)
1609−
1610−data LatLon = LatLon { lat :: Double
1611− , lon :: Double } deriving (Eq, Read, Show, Generic, Typeable)
1612−
1613−data GeoBoundingBox =
1614− GeoBoundingBox { topLeft :: LatLon
1615− , bottomRight :: LatLon } deriving (Eq, Read, Show, Generic, Typeable)
1616−
1617−data GeoBoundingBoxConstraint =
1618− GeoBoundingBoxConstraint { geoBBField :: FieldName
1619− , constraintBox :: GeoBoundingBox
1620− , bbConstraintcache :: Cache
1621− , geoType :: GeoFilterType
1622− } deriving (Eq, Read, Show, Generic, Typeable)
1623−
1624−data GeoPoint =
1625− GeoPoint { geoField :: FieldName
1626− , latLon :: LatLon} deriving (Eq, Read, Show, Generic, Typeable)
1627−
1628−data DistanceUnit = Miles
1629− | Yards
1630− | Feet
1631− | Inches
1632− | Kilometers
1633− | Meters
1634− | Centimeters
1635− | Millimeters
1636− | NauticalMiles deriving (Eq, Read, Show, Generic, Typeable)
1637−
1638−data DistanceType = Arc
1639− | SloppyArc -- doesn't exist <1.0
1640− | Plane deriving (Eq, Read, Show, Generic, Typeable)
1641−
1642−data OptimizeBbox = OptimizeGeoFilterType GeoFilterType
1643− | NoOptimizeBbox deriving (Eq, Read, Show, Generic, Typeable)
1644−
1645−data Distance =
1646− Distance { coefficient :: Double
1647− , unit :: DistanceUnit } deriving (Eq, Read, Show, Generic, Typeable)
1648−
1649−data DistanceRange =
1650− DistanceRange { distanceFrom :: Distance
1651− , distanceTo :: Distance } deriving (Eq, Read, Show, Generic, Typeable)
1652−
1653−type TemplateQueryKey = Text
1654−type TemplateQueryValue = Text
1655−
1656−newtype TemplateQueryKeyValuePairs = TemplateQueryKeyValuePairs (HM.HashMap TemplateQueryKey TemplateQueryValue)
1657− deriving (Eq, Read, Show, Generic, Typeable)
1658−
1659−instance ToJSON TemplateQueryKeyValuePairs where
1660− toJSON (TemplateQueryKeyValuePairs x) = Object $ HM.map toJSON x
1661−
1662−instance FromJSON TemplateQueryKeyValuePairs where
1663− parseJSON (Object o) = pure . TemplateQueryKeyValuePairs $ HM.mapMaybe getValue o
1664− where getValue (String x) = Just x
1665− getValue _ = Nothing
1666− parseJSON _ = fail "error parsing TemplateQueryKeyValuePairs"
1667−
1668−data TemplateQueryInline =
1669− TemplateQueryInline { inline :: Query
1670− , params :: TemplateQueryKeyValuePairs
1671− }
1672− deriving (Eq, Read, Show, Generic, Typeable)
1673−
1674−instance ToJSON TemplateQueryInline where
1675− toJSON TemplateQueryInline{..} = object [ "query" .= inline
1676− , "params" .= params
1677− ]
1678−
1679−instance FromJSON TemplateQueryInline where
1680− parseJSON = withObject "TemplateQueryInline" parse
1681− where parse o = TemplateQueryInline
1682− <$> o .: "query"
1683− <*> o .: "params"
1684−
1685−data SearchResult a =
1686− SearchResult { took :: Int
1687− , timedOut :: Bool
1688− , shards :: ShardResult
1689− , searchHits :: SearchHits a
1690− , aggregations :: Maybe AggregationResults
1691− , scrollId :: Maybe ScrollId
1692− , suggest :: Maybe NamedSuggestionResponse -- ^ Only one Suggestion request / response per Search is supported.
1693− }
1694− deriving (Eq, Read, Show, Generic, Typeable)
1695−
1696−newtype ScrollId = ScrollId Text deriving (Eq, Read, Show, Generic, Ord, ToJSON, FromJSON)
1697−
1698−type Score = Maybe Double
1699−
1700−data SearchHits a =
1701− SearchHits { hitsTotal :: Int
1702− , maxScore :: Score
1703− , hits :: [Hit a] } deriving (Eq, Read, Show, Generic, Typeable)
1704−
1705−instance Semigroup (SearchHits a) where
1706− (SearchHits ta ma ha) <> (SearchHits tb mb hb) = SearchHits (ta + tb) (max ma mb) (ha <> hb)
1707−
1708−instance Monoid (SearchHits a) where
1709− mempty = SearchHits 0 Nothing mempty
1710− mappend = (<>)
1711−
1712−data Hit a =
1713− Hit { hitIndex :: IndexName
1714− , hitType :: MappingName
1715− , hitDocId :: DocId
1716− , hitScore :: Score
1717− , hitSource :: Maybe a
1718− , hitHighlight :: Maybe HitHighlight } deriving (Eq, Read, Show, Generic, Typeable)
1719−
1720−data ShardResult =
1721− ShardResult { shardTotal :: Int
1722− , shardsSuccessful :: Int
1723− , shardsFailed :: Int } deriving (Eq, Read, Show, Generic, Typeable)
1724−
1725−type HitHighlight = M.Map Text [Text]
1726−
1727−showText :: Show a => a -> Text
1728−showText = T.pack . show
1729−
1730−readMay :: Read a => String -> Maybe a
1731−readMay s = case reads s of
1732− (a, ""):_ -> Just a
1733− _ -> Nothing
1734−
1735−parseReadText :: Read a => Text -> Parser a
1736−parseReadText = maybe mzero return . readMay . T.unpack
1737−
1738−type Aggregations = M.Map Text Aggregation
1739−
1740−emptyAggregations :: Aggregations
1741−emptyAggregations = M.empty
1742−
1743−mkAggregations :: Text -> Aggregation -> Aggregations
1744−mkAggregations name aggregation = M.insert name aggregation emptyAggregations
1745−
1746−data TermOrder = TermOrder{ termSortField :: Text
1747− , termSortOrder :: SortOrder } deriving (Eq, Read, Show, Generic, Typeable)
1748−
1749−data TermInclusion = TermInclusion Text
1750− | TermPattern Text Text deriving (Eq, Read, Show, Generic, Typeable)
1751−
1752−data CollectionMode = BreadthFirst
1753− | DepthFirst deriving (Eq, Read, Show, Generic, Typeable)
1754−
1755−data ExecutionHint = Ordinals
1756− | GlobalOrdinals
1757− | GlobalOrdinalsHash
1758− | GlobalOrdinalsLowCardinality
1759− | Map deriving (Eq, Read, Show, Generic, Typeable)
1760−
1761−data TimeInterval = Weeks
1762− | Days
1763− | Hours
1764− | Minutes
1765− | Seconds deriving Eq
1766−
1767−data Interval = Year
1768− | Quarter
1769− | Month
1770− | Week
1771− | Day
1772− | Hour
1773− | Minute
1774− | Second
1775− | FractionalInterval Float TimeInterval deriving (Eq, Read, Show, Generic, Typeable)
1776−
1777−data Aggregation = TermsAgg TermsAggregation
1778− | CardinalityAgg CardinalityAggregation
1779− | DateHistogramAgg DateHistogramAggregation
1780− | ValueCountAgg ValueCountAggregation
1781− | FilterAgg FilterAggregation
1782− | DateRangeAgg DateRangeAggregation
1783− | MissingAgg MissingAggregation
1784− | TopHitsAgg TopHitsAggregation
1785− deriving (Eq, Read, Show, Generic, Typeable)
1786−
1787−data TopHitsAggregation = TopHitsAggregation
1788− { taFrom :: Maybe From
1789− , taSize :: Maybe Size
1790− , taSort :: Maybe Sort
1791− } deriving (Eq, Read, Show)
1792−
1793−data MissingAggregation = MissingAggregation
1794− { maField :: Text
1795− } deriving (Eq, Read, Show, Generic, Typeable)
1796−
1797−data TermsAggregation = TermsAggregation { term :: Either Text Text
1798− , termInclude :: Maybe TermInclusion
1799− , termExclude :: Maybe TermInclusion
1800− , termOrder :: Maybe TermOrder
1801− , termMinDocCount :: Maybe Int
1802− , termSize :: Maybe Int
1803− , termShardSize :: Maybe Int
1804− , termCollectMode :: Maybe CollectionMode
1805− , termExecutionHint :: Maybe ExecutionHint
1806− , termAggs :: Maybe Aggregations
1807− } deriving (Eq, Read, Show, Generic, Typeable)
1808−
1809−data CardinalityAggregation = CardinalityAggregation { cardinalityField :: FieldName,
1810− precisionThreshold :: Maybe Int
1811− } deriving (Eq, Read, Show, Generic, Typeable)
1812−
1813−data DateHistogramAggregation = DateHistogramAggregation { dateField :: FieldName
1814− , dateInterval :: Interval
1815− , dateFormat :: Maybe Text
1816− -- pre and post deprecated in 1.5
1817− , datePreZone :: Maybe Text
1818− , datePostZone :: Maybe Text
1819− , datePreOffset :: Maybe Text
1820− , datePostOffset :: Maybe Text
1821− , dateAggs :: Maybe Aggregations
1822− } deriving (Eq, Read, Show, Generic, Typeable)
1823−
1824−
1825−data DateRangeAggregation = DateRangeAggregation { draField :: FieldName
1826− , draFormat :: Maybe Text
1827− , draRanges :: NonEmpty DateRangeAggRange
1828− } deriving (Eq, Read, Show, Generic, Typeable)
1829−
1830−data DateRangeAggRange = DateRangeFrom DateMathExpr
1831− | DateRangeTo DateMathExpr
1832− | DateRangeFromAndTo DateMathExpr DateMathExpr deriving (Eq, Read, Show, Generic, Typeable)
1833−
1834−-- | See <https://www.elastic.co/guide/en/elasticsearch/reference/current/common-options.html#date-math> for more information.
1835−data DateMathExpr = DateMathExpr DateMathAnchor [DateMathModifier] deriving (Eq, Read, Show, Generic, Typeable)
1836−
1837−
1838−-- | Starting point for a date range. This along with the 'DateMathModifiers' gets you the date ES will start from.
1839−data DateMathAnchor = DMNow
1840− | DMDate Day deriving (Eq, Read, Show, Generic, Typeable)
1841−
1842−data DateMathModifier = AddTime Int DateMathUnit
1843− | SubtractTime Int DateMathUnit
1844− | RoundDownTo DateMathUnit deriving (Eq, Read, Show, Generic, Typeable)
1845−
1846−data DateMathUnit = DMYear
1847− | DMMonth
1848− | DMWeek
1849− | DMDay
1850− | DMHour
1851− | DMMinute
1852− | DMSecond deriving (Eq, Read, Show, Generic, Typeable)
1853−
1854−-- | See <https://www.elastic.co/guide/en/elasticsearch/reference/current/search-aggregations-metrics-valuecount-aggregation.html> for more information.
1855−data ValueCountAggregation = FieldValueCount FieldName
1856− | ScriptValueCount Script deriving (Eq, Read, Show, Generic, Typeable)
1857−
1858−-- | Single-bucket filter aggregations. See <https://www.elastic.co/guide/en/elasticsearch/reference/current/search-aggregations-bucket-filter-aggregation.html#search-aggregations-bucket-filter-aggregation> for more information.
1859−data FilterAggregation = FilterAggregation { faFilter :: Filter
1860− , faAggs :: Maybe Aggregations} deriving (Eq, Read, Show, Generic, Typeable)
1861−
1862−mkTermsAggregation :: Text -> TermsAggregation
1863−mkTermsAggregation t = TermsAggregation (Left t) Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing
1864−
1865−mkTermsScriptAggregation :: Text -> TermsAggregation
1866−mkTermsScriptAggregation t = TermsAggregation (Right t) Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing
1867−
1868−mkDateHistogram :: FieldName -> Interval -> DateHistogramAggregation
1869−mkDateHistogram t i = DateHistogramAggregation t i Nothing Nothing Nothing Nothing Nothing Nothing
1870−
1871−mkCardinalityAggregation :: FieldName -> CardinalityAggregation
1872−mkCardinalityAggregation t = CardinalityAggregation t Nothing
1873−
1874−instance ToJSON Version where
1875− toJSON Version {..} = object ["number" .= number
1876− ,"build_hash" .= build_hash
1877− ,"build_timestamp" .= build_timestamp
1878− ,"build_snapshot" .= build_snapshot
1879− ,"lucene_version" .= lucene_version]
1880−
1881−instance FromJSON Version where
1882− parseJSON = withObject "Version" parse
1883− where parse o = Version
1884− <$> o .: "number"
1885− <*> o .: "build_hash"
1886− <*> o .: "build_timestamp"
1887− <*> o .: "build_snapshot"
1888− <*> o .: "lucene_version"
1889−
1890−instance ToJSON VersionNumber where
1891− toJSON = toJSON . Vers.showVersion . versionNumber
1892−
1893−instance FromJSON VersionNumber where
1894− parseJSON = withText "VersionNumber" (parse . T.unpack)
1895− where
1896− parse s = case filter (null . snd)(RP.readP_to_S Vers.parseVersion s) of
1897− [(v, _)] -> pure (VersionNumber v)
1898− [] -> fail ("Invalid version string " ++ s)
1899− xs -> fail ("Ambiguous version string " ++ s ++ " (" ++ intercalate ", " (Vers.showVersion . fst <$> xs) ++ ")")
1900−
1901−instance ToJSON TermOrder where
1902− toJSON (TermOrder termSortField termSortOrder) = object [termSortField .= termSortOrder]
1903−
1904−instance ToJSON TermInclusion where
1905− toJSON (TermInclusion x) = toJSON x
1906− toJSON (TermPattern pattern flags) = omitNulls [ "pattern" .= pattern,
1907− "flags" .= flags]
1908−
1909−instance ToJSON CollectionMode where
1910− toJSON BreadthFirst = "breadth_first"
1911− toJSON DepthFirst = "depth_first"
1912−
1913−instance ToJSON ExecutionHint where
1914− toJSON Ordinals = "ordinals"
1915− toJSON GlobalOrdinals = "global_ordinals"
1916− toJSON GlobalOrdinalsHash = "global_ordinals_hash"
1917− toJSON GlobalOrdinalsLowCardinality = "global_ordinals_low_cardinality"
1918− toJSON Map = "map"
1919−
1920−instance ToJSON Interval where
1921− toJSON Year = "year"
1922− toJSON Quarter = "quarter"
1923− toJSON Month = "month"
1924− toJSON Week = "week"
1925− toJSON Day = "day"
1926− toJSON Hour = "hour"
1927− toJSON Minute = "minute"
1928− toJSON Second = "second"
1929− toJSON (FractionalInterval fraction interval) = toJSON $ show fraction ++ show interval
1930−
1931−instance Show TimeInterval where
1932− show Weeks = "w"
1933− show Days = "d"
1934− show Hours = "h"
1935− show Minutes = "m"
1936− show Seconds = "s"
1937−
1938−instance Read TimeInterval where
1939− readPrec = f =<< TR.get
1940− where
1941− f 'w' = return Weeks
1942− f 'd' = return Days
1943− f 'h' = return Hours
1944− f 'm' = return Minutes
1945− f 's' = return Seconds
1946− f _ = fail "TimeInterval expected one of w, d, h, m, s"
1947−
1948−instance ToJSON Aggregation where
1949− toJSON (TermsAgg (TermsAggregation term include exclude order minDocCount size shardSize collectMode executionHint termAggs)) =
1950− omitNulls ["terms" .= omitNulls [ toJSON' term,
1951− "include" .= include,
1952− "exclude" .= exclude,
1953− "order" .= order,
1954− "min_doc_count" .= minDocCount,
1955− "size" .= size,
1956− "shard_size" .= shardSize,
1957− "collect_mode" .= collectMode,
1958− "execution_hint" .= executionHint
1959− ],
1960− "aggs" .= termAggs ]
1961− where
1962− toJSON' x = case x of { Left y -> "field" .= y; Right y -> "script" .= y }
1963−
1964− toJSON (CardinalityAgg (CardinalityAggregation field precisionThreshold)) =
1965− object ["cardinality" .= omitNulls [ "field" .= field,
1966− "precisionThreshold" .= precisionThreshold
1967− ]
1968− ]
1969−
1970− toJSON (DateHistogramAgg (DateHistogramAggregation field interval format preZone postZone preOffset postOffset dateHistoAggs)) =
1971− omitNulls ["date_histogram" .= omitNulls [ "field" .= field,
1972− "interval" .= interval,
1973− "format" .= format,
1974− "pre_zone" .= preZone,
1975− "post_zone" .= postZone,
1976− "pre_offset" .= preOffset,
1977− "post_offset" .= postOffset
1978− ],
1979− "aggs" .= dateHistoAggs ]
1980− toJSON (ValueCountAgg a) = object ["value_count" .= v]
1981− where v = case a of
1982− (FieldValueCount (FieldName n)) -> object ["field" .= n]
1983− (ScriptValueCount (Script s)) -> object ["script" .= s]
1984− toJSON (FilterAgg (FilterAggregation filt ags)) =
1985− omitNulls [ "filter" .= filt
1986− , "aggs" .= ags]
1987− toJSON (DateRangeAgg a) = object [ "date_range" .= a
1988− ]
1989− toJSON (MissingAgg (MissingAggregation{..})) =
1990− object ["missing" .= object ["field" .= maField]]
1991−
1992− toJSON (TopHitsAgg (TopHitsAggregation mfrom msize msort)) =
1993− omitNulls ["top_hits" .= omitNulls [ "size" .= msize
1994− , "from" .= mfrom
1995− , "sort" .= msort
1996− ]
1997− ]
1998−
1999−instance ToJSON DateRangeAggregation where
2000− toJSON DateRangeAggregation {..} =
2001− omitNulls [ "field" .= draField
2002− , "format" .= draFormat
2003− , "ranges" .= toList draRanges
2004− ]
2005−
2006−instance ToJSON DateRangeAggRange where
2007− toJSON (DateRangeFrom e) = object [ "from" .= e ]
2008− toJSON (DateRangeTo e) = object [ "to" .= e ]
2009− toJSON (DateRangeFromAndTo f t) = object [ "from" .= f, "to" .= t ]
2010−
2011−instance ToJSON DateMathExpr where
2012− toJSON (DateMathExpr a mods) = String (fmtA a <> mconcat (fmtMod <$> mods))
2013− where fmtA DMNow = "now"
2014− fmtA (DMDate date) = (T.pack $ showGregorian date) <> "||"
2015− fmtMod (AddTime n u) = "+" <> showText n <> fmtU u
2016− fmtMod (SubtractTime n u) = "-" <> showText n <> fmtU u
2017− fmtMod (RoundDownTo u) = "/" <> fmtU u
2018− fmtU DMYear = "y"
2019− fmtU DMMonth = "M"
2020− fmtU DMWeek = "w"
2021− fmtU DMDay = "d"
2022− fmtU DMHour = "h"
2023− fmtU DMMinute = "m"
2024− fmtU DMSecond = "s"
2025−
2026−
2027−type AggregationResults = M.Map Text Value
2028−
2029−class BucketAggregation a where
2030− key :: a -> BucketValue
2031− docCount :: a -> Int
2032− aggs :: a -> Maybe AggregationResults
2033−
2034−
2035−data Bucket a = Bucket { buckets :: [a]} deriving (Read, Show)
2036−
2037−data BucketValue = TextValue Text
2038− | ScientificValue Scientific
2039− | BoolValue Bool deriving (Read, Show)
2040−
2041−data MissingResult = MissingResult { missingDocCount :: Int } deriving (Show)
2042−
2043−data TopHitResult a = TopHitResult { tarHits :: (SearchHits a)
2044− } deriving Show
2045−
2046−data TermsResult = TermsResult { termKey :: BucketValue
2047− , termsDocCount :: Int
2048− , termsAggs :: Maybe AggregationResults } deriving (Read, Show)
2049−
2050−data DateHistogramResult = DateHistogramResult { dateKey :: Int
2051− , dateKeyStr :: Maybe Text
2052− , dateDocCount :: Int
2053− , dateHistogramAggs :: Maybe AggregationResults } deriving (Read, Show)
2054−
2055−data DateRangeResult = DateRangeResult { dateRangeKey :: Text
2056− , dateRangeFrom :: Maybe UTCTime
2057− , dateRangeFromAsString :: Maybe Text
2058− , dateRangeTo :: Maybe UTCTime
2059− , dateRangeToAsString :: Maybe Text
2060− , dateRangeDocCount :: Int
2061− , dateRangeAggs :: Maybe AggregationResults } deriving (Read, Show, Eq, Generic, Typeable)
2062−
2063−toTerms :: Text -> AggregationResults -> Maybe (Bucket TermsResult)
2064−toTerms = toAggResult
2065−
2066−toDateHistogram :: Text -> AggregationResults -> Maybe (Bucket DateHistogramResult)
2067−toDateHistogram = toAggResult
2068−
2069−toMissing :: Text -> AggregationResults -> Maybe MissingResult
2070−toMissing = toAggResult
2071−
2072−toTopHits :: (FromJSON a) => Text -> AggregationResults -> Maybe (TopHitResult a)
2073−toTopHits = toAggResult
2074−
2075−toAggResult :: (FromJSON a) => Text -> AggregationResults -> Maybe a
2076−toAggResult t a = M.lookup t a >>= deserialize
2077− where deserialize = parseMaybe parseJSON
2078−
2079−instance BucketAggregation TermsResult where
2080− key = termKey
2081− docCount = termsDocCount
2082− aggs = termsAggs
2083−
2084−instance BucketAggregation DateHistogramResult where
2085− key = TextValue . showText . dateKey
2086− docCount = dateDocCount
2087− aggs = dateHistogramAggs
2088−
2089−instance BucketAggregation DateRangeResult where
2090− key = TextValue . dateRangeKey
2091− docCount = dateRangeDocCount
2092− aggs = dateRangeAggs
2093−
2094−instance (FromJSON a) => FromJSON (Bucket a) where
2095− parseJSON (Object v) = Bucket <$>
2096− v .: "buckets"
2097− parseJSON _ = mempty
2098−
2099−instance FromJSON BucketValue where
2100− parseJSON (String t) = return $ TextValue t
2101− parseJSON (Number s) = return $ ScientificValue s
2102− parseJSON (Bool b) = return $ BoolValue b
2103− parseJSON _ = mempty
2104−
2105−instance FromJSON MissingResult where
2106− parseJSON = withObject "MissingResult" parse
2107− where parse v = MissingResult <$> v .: "doc_count"
2108−
2109−instance FromJSON TermsResult where
2110− parseJSON (Object v) = TermsResult <$>
2111− v .: "key" <*>
2112− v .: "doc_count" <*>
2113− (pure $ getNamedSubAgg v ["key", "doc_count"])
2114− parseJSON _ = mempty
2115−
2116−instance FromJSON DateHistogramResult where
2117− parseJSON (Object v) = DateHistogramResult <$>
2118− v .: "key" <*>
2119− v .:? "key_as_string" <*>
2120− v .: "doc_count" <*>
2121− (pure $ getNamedSubAgg v [ "key"
2122− , "doc_count"
2123− , "key_as_string"
2124− ]
2125− )
2126− parseJSON _ = mempty
2127−
2128−instance FromJSON DateRangeResult where
2129− parseJSON = withObject "DateRangeResult" parse
2130− where parse v = DateRangeResult <$>
2131− v .: "key" <*>
2132− (fmap posixMS <$> v .:? "from") <*>
2133− v .:? "from_as_string" <*>
2134− (fmap posixMS <$> v .:? "to") <*>
2135− v .:? "to_as_string" <*>
2136− v .: "doc_count" <*>
2137− (pure $ getNamedSubAgg v [ "key"
2138− , "from"
2139− , "from_as_string"
2140− , "to"
2141− , "to_as_string"
2142− , "doc_count"
2143− ]
2144− )
2145−
2146−instance FromJSON POSIXMS where
2147− parseJSON = withScientific "POSIXMS" (return . parse)
2148− where parse n = let n' = truncate n :: Integer
2149− in POSIXMS (posixSecondsToUTCTime (fromInteger (n' `div` 1000)))
2150−
2151−instance (FromJSON a) => FromJSON (TopHitResult a) where
2152− parseJSON (Object v) = TopHitResult <$>
2153− v .: "hits"
2154− parseJSON _ = fail "Failure in FromJSON (TopHitResult a)"
2155−
2156−instance Semigroup Filter where
2157− a <> b = AndFilter [a, b] defaultCache
2158−
2159−instance Monoid Filter where
2160− mempty = IdentityFilter
2161− mappend = (<>)
2162−
2163−instance Seminearring Filter where
2164− a <||> b = OrFilter [a, b] defaultCache
2165−
2166−instance ToJSON Filter where
2167− toJSON (AndFilter filters cache) =
2168− object ["and" .=
2169− object [ "filters" .= fmap toJSON filters
2170− , "_cache" .= cache]]
2171−
2172− toJSON (OrFilter filters cache) =
2173− object ["or" .=
2174− object [ "filters" .= fmap toJSON filters
2175− , "_cache" .= cache]]
2176−
2177− toJSON (NotFilter notFilter cache) =
2178− object ["not" .=
2179− object ["filter" .= notFilter
2180− , "_cache" .= cache]]
2181−
2182− toJSON (IdentityFilter) =
2183− object ["match_all" .= object []]
2184−
2185− toJSON (TermFilter (Term termFilterField termFilterValue) cache) =
2186− object ["term" .= object base]
2187− where base = [termFilterField .= termFilterValue,
2188− "_cache" .= cache]
2189−
2190− toJSON (ExistsFilter (FieldName fieldName)) =
2191− object ["exists" .= object
2192− ["field" .= fieldName]]
2193−
2194− toJSON (BoolFilter boolMatch) =
2195− object ["bool" .= boolMatch]
2196−
2197− toJSON (GeoBoundingBoxFilter bbConstraint) =
2198− object ["geo_bounding_box" .= bbConstraint]
2199−
2200− toJSON (GeoDistanceFilter (GeoPoint (FieldName distanceGeoField) geoDistLatLon)
2201− distance distanceType optimizeBbox cache) =
2202− object ["geo_distance" .=
2203− object ["distance" .= distance
2204− , "distance_type" .= distanceType
2205− , "optimize_bbox" .= optimizeBbox
2206− , distanceGeoField .= geoDistLatLon
2207− , "_cache" .= cache]]
2208−
2209− toJSON (GeoDistanceRangeFilter (GeoPoint (FieldName gddrField) drLatLon)
2210− (DistanceRange geoDistRangeDistFrom drDistanceTo)) =
2211− object ["geo_distance_range" .=
2212− object ["from" .= geoDistRangeDistFrom
2213− , "to" .= drDistanceTo
2214− , gddrField .= drLatLon]]
2215−
2216− toJSON (GeoPolygonFilter (FieldName geoPolygonFilterField) latLons) =
2217− object ["geo_polygon" .=
2218− object [geoPolygonFilterField .=
2219− object ["points" .= fmap toJSON latLons]]]
2220−
2221− toJSON (IdsFilter (MappingName mappingName) values) =
2222− object ["ids" .=
2223− object ["type" .= mappingName
2224− , "values" .= fmap unpackId values]]
2225−
2226− toJSON (LimitFilter limit) =
2227− object ["limit" .= object ["value" .= limit]]
2228−
2229− toJSON (MissingFilter (FieldName fieldName) (Existence existence) (NullValue nullValue)) =
2230− object ["missing" .=
2231− object [ "field" .= fieldName
2232− , "existence" .= existence
2233− , "null_value" .= nullValue]]
2234−
2235− toJSON (PrefixFilter (FieldName fieldName) fieldValue cache) =
2236− object ["prefix" .=
2237− object [fieldName .= fieldValue
2238− , "_cache" .= cache]]
2239−
2240− toJSON (QueryFilter query False) =
2241− object ["query" .= toJSON query ]
2242− toJSON (QueryFilter query True) =
2243− object ["fquery" .=
2244− object [ "query" .= toJSON query
2245− , "_cache" .= True ]]
2246−
2247− toJSON (RangeFilter (FieldName fieldName) rangeValue rangeExecution cache) =
2248− object ["range" .=
2249− object [ fieldName .= object (rangeValueToPair rangeValue)
2250− , "execution" .= rangeExecution
2251− , "_cache" .= cache]]
2252−
2253− toJSON (RegexpFilter (FieldName fieldName)
2254− (Regexp regexText) flags (CacheName cacheName) cache (CacheKey cacheKey)) =
2255− object ["regexp" .=
2256− object [fieldName .=
2257− object ["value" .= regexText
2258− , "flags" .= flags]
2259− , "_name" .= cacheName
2260− , "_cache" .= cache
2261− , "_cache_key" .= cacheKey]]
2262−
2263−instance FromJSON Filter where
2264− parseJSON = withObject "Filter" parse
2265− where parse o = andFilter `taggedWith` "and"
2266− <|> orFilter `taggedWith` "or"
2267− <|> notFilter `taggedWith` "not"
2268− <|> identityFilter `taggedWith` "match_all"
2269− <|> boolFilter `taggedWith` "bool"
2270− <|> existsFilter `taggedWith` "exists"
2271− <|> geoBoundingBoxFilter `taggedWith` "geo_bounding_box"
2272− <|> geoDistanceFilter `taggedWith` "geo_distance"
2273− <|> geoDistanceRangeFilter `taggedWith` "geo_distance_range"
2274− <|> geoPolygonFilter `taggedWith` "geo_polygon"
2275− <|> idsFilter `taggedWith` "ids"
2276− <|> limitFilter `taggedWith` "limit"
2277− <|> missingFilter `taggedWith` "missing"
2278− <|> prefixFilter `taggedWith` "prefix"
2279− <|> queryFilter `taggedWith` "query"
2280− <|> fqueryFilter `taggedWith` "fquery"
2281− <|> rangeFilter `taggedWith` "range"
2282− <|> regexpFilter `taggedWith` "regexp"
2283− <|> termFilter `taggedWith` "term"
2284− where taggedWith parser k = parser =<< o .: k
2285− andFilter o = AndFilter <$> o .: "filters"
2286− <*> o .:? "_cache" .!= defaultCache
2287− orFilter o = OrFilter <$> o .: "filters"
2288− <*> o .:? "_cache" .!= defaultCache
2289− notFilter o = NotFilter <$> o .: "filter"
2290− <*> o .: "_cache" .!= defaultCache
2291− identityFilter :: Object -> Parser Filter
2292− identityFilter m
2293− | HM.null m = pure IdentityFilter
2294− | otherwise = fail ("Identityfilter expected empty object but got " <> show m)
2295− boolFilter = pure . BoolFilter
2296− existsFilter o = ExistsFilter <$> o .: "field"
2297− geoBoundingBoxFilter = pure . GeoBoundingBoxFilter
2298− geoDistanceFilter o = do
2299− case HM.toList (deleteSeveral ["distance", "distance_type", "optimize_bbox", "_cache"] o) of
2300− [(fn, v)] -> do
2301− gp <- GeoPoint (FieldName fn) <$> parseJSON v
2302− GeoDistanceFilter gp <$> o .: "distance"
2303− <*> o .: "distance_type"
2304− <*> o .: "optimize_bbox"
2305− <*> o .:? "_cache" .!= defaultCache
2306− _ -> fail "Could not find GeoDistanceFilter field name"
2307− geoDistanceRangeFilter o = do
2308− case HM.toList (deleteSeveral ["from", "to"] o) of
2309− [(fn, v)] -> do
2310− gp <- GeoPoint (FieldName fn) <$> parseJSON v
2311− rng <- DistanceRange <$> o .: "from" <*> o .: "to"
2312− return (GeoDistanceRangeFilter gp rng)
2313− _ -> fail "Could not find GeoDistanceRangeFilter field name"
2314− geoPolygonFilter = fieldTagged $ \fn o -> GeoPolygonFilter fn <$> o .: "points"
2315− idsFilter o = IdsFilter <$> o .: "type"
2316− <*> o .: "values"
2317− limitFilter o = LimitFilter <$> o .: "value"
2318− missingFilter o = MissingFilter <$> o .: "field"
2319− <*> o .: "existence"
2320− <*> o .: "null_value"
2321− prefixFilter o = case HM.toList (HM.delete "_cache" o) of
2322− [(fn, String v)] -> PrefixFilter (FieldName fn) v <$> o .:? "_cache" .!= defaultCache
2323− _ -> fail "Could not parse PrefixFilter"
2324−
2325− queryFilter q = pure (QueryFilter q False)
2326− fqueryFilter o = QueryFilter <$> o .: "query" <*> pure True
2327− rangeFilter o = case HM.toList (deleteSeveral ["execution", "_cache"] o) of
2328− [(fn, v)] -> RangeFilter (FieldName fn)
2329− <$> parseJSON v
2330− <*> o .: "execution"
2331− <*> o .:? "_cache" .!= defaultCache
2332− _ -> fail "Could not find field name for RangeFilter"
2333− regexpFilter o = case HM.toList (deleteSeveral ["_name", "_cache", "_cache_key"] o) of
2334− [(fn, Object o')] -> RegexpFilter (FieldName fn)
2335− <$> o' .: "value"
2336− <*> o' .: "flags"
2337− <*> o .: "_name"
2338− <*> o .:? "_cache" .!= defaultCache
2339− <*> o .: "_cache_key"
2340− _ -> fail "Could not find field name for RegexpFilter"
2341− termFilter o = case HM.toList (HM.delete "_cache" o) of
2342− [(termField, String termVal)] -> TermFilter (Term termField termVal)
2343− <$> o .:? "_cache" .!= defaultCache
2344− _ -> fail "Could not find term field for TermFilter"
2345−
2346−fieldTagged :: Monad m => (FieldName -> Object -> m a) -> Object -> m a
2347−fieldTagged f o = case HM.toList o of
2348− [(k, Object o')] -> f (FieldName k) o'
2349− _ -> fail "Expected object with 1 field-named key"
2350−
2351−-- Try to get an AggregationResults when we don't know the
2352−-- field name. We filter out the known keys to try to minimize the noise.
2353−getNamedSubAgg :: Object -> [Text] -> Maybe AggregationResults
2354−getNamedSubAgg o knownKeys = maggRes
2355− where unknownKeys = HM.filterWithKey (\k _ -> k `notElem` knownKeys) o
2356− maggRes
2357− | HM.null unknownKeys = Nothing
2358− | otherwise = Just . M.fromList $ HM.toList unknownKeys
2359−
2360−instance ToJSON GeoPoint where
2361− toJSON (GeoPoint (FieldName geoPointField) geoPointLatLon) =
2362− object [ geoPointField .= geoPointLatLon ]
2363−
2364−
2365−instance ToJSON Query where
2366− toJSON (TermQuery (Term termQueryField termQueryValue) boost) =
2367− object [ "term" .=
2368− object [termQueryField .= object merged]]
2369− where
2370− base = [ "value" .= termQueryValue ]
2371− boosted = maybe [] (return . ("boost" .=)) boost
2372− merged = mappend base boosted
2373−
2374− toJSON (TermsQuery fieldName terms) =
2375− object [ "terms" .= object conjoined ]
2376− where conjoined = [fieldName .= terms]
2377−
2378− toJSON (IdsQuery idsQueryMappingName docIds) =
2379− object [ "ids" .= object conjoined ]
2380− where conjoined = [ "type" .= idsQueryMappingName
2381− , "values" .= fmap toJSON docIds ]
2382−
2383− toJSON (QueryQueryStringQuery qQueryStringQuery) =
2384− object [ "query_string" .= qQueryStringQuery ]
2385−
2386− toJSON (QueryMatchQuery matchQuery) =
2387− object [ "match" .= matchQuery ]
2388−
2389− toJSON (QueryMultiMatchQuery multiMatchQuery) =
2390− toJSON multiMatchQuery
2391−
2392− toJSON (QueryBoolQuery boolQuery) =
2393− object [ "bool" .= boolQuery ]
2394−
2395− toJSON (QueryBoostingQuery boostingQuery) =
2396− object [ "boosting" .= boostingQuery ]
2397−
2398− toJSON (QueryCommonTermsQuery commonTermsQuery) =
2399− object [ "common" .= commonTermsQuery ]
2400−
2401− toJSON (ConstantScoreFilter csFilter boost) =
2402− object ["constant_score" .= object ["filter" .= csFilter
2403− , "boost" .= boost]]
2404−
2405− toJSON (ConstantScoreQuery query boost) =
2406− object ["constant_score" .= object ["query" .= query
2407− , "boost" .= boost]]
2408−
2409− toJSON (QueryDisMaxQuery disMaxQuery) =
2410− object [ "dis_max" .= disMaxQuery ]
2411−
2412− toJSON (QueryFilteredQuery qFilteredQuery) =
2413− object [ "filtered" .= qFilteredQuery ]
2414−
2415− toJSON (QueryFuzzyLikeThisQuery fuzzyQuery) =
2416− object [ "fuzzy_like_this" .= fuzzyQuery ]
2417−
2418− toJSON (QueryFuzzyLikeFieldQuery fuzzyFieldQuery) =
2419− object [ "fuzzy_like_this_field" .= fuzzyFieldQuery ]
2420−
2421− toJSON (QueryFuzzyQuery fuzzyQuery) =
2422− object [ "fuzzy" .= fuzzyQuery ]
2423−
2424− toJSON (QueryHasChildQuery childQuery) =
2425− object [ "has_child" .= childQuery ]
2426−
2427− toJSON (QueryHasParentQuery parentQuery) =
2428− object [ "has_parent" .= parentQuery ]
2429−
2430− toJSON (QueryIndicesQuery qIndicesQuery) =
2431− object [ "indices" .= qIndicesQuery ]
2432−
2433− toJSON (MatchAllQuery boost) =
2434− object [ "match_all" .= omitNulls [ "boost" .= boost ] ]
2435−
2436− toJSON (QueryMoreLikeThisQuery query) =
2437− object [ "more_like_this" .= query ]
2438−
2439− toJSON (QueryMoreLikeThisFieldQuery query) =
2440− object [ "more_like_this_field" .= query ]
2441−
2442− toJSON (QueryNestedQuery query) =
2443− object [ "nested" .= query ]
2444−
2445− toJSON (QueryPrefixQuery query) =
2446− object [ "prefix" .= query ]
2447−
2448− toJSON (QueryRangeQuery query) =
2449− object [ "range" .= query ]
2450−
2451− toJSON (QueryRegexpQuery query) =
2452− object [ "regexp" .= query ]
2453−
2454− toJSON (QuerySimpleQueryStringQuery query) =
2455− object [ "simple_query_string" .= query ]
2456−
2457− toJSON (QueryTemplateQueryInline templateQuery) =
2458− object [ "template" .= templateQuery ]
2459−
2460−instance FromJSON Query where
2461− parseJSON v = withObject "Query" parse v
2462− where parse o = termQuery `taggedWith` "term"
2463− <|> termsQuery `taggedWith` "terms"
2464− <|> idsQuery `taggedWith` "ids"
2465− <|> queryQueryStringQuery `taggedWith` "query_string"
2466− <|> queryMatchQuery `taggedWith` "match"
2467− <|> queryMultiMatchQuery
2468− <|> queryBoolQuery `taggedWith` "bool"
2469− <|> queryBoostingQuery `taggedWith` "boosting"
2470− <|> queryCommonTermsQuery `taggedWith` "common"
2471− <|> constantScoreFilter `taggedWith` "constant_score"
2472− <|> constantScoreQuery `taggedWith` "constant_score"
2473− <|> queryDisMaxQuery `taggedWith` "dis_max"
2474− <|> queryFilteredQuery `taggedWith` "filtered"
2475− <|> queryFuzzyLikeThisQuery `taggedWith` "fuzzy_like_this"
2476− <|> queryFuzzyLikeFieldQuery `taggedWith` "fuzzy_like_this_field"
2477− <|> queryFuzzyQuery `taggedWith` "fuzzy"
2478− <|> queryHasChildQuery `taggedWith` "has_child"
2479− <|> queryHasParentQuery `taggedWith` "has_parent"
2480− <|> queryIndicesQuery `taggedWith` "indices"
2481− <|> matchAllQuery `taggedWith` "match_all"
2482− <|> queryMoreLikeThisQuery `taggedWith` "more_like_this"
2483− <|> queryMoreLikeThisFieldQuery `taggedWith` "more_like_this_field"
2484− <|> queryNestedQuery `taggedWith` "nested"
2485− <|> queryPrefixQuery `taggedWith` "prefix"
2486− <|> queryRangeQuery `taggedWith` "range"
2487− <|> queryRegexpQuery `taggedWith` "regexp"
2488− <|> querySimpleQueryStringQuery `taggedWith` "simple_query_string"
2489− <|> queryTemplateQueryInline `taggedWith` "template"
2490− where taggedWith parser k = parser =<< o .: k
2491− termQuery = fieldTagged $ \(FieldName fn) o ->
2492− TermQuery <$> (Term fn <$> o .: "value") <*> o .:? "boost"
2493− termsQuery o = case HM.toList o of
2494− [(fn, vs)] -> do vals <- parseJSON vs
2495− case vals of
2496− x:xs -> return (TermsQuery fn (x :| xs))
2497− _ -> fail "Expected non empty list of values"
2498− _ -> fail "Expected object with 1 field-named key"
2499− idsQuery o = IdsQuery <$> o .: "type"
2500− <*> o .: "values"
2501− queryQueryStringQuery = pure . QueryQueryStringQuery
2502− queryMatchQuery = pure . QueryMatchQuery
2503− queryMultiMatchQuery = QueryMultiMatchQuery <$> parseJSON v
2504− queryBoolQuery = pure . QueryBoolQuery
2505− queryBoostingQuery = pure . QueryBoostingQuery
2506− queryCommonTermsQuery = pure . QueryCommonTermsQuery
2507− constantScoreFilter o = case HM.lookup "filter" o of
2508− Just x -> ConstantScoreFilter <$> parseJSON x
2509− <*> o .: "boost"
2510− _ -> fail "Does not appear to be a ConstantScoreFilter"
2511− constantScoreQuery o = case HM.lookup "query" o of
2512− Just x -> ConstantScoreQuery <$> parseJSON x
2513− <*> o .: "boost"
2514− _ -> fail "Does not appear to be a ConstantScoreQuery"
2515− queryDisMaxQuery = pure . QueryDisMaxQuery
2516− queryFilteredQuery = pure . QueryFilteredQuery
2517− queryFuzzyLikeThisQuery = pure . QueryFuzzyLikeThisQuery
2518− queryFuzzyLikeFieldQuery = pure . QueryFuzzyLikeFieldQuery
2519− queryFuzzyQuery = pure . QueryFuzzyQuery
2520− queryHasChildQuery = pure . QueryHasChildQuery
2521− queryHasParentQuery = pure . QueryHasParentQuery
2522− queryIndicesQuery = pure . QueryIndicesQuery
2523− matchAllQuery o = MatchAllQuery <$> o .:? "boost"
2524− queryMoreLikeThisQuery = pure . QueryMoreLikeThisQuery
2525− queryMoreLikeThisFieldQuery = pure . QueryMoreLikeThisFieldQuery
2526− queryNestedQuery = pure . QueryNestedQuery
2527− queryPrefixQuery = pure . QueryPrefixQuery
2528− queryRangeQuery = pure . QueryRangeQuery
2529− queryRegexpQuery = pure . QueryRegexpQuery
2530− querySimpleQueryStringQuery = pure . QuerySimpleQueryStringQuery
2531− queryTemplateQueryInline = pure . QueryTemplateQueryInline
2532−
2533−
2534−omitNulls :: [(Text, Value)] -> Value
2535−omitNulls = object . filter notNull where
2536− notNull (_, Null) = False
2537− notNull (_, Array a) = (not . V.null) a
2538− notNull _ = True
2539−
2540−
2541−instance ToJSON SimpleQueryStringQuery where
2542− toJSON SimpleQueryStringQuery {..} =
2543− omitNulls (base ++ maybeAdd)
2544− where base = [ "query" .= simpleQueryStringQuery ]
2545− maybeAdd = [ "fields" .= simpleQueryStringField
2546− , "default_operator" .= simpleQueryStringOperator
2547− , "analyzer" .= simpleQueryStringAnalyzer
2548− , "flags" .= simpleQueryStringFlags
2549− , "lowercase_expanded_terms" .= simpleQueryStringLowercaseExpanded
2550− , "locale" .= simpleQueryStringLocale ]
2551−
2552−instance FromJSON SimpleQueryStringQuery where
2553− parseJSON = withObject "SimpleQueryStringQuery" parse
2554− where parse o = SimpleQueryStringQuery <$> o .: "query"
2555− <*> o .:? "fields"
2556− <*> o .:? "default_operator"
2557− <*> o .:? "analyzer"
2558− <*> (parseFlags <$> o .:? "flags")
2559− <*> o .:? "lowercase_expanded_terms"
2560− <*> o .:? "locale"
2561− parseFlags (Just (x:xs)) = Just (x :| xs)
2562− parseFlags _ = Nothing
2563−
2564−instance ToJSON FieldOrFields where
2565− toJSON (FofField fieldName) =
2566− toJSON fieldName
2567− toJSON (FofFields fieldNames) =
2568− toJSON fieldNames
2569−
2570−instance FromJSON FieldOrFields where
2571− parseJSON v = FofField <$> parseJSON v
2572− <|> FofFields <$> (parseNEJSON =<< parseJSON v)
2573−
2574−instance ToJSON SimpleQueryFlag where
2575− toJSON SimpleQueryAll = "ALL"
2576− toJSON SimpleQueryNone = "NONE"
2577− toJSON SimpleQueryAnd = "AND"
2578− toJSON SimpleQueryOr = "OR"
2579− toJSON SimpleQueryPrefix = "PREFIX"
2580− toJSON SimpleQueryPhrase = "PHRASE"
2581− toJSON SimpleQueryPrecedence = "PRECEDENCE"
2582− toJSON SimpleQueryEscape = "ESCAPE"
2583− toJSON SimpleQueryWhitespace = "WHITESPACE"
2584− toJSON SimpleQueryFuzzy = "FUZZY"
2585− toJSON SimpleQueryNear = "NEAR"
2586− toJSON SimpleQuerySlop = "SLOP"
2587−
2588−instance FromJSON SimpleQueryFlag where
2589− parseJSON = withText "SimpleQueryFlag" parse
2590− where parse "ALL" = pure SimpleQueryAll
2591− parse "NONE" = pure SimpleQueryNone
2592− parse "AND" = pure SimpleQueryAnd
2593− parse "OR" = pure SimpleQueryOr
2594− parse "PREFIX" = pure SimpleQueryPrefix
2595− parse "PHRASE" = pure SimpleQueryPhrase
2596− parse "PRECEDENCE" = pure SimpleQueryPrecedence
2597− parse "ESCAPE" = pure SimpleQueryEscape
2598− parse "WHITESPACE" = pure SimpleQueryWhitespace
2599− parse "FUZZY" = pure SimpleQueryFuzzy
2600− parse "NEAR" = pure SimpleQueryNear
2601− parse "SLOP" = pure SimpleQuerySlop
2602− parse f = fail ("Unexpected SimpleQueryFlag: " <> show f)
2603−
2604−instance ToJSON RegexpQuery where
2605− toJSON (RegexpQuery (FieldName rqQueryField)
2606− (Regexp regexpQueryQuery) rqQueryFlags
2607− rqQueryBoost) =
2608− object [ rqQueryField .= omitNulls base ]
2609− where base = [ "value" .= regexpQueryQuery
2610− , "flags" .= rqQueryFlags
2611− , "boost" .= rqQueryBoost ]
2612−
2613−instance FromJSON RegexpQuery where
2614− parseJSON = withObject "RegexpQuery" parse
2615− where parse = fieldTagged $ \fn o ->
2616− RegexpQuery fn
2617− <$> o .: "value"
2618− <*> o .: "flags"
2619− <*> o .:? "boost"
2620−
2621−instance ToJSON QueryStringQuery where
2622− toJSON (QueryStringQuery qsQueryString
2623− qsDefaultField qsOperator
2624− qsAnalyzer qsAllowWildcard
2625− qsLowercaseExpanded qsEnablePositionIncrements
2626− qsFuzzyMaxExpansions qsFuzziness
2627− qsFuzzyPrefixLength qsPhraseSlop
2628− qsBoost qsAnalyzeWildcard
2629− qsGeneratePhraseQueries qsMinimumShouldMatch
2630− qsLenient qsLocale) =
2631− omitNulls base
2632− where
2633− base = [ "query" .= qsQueryString
2634− , "default_field" .= qsDefaultField
2635− , "default_operator" .= qsOperator
2636− , "analyzer" .= qsAnalyzer
2637− , "allow_leading_wildcard" .= qsAllowWildcard
2638− , "lowercase_expanded_terms" .= qsLowercaseExpanded
2639− , "enable_position_increments" .= qsEnablePositionIncrements
2640− , "fuzzy_max_expansions" .= qsFuzzyMaxExpansions
2641− , "fuzziness" .= qsFuzziness
2642− , "fuzzy_prefix_length" .= qsFuzzyPrefixLength
2643− , "phrase_slop" .= qsPhraseSlop
2644− , "boost" .= qsBoost
2645− , "analyze_wildcard" .= qsAnalyzeWildcard
2646− , "auto_generate_phrase_queries" .= qsGeneratePhraseQueries
2647− , "minimum_should_match" .= qsMinimumShouldMatch
2648− , "lenient" .= qsLenient
2649− , "locale" .= qsLocale ]
2650−
2651−instance FromJSON QueryStringQuery where
2652− parseJSON = withObject "QueryStringQuery" parse
2653− where parse o = QueryStringQuery
2654− <$> o .: "query"
2655− <*> o .:? "default_field"
2656− <*> o .:? "default_operator"
2657− <*> o .:? "analyzer"
2658− <*> o .:? "allow_leading_wildcard"
2659− <*> o .:? "lowercase_expanded_terms"
2660− <*> o .:? "enable_position_increments"
2661− <*> o .:? "fuzzy_max_expansions"
2662− <*> o .:? "fuzziness"
2663− <*> o .:? "fuzzy_prefix_length"
2664− <*> o .:? "phrase_slop"
2665− <*> o .:? "boost"
2666− <*> o .:? "analyze_wildcard"
2667− <*> o .:? "auto_generate_phrase_queries"
2668− <*> o .:? "minimum_should_match"
2669− <*> o .:? "lenient"
2670− <*> o .:? "locale"
2671−
2672−instance ToJSON RangeQuery where
2673− toJSON (RangeQuery (FieldName fieldName) range boost) =
2674− object [ fieldName .= object conjoined ]
2675− where conjoined = [ "boost" .= boost ] ++ (rangeValueToPair range)
2676−
2677−instance FromJSON RangeQuery where
2678− parseJSON = withObject "RangeQuery" parse
2679− where parse = fieldTagged $ \fn o ->
2680− RangeQuery fn
2681− <$> parseJSON (Object o)
2682− <*> o .: "boost"
2683−
2684−instance FromJSON RangeValue where
2685− parseJSON = withObject "RangeValue" parse
2686− where parse o = parseDate o
2687− <|> parseDouble o
2688− parseDate o = do lt <- o .:? "lt"
2689− lte <- o .:? "lte"
2690− gt <- o .:? "gt"
2691− gte <- o .:? "gte"
2692− case (lt, lte, gt, gte) of
2693− (Just a, _, Just b, _) -> return (RangeDateGtLt (GreaterThanD b) (LessThanD a))
2694− (Just a, _, _, Just b)-> return (RangeDateGteLt (GreaterThanEqD b) (LessThanD a))
2695− (_, Just a, Just b, _)-> return (RangeDateGtLte (GreaterThanD b) (LessThanEqD a))
2696− (_, Just a, _, Just b)-> return (RangeDateGteLte (GreaterThanEqD b) (LessThanEqD a))
2697− (_, _, Just a, _)-> return (RangeDateGt (GreaterThanD a))
2698− (Just a, _, _, _)-> return (RangeDateLt (LessThanD a))
2699− (_, _, _, Just a)-> return (RangeDateGte (GreaterThanEqD a))
2700− (_, Just a, _, _)-> return (RangeDateLte (LessThanEqD a))
2701− (Nothing, Nothing, Nothing, Nothing) -> mzero
2702− parseDouble o = do lt <- o .:? "lt"
2703− lte <- o .:? "lte"
2704− gt <- o .:? "gt"
2705− gte <- o .:? "gte"
2706− case (lt, lte, gt, gte) of
2707− (Just a, _, Just b, _) -> return (RangeDoubleGtLt (GreaterThan b) (LessThan a))
2708− (Just a, _, _, Just b)-> return (RangeDoubleGteLt (GreaterThanEq b) (LessThan a))
2709− (_, Just a, Just b, _)-> return (RangeDoubleGtLte (GreaterThan b) (LessThanEq a))
2710− (_, Just a, _, Just b)-> return (RangeDoubleGteLte (GreaterThanEq b) (LessThanEq a))
2711− (_, _, Just a, _)-> return (RangeDoubleGt (GreaterThan a))
2712− (Just a, _, _, _)-> return (RangeDoubleLt (LessThan a))
2713− (_, _, _, Just a)-> return (RangeDoubleGte (GreaterThanEq a))
2714− (_, Just a, _, _)-> return (RangeDoubleLte (LessThanEq a))
2715− (Nothing, Nothing, Nothing, Nothing) -> mzero
2716−
2717−instance ToJSON PrefixQuery where
2718− toJSON (PrefixQuery (FieldName fieldName) queryValue boost) =
2719− object [ fieldName .= omitNulls base ]
2720− where base = [ "value" .= queryValue
2721− , "boost" .= boost ]
2722−
2723−instance FromJSON PrefixQuery where
2724− parseJSON = withObject "PrefixQuery" parse
2725− where parse = fieldTagged $ \fn o ->
2726− PrefixQuery fn
2727− <$> o .: "value"
2728− <*> o .:? "boost"
2729−
2730−instance ToJSON NestedQuery where
2731− toJSON (NestedQuery nqPath nqScoreType nqQuery) =
2732− object [ "path" .= nqPath
2733− , "score_mode" .= nqScoreType
2734− , "query" .= nqQuery ]
2735−
2736−instance FromJSON NestedQuery where
2737− parseJSON = withObject "NestedQuery" parse
2738− where parse o = NestedQuery
2739− <$> o .: "path"
2740− <*> o .: "score_mode"
2741− <*> o .: "query"
2742−
2743−instance ToJSON MoreLikeThisFieldQuery where
2744− toJSON (MoreLikeThisFieldQuery text (FieldName fieldName)
2745− percent mtf mqt stopwords mindf maxdf
2746− minwl maxwl boostTerms boost analyzer) =
2747− object [ fieldName .= omitNulls base ]
2748− where base = [ "like_text" .= text
2749− , "percent_terms_to_match" .= percent
2750− , "min_term_freq" .= mtf
2751− , "max_query_terms" .= mqt
2752− , "stop_words" .= stopwords
2753− , "min_doc_freq" .= mindf
2754− , "max_doc_freq" .= maxdf
2755− , "min_word_length" .= minwl
2756− , "max_word_length" .= maxwl
2757− , "boost_terms" .= boostTerms
2758− , "boost" .= boost
2759− , "analyzer" .= analyzer ]
2760−
2761−instance FromJSON MoreLikeThisFieldQuery where
2762− parseJSON = withObject "MoreLikeThisFieldQuery" parse
2763− where parse = fieldTagged $ \fn o ->
2764− MoreLikeThisFieldQuery
2765− <$> o .: "like_text"
2766− <*> pure fn
2767− <*> o .:? "percent_terms_to_match"
2768− <*> o .:? "min_term_freq"
2769− <*> o .:? "max_query_terms"
2770− -- <*> (optionalNE =<< o .:? "stop_words")
2771− <*> o .:? "stop_words"
2772− <*> o .:? "min_doc_freq"
2773− <*> o .:? "max_doc_freq"
2774− <*> o .:? "min_word_length"
2775− <*> o .:? "max_word_length"
2776− <*> o .:? "boost_terms"
2777− <*> o .:? "boost"
2778− <*> o .:? "analyzer"
2779− -- optionalNE = maybe (pure Nothing) (fmap Just . parseNEJSON)
2780−
2781−instance ToJSON MoreLikeThisQuery where
2782− toJSON (MoreLikeThisQuery text fields percent
2783− mtf mqt stopwords mindf maxdf
2784− minwl maxwl boostTerms boost analyzer) =
2785− omitNulls base
2786− where base = [ "like_text" .= text
2787− , "fields" .= fields
2788− , "percent_terms_to_match" .= percent
2789− , "min_term_freq" .= mtf
2790− , "max_query_terms" .= mqt
2791− , "stop_words" .= stopwords
2792− , "min_doc_freq" .= mindf
2793− , "max_doc_freq" .= maxdf
2794− , "min_word_length" .= minwl
2795− , "max_word_length" .= maxwl
2796− , "boost_terms" .= boostTerms
2797− , "boost" .= boost
2798− , "analyzer" .= analyzer ]
2799−
2800−instance FromJSON MoreLikeThisQuery where
2801− parseJSON = withObject "MoreLikeThisQuery" parse
2802− where parse o = MoreLikeThisQuery
2803− <$> o .: "like_text"
2804− -- <*> (optionalNE =<< o .:? "fields")
2805− <*> o .:? "fields"
2806− <*> o .:? "percent_terms_to_match"
2807− <*> o .:? "min_term_freq"
2808− <*> o .:? "max_query_terms"
2809− -- <*> (optionalNE =<< o .:? "stop_words")
2810− <*> o .:? "stop_words"
2811− <*> o .:? "min_doc_freq"
2812− <*> o .:? "max_doc_freq"
2813− <*> o .:? "min_word_length"
2814− <*> o .:? "max_word_length"
2815− <*> o .:? "boost_terms"
2816− <*> o .:? "boost"
2817− <*> o .:? "analyzer"
2818− -- optionalNE = maybe (pure Nothing) (fmap Just . parseNEJSON)
2819−
2820−instance ToJSON IndicesQuery where
2821− toJSON (IndicesQuery indices query noMatch) =
2822− omitNulls [ "indices" .= indices
2823− , "no_match_query" .= noMatch
2824− , "query" .= query ]
2825−
2826−instance FromJSON IndicesQuery where
2827− parseJSON = withObject "IndicesQuery" parse
2828− where parse o = IndicesQuery
2829− <$> o .:? "indices" .!= []
2830− <*> o .: "query"
2831− <*> o .:? "no_match_query"
2832−
2833−instance ToJSON HasParentQuery where
2834− toJSON (HasParentQuery queryType query scoreType) =
2835− omitNulls [ "parent_type" .= queryType
2836− , "score_type" .= scoreType
2837− , "query" .= query ]
2838−
2839−instance FromJSON HasParentQuery where
2840− parseJSON = withObject "HasParentQuery" parse
2841− where parse o = HasParentQuery
2842− <$> o .: "parent_type"
2843− <*> o .: "query"
2844− <*> o .:? "score_type"
2845−
2846−instance ToJSON HasChildQuery where
2847− toJSON (HasChildQuery queryType query scoreType) =
2848− omitNulls [ "query" .= query
2849− , "score_type" .= scoreType
2850− , "type" .= queryType ]
2851−
2852−instance FromJSON HasChildQuery where
2853− parseJSON = withObject "HasChildQuery" parse
2854− where parse o = HasChildQuery
2855− <$> o .: "type"
2856− <*> o .: "query"
2857− <*> o .:? "score_type"
2858−
2859−instance ToJSON FuzzyQuery where
2860− toJSON (FuzzyQuery (FieldName fieldName) queryText
2861− prefixLength maxEx fuzziness boost) =
2862− object [ fieldName .= omitNulls base ]
2863− where base = [ "value" .= queryText
2864− , "fuzziness" .= fuzziness
2865− , "prefix_length" .= prefixLength
2866− , "boost" .= boost
2867− , "max_expansions" .= maxEx ]
2868−
2869−instance FromJSON FuzzyQuery where
2870− parseJSON = withObject "FuzzyQuery" parse
2871− where parse = fieldTagged $ \fn o ->
2872− FuzzyQuery fn
2873− <$> o .: "value"
2874− <*> o .: "prefix_length"
2875− <*> o .: "max_expansions"
2876− <*> o .: "fuzziness"
2877− <*> o .:? "boost"
2878−
2879−instance ToJSON FuzzyLikeFieldQuery where
2880− toJSON (FuzzyLikeFieldQuery (FieldName fieldName)
2881− fieldText maxTerms ignoreFreq fuzziness prefixLength
2882− boost analyzer) =
2883− object [ fieldName .=
2884− omitNulls [ "like_text" .= fieldText
2885− , "max_query_terms" .= maxTerms
2886− , "ignore_tf" .= ignoreFreq
2887− , "fuzziness" .= fuzziness
2888− , "prefix_length" .= prefixLength
2889− , "analyzer" .= analyzer
2890− , "boost" .= boost ]]
2891−
2892−instance FromJSON FuzzyLikeFieldQuery where
2893− parseJSON = withObject "FuzzyLikeFieldQuery" parse
2894− where parse = fieldTagged $ \fn o ->
2895− FuzzyLikeFieldQuery fn
2896− <$> o .: "like_text"
2897− <*> o .: "max_query_terms"
2898− <*> o .: "ignore_tf"
2899− <*> o .: "fuzziness"
2900− <*> o .: "prefix_length"
2901− <*> o .: "boost"
2902− <*> o .:? "analyzer"
2903−
2904−instance ToJSON FuzzyLikeThisQuery where
2905− toJSON (FuzzyLikeThisQuery fields text maxTerms
2906− ignoreFreq fuzziness prefixLength boost analyzer) =
2907− omitNulls base
2908− where base = [ "fields" .= fields
2909− , "like_text" .= text
2910− , "max_query_terms" .= maxTerms
2911− , "ignore_tf" .= ignoreFreq
2912− , "fuzziness" .= fuzziness
2913− , "prefix_length" .= prefixLength
2914− , "analyzer" .= analyzer
2915− , "boost" .= boost ]
2916−
2917−instance FromJSON FuzzyLikeThisQuery where
2918− parseJSON = withObject "FuzzyLikeThisQuery" parse
2919− where parse o = FuzzyLikeThisQuery
2920− <$> o .:? "fields" .!= []
2921− <*> o .: "like_text"
2922− <*> o .: "max_query_terms"
2923− <*> o .: "ignore_tf"
2924− <*> o .: "fuzziness"
2925− <*> o .: "prefix_length"
2926− <*> o .: "boost"
2927− <*> o .:? "analyzer"
2928−
2929−instance ToJSON FilteredQuery where
2930− toJSON (FilteredQuery query fFilter) =
2931− object [ "query" .= query
2932− , "filter" .= fFilter ]
2933−
2934−instance FromJSON FilteredQuery where
2935− parseJSON = withObject "FilteredQuery" parse
2936− where parse o = FilteredQuery
2937− <$> o .: "query"
2938− <*> o .: "filter"
2939−
2940−instance ToJSON DisMaxQuery where
2941− toJSON (DisMaxQuery queries tiebreaker boost) =
2942− omitNulls base
2943− where base = [ "queries" .= queries
2944− , "boost" .= boost
2945− , "tie_breaker" .= tiebreaker ]
2946−
2947−instance FromJSON DisMaxQuery where
2948− parseJSON = withObject "DisMaxQuery" parse
2949− where parse o = DisMaxQuery
2950− <$> o .:? "queries" .!= []
2951− <*> o .: "tie_breaker"
2952− <*> o .:? "boost"
2953−
2954−instance ToJSON CommonTermsQuery where
2955− toJSON (CommonTermsQuery (FieldName fieldName)
2956− (QueryString query) cf lfo hfo msm
2957− boost analyzer disableCoord) =
2958− object [fieldName .= omitNulls base ]
2959− where base = [ "query" .= query
2960− , "cutoff_frequency" .= cf
2961− , "low_freq_operator" .= lfo
2962− , "minimum_should_match" .= msm
2963− , "boost" .= boost
2964− , "analyzer" .= analyzer
2965− , "disable_coord" .= disableCoord
2966− , "high_freq_operator" .= hfo ]
2967−
2968−instance FromJSON CommonTermsQuery where
2969− parseJSON = withObject "CommonTermsQuery" parse
2970− where parse = fieldTagged $ \fn o ->
2971− CommonTermsQuery fn
2972− <$> o .: "query"
2973− <*> o .: "cutoff_frequency"
2974− <*> o .: "low_freq_operator"
2975− <*> o .: "high_freq_operator"
2976− <*> o .:? "minimum_should_match"
2977− <*> o .:? "boost"
2978− <*> o .:? "analyzer"
2979− <*> o .:? "disable_coord"
2980−
2981−instance ToJSON CommonMinimumMatch where
2982− toJSON (CommonMinimumMatch mm) = toJSON mm
2983− toJSON (CommonMinimumMatchHighLow (MinimumMatchHighLow lowF highF)) =
2984− object [ "low_freq" .= lowF
2985− , "high_freq" .= highF ]
2986−
2987−instance FromJSON CommonMinimumMatch where
2988− parseJSON v = parseMinimum v
2989− <|> parseMinimumHighLow v
2990− where parseMinimum = fmap CommonMinimumMatch . parseJSON
2991− parseMinimumHighLow = fmap CommonMinimumMatchHighLow . withObject "CommonMinimumMatchHighLow" (\o ->
2992− MinimumMatchHighLow
2993− <$> o .: "low_freq"
2994− <*> o .: "high_freq")
2995−
2996−
2997−instance ToJSON BoostingQuery where
2998− toJSON (BoostingQuery bqPositiveQuery bqNegativeQuery bqNegativeBoost) =
2999− object [ "positive" .= bqPositiveQuery
3000− , "negative" .= bqNegativeQuery
3001− , "negative_boost" .= bqNegativeBoost ]
3002−
3003−instance FromJSON BoostingQuery where
3004− parseJSON = withObject "BoostingQuery" parse
3005− where parse o = BoostingQuery
3006− <$> o .: "positive"
3007− <*> o .: "negative"
3008− <*> o .: "negative_boost"
3009−
3010−instance ToJSON BoolQuery where
3011− toJSON (BoolQuery mustM notM shouldM bqMin boost disableCoord) =
3012− omitNulls base
3013− where base = [ "must" .= mustM
3014− , "must_not" .= notM
3015− , "should" .= shouldM
3016− , "minimum_should_match" .= bqMin
3017− , "boost" .= boost
3018− , "disable_coord" .= disableCoord ]
3019−
3020−instance FromJSON BoolQuery where
3021− parseJSON = withObject "BoolQuery" parse
3022− where parse o = BoolQuery
3023− <$> o .:? "must" .!= []
3024− <*> o .:? "must_not" .!= []
3025− <*> o .:? "should" .!= []
3026− <*> o .:? "minimum_should_match"
3027− <*> o .:? "boost"
3028− <*> o .:? "disable_coord"
3029−
3030−instance ToJSON MatchQuery where
3031− toJSON (MatchQuery (FieldName fieldName)
3032− (QueryString mqQueryString) booleanOperator
3033− zeroTermsQuery cutoffFrequency matchQueryType
3034− analyzer maxExpansions lenient boost) =
3035− object [ fieldName .= omitNulls base ]
3036− where base = [ "query" .= mqQueryString
3037− , "operator" .= booleanOperator
3038− , "zero_terms_query" .= zeroTermsQuery
3039− , "cutoff_frequency" .= cutoffFrequency
3040− , "type" .= matchQueryType
3041− , "analyzer" .= analyzer
3042− , "max_expansions" .= maxExpansions
3043− , "lenient" .= lenient
3044− , "boost" .= boost ]
3045−
3046−instance FromJSON MatchQuery where
3047− parseJSON = withObject "MatchQuery" parse
3048− where parse = fieldTagged $ \fn o ->
3049− MatchQuery fn
3050− <$> o .: "query"
3051− <*> o .: "operator"
3052− <*> o .: "zero_terms_query"
3053− <*> o .:? "cutoff_frequency"
3054− <*> o .:? "type"
3055− <*> o .:? "analyzer"
3056− <*> o .:? "max_expansions"
3057− <*> o .:? "lenient"
3058− <*> o .:? "boost"
3059−
3060−instance ToJSON MultiMatchQuery where
3061− toJSON (MultiMatchQuery fields (QueryString query) boolOp
3062− ztQ tb mmqt cf analyzer maxEx lenient) =
3063− object ["multi_match" .= omitNulls base]
3064− where base = [ "fields" .= fmap toJSON fields
3065− , "query" .= query
3066− , "operator" .= boolOp
3067− , "zero_terms_query" .= ztQ
3068− , "tie_breaker" .= tb
3069− , "type" .= mmqt
3070− , "cutoff_frequency" .= cf
3071− , "analyzer" .= analyzer
3072− , "max_expansions" .= maxEx
3073− , "lenient" .= lenient ]
3074−
3075−instance FromJSON MultiMatchQuery where
3076− parseJSON = withObject "MultiMatchQuery" parse
3077− where parse raw = do o <- raw .: "multi_match"
3078− MultiMatchQuery
3079− <$> o .:? "fields" .!= []
3080− <*> o .: "query"
3081− <*> o .: "operator"
3082− <*> o .: "zero_terms_query"
3083− <*> o .:? "tie_breaker"
3084− <*> o .:? "type"
3085− <*> o .:? "cutoff_frequency"
3086− <*> o .:? "analyzer"
3087− <*> o .:? "max_expansions"
3088− <*> o .:? "lenient"
3089−
3090−instance ToJSON MultiMatchQueryType where
3091− toJSON MultiMatchBestFields = "best_fields"
3092− toJSON MultiMatchMostFields = "most_fields"
3093− toJSON MultiMatchCrossFields = "cross_fields"
3094− toJSON MultiMatchPhrase = "phrase"
3095− toJSON MultiMatchPhrasePrefix = "phrase_prefix"
3096−
3097−instance FromJSON MultiMatchQueryType where
3098− parseJSON = withText "MultiMatchPhrasePrefix" parse
3099− where parse "best_fields" = pure MultiMatchBestFields
3100− parse "most_fields" = pure MultiMatchMostFields
3101− parse "cross_fields" = pure MultiMatchCrossFields
3102− parse "phrase" = pure MultiMatchPhrase
3103− parse "phrase_prefix" = pure MultiMatchPhrasePrefix
3104− parse t = fail ("Unexpected MultiMatchPhrasePrefix: " <> show t)
3105−
3106−instance ToJSON BooleanOperator where
3107− toJSON And = String "and"
3108− toJSON Or = String "or"
3109−
3110−instance FromJSON BooleanOperator where
3111− parseJSON = withText "BooleanOperator" parse
3112− where parse "and" = pure And
3113− parse "or" = pure Or
3114− parse o = fail ("Unexpected BooleanOperator: " <> show o)
3115−
3116−instance ToJSON ZeroTermsQuery where
3117− toJSON ZeroTermsNone = String "none"
3118− toJSON ZeroTermsAll = String "all"
3119−
3120−instance FromJSON ZeroTermsQuery where
3121− parseJSON = withText "ZeroTermsQuery" parse
3122− where parse "none" = pure ZeroTermsNone
3123− parse "all" = pure ZeroTermsAll
3124− parse q = fail ("Unexpected ZeroTermsQuery: " <> show q)
3125−
3126−instance ToJSON MatchQueryType where
3127− toJSON MatchPhrase = "phrase"
3128− toJSON MatchPhrasePrefix = "phrase_prefix"
3129−
3130−instance FromJSON MatchQueryType where
3131− parseJSON = withText "MatchQueryType" parse
3132− where parse "phrase" = pure MatchPhrase
3133− parse "phrase_prefix" = pure MatchPhrasePrefix
3134− parse t = fail ("Unexpected MatchQueryType: " <> show t)
3135−
3136−instance FromJSON Status where
3137− parseJSON (Object v) = Status <$>
3138− v .:? "ok" <*>
3139− (v .:? "status" .!= 200) <*>
3140− v .: "name" <*>
3141− v .: "version" <*>
3142− v .: "tagline"
3143− parseJSON _ = empty
3144−
3145−
3146−instance ToJSON IndexSettings where
3147− toJSON (IndexSettings s r) = object ["settings" .=
3148− object ["index" .=
3149− object ["number_of_shards" .= s, "number_of_replicas" .= r]
3150− ]
3151− ]
3152−
3153−instance FromJSON IndexSettings where
3154− parseJSON = withObject "IndexSettings" parse
3155− where parse o = do s <- o .: "settings"
3156− i <- s .: "index"
3157− IndexSettings <$> i .: "number_of_shards"
3158− <*> i .: "number_of_replicas"
3159−
3160−instance ToJSON UpdatableIndexSetting where
3161− toJSON (NumberOfReplicas x) = oPath ("index" :| ["number_of_replicas"]) x
3162− toJSON (AutoExpandReplicas x) = oPath ("index" :| ["auto_expand_replicas"]) x
3163− toJSON (RefreshInterval x) = oPath ("index" :| ["refresh_interval"]) (NominalDiffTimeJSON x)
3164− toJSON (IndexConcurrency x) = oPath ("index" :| ["concurrency"]) x
3165− toJSON (FailOnMergeFailure x) = oPath ("index" :| ["fail_on_merge_failure"]) x
3166− toJSON (TranslogFlushThresholdOps x) = oPath ("index" :| ["translog", "flush_threshold_ops"]) x
3167− toJSON (TranslogFlushThresholdSize x) = oPath ("index" :| ["translog", "flush_threshold_size"]) x
3168− toJSON (TranslogFlushThresholdPeriod x) = oPath ("index" :| ["translog", "flush_threshold_period"]) (NominalDiffTimeJSON x)
3169− toJSON (TranslogDisableFlush x) = oPath ("index" :| ["translog", "disable_flush"]) x
3170− toJSON (CacheFilterMaxSize x) = oPath ("index" :| ["cache", "filter", "max_size"]) x
3171− toJSON (CacheFilterExpire x) = oPath ("index" :| ["cache", "filter", "expire"]) (NominalDiffTimeJSON <$> x)
3172− toJSON (GatewaySnapshotInterval x) = oPath ("index" :| ["gateway", "snapshot_interval"]) (NominalDiffTimeJSON x)
3173− toJSON (RoutingAllocationInclude fs) = oPath ("index" :| ["routing", "allocation", "include"]) (attrFilterJSON fs)
3174− toJSON (RoutingAllocationExclude fs) = oPath ("index" :| ["routing", "allocation", "exclude"]) (attrFilterJSON fs)
3175− toJSON (RoutingAllocationRequire fs) = oPath ("index" :| ["routing", "allocation", "require"]) (attrFilterJSON fs)
3176− toJSON (RoutingAllocationEnable x) = oPath ("index" :| ["routing", "allocation", "enable"]) x
3177− toJSON (RoutingAllocationShardsPerNode x) = oPath ("index" :| ["routing", "allocation", "total_shards_per_node"]) x
3178− toJSON (RecoveryInitialShards x) = oPath ("index" :| ["recovery", "initial_shards"]) x
3179− toJSON (GCDeletes x) = oPath ("index" :| ["gc_deletes"]) (NominalDiffTimeJSON x)
3180− toJSON (TTLDisablePurge x) = oPath ("index" :| ["ttl", "disable_purge"]) x
3181− toJSON (TranslogFSType x) = oPath ("index" :| ["translog", "fs", "type"]) x
3182− toJSON (IndexCompoundFormat x) = oPath ("index" :| ["compound_format"]) x
3183− toJSON (IndexCompoundOnFlush x) = oPath ("index" :| ["compound_on_flush"]) x
3184− toJSON (WarmerEnabled x) = oPath ("index" :| ["warmer", "enabled"]) x
3185− toJSON (BlocksReadOnly x) = oPath ("blocks" :| ["read_only"]) x
3186− toJSON (BlocksRead x) = oPath ("blocks" :| ["read"]) x
3187− toJSON (BlocksWrite x) = oPath ("blocks" :| ["write"]) x
3188− toJSON (BlocksMetaData x) = oPath ("blocks" :| ["metadata"]) x
3189−
3190−instance FromJSON UpdatableIndexSetting where
3191− parseJSON = withObject "UpdatableIndexSetting" parse
3192− where parse o = numberOfReplicas `taggedAt` ["index", "number_of_replicas"]
3193− <|> autoExpandReplicas `taggedAt` ["index", "auto_expand_replicas"]
3194− <|> refreshInterval `taggedAt` ["index", "refresh_interval"]
3195− <|> indexConcurrency `taggedAt` ["index", "concurrency"]
3196− <|> failOnMergeFailure `taggedAt` ["index", "fail_on_merge_failure"]
3197− <|> translogFlushThresholdOps `taggedAt` ["index", "translog", "flush_threshold_ops"]
3198− <|> translogFlushThresholdSize `taggedAt` ["index", "translog", "flush_threshold_size"]
3199− <|> translogFlushThresholdPeriod `taggedAt` ["index", "translog", "flush_threshold_period"]
3200− <|> translogDisableFlush `taggedAt` ["index", "translog", "disable_flush"]
3201− <|> cacheFilterMaxSize `taggedAt` ["index", "cache", "filter", "max_size"]
3202− <|> cacheFilterExpire `taggedAt` ["index", "cache", "filter", "expire"]
3203− <|> gatewaySnapshotInterval `taggedAt` ["index", "gateway", "snapshot_interval"]
3204− <|> routingAllocationInclude `taggedAt` ["index", "routing", "allocation", "include"]
3205− <|> routingAllocationExclude `taggedAt` ["index", "routing", "allocation", "exclude"]
3206− <|> routingAllocationRequire `taggedAt` ["index", "routing", "allocation", "require"]
3207− <|> routingAllocationEnable `taggedAt` ["index", "routing", "allocation", "enable"]
3208− <|> routingAllocationShardsPerNode `taggedAt` ["index", "routing", "allocation", "total_shards_per_node"]
3209− <|> recoveryInitialShards `taggedAt` ["index", "recovery", "initial_shards"]
3210− <|> gcDeletes `taggedAt` ["index", "gc_deletes"]
3211− <|> ttlDisablePurge `taggedAt` ["index", "ttl", "disable_purge"]
3212− <|> translogFSType `taggedAt` ["index", "translog", "fs", "type"]
3213− <|> compoundFormat `taggedAt` ["index", "compound_format"]
3214− <|> compoundOnFlush `taggedAt` ["index", "compound_on_flush"]
3215− <|> warmerEnabled `taggedAt` ["index", "warmer", "enabled"]
3216− <|> blocksReadOnly `taggedAt` ["blocks", "read_only"]
3217− <|> blocksRead `taggedAt` ["blocks", "read"]
3218− <|> blocksWrite `taggedAt` ["blocks", "write"]
3219− <|> blocksMetaData `taggedAt` ["blocks", "metadata"]
3220− where taggedAt f ks = taggedAt' f (Object o) ks
3221− taggedAt' f v [] = f =<< (parseJSON v <|> (parseJSON (unStringlyTypeJSON v)))
3222− taggedAt' f v (k:ks) = withObject "Object" (\o -> do v' <- o .: k
3223− taggedAt' f v' ks) v
3224− numberOfReplicas = pure . NumberOfReplicas
3225− autoExpandReplicas = pure . AutoExpandReplicas
3226− refreshInterval = pure . RefreshInterval . ndtJSON
3227− indexConcurrency = pure . IndexConcurrency
3228− failOnMergeFailure = pure . FailOnMergeFailure
3229− translogFlushThresholdOps = pure . TranslogFlushThresholdOps
3230− translogFlushThresholdSize = pure . TranslogFlushThresholdSize
3231− translogFlushThresholdPeriod = pure . TranslogFlushThresholdPeriod . ndtJSON
3232− translogDisableFlush = pure . TranslogDisableFlush
3233− cacheFilterMaxSize = pure . CacheFilterMaxSize
3234− cacheFilterExpire = pure . CacheFilterExpire . fmap ndtJSON
3235− gatewaySnapshotInterval = pure . GatewaySnapshotInterval . ndtJSON
3236− routingAllocationInclude = fmap RoutingAllocationInclude . parseAttrFilter
3237− routingAllocationExclude = fmap RoutingAllocationExclude . parseAttrFilter
3238− routingAllocationRequire = fmap RoutingAllocationRequire . parseAttrFilter
3239− routingAllocationEnable = pure . RoutingAllocationEnable
3240− routingAllocationShardsPerNode = pure . RoutingAllocationShardsPerNode
3241− recoveryInitialShards = pure . RecoveryInitialShards
3242− gcDeletes = pure . GCDeletes . ndtJSON
3243− ttlDisablePurge = pure . TTLDisablePurge
3244− translogFSType = pure . TranslogFSType
3245− compoundFormat = pure . IndexCompoundFormat
3246− compoundOnFlush = pure . IndexCompoundOnFlush
3247− warmerEnabled = pure . WarmerEnabled
3248− blocksReadOnly = pure . BlocksReadOnly
3249− blocksRead = pure . BlocksRead
3250− blocksWrite = pure . BlocksWrite
3251− blocksMetaData = pure . BlocksMetaData
3252−
3253−instance FromJSON IndexSettingsSummary where
3254− parseJSON = withObject "IndexSettingsSummary" parse
3255− where parse o = case HM.toList o of
3256− [(ixn, v@(Object o'))] -> IndexSettingsSummary (IndexName ixn)
3257− <$> parseJSON v
3258− <*> (fmap (filter (not . redundant)) . parseSettings =<< o' .: "settings")
3259− _ -> fail "Expected single-key object with index name"
3260− redundant (NumberOfReplicas _) = True
3261− redundant _ = False
3262−
3263−-- | For some reason in several settings APIs, all leaf values get returned
3264−-- as strings. This function attepmts to recover from this for all
3265−-- non-recursive JSON types. If nothing can be done, the value is left alone.
3266−unStringlyTypeJSON :: Value -> Value
3267−unStringlyTypeJSON (String "true") = Bool True
3268−unStringlyTypeJSON (String "false") = Bool False
3269−unStringlyTypeJSON (String "null") = Null
3270−unStringlyTypeJSON v@(String t) = case readMay (T.unpack t) of
3271− Just n -> Number n
3272− Nothing -> v
3273−unStringlyTypeJSON v = v
3274−
3275−
3276−parseSettings :: Object -> Parser [UpdatableIndexSetting]
3277−parseSettings o = do
3278− o' <- o .: "index"
3279− -- slice the index object into singleton hashmaps and try to parse each
3280− parses <- forM (HM.toList o') $ \(k, v) -> do
3281− -- blocks are now nested into the "index" key, which is not how they're serialized
3282− let atRoot = Object (HM.singleton k v)
3283− let atIndex = Object (HM.singleton "index" atRoot)
3284− optional (parseJSON atRoot <|> parseJSON atIndex)
3285− return (catMaybes parses)
3286−
3287−oPath :: ToJSON a => NonEmpty Text -> a -> Value
3288−oPath (k :| []) v = object [k .= v]
3289−oPath (k:| (h:t)) v = object [k .= oPath (h :| t) v]
3290−
3291−attrFilterJSON :: NonEmpty NodeAttrFilter -> Value
3292−attrFilterJSON fs = object [ n .= T.intercalate "," (toList vs)
3293− | NodeAttrFilter (NodeAttrName n) vs <- toList fs]
3294−
3295−parseAttrFilter :: Value -> Parser (NonEmpty NodeAttrFilter)
3296−parseAttrFilter = withObject "NonEmpty NodeAttrFilter" parse
3297− where parse o = case HM.toList o of
3298− [] -> fail "Expected non-empty list of NodeAttrFilters"
3299− x:xs -> DT.mapM (uncurry parse') (x :| xs)
3300− parse' n = withText "Text" $ \t ->
3301− case T.splitOn "," t of
3302− fv:fvs -> return (NodeAttrFilter (NodeAttrName n) (fv :| fvs))
3303− [] -> fail "Expected non-empty list of filter values"
3304−
3305−instance ToJSON ReplicaBounds where
3306− toJSON (ReplicasBounded a b) = String (showText a <> "-" <> showText b)
3307− toJSON (ReplicasLowerBounded a) = String (showText a <> "-all")
3308− toJSON ReplicasUnbounded = Bool False
3309−
3310−instance FromJSON ReplicaBounds where
3311− parseJSON v = withText "ReplicaBounds" parseText v
3312− <|> withBool "ReplicaBounds" parseBool v
3313− where parseText t = case T.splitOn "-" t of
3314− [a, "all"] -> ReplicasLowerBounded <$> parseReadText a
3315− [a, b] -> ReplicasBounded <$> parseReadText a
3316− <*> parseReadText b
3317− _ -> fail ("Could not parse ReplicaBounds: " <> show t)
3318− parseBool False = pure ReplicasUnbounded
3319− parseBool _ = fail "ReplicasUnbounded cannot be represented with True"
3320−
3321−instance ToJSON AllocationPolicy where
3322− toJSON AllocAll = String "all"
3323− toJSON AllocPrimaries = String "primaries"
3324− toJSON AllocNewPrimaries = String "new_primaries"
3325− toJSON AllocNone = String "none"
3326−
3327−instance FromJSON AllocationPolicy where
3328− parseJSON = withText "AllocationPolicy" parse
3329− where parse "all" = pure AllocAll
3330− parse "primaries" = pure AllocPrimaries
3331− parse "new_primaries" = pure AllocNewPrimaries
3332− parse "none" = pure AllocNone
3333− parse t = fail ("Invlaid AllocationPolicy: " <> show t)
3334−
3335−instance ToJSON InitialShardCount where
3336− toJSON QuorumShards = String "quorum"
3337− toJSON QuorumMinus1Shards = String "quorum-1"
3338− toJSON FullShards = String "full"
3339− toJSON FullMinus1Shards = String "full-1"
3340− toJSON (ExplicitShards x) = toJSON x
3341−
3342−instance FromJSON InitialShardCount where
3343− parseJSON v = withText "InitialShardCount" parseText v
3344− <|> ExplicitShards <$> parseJSON v
3345− where parseText "quorum" = pure QuorumShards
3346− parseText "quorum-1" = pure QuorumMinus1Shards
3347− parseText "full" = pure FullShards
3348− parseText "full-1" = pure FullMinus1Shards
3349− parseText _ = mzero
3350−
3351−instance ToJSON FSType where
3352− toJSON FSSimple = "simple"
3353− toJSON FSBuffered = "buffered"
3354−
3355−instance FromJSON FSType where
3356− parseJSON = withText "FSType" parse
3357− where parse "simple" = pure FSSimple
3358− parse "buffered" = pure FSBuffered
3359− parse t = fail ("Invalid FSType: " <> show t)
3360−
3361−instance ToJSON CompoundFormat where
3362− toJSON (CompoundFileFormat x) = Bool x
3363− toJSON (MergeSegmentVsTotalIndex x) = toJSON x
3364−
3365−instance FromJSON CompoundFormat where
3366− parseJSON v = CompoundFileFormat <$> parseJSON v
3367− <|> MergeSegmentVsTotalIndex <$> parseJSON v
3368−
3369−instance ToJSON NominalDiffTimeJSON where
3370− toJSON (NominalDiffTimeJSON t) = String (showText (round t :: Integer) <> "s")
3371−
3372−instance FromJSON NominalDiffTimeJSON where
3373− parseJSON = withText "NominalDiffTime" parse
3374− where parse t = case T.takeEnd 1 t of
3375− "s" -> NominalDiffTimeJSON . fromInteger <$> parseReadText (T.dropEnd 1 t)
3376− _ -> fail "Invalid or missing NominalDiffTime unit (expected s)"
3377−
3378−instance ToJSON IndexTemplate where
3379− toJSON (IndexTemplate p s m) = merge
3380− (object [ "template" .= p
3381− , "mappings" .= foldl' merge (object []) m
3382− ])
3383− (toJSON s)
3384− where
3385− merge (Object o1) (Object o2) = toJSON $ HM.union o1 o2
3386− merge o Null = o
3387− merge _ _ = undefined
3388−
3389−instance (FromJSON a) => FromJSON (EsResult a) where
3390− parseJSON jsonVal@(Object v) = do
3391− found <- v .:? "found" .!= False
3392− fr <- if found
3393− then parseJSON jsonVal
3394− else return Nothing
3395− EsResult <$> v .: "_index" <*>
3396− v .: "_type" <*>
3397− v .: "_id" <*>
3398− pure fr
3399− parseJSON _ = empty
3400−
3401−instance (FromJSON a) => FromJSON (EsResultFound a) where
3402− parseJSON (Object v) = EsResultFound <$>
3403− v .: "_version" <*>
3404− v .: "_source"
3405− parseJSON _ = empty
3406−
3407−instance FromJSON EsError where
3408− parseJSON (Object v) = EsError <$>
3409− v .: "status" <*>
3410− (v .: "error" <|> (v .: "error" >>= (.: "reason")))
3411− parseJSON _ = empty
3412−
3413−instance FromJSON IndexAliasesSummary where
3414− parseJSON = withObject "IndexAliasesSummary" parse
3415− where parse o = IndexAliasesSummary . mconcat <$> mapM (uncurry go) (HM.toList o)
3416− go ixn = withObject "index aliases" $ \ia -> do
3417− aliases <- ia .:? "aliases" .!= mempty
3418− forM (HM.toList aliases) $ \(aName, v) -> do
3419− let indexAlias = IndexAlias (IndexName ixn) (IndexAliasName (IndexName aName))
3420− IndexAliasSummary indexAlias <$> parseJSON v
3421−
3422−
3423−instance ToJSON IndexAliasAction where
3424− toJSON (AddAlias ia opts) = object ["add" .= (iaObj <> optsObj)]
3425− where Object iaObj = toJSON ia
3426− Object optsObj = toJSON opts
3427− toJSON (RemoveAlias ia) = object ["remove" .= iaObj]
3428− where Object iaObj = toJSON ia
3429−
3430−instance ToJSON IndexAlias where
3431− toJSON IndexAlias {..} = object ["index" .= srcIndex
3432− , "alias" .= indexAlias
3433− ]
3434−
3435−instance ToJSON IndexAliasCreate where
3436− toJSON IndexAliasCreate {..} = Object (filterObj <> routingObj)
3437− where filterObj = maybe mempty (HM.singleton "filter" . toJSON) aliasCreateFilter
3438− Object routingObj = maybe (Object mempty) toJSON aliasCreateRouting
3439−
3440−instance ToJSON AliasRouting where
3441− toJSON (AllAliasRouting v) = object ["routing" .= v]
3442− toJSON (GranularAliasRouting srch idx) = object (catMaybes prs)
3443− where prs = [("search_routing" .=) <$> srch
3444− ,("index_routing" .=) <$> idx]
3445−
3446−instance FromJSON AliasRouting where
3447− parseJSON = withObject "AliasRouting" parse
3448− where parse o = parseAll o <|> parseGranular o
3449− parseAll o = AllAliasRouting <$> o .: "routing"
3450− parseGranular o = do
3451− sr <- o .:? "search_routing"
3452− ir <- o .:? "index_routing"
3453− if isNothing sr && isNothing ir
3454− then fail "Both search_routing and index_routing can't be blank"
3455− else return (GranularAliasRouting sr ir)
3456−
3457−instance FromJSON IndexAliasCreate where
3458− parseJSON v = withObject "IndexAliasCreate" parse v
3459− where parse o = IndexAliasCreate <$> optional (parseJSON v)
3460− <*> o .:? "filter"
3461−
3462−instance ToJSON SearchAliasRouting where
3463− toJSON (SearchAliasRouting rvs) = toJSON (T.intercalate "," (routingValue <$> toList rvs))
3464−
3465−instance FromJSON SearchAliasRouting where
3466− parseJSON = withText "SearchAliasRouting" parse
3467− where parse t = SearchAliasRouting <$> parseNEJSON (String <$> T.splitOn "," t)
3468−
3469−instance ToJSON Search where
3470− toJSON (Search query sFilter sort searchAggs highlight sTrackSortScores sFrom sSize _ sFields sSource sSuggest) =
3471− omitNulls [ "query" .= query
3472− , "filter" .= sFilter
3473− , "sort" .= sort
3474− , "aggregations" .= searchAggs
3475− , "highlight" .= highlight
3476− , "from" .= sFrom
3477− , "size" .= sSize
3478− , "track_scores" .= sTrackSortScores
3479− , "fields" .= sFields
3480− , "_source" .= sSource
3481− , "suggest" .= sSuggest]
3482−
3483−
3484−instance ToJSON Source where
3485− toJSON NoSource = toJSON False
3486− toJSON (SourcePatterns patterns) = toJSON patterns
3487− toJSON (SourceIncludeExclude incl excl) = object [ "include" .= incl, "exclude" .= excl ]
3488−
3489−instance ToJSON PatternOrPatterns where
3490− toJSON (PopPattern pattern) = toJSON pattern
3491− toJSON (PopPatterns patterns) = toJSON patterns
3492−
3493−instance ToJSON Include where
3494− toJSON (Include patterns) = toJSON patterns
3495−
3496−instance ToJSON Exclude where
3497− toJSON (Exclude patterns) = toJSON patterns
3498−
3499−instance ToJSON Pattern where
3500− toJSON (Pattern pattern) = toJSON pattern
3501−
3502−
3503−instance ToJSON FieldHighlight where
3504− toJSON (FieldHighlight (FieldName fName) (Just fSettings)) =
3505− object [ fName .= fSettings ]
3506− toJSON (FieldHighlight (FieldName fName) Nothing) =
3507− object [ fName .= emptyObject ]
3508−
3509−instance ToJSON Highlights where
3510− toJSON (Highlights global fields) =
3511− omitNulls (("fields" .= fields)
3512− : highlightSettingsPairs global)
3513−
3514−instance ToJSON HighlightSettings where
3515− toJSON hs = omitNulls (highlightSettingsPairs (Just hs))
3516−
3517−highlightSettingsPairs :: Maybe HighlightSettings -> [Pair]
3518−highlightSettingsPairs Nothing = []
3519−highlightSettingsPairs (Just (Plain plh)) = plainHighPairs (Just plh)
3520−highlightSettingsPairs (Just (Postings ph)) = postHighPairs (Just ph)
3521−highlightSettingsPairs (Just (FastVector fvh)) = fastVectorHighPairs (Just fvh)
3522−
3523−
3524−plainHighPairs :: Maybe PlainHighlight -> [Pair]
3525−plainHighPairs Nothing = []
3526−plainHighPairs (Just (PlainHighlight plCom plNonPost)) =
3527− [ "type" .= String "plain"]
3528− ++ commonHighlightPairs plCom
3529− ++ nonPostingsToPairs plNonPost
3530−
3531−postHighPairs :: Maybe PostingsHighlight -> [Pair]
3532−postHighPairs Nothing = []
3533−postHighPairs (Just (PostingsHighlight pCom)) =
3534− ("type" .= String "postings")
3535− : commonHighlightPairs pCom
3536−
3537−fastVectorHighPairs :: Maybe FastVectorHighlight -> [Pair]
3538−fastVectorHighPairs Nothing = []
3539−fastVectorHighPairs (Just
3540− (FastVectorHighlight fvCom fvNonPostSettings fvBoundChars
3541− fvBoundMaxScan fvFragOff fvMatchedFields
3542− fvPhraseLim)) =
3543− [ "type" .= String "fvh"
3544− , "boundary_chars" .= fvBoundChars
3545− , "boundary_max_scan" .= fvBoundMaxScan
3546− , "fragment_offset" .= fvFragOff
3547− , "matched_fields" .= fvMatchedFields
3548− , "phraseLimit" .= fvPhraseLim]
3549− ++ commonHighlightPairs fvCom
3550− ++ nonPostingsToPairs fvNonPostSettings
3551−
3552−deleteSeveral :: (Eq k, Hashable k) => [k] -> HM.HashMap k v -> HM.HashMap k v
3553−deleteSeveral ks hm = foldr HM.delete hm ks
3554−
3555−commonHighlightPairs :: Maybe CommonHighlight -> [Pair]
3556−commonHighlightPairs Nothing = []
3557−commonHighlightPairs (Just (CommonHighlight chScore chForceSource chTag chEncoder
3558− chNoMatchSize chHighlightQuery
3559− chRequireFieldMatch)) =
3560− [ "order" .= chScore
3561− , "force_source" .= chForceSource
3562− , "encoder" .= chEncoder
3563− , "no_match_size" .= chNoMatchSize
3564− , "highlight_query" .= chHighlightQuery
3565− , "require_fieldMatch" .= chRequireFieldMatch]
3566− ++ highlightTagToPairs chTag
3567−
3568−
3569−nonPostingsToPairs :: Maybe NonPostings -> [Pair]
3570−nonPostingsToPairs Nothing = []
3571−nonPostingsToPairs (Just (NonPostings npFragSize npNumOfFrags)) =
3572− [ "fragment_size" .= npFragSize
3573− , "number_of_fragments" .= npNumOfFrags]
3574−
3575−parseNEJSON :: (FromJSON a) => [Value] -> Parser (NonEmpty a)
3576−parseNEJSON [] = fail "Expected non-empty list"
3577−parseNEJSON (x:xs) = DT.mapM parseJSON (x :| xs)
3578−
3579−
3580−instance ToJSON HighlightEncoder where
3581− toJSON DefaultEncoder = String "default"
3582− toJSON HTMLEncoder = String "html"
3583−
3584−highlightTagToPairs :: Maybe HighlightTag -> [Pair]
3585−highlightTagToPairs (Just (TagSchema _)) = [ "scheme" .= String "default"]
3586−highlightTagToPairs (Just (CustomTags (pre, post))) = [ "pre_tags" .= pre
3587− , "post_tags" .= post]
3588−highlightTagToPairs Nothing = []
3589−
3590−instance ToJSON SortSpec where
3591− toJSON (DefaultSortSpec
3592− (DefaultSort (FieldName dsSortFieldName) dsSortOrder dsIgnoreUnmapped
3593− dsSortMode dsMissingSort dsNestedFilter)) =
3594− object [dsSortFieldName .= omitNulls base] where
3595− base = [ "order" .= dsSortOrder
3596− , "ignore_unmapped" .= dsIgnoreUnmapped
3597− , "mode" .= dsSortMode
3598− , "missing" .= dsMissingSort
3599− , "nested_filter" .= dsNestedFilter ]
3600−
3601− toJSON (GeoDistanceSortSpec gdsSortOrder (GeoPoint (FieldName field) gdsLatLon) units) =
3602− object [ "unit" .= units
3603− , field .= gdsLatLon
3604− , "order" .= gdsSortOrder ]
3605−
3606−
3607−instance ToJSON SortOrder where
3608− toJSON Ascending = String "asc"
3609− toJSON Descending = String "desc"
3610−
3611−
3612−instance ToJSON SortMode where
3613− toJSON SortMin = String "min"
3614− toJSON SortMax = String "max"
3615− toJSON SortSum = String "sum"
3616− toJSON SortAvg = String "avg"
3617−
3618−
3619−instance ToJSON Missing where
3620− toJSON LastMissing = String "_last"
3621− toJSON FirstMissing = String "_first"
3622− toJSON (CustomMissing txt) = String txt
3623−
3624−
3625−instance ToJSON ScoreType where
3626− toJSON ScoreTypeMax = "max"
3627− toJSON ScoreTypeAvg = "avg"
3628− toJSON ScoreTypeSum = "sum"
3629− toJSON ScoreTypeNone = "none"
3630−
3631−instance FromJSON ScoreType where
3632− parseJSON = withText "ScoreType" parse
3633− where parse "max" = pure ScoreTypeMax
3634− parse "avg" = pure ScoreTypeAvg
3635− parse "sum" = pure ScoreTypeSum
3636− parse "none" = pure ScoreTypeNone
3637− parse t = fail ("Unexpected ScoreType: " <> show t)
3638−
3639−instance ToJSON Distance where
3640− toJSON (Distance dCoefficient dUnit) =
3641− String boltedTogether where
3642− coefText = showText dCoefficient
3643− (String unitText) = toJSON dUnit
3644− boltedTogether = mappend coefText unitText
3645−
3646−instance FromJSON Distance where
3647− parseJSON = withText "Distance" parse
3648− where parse t = Distance <$> parseCoeff nT
3649− <*> parseJSON (String unitT)
3650− where (nT, unitT) = T.span validForNumber t
3651− -- may be a better way to do this
3652− validForNumber '-' = True
3653− validForNumber '.' = True
3654− validForNumber 'e' = True
3655− validForNumber c = isNumber c
3656− parseCoeff "" = fail "Empty string cannot be parsed as number"
3657− parseCoeff s = return (read (T.unpack s))
3658−
3659−instance ToJSON DistanceUnit where
3660− toJSON Miles = String "mi"
3661− toJSON Yards = String "yd"
3662− toJSON Feet = String "ft"
3663− toJSON Inches = String "in"
3664− toJSON Kilometers = String "km"
3665− toJSON Meters = String "m"
3666− toJSON Centimeters = String "cm"
3667− toJSON Millimeters = String "mm"
3668− toJSON NauticalMiles = String "nmi"
3669−
3670−
3671−instance FromJSON DistanceUnit where
3672− parseJSON = withText "DistanceUnit" parse
3673− where parse "mi" = pure Miles
3674− parse "yd" = pure Yards
3675− parse "ft" = pure Feet
3676− parse "in" = pure Inches
3677− parse "km" = pure Kilometers
3678− parse "m" = pure Meters
3679− parse "cm" = pure Centimeters
3680− parse "mm" = pure Millimeters
3681− parse "nmi" = pure NauticalMiles
3682− parse u = fail ("Unrecognized DistanceUnit: " <> show u)
3683−
3684−instance ToJSON DistanceType where
3685− toJSON Arc = String "arc"
3686− toJSON SloppyArc = String "sloppy_arc"
3687− toJSON Plane = String "plane"
3688−
3689−instance FromJSON DistanceType where
3690− parseJSON = withText "DistanceType" parse
3691− where parse "arc" = pure Arc
3692− parse "sloppy_arc" = pure SloppyArc
3693− parse "plane" = pure Plane
3694− parse t = fail ("Unrecognized DistanceType: " <> show t)
3695−
3696−
3697−instance ToJSON OptimizeBbox where
3698− toJSON NoOptimizeBbox = String "none"
3699− toJSON (OptimizeGeoFilterType gft) = toJSON gft
3700−
3701−instance FromJSON OptimizeBbox where
3702− parseJSON v = withText "NoOptimizeBbox" parseNoOptimize v
3703− <|> parseOptimize v
3704− where parseNoOptimize "none" = pure NoOptimizeBbox
3705− parseNoOptimize _ = mzero
3706− parseOptimize = fmap OptimizeGeoFilterType . parseJSON
3707−
3708−instance ToJSON GeoBoundingBoxConstraint where
3709− toJSON (GeoBoundingBoxConstraint
3710− (FieldName gbbcGeoBBField) gbbcConstraintBox cache type') =
3711− object [gbbcGeoBBField .= gbbcConstraintBox
3712− , "_cache" .= cache
3713− , "type" .= type']
3714−
3715−instance FromJSON GeoBoundingBoxConstraint where
3716− parseJSON = withObject "GeoBoundingBoxConstraint" parse
3717− where parse o = case HM.toList (deleteSeveral ["type", "_cache"] o) of
3718− [(fn, v)] -> GeoBoundingBoxConstraint (FieldName fn)
3719− <$> parseJSON v
3720− <*> o .:? "_cache" .!= defaultCache
3721− <*> o .: "type"
3722− _ -> fail "Could not find field name for GeoBoundingBoxConstraint"
3723−
3724−instance ToJSON GeoFilterType where
3725− toJSON GeoFilterMemory = String "memory"
3726− toJSON GeoFilterIndexed = String "indexed"
3727−
3728−instance FromJSON GeoFilterType where
3729− parseJSON = withText "GeoFilterType" parse
3730− where parse "memory" = pure GeoFilterMemory
3731− parse "indexed" = pure GeoFilterIndexed
3732− parse t = fail ("Unrecognized GeoFilterType: " <> show t)
3733−
3734−instance ToJSON GeoBoundingBox where
3735− toJSON (GeoBoundingBox gbbTopLeft gbbBottomRight) =
3736− object ["top_left" .= gbbTopLeft
3737− , "bottom_right" .= gbbBottomRight]
3738−
3739−instance FromJSON GeoBoundingBox where
3740− parseJSON = withObject "GeoBoundingBox" parse
3741− where parse o = GeoBoundingBox
3742− <$> o .: "top_left"
3743− <*> o .: "bottom_right"
3744−
3745−instance ToJSON LatLon where
3746− toJSON (LatLon lLat lLon) =
3747− object ["lat" .= lLat
3748− , "lon" .= lLon]
3749−
3750−instance FromJSON LatLon where
3751− parseJSON = withObject "LatLon" parse
3752− where parse o = LatLon <$> o .: "lat"
3753− <*> o .: "lon"
3754−
3755−-- index for smaller ranges, fielddata for longer ranges
3756−instance ToJSON RangeExecution where
3757− toJSON RangeExecutionIndex = "index"
3758− toJSON RangeExecutionFielddata = "fielddata"
3759−
3760−
3761−instance FromJSON RangeExecution where
3762− parseJSON = withText "RangeExecution" parse
3763− where parse "index" = pure RangeExecutionIndex
3764− parse "fielddata" = pure RangeExecutionFielddata
3765− parse t = error ("Unrecognized RangeExecution " <> show t)
3766−
3767−instance ToJSON RegexpFlags where
3768− toJSON AllRegexpFlags = String "ALL"
3769− toJSON NoRegexpFlags = String "NONE"
3770− toJSON (SomeRegexpFlags (h :| fs)) = String $ T.intercalate "|" flagStrs
3771− where flagStrs = map flagStr . nub $ h:fs
3772− flagStr AnyString = "ANYSTRING"
3773− flagStr Automaton = "AUTOMATON"
3774− flagStr Complement = "COMPLEMENT"
3775− flagStr Empty = "EMPTY"
3776− flagStr Intersection = "INTERSECTION"
3777− flagStr Interval = "INTERVAL"
3778−
3779−instance FromJSON RegexpFlags where
3780− parseJSON = withText "RegexpFlags" parse
3781− where parse "ALL" = pure AllRegexpFlags
3782− parse "NONE" = pure NoRegexpFlags
3783− parse t = SomeRegexpFlags <$> parseNEJSON (String <$> T.splitOn "|" t)
3784−
3785−instance FromJSON RegexpFlag where
3786− parseJSON = withText "RegexpFlag" parse
3787− where parse "ANYSTRING" = pure AnyString
3788− parse "AUTOMATON" = pure Automaton
3789− parse "COMPLEMENT" = pure Complement
3790− parse "EMPTY" = pure Empty
3791− parse "INTERSECTION" = pure Intersection
3792− parse "INTERVAL" = pure Interval
3793− parse f = fail ("Unknown RegexpFlag: " <> show f)
3794−
3795−instance ToJSON Term where
3796− toJSON (Term field value) = object ["term" .= object
3797− [field .= value]]
3798−
3799−instance FromJSON Term where
3800− parseJSON = withObject "Term" parse
3801− where parse o = do termObj <- o .: "term"
3802− case HM.toList termObj of
3803− [(fn, v)] -> Term fn <$> parseJSON v
3804− _ -> fail "Expected object with 1 field-named key"
3805−
3806−instance ToJSON BoolMatch where
3807− toJSON (MustMatch term cache) = object ["must" .= term,
3808− "_cache" .= cache]
3809− toJSON (MustNotMatch term cache) = object ["must_not" .= term,
3810− "_cache" .= cache]
3811− toJSON (ShouldMatch terms cache) = object ["should" .= fmap toJSON terms,
3812− "_cache" .= cache]
3813−
3814−instance FromJSON BoolMatch where
3815− parseJSON = withObject "BoolMatch" parse
3816− where parse o = mustMatch `taggedWith` "must"
3817− <|> mustNotMatch `taggedWith` "must_not"
3818− <|> shouldMatch `taggedWith` "should"
3819− where taggedWith parser k = parser =<< o .: k
3820− mustMatch t = MustMatch t <$> o .:? "_cache" .!= defaultCache
3821− mustNotMatch t = MustNotMatch t <$> o .:? "_cache" .!= defaultCache
3822− shouldMatch t = ShouldMatch t <$> o .:? "_cache" .!= defaultCache
3823−
3824−instance (FromJSON a) => FromJSON (SearchResult a) where
3825− parseJSON (Object v) = SearchResult <$>
3826− v .: "took" <*>
3827− v .: "timed_out" <*>
3828− v .: "_shards" <*>
3829− v .: "hits" <*>
3830− v .:? "aggregations" <*>
3831− v .:? "_scroll_id" <*>
3832− v .:? "suggest"
3833− parseJSON _ = empty
3834−
3835−instance (FromJSON a) => FromJSON (SearchHits a) where
3836− parseJSON (Object v) = SearchHits <$>
3837− v .: "total" <*>
3838− v .: "max_score" <*>
3839− v .: "hits"
3840− parseJSON _ = empty
3841−
3842−instance (FromJSON a) => FromJSON (Hit a) where
3843− parseJSON (Object v) = Hit <$>
3844− v .: "_index" <*>
3845− v .: "_type" <*>
3846− v .: "_id" <*>
3847− v .: "_score" <*>
3848− v .:? "_source" <*>
3849− v .:? "highlight"
3850− parseJSON _ = empty
3851−
3852−instance FromJSON ShardResult where
3853− parseJSON (Object v) = ShardResult <$>
3854− v .: "total" <*>
3855− v .: "successful" <*>
3856− v .: "failed"
3857− parseJSON _ = empty
3858−
3859−
3860−instance FromJSON DocVersion where
3861− parseJSON v = do
3862− i <- parseJSON v
3863− maybe (fail "DocVersion out of range") return $ mkDocVersion i
3864−
3865−-- This insanity is because ES *sometimes* returns Replica/Shard counts as strings
3866−instance FromJSON ReplicaCount where
3867− parseJSON v = parseAsInt v
3868− <|> parseAsString v
3869− where parseAsInt = fmap ReplicaCount . parseJSON
3870− parseAsString = withText "ReplicaCount" (fmap ReplicaCount . parseReadText)
3871−
3872−instance FromJSON ShardCount where
3873− parseJSON v = parseAsInt v
3874− <|> parseAsString v
3875− where parseAsInt = fmap ShardCount . parseJSON
3876− parseAsString = withText "ShardCount" (fmap ShardCount . parseReadText)
3877−
3878−instance Bounded DocVersion where
3879− minBound = DocVersion 1
3880− maxBound = DocVersion 9200000000000000000 -- 9.2e+18
3881−
3882−instance Enum DocVersion where
3883− succ x
3884− | x /= maxBound = DocVersion (succ $ docVersionNumber x)
3885− | otherwise = succError "DocVersion"
3886− pred x
3887− | x /= minBound = DocVersion (pred $ docVersionNumber x)
3888− | otherwise = predError "DocVersion"
3889− toEnum i =
3890− fromMaybe (error $ show i ++ " out of DocVersion range") $ mkDocVersion i
3891− fromEnum = docVersionNumber
3892− enumFrom = boundedEnumFrom
3893− enumFromThen = boundedEnumFromThen
3894−
3895−-- | Username type used for HTTP Basic authentication. See 'basicAuthHook'.
3896−newtype EsUsername = EsUsername { esUsername :: Text } deriving (Read, Show, Eq)
3897−
3898−-- | Password type used for HTTP Basic authentication. See 'basicAuthHook'.
3899−newtype EsPassword = EsPassword { esPassword :: Text } deriving (Read, Show, Eq)
3900−
3901−
3902−data SnapshotRepoSelection = SnapshotRepoList (NonEmpty SnapshotRepoPattern)
3903− | AllSnapshotRepos deriving (Eq, Generic, Show, Typeable)
3904−
3905−
3906−-- | Either specifies an exact repo name or one with globs in it,
3907−-- e.g. @RepoPattern "foo*"@ __NOTE__: Patterns are not supported on ES < 1.7
3908−data SnapshotRepoPattern = ExactRepo SnapshotRepoName
3909− | RepoPattern Text
3910− deriving (Eq, Generic, Show, Typeable)
3911−
3912−-- | The unique name of a snapshot repository.
3913−newtype SnapshotRepoName = SnapshotRepoName { snapshotRepoName :: Text }
3914− deriving (Eq, Ord, Generic, Show, Typeable, ToJSON, FromJSON)
3915−
3916−
3917−-- | A generic representation of a snapshot repo. This is what gets
3918−-- sent to and parsed from the server. For repo types enabled by
3919−-- plugins that aren't exported by this library, consider making a
3920−-- custom type which implements 'SnapshotRepo'. If it is a common repo
3921−-- type, consider submitting a pull request to have it included in the
3922−-- library proper
3923−data GenericSnapshotRepo = GenericSnapshotRepo {
3924− gSnapshotRepoName :: SnapshotRepoName
3925− , gSnapshotRepoType :: SnapshotRepoType
3926− , gSnapshotRepoSettings :: GenericSnapshotRepoSettings
3927− } deriving (Eq, Generic, Show, Typeable)
3928−
3929−
3930−instance SnapshotRepo GenericSnapshotRepo where
3931− toGSnapshotRepo = id
3932− fromGSnapshotRepo = Right
3933−
3934−
3935−newtype SnapshotRepoType = SnapshotRepoType { snapshotRepoType :: Text }
3936− deriving (Eq, Ord, Generic, Show, Typeable, ToJSON, FromJSON)
3937−
3938−
3939−-- | Opaque representation of snapshot repo settings. Instances of
3940−-- 'SnapshotRepo' will produce this.
3941−newtype GenericSnapshotRepoSettings = GenericSnapshotRepoSettings { gSnapshotRepoSettingsObject :: Object }
3942− deriving (Eq, Generic, Show, Typeable, ToJSON)
3943−
3944−
3945− -- Regardless of whether you send strongly typed json, my version of
3946− -- ES sends back stringly typed json in the settings, e.g. booleans
3947− -- as strings, so we'll try to convert them.
3948−instance FromJSON GenericSnapshotRepoSettings where
3949− parseJSON = fmap (GenericSnapshotRepoSettings . fmap unStringlyTypeJSON). parseJSON
3950−
3951−-- | The result of running 'verifySnapshotRepo'.
3952−newtype SnapshotVerification = SnapshotVerification { snapshotNodeVerifications :: [SnapshotNodeVerification] }
3953− deriving (Eq, Generic, Show, Typeable)
3954−
3955−
3956−instance FromJSON SnapshotVerification where
3957− parseJSON = withObject "SnapshotVerification" parse
3958− where
3959− parse o = do
3960− o2 <- o .: "nodes"
3961− SnapshotVerification <$> mapM (uncurry parse') (HM.toList o2)
3962− parse' rawFullId = withObject "SnapshotNodeVerification" $ \o ->
3963− SnapshotNodeVerification (FullNodeId rawFullId) <$> o .: "name"
3964−
3965−
3966−-- | A node that has verified a snapshot
3967−data SnapshotNodeVerification = SnapshotNodeVerification {
3968− snvFullId :: FullNodeId
3969− , snvNodeName :: NodeName
3970− } deriving (Eq, Generic, Show, Typeable)
3971−
3972−
3973−-- | Unique, automatically-generated name assigned to nodes that are
3974−-- usually returned in node-oriented APIs.
3975−newtype FullNodeId = FullNodeId { fullNodeId :: Text }
3976− deriving (Eq, Ord, Generic, Show, Typeable, FromJSON)
3977−
3978−
3979−-- | A human-readable node name that is supplied by the user in the
3980−-- node config or automatically generated by ElasticSearch.
3981−newtype NodeName = NodeName { nodeName :: Text }
3982− deriving (Eq, Ord, Generic, Show, Typeable, FromJSON)
3983−
3984−newtype ClusterName = ClusterName { clusterName :: Text }
3985− deriving (Eq, Ord, Generic, Show, Typeable, FromJSON)
3986−
3987−data NodesInfo = NodesInfo {
3988− nodesInfo :: [NodeInfo]
3989− , nodesClusterName :: ClusterName
3990− } deriving (Eq, Show, Generic, Typeable)
3991−
3992−data NodesStats = NodesStats {
3993− nodesStats :: [NodeStats]
3994− , nodesStatsClusterName :: ClusterName
3995− } deriving (Eq, Show, Generic, Typeable)
3996−
3997−data NodeStats = NodeStats {
3998− nodeStatsName :: NodeName
3999− , nodeStatsFullId :: FullNodeId
4000− , nodeStatsBreakersStats :: Maybe NodeBreakersStats
4001− , nodeStatsHTTP :: NodeHTTPStats
4002− , nodeStatsTransport :: NodeTransportStats
4003− , nodeStatsFS :: NodeFSStats
4004− , nodeStatsNetwork :: NodeNetworkStats
4005− , nodeStatsThreadPool :: NodeThreadPoolsStats
4006− , nodeStatsJVM :: NodeJVMStats
4007− , nodeStatsProcess :: NodeProcessStats
4008− , nodeStatsOS :: NodeOSStats
4009− , nodeStatsIndices :: NodeIndicesStats
4010− } deriving (Eq, Show, Generic, Typeable)
4011−
4012−data NodeBreakersStats = NodeBreakersStats {
4013− nodeStatsParentBreaker :: NodeBreakerStats
4014− , nodeStatsRequestBreaker :: NodeBreakerStats
4015− , nodeStatsFieldDataBreaker :: NodeBreakerStats
4016− } deriving (Eq, Show, Generic, Typeable)
4017−
4018−data NodeBreakerStats = NodeBreakerStats {
4019− nodeBreakersTripped :: Int
4020− , nodeBreakersOverhead :: Double
4021− , nodeBreakersEstSize :: Bytes
4022− , nodeBreakersLimitSize :: Bytes
4023− } deriving (Eq, Show, Generic, Typeable)
4024−
4025−data NodeHTTPStats = NodeHTTPStats {
4026− nodeHTTPTotalOpened :: Int
4027− , nodeHTTPCurrentOpen :: Int
4028− } deriving (Eq, Show, Generic, Typeable)
4029−
4030−data NodeTransportStats = NodeTransportStats {
4031− nodeTransportTXSize :: Bytes
4032− , nodeTransportCount :: Int
4033− , nodeTransportRXSize :: Bytes
4034− , nodeTransportRXCount :: Int
4035− , nodeTransportServerOpen :: Int
4036− } deriving (Eq, Show, Generic, Typeable)
4037−
4038−data NodeFSStats = NodeFSStats {
4039− nodeFSDataPaths :: [NodeDataPathStats]
4040− , nodeFSTotal :: NodeFSTotalStats
4041− , nodeFSTimestamp :: UTCTime
4042− } deriving (Eq, Show, Generic, Typeable)
4043−
4044−data NodeDataPathStats = NodeDataPathStats {
4045− nodeDataPathDiskServiceTime :: Maybe Double
4046− , nodeDataPathDiskQueue :: Maybe Double
4047− , nodeDataPathIOSize :: Maybe Bytes
4048− , nodeDataPathWriteSize :: Maybe Bytes
4049− , nodeDataPathReadSize :: Maybe Bytes
4050− , nodeDataPathIOOps :: Maybe Int
4051− , nodeDataPathWrites :: Maybe Int
4052− , nodeDataPathReads :: Maybe Int
4053− , nodeDataPathAvailable :: Bytes
4054− , nodeDataPathFree :: Bytes
4055− , nodeDataPathTotal :: Bytes
4056− , nodeDataPathType :: Maybe Text
4057− , nodeDataPathDevice :: Text
4058− , nodeDataPathMount :: Text
4059− , nodeDataPathPath :: Text
4060− } deriving (Eq, Show, Generic, Typeable)
4061−
4062−data NodeFSTotalStats = NodeFSTotalStats {
4063− nodeFSTotalDiskServiceTime :: Maybe Double
4064− , nodeFSTotalDiskQueue :: Maybe Double
4065− , nodeFSTotalIOSize :: Maybe Bytes
4066− , nodeFSTotalWriteSize :: Maybe Bytes
4067− , nodeFSTotalReadSize :: Maybe Bytes
4068− , nodeFSTotalIOOps :: Maybe Int
4069− , nodeFSTotalWrites :: Maybe Int
4070− , nodeFSTotalReads :: Maybe Int
4071− , nodeFSTotalAvailable :: Bytes
4072− , nodeFSTotalFree :: Bytes
4073− , nodeFSTotalTotal :: Bytes
4074− } deriving (Eq, Show, Generic, Typeable)
4075−
4076−data NodeNetworkStats = NodeNetworkStats {
4077− nodeNetTCPOutRSTs :: Int
4078− , nodeNetTCPInErrs :: Int
4079− , nodeNetTCPAttemptFails :: Int
4080− , nodeNetTCPEstabResets :: Int
4081− , nodeNetTCPRetransSegs :: Int
4082− , nodeNetTCPOutSegs :: Int
4083− , nodeNetTCPInSegs :: Int
4084− , nodeNetTCPCurrEstab :: Int
4085− , nodeNetTCPPassiveOpens :: Int
4086− , nodeNetTCPActiveOpens :: Int
4087− } deriving (Eq, Show, Generic, Typeable)
4088−
4089−data NodeThreadPoolsStats = NodeThreadPoolsStats {
4090− nodeThreadPoolsStatsSnapshot :: NodeThreadPoolStats
4091− , nodeThreadPoolsStatsBulk :: NodeThreadPoolStats
4092− , nodeThreadPoolsStatsMerge :: NodeThreadPoolStats
4093− , nodeThreadPoolsStatsGet :: NodeThreadPoolStats
4094− , nodeThreadPoolsStatsManagement :: NodeThreadPoolStats
4095− , nodeThreadPoolsStatsFetchShardStore :: Maybe NodeThreadPoolStats
4096− , nodeThreadPoolsStatsOptimize :: NodeThreadPoolStats
4097− , nodeThreadPoolsStatsFlush :: NodeThreadPoolStats
4098− , nodeThreadPoolsStatsSearch :: NodeThreadPoolStats
4099− , nodeThreadPoolsStatsWarmer :: NodeThreadPoolStats
4100− , nodeThreadPoolsStatsGeneric :: NodeThreadPoolStats
4101− , nodeThreadPoolsStatsSuggest :: NodeThreadPoolStats
4102− , nodeThreadPoolsStatsRefresh :: NodeThreadPoolStats
4103− , nodeThreadPoolsStatsIndex :: NodeThreadPoolStats
4104− , nodeThreadPoolsStatsListener :: Maybe NodeThreadPoolStats
4105− , nodeThreadPoolsStatsFetchShardStarted :: Maybe NodeThreadPoolStats
4106− , nodeThreadPoolsStatsPercolate :: NodeThreadPoolStats
4107− } deriving (Eq, Show, Generic, Typeable)
4108−
4109−data NodeThreadPoolStats = NodeThreadPoolStats {
4110− nodeThreadPoolCompleted :: Int
4111− , nodeThreadPoolLargest :: Int
4112− , nodeThreadPoolRejected :: Int
4113− , nodeThreadPoolActive :: Int
4114− , nodeThreadPoolQueue :: Int
4115− , nodeThreadPoolThreads :: Int
4116− } deriving (Eq, Show, Generic, Typeable)
4117−
4118−data NodeJVMStats = NodeJVMStats {
4119− nodeJVMStatsMappedBufferPool :: JVMBufferPoolStats
4120− , nodeJVMStatsDirectBufferPool :: JVMBufferPoolStats
4121− , nodeJVMStatsGCOldCollector :: JVMGCStats
4122− , nodeJVMStatsGCYoungCollector :: JVMGCStats
4123− , nodeJVMStatsPeakThreadsCount :: Int
4124− , nodeJVMStatsThreadsCount :: Int
4125− , nodeJVMStatsOldPool :: JVMPoolStats
4126− , nodeJVMStatsSurvivorPool :: JVMPoolStats
4127− , nodeJVMStatsYoungPool :: JVMPoolStats
4128− , nodeJVMStatsNonHeapCommitted :: Bytes
4129− , nodeJVMStatsNonHeapUsed :: Bytes
4130− , nodeJVMStatsHeapMax :: Bytes
4131− , nodeJVMStatsHeapCommitted :: Bytes
4132− , nodeJVMStatsHeapUsedPercent :: Int
4133− , nodeJVMStatsHeapUsed :: Bytes
4134− , nodeJVMStatsUptime :: NominalDiffTime
4135− , nodeJVMStatsTimestamp :: UTCTime
4136− } deriving (Eq, Show, Generic, Typeable)
4137−
4138−data JVMBufferPoolStats = JVMBufferPoolStats {
4139− jvmBufferPoolStatsTotalCapacity :: Bytes
4140− , jvmBufferPoolStatsUsed :: Bytes
4141− , jvmBufferPoolStatsCount :: Int
4142− } deriving (Eq, Show, Generic, Typeable)
4143−
4144−data JVMGCStats = JVMGCStats {
4145− jvmGCStatsCollectionTime :: NominalDiffTime
4146− , jvmGCStatsCollectionCount :: Int
4147− } deriving (Eq, Show, Generic, Typeable)
4148−
4149−data JVMPoolStats = JVMPoolStats {
4150− jvmPoolStatsPeakMax :: Bytes
4151− , jvmPoolStatsPeakUsed :: Bytes
4152− , jvmPoolStatsMax :: Bytes
4153− , jvmPoolStatsUsed :: Bytes
4154− } deriving (Eq, Show, Generic, Typeable)
4155−
4156−data NodeProcessStats = NodeProcessStats {
4157− nodeProcessMemTotalVirtual :: Bytes
4158− , nodeProcessMemShare :: Bytes
4159− , nodeProcessMemResident :: Bytes
4160− , nodeProcessCPUTotal :: NominalDiffTime
4161− , nodeProcessCPUUser :: NominalDiffTime
4162− , nodeProcessCPUSys :: NominalDiffTime
4163− , nodeProcessCPUPercent :: Int
4164− , nodeProcessOpenFDs :: Int
4165− , nodeProcessTimestamp :: UTCTime
4166− } deriving (Eq, Show, Generic, Typeable)
4167−
4168−data NodeOSStats = NodeOSStats {
4169− nodeOSSwapFree :: Bytes
4170− , nodeOSSwapUsed :: Bytes
4171− , nodeOSMemActualUsed :: Bytes
4172− , nodeOSMemActualFree :: Bytes
4173− , nodeOSMemUsedPercent :: Int
4174− , nodeOSMemFreePercent :: Int
4175− , nodeOSMemUsed :: Bytes
4176− , nodeOSMemFree :: Bytes
4177− , nodeOSCPUStolen :: Int
4178− , nodeOSCPUUsage :: Int
4179− , nodeOSCPUIdle :: Int
4180− , nodeOSCPUUser :: Int
4181− , nodeOSCPUSys :: Int
4182− , nodeOSLoad :: Maybe LoadAvgs
4183− , nodeOSUptime :: NominalDiffTime
4184− , nodeOSTimestamp :: UTCTime
4185− } deriving (Eq, Show, Generic, Typeable)
4186−
4187−data LoadAvgs = LoadAvgs {
4188− loadAvg1Min :: Double
4189− , loadAvg5Min :: Double
4190− , loadAvg15Min :: Double
4191− } deriving (Eq, Show, Generic, Typeable)
4192−
4193−data NodeIndicesStats = NodeIndicesStats {
4194− nodeIndicesStatsRecoveryThrottleTime :: Maybe NominalDiffTime
4195− , nodeIndicesStatsRecoveryCurrentAsTarget :: Maybe Int
4196− , nodeIndicesStatsRecoveryCurrentAsSource :: Maybe Int
4197− , nodeIndicesStatsQueryCacheMisses :: Maybe Int
4198− , nodeIndicesStatsQueryCacheHits :: Maybe Int
4199− , nodeIndicesStatsQueryCacheEvictions :: Maybe Int
4200− , nodeIndicesStatsQueryCacheSize :: Maybe Bytes
4201− , nodeIndicesStatsSuggestCurrent :: Int
4202− , nodeIndicesStatsSuggestTime :: NominalDiffTime
4203− , nodeIndicesStatsSuggestTotal :: Int
4204− , nodeIndicesStatsTranslogSize :: Bytes
4205− , nodeIndicesStatsTranslogOps :: Int
4206− , nodeIndicesStatsSegFixedBitSetMemory :: Maybe Bytes
4207− , nodeIndicesStatsSegVersionMapMemory :: Bytes
4208− , nodeIndicesStatsSegIndexWriterMaxMemory :: Maybe Bytes
4209− , nodeIndicesStatsSegIndexWriterMemory :: Bytes
4210− , nodeIndicesStatsSegMemory :: Bytes
4211− , nodeIndicesStatsSegCount :: Int
4212− , nodeIndicesStatsCompletionSize :: Bytes
4213− , nodeIndicesStatsPercolateQueries :: Int
4214− , nodeIndicesStatsPercolateMemory :: Bytes
4215− , nodeIndicesStatsPercolateCurrent :: Int
4216− , nodeIndicesStatsPercolateTime :: NominalDiffTime
4217− , nodeIndicesStatsPercolateTotal :: Int
4218− , nodeIndicesStatsFieldDataEvictions :: Int
4219− , nodeIndicesStatsFieldDataMemory :: Bytes
4220− , nodeIndicesStatsIDCacheMemory :: Bytes
4221− , nodeIndicesStatsFilterCacheEvictions :: Int
4222− , nodeIndicesStatsFilterCacheMemory :: Bytes
4223− , nodeIndicesStatsWarmerTotalTime :: NominalDiffTime
4224− , nodeIndicesStatsWarmerTotal :: Int
4225− , nodeIndicesStatsWarmerCurrent :: Int
4226− , nodeIndicesStatsFlushTotalTime :: NominalDiffTime
4227− , nodeIndicesStatsFlushTotal :: Int
4228− , nodeIndicesStatsRefreshTotalTime :: NominalDiffTime
4229− , nodeIndicesStatsRefreshTotal :: Int
4230− , nodeIndicesStatsMergesTotalSize :: Bytes
4231− , nodeIndicesStatsMergesTotalDocs :: Int
4232− , nodeIndicesStatsMergesTotalTime :: NominalDiffTime
4233− , nodeIndicesStatsMergesTotal :: Int
4234− , nodeIndicesStatsMergesCurrentSize :: Bytes
4235− , nodeIndicesStatsMergesCurrentDocs :: Int
4236− , nodeIndicesStatsMergesCurrent :: Int
4237− , nodeIndicesStatsSearchFetchCurrent :: Int
4238− , nodeIndicesStatsSearchFetchTime :: NominalDiffTime
4239− , nodeIndicesStatsSearchFetchTotal :: Int
4240− , nodeIndicesStatsSearchQueryCurrent :: Int
4241− , nodeIndicesStatsSearchQueryTime :: NominalDiffTime
4242− , nodeIndicesStatsSearchQueryTotal :: Int
4243− , nodeIndicesStatsSearchOpenContexts :: Int
4244− , nodeIndicesStatsGetCurrent :: Int
4245− , nodeIndicesStatsGetMissingTime :: NominalDiffTime
4246− , nodeIndicesStatsGetMissingTotal :: Int
4247− , nodeIndicesStatsGetExistsTime :: NominalDiffTime
4248− , nodeIndicesStatsGetExistsTotal :: Int
4249− , nodeIndicesStatsGetTime :: NominalDiffTime
4250− , nodeIndicesStatsGetTotal :: Int
4251− , nodeIndicesStatsIndexingThrottleTime :: Maybe NominalDiffTime
4252− , nodeIndicesStatsIndexingIsThrottled :: Maybe Bool
4253− , nodeIndicesStatsIndexingNoopUpdateTotal :: Maybe Int
4254− , nodeIndicesStatsIndexingDeleteCurrent :: Int
4255− , nodeIndicesStatsIndexingDeleteTime :: NominalDiffTime
4256− , nodeIndicesStatsIndexingDeleteTotal :: Int
4257− , nodeIndicesStatsIndexingIndexCurrent :: Int
4258− , nodeIndicesStatsIndexingIndexTime :: NominalDiffTime
4259− , nodeIndicesStatsIndexingTotal :: Int
4260− , nodeIndicesStatsStoreThrottleTime :: NominalDiffTime
4261− , nodeIndicesStatsStoreSize :: Bytes
4262− , nodeIndicesStatsDocsDeleted :: Int
4263− , nodeIndicesStatsDocsCount :: Int
4264− } deriving (Eq, Show, Generic, Typeable)
4265−
4266−-- | A quirky address format used throughout ElasticSearch. An example
4267−-- would be inet[/1.1.1.1:9200]. inet may be a placeholder for a
4268−-- <https://en.wikipedia.org/wiki/Fully_qualified_domain_name FQDN>.
4269−newtype EsAddress = EsAddress { esAddress :: Text }
4270− deriving (Eq, Ord, Generic, Show, Typeable, FromJSON)
4271−
4272−-- | Typically a 7 character hex string.
4273−newtype BuildHash = BuildHash { buildHash :: Text }
4274− deriving (Eq, Ord, Generic, Read, Show, Typeable, FromJSON, ToJSON)
4275−
4276−newtype PluginName = PluginName { pluginName :: Text }
4277− deriving (Eq, Ord, Generic, Show, Typeable, FromJSON)
4278−
4279−data NodeInfo = NodeInfo {
4280− nodeInfoHTTPAddress :: EsAddress
4281− , nodeInfoBuild :: BuildHash
4282− , nodeInfoESVersion :: VersionNumber
4283− , nodeInfoIP :: Server
4284− , nodeInfoHost :: Server
4285− , nodeInfoTransportAddress :: EsAddress
4286− , nodeInfoName :: NodeName
4287− , nodeInfoFullId :: FullNodeId
4288− , nodeInfoPlugins :: [NodePluginInfo]
4289− , nodeInfoHTTP :: NodeHTTPInfo
4290− , nodeInfoTransport :: NodeTransportInfo
4291− , nodeInfoNetwork :: NodeNetworkInfo
4292− , nodeInfoThreadPool :: NodeThreadPoolsInfo
4293− , nodeInfoJVM :: NodeJVMInfo
4294− , nodeInfoProcess :: NodeProcessInfo
4295− , nodeInfoOS :: NodeOSInfo
4296− , nodeInfoSettings :: Object
4297− -- ^ The members of the settings objects are not consistent,
4298− -- dependent on plugins, etc.
4299− } deriving (Eq, Show, Generic, Typeable)
4300−
4301−data NodePluginInfo = NodePluginInfo {
4302− nodePluginSite :: Bool
4303− -- ^ Is this a site plugin?
4304− , nodePluginJVM :: Bool
4305− -- ^ Is this plugin running on the JVM
4306− , nodePluginDescription :: Text
4307− , nodePluginVersion :: MaybeNA VersionNumber
4308− , nodePluginName :: PluginName
4309− } deriving (Eq, Show, Generic, Typeable)
4310−
4311−data NodeHTTPInfo = NodeHTTPInfo {
4312− nodeHTTPMaxContentLength :: Bytes
4313− , nodeHTTPTransportAddress :: BoundTransportAddress
4314− } deriving (Eq, Show, Generic, Typeable)
4315−
4316−data NodeTransportInfo = NodeTransportInfo {
4317− nodeTransportProfiles :: [BoundTransportAddress]
4318− , nodeTransportAddress :: BoundTransportAddress
4319− } deriving (Eq, Show, Generic, Typeable)
4320−
4321−data BoundTransportAddress = BoundTransportAddress {
4322− publishAddress :: EsAddress
4323− , boundAddress :: EsAddress
4324− } deriving (Eq, Show, Generic, Typeable)
4325−
4326−data NodeNetworkInfo = NodeNetworkInfo {
4327− nodeNetworkPrimaryInterface :: NodeNetworkInterface
4328− , nodeNetworkRefreshInterval :: NominalDiffTime
4329− } deriving (Eq, Show, Generic, Typeable)
4330−
4331−newtype MacAddress = MacAddress { macAddress :: Text }
4332− deriving (Eq, Ord, Generic, Show, Typeable, FromJSON)
4333−
4334−newtype NetworkInterfaceName = NetworkInterfaceName { networkInterfaceName :: Text }
4335− deriving (Eq, Ord, Generic, Show, Typeable, FromJSON)
4336−
4337−data NodeNetworkInterface = NodeNetworkInterface {
4338− nodeNetIfaceMacAddress :: MacAddress
4339− , nodeNetIfaceName :: NetworkInterfaceName
4340− , nodeNetIfaceAddress :: Server
4341− } deriving (Eq, Show, Generic, Typeable)
4342−
4343−data NodeThreadPoolsInfo = NodeThreadPoolsInfo {
4344− nodeThreadPoolsRefresh :: NodeThreadPoolInfo
4345− , nodeThreadPoolsManagement :: NodeThreadPoolInfo
4346− , nodeThreadPoolsPercolate :: NodeThreadPoolInfo
4347− , nodeThreadPoolsListener :: Maybe NodeThreadPoolInfo
4348− , nodeThreadPoolsFetchShardStarted :: Maybe NodeThreadPoolInfo
4349− , nodeThreadPoolsSearch :: NodeThreadPoolInfo
4350− , nodeThreadPoolsFlush :: NodeThreadPoolInfo
4351− , nodeThreadPoolsWarmer :: NodeThreadPoolInfo
4352− , nodeThreadPoolsOptimize :: NodeThreadPoolInfo
4353− , nodeThreadPoolsBulk :: NodeThreadPoolInfo
4354− , nodeThreadPoolsSuggest :: NodeThreadPoolInfo
4355− , nodeThreadPoolsMerge :: NodeThreadPoolInfo
4356− , nodeThreadPoolsSnapshot :: NodeThreadPoolInfo
4357− , nodeThreadPoolsGet :: NodeThreadPoolInfo
4358− , nodeThreadPoolsFetchShardStore :: Maybe NodeThreadPoolInfo
4359− , nodeThreadPoolsIndex :: NodeThreadPoolInfo
4360− , nodeThreadPoolsGeneric :: NodeThreadPoolInfo
4361− } deriving (Eq, Show, Generic, Typeable)
4362−
4363−data NodeThreadPoolInfo = NodeThreadPoolInfo {
4364− nodeThreadPoolQueueSize :: ThreadPoolSize
4365− , nodeThreadPoolKeepalive :: Maybe NominalDiffTime
4366− , nodeThreadPoolMin :: Maybe Int
4367− , nodeThreadPoolMax :: Maybe Int
4368− , nodeThreadPoolType :: ThreadPoolType
4369− } deriving (Eq, Show, Generic, Typeable)
4370−
4371−data ThreadPoolSize = ThreadPoolBounded Int
4372− | ThreadPoolUnbounded
4373− deriving (Eq, Show, Generic, Typeable)
4374−
4375−data ThreadPoolType = ThreadPoolScaling
4376− | ThreadPoolFixed
4377− | ThreadPoolCached
4378− deriving (Eq, Show, Generic, Typeable)
4379−
4380−data NodeJVMInfo = NodeJVMInfo {
4381− nodeJVMInfoMemoryPools :: [JVMMemoryPool]
4382− , nodeJVMInfoMemoryPoolsGCCollectors :: [JVMGCCollector]
4383− , nodeJVMInfoMemoryInfo :: JVMMemoryInfo
4384− , nodeJVMInfoStartTime :: UTCTime
4385− , nodeJVMInfoVMVendor :: Text
4386− , nodeJVMVMVersion :: VersionNumber
4387− -- ^ JVM doesn't seme to follow normal version conventions
4388− , nodeJVMVMName :: Text
4389− , nodeJVMVersion :: VersionNumber
4390− , nodeJVMPID :: PID
4391− } deriving (Eq, Show, Generic, Typeable)
4392−
4393−-- | Handles quirks in the way JVM versions are rendered (1.7.0_101 -> 1.7.0.101)
4394−newtype JVMVersion = JVMVersion { unJVMVersion :: VersionNumber }
4395−
4396−data JVMMemoryInfo = JVMMemoryInfo {
4397− jvmMemoryInfoDirectMax :: Bytes
4398− , jvmMemoryInfoNonHeapMax :: Bytes
4399− , jvmMemoryInfoNonHeapInit :: Bytes
4400− , jvmMemoryInfoHeapMax :: Bytes
4401− , jvmMemoryInfoHeapInit :: Bytes
4402− } deriving (Eq, Show, Generic, Typeable)
4403−
4404−newtype JVMMemoryPool = JVMMemoryPool {
4405− jvmMemoryPool :: Text
4406− } deriving (Eq, Show, Generic, Typeable, FromJSON)
4407−
4408−newtype JVMGCCollector = JVMGCCollector {
4409− jvmGCCollector :: Text
4410− } deriving (Eq, Show, Generic, Typeable, FromJSON)
4411−
4412−newtype PID = PID {
4413− pid :: Int
4414− } deriving (Eq, Show, Generic, Typeable, FromJSON)
4415−
4416−data NodeOSInfo = NodeOSInfo {
4417− nodeOSSwap :: Bytes
4418− , nodeOSMem :: Bytes
4419− , nodeOSCPUInfo :: CPUInfo
4420− , nodeOSAvailableProcessors :: Int
4421− , nodeOSRefreshInterval :: NominalDiffTime
4422− } deriving (Eq, Show, Generic, Typeable)
4423−
4424−data CPUInfo = CPUInfo {
4425− cpuCacheSize :: Bytes
4426− , cpuCoresPerSocket :: Int
4427− , cpuTotalSockets :: Int
4428− , cpuTotalCores :: Int
4429− , cpuMHZ :: Int
4430− , cpuModel :: Text
4431− , cpuVendor :: Text
4432− } deriving (Eq, Show, Generic, Typeable)
4433−
4434−data NodeProcessInfo = NodeProcessInfo {
4435− nodeProcessMLockAll :: Bool
4436− -- ^ See <https://www.elastic.co/guide/en/elasticsearch/reference/current/setup-configuration.html>
4437− , nodeProcessMaxFileDescriptors :: Int
4438− , nodeProcessId :: PID
4439− , nodeProcessRefreshInterval :: NominalDiffTime
4440− } deriving (Eq, Show, Generic, Typeable)
4441−
4442−data SnapshotRepoUpdateSettings = SnapshotRepoUpdateSettings {
4443− repoUpdateVerify :: Bool
4444− -- ^ After creation/update, synchronously check that nodes can
4445− -- write to this repo. Defaults to True. You may use False if you
4446− -- need a faster response and plan on verifying manually later
4447− -- with 'verifySnapshotRepo'.
4448− } deriving (Eq, Show, Generic, Typeable)
4449−
4450−
4451−-- | Reasonable defaults for repo creation/update
4452−--
4453−-- * repoUpdateVerify True
4454−defaultSnapshotRepoUpdateSettings :: SnapshotRepoUpdateSettings
4455−defaultSnapshotRepoUpdateSettings = SnapshotRepoUpdateSettings True
4456−
4457−
4458−-- | A filesystem-based snapshot repo that ships with
4459−-- ElasticSearch. This is an instance of 'SnapshotRepo' so it can be
4460−-- used with 'updateSnapshotRepo'
4461−data FsSnapshotRepo = FsSnapshotRepo {
4462− fsrName :: SnapshotRepoName
4463− , fsrLocation :: FilePath
4464− , fsrCompressMetadata :: Bool
4465− , fsrChunkSize :: Maybe Bytes
4466− -- ^ Size by which to split large files during snapshotting.
4467− , fsrMaxRestoreBytesPerSec :: Maybe Bytes
4468− -- ^ Throttle node restore rate. If not supplied, defaults to 40mb/sec
4469− , fsrMaxSnapshotBytesPerSec :: Maybe Bytes
4470− -- ^ Throttle node snapshot rate. If not supplied, defaults to 40mb/sec
4471− } deriving (Eq, Generic, Show, Typeable)
4472−
4473−
4474−instance SnapshotRepo FsSnapshotRepo where
4475− toGSnapshotRepo FsSnapshotRepo {..} =
4476− GenericSnapshotRepo fsrName fsRepoType (GenericSnapshotRepoSettings settings)
4477− where
4478− Object settings = object $ [ "location" .= fsrLocation
4479− , "compress" .= fsrCompressMetadata
4480− ] ++ optionalPairs
4481− optionalPairs = catMaybes [ ("chunk_size" .=) <$> fsrChunkSize
4482− , ("max_restore_bytes_per_sec" .=) <$> fsrMaxRestoreBytesPerSec
4483− , ("max_snapshot_bytes_per_sec" .=) <$> fsrMaxSnapshotBytesPerSec
4484− ]
4485− fromGSnapshotRepo GenericSnapshotRepo {..}
4486− | gSnapshotRepoType == fsRepoType = do
4487− let o = gSnapshotRepoSettingsObject gSnapshotRepoSettings
4488− parseRepo $ do
4489− FsSnapshotRepo gSnapshotRepoName <$> o .: "location"
4490− <*> o .:? "compress" .!= False
4491− <*> o .:? "chunk_size"
4492− <*> o .:? "max_restore_bytes_per_sec"
4493− <*> o .:? "max_snapshot_bytes_per_sec"
4494− | otherwise = Left (RepoTypeMismatch fsRepoType gSnapshotRepoType)
4495−
4496−
4497−parseRepo :: Parser a -> Either SnapshotRepoConversionError a
4498−parseRepo parser = case parseEither (const parser) () of
4499− Left e -> Left (OtherRepoConversionError (T.pack e))
4500− Right a -> Right a
4501−
4502−
4503−fsRepoType :: SnapshotRepoType
4504−fsRepoType = SnapshotRepoType "fs"
4505−
4506−-- | Law: fromGSnapshotRepo (toGSnapshotRepo r) == Right r
4507−class SnapshotRepo r where
4508− toGSnapshotRepo :: r -> GenericSnapshotRepo
4509− fromGSnapshotRepo :: GenericSnapshotRepo -> Either SnapshotRepoConversionError r
4510−
4511−
4512−data SnapshotRepoConversionError = RepoTypeMismatch SnapshotRepoType SnapshotRepoType
4513− -- ^ Expected type and actual type
4514− | OtherRepoConversionError Text
4515− deriving (Show, Eq, Generic, Typeable)
4516−
4517−
4518−instance Exception SnapshotRepoConversionError
4519−
4520−
4521−data SnapshotCreateSettings = SnapshotCreateSettings {
4522− snapWaitForCompletion :: Bool
4523− -- ^ Should the API call return immediately after initializing
4524− -- the snapshot or wait until completed? Note that if this is
4525− -- enabled it could wait a long time, so you should adjust your
4526− -- 'ManagerSettings' accordingly to set long timeouts or
4527− -- explicitly handle timeouts.
4528− , snapIndices :: Maybe IndexSelection
4529− -- ^ Nothing will snapshot all indices. Just [] is permissable and
4530− -- will essentially be a no-op snapshot.
4531− , snapIgnoreUnavailable :: Bool
4532− -- ^ If set to True, any matched indices that don't exist will be
4533− -- ignored. Otherwise it will be an error and fail.
4534− , snapIncludeGlobalState :: Bool
4535− , snapPartial :: Bool
4536− -- ^ If some indices failed to snapshot (e.g. if not all primary
4537− -- shards are available), should the process proceed?
4538− } deriving (Eq, Generic, Show, Typeable)
4539−
4540−
4541−-- | Reasonable defaults for snapshot creation
4542−--
4543−-- * snapWaitForCompletion False
4544−-- * snapIndices Nothing
4545−-- * snapIgnoreUnavailable False
4546−-- * snapIncludeGlobalState True
4547−-- * snapPartial False
4548−defaultSnapshotCreateSettings :: SnapshotCreateSettings
4549−defaultSnapshotCreateSettings = SnapshotCreateSettings {
4550− snapWaitForCompletion = False
4551− , snapIndices = Nothing
4552− , snapIgnoreUnavailable = False
4553− , snapIncludeGlobalState = True
4554− , snapPartial = False
4555− }
4556−
4557−
4558−data SnapshotSelection = SnapshotList (NonEmpty SnapshotPattern)
4559− | AllSnapshots deriving (Eq, Generic, Show, Typeable)
4560−
4561−
4562−-- | Either specifies an exact snapshot name or one with globs in it,
4563−-- e.g. @SnapPattern "foo*"@ __NOTE__: Patterns are not supported on
4564−-- ES < 1.7
4565−data SnapshotPattern = ExactSnap SnapshotName
4566− | SnapPattern Text
4567− deriving (Eq, Generic, Show, Typeable)
4568−
4569−
4570−-- | General information about the state of a snapshot. Has some
4571−-- redundancies with 'SnapshotStatus'
4572−data SnapshotInfo = SnapshotInfo {
4573− snapInfoShards :: ShardResult
4574− , snapInfoFailures :: [SnapshotShardFailure]
4575− , snapInfoDuration :: NominalDiffTime
4576− , snapInfoEndTime :: UTCTime
4577− , snapInfoStartTime :: UTCTime
4578− , snapInfoState :: SnapshotState
4579− , snapInfoIndices :: [IndexName]
4580− , snapInfoName :: SnapshotName
4581− } deriving (Eq, Generic, Show, Typeable)
4582−
4583−
4584−instance FromJSON SnapshotInfo where
4585− parseJSON = withObject "SnapshotInfo" parse
4586− where
4587− parse o = SnapshotInfo <$> o .: "shards"
4588− <*> o .: "failures"
4589− <*> (unMS <$> o .: "duration_in_millis")
4590− <*> (posixMS <$> o .: "end_time_in_millis")
4591− <*> (posixMS <$> o .: "start_time_in_millis")
4592− <*> o .: "state"
4593− <*> o .: "indices"
4594− <*> o .: "snapshot"
4595−
4596−data SnapshotShardFailure = SnapshotShardFailure {
4597− snapShardFailureIndex :: IndexName
4598− , snapShardFailureNodeId :: Maybe NodeName -- I'm not 100% sure this isn't actually 'FullNodeId'
4599− , snapShardFailureReason :: Text
4600− , snapShardFailureShardId :: ShardId
4601− } deriving (Eq, Show, Generic, Typeable)
4602−
4603−
4604−instance FromJSON SnapshotShardFailure where
4605− parseJSON = withObject "SnapshotShardFailure" parse
4606− where
4607− parse o = SnapshotShardFailure <$> o .: "index"
4608− <*> o .:? "node_id"
4609− <*> o .: "reason"
4610− <*> o .: "shard_id"
4611−
4612−
4613−newtype ShardId = ShardId { shardId :: Int }
4614− deriving (Eq, Show, Generic, Typeable, FromJSON)
4615−
4616−-- | Milliseconds
4617−newtype MS = MS NominalDiffTime
4618−
4619−
4620−-- keeps the unexported constructor warnings at bay
4621−unMS :: MS -> NominalDiffTime
4622−unMS (MS t) = t
4623−
4624−
4625−instance FromJSON MS where
4626− parseJSON = withScientific "MS" (return . MS . parse)
4627− where
4628− parse n = fromInteger ((truncate n) * 1000)
4629−
4630−
4631−data SnapshotState = SnapshotInit
4632− | SnapshotStarted
4633− | SnapshotSuccess
4634− | SnapshotFailed
4635− | SnapshotAborted
4636− | SnapshotMissing
4637− | SnapshotWaiting
4638− deriving (Show, Eq, Generic, Typeable)
4639−
4640−instance FromJSON SnapshotState where
4641− parseJSON = withText "SnapshotState" parse
4642− where
4643− parse "INIT" = return SnapshotInit
4644− parse "STARTED" = return SnapshotStarted
4645− parse "SUCCESS" = return SnapshotSuccess
4646− parse "FAILED" = return SnapshotFailed
4647− parse "ABORTED" = return SnapshotAborted
4648− parse "MISSING" = return SnapshotMissing
4649− parse "WAITING" = return SnapshotWaiting
4650− parse t = fail ("Invalid snapshot state " <> T.unpack t)
4651−
4652−
4653−newtype SnapshotName = SnapshotName { snapshotName :: Text }
4654− deriving (Show, Eq, Ord, Generic, Typeable, ToJSON, FromJSON)
4655−
4656−
4657−data SnapshotRestoreSettings = SnapshotRestoreSettings {
4658− snapRestoreWaitForCompletion :: Bool
4659− -- ^ Should the API call return immediately after initializing
4660− -- the restore or wait until completed? Note that if this is
4661− -- enabled, it could wait a long time, so you should adjust your
4662− -- 'ManagerSettings' accordingly to set long timeouts or
4663− -- explicitly handle timeouts.
4664− , snapRestoreIndices :: Maybe IndexSelection
4665− -- ^ Nothing will restore all indices in the snapshot. Just [] is
4666− -- permissable and will essentially be a no-op restore.
4667− , snapRestoreIgnoreUnavailable :: Bool
4668− -- ^ If set to True, any indices that do not exist will be ignored
4669− -- during snapshot rather than failing the restore.
4670− , snapRestoreIncludeGlobalState :: Bool
4671− -- ^ If set to false, will ignore any global state in the snapshot
4672− -- and will not restore it.
4673− , snapRestoreRenamePattern :: Maybe RestoreRenamePattern
4674− -- ^ A regex pattern for matching indices. Used with
4675− -- 'snapRestoreRenameReplacement', the restore can reference the
4676− -- matched index and create a new index name upon restore.
4677− , snapRestoreRenameReplacement :: Maybe (NonEmpty RestoreRenameToken)
4678− -- ^ Expression of how index renames should be constructed.
4679− , snapRestorePartial :: Bool
4680− -- ^ If some indices fail to restore, should the process proceed?
4681− , snapRestoreIncludeAliases :: Bool
4682− -- ^ Should the restore also restore the aliases captured in the
4683− -- snapshot.
4684− , snapRestoreIndexSettingsOverrides :: Maybe RestoreIndexSettings
4685− -- ^ Settings to apply during the restore process. __NOTE:__ This
4686− -- option is not supported in ES < 1.5 and should be set to
4687− -- Nothing in that case.
4688− , snapRestoreIgnoreIndexSettings :: Maybe (NonEmpty Text)
4689− -- ^ This type could be more rich but it isn't clear which
4690− -- settings are allowed to be ignored during restore, so we're
4691− -- going with including this feature in a basic form rather than
4692− -- omitting it. One example here would be
4693− -- "index.refresh_interval". Any setting specified here will
4694− -- revert back to the server default during the restore process.
4695− } deriving (Eq, Generic, Show, Typeable)
4696−
4697−-- | Regex-stype pattern, e.g. "index_(.+)" to match index names
4698−newtype RestoreRenamePattern = RestoreRenamePattern { rrPattern :: Text }
4699− deriving (Show, Eq, Generic, Typeable, Ord, ToJSON)
4700−
4701−
4702−-- | A single token in a index renaming scheme for a restore. These
4703−-- are concatenated into a string before being sent to
4704−-- ElasticSearch. Check out these Java
4705−-- <https://docs.oracle.com/javase/7/docs/api/java/util/regex/Matcher.html docs> to find out more if you're into that sort of thing.
4706−data RestoreRenameToken = RRTLit Text
4707− -- ^ Just a literal string of characters
4708− | RRSubWholeMatch
4709− -- ^ Equivalent to $0. The entire matched pattern, not any subgroup
4710− | RRSubGroup RRGroupRefNum
4711− -- ^ A specific reference to a group number
4712− deriving (Show, Eq, Generic, Typeable)
4713−
4714−
4715−-- | A group number for regex matching. Only values from 1-9 are
4716−-- supported. Construct with 'mkRRGroupRefNum'
4717−newtype RRGroupRefNum = RRGroupRefNum { rrGroupRefNum :: Int }
4718− deriving (Show, Eq, Generic, Typeable, Ord)
4719−
4720−instance Bounded RRGroupRefNum where
4721− minBound = RRGroupRefNum 1
4722− maxBound = RRGroupRefNum 9
4723−
4724−
4725−-- | Only allows valid group number references (1-9).
4726−mkRRGroupRefNum :: Int -> Maybe RRGroupRefNum
4727−mkRRGroupRefNum i
4728− | i >= (rrGroupRefNum minBound) && i <= (rrGroupRefNum maxBound) =
4729− Just $ RRGroupRefNum i
4730− | otherwise = Nothing
4731−
4732−
4733−-- | Reasonable defaults for snapshot restores
4734−--
4735−-- * snapRestoreWaitForCompletion False
4736−-- * snapRestoreIndices Nothing
4737−-- * snapRestoreIgnoreUnavailable False
4738−-- * snapRestoreIncludeGlobalState True
4739−-- * snapRestoreRenamePattern Nothing
4740−-- * snapRestoreRenameReplacement Nothing
4741−-- * snapRestorePartial False
4742−-- * snapRestoreIncludeAliases True
4743−-- * snapRestoreIndexSettingsOverrides Nothing
4744−-- * snapRestoreIgnoreIndexSettings Nothing
4745−defaultSnapshotRestoreSettings :: SnapshotRestoreSettings
4746−defaultSnapshotRestoreSettings = SnapshotRestoreSettings {
4747− snapRestoreWaitForCompletion = False
4748− , snapRestoreIndices = Nothing
4749− , snapRestoreIgnoreUnavailable = False
4750− , snapRestoreIncludeGlobalState = True
4751− , snapRestoreRenamePattern = Nothing
4752− , snapRestoreRenameReplacement = Nothing
4753− , snapRestorePartial = False
4754− , snapRestoreIncludeAliases = True
4755− , snapRestoreIndexSettingsOverrides = Nothing
4756− , snapRestoreIgnoreIndexSettings = Nothing
4757− }
4758−
4759−
4760−-- | Index settings that can be overridden. The docs only mention you
4761−-- can update number of replicas, but there may be more. You
4762−-- definitely cannot override shard count.
4763−data RestoreIndexSettings = RestoreIndexSettings {
4764− restoreOverrideReplicas :: Maybe ReplicaCount
4765− } deriving (Show, Eq, Generic, Typeable)
4766−
4767−
4768−instance ToJSON RestoreIndexSettings where
4769− toJSON RestoreIndexSettings {..} = object prs
4770− where
4771− prs = catMaybes [("index.number_of_replicas" .=) <$> restoreOverrideReplicas]
4772−
4773−
4774−instance FromJSON NodesInfo where
4775− parseJSON = withObject "NodesInfo" parse
4776− where
4777− parse o = do
4778− nodes <- o .: "nodes"
4779− infos <- forM (HM.toList nodes) $ \(fullNID, v) -> do
4780− node <- parseJSON v
4781− parseNodeInfo (FullNodeId fullNID) node
4782− cn <- o .: "cluster_name"
4783− return (NodesInfo infos cn)
4784−
4785−instance FromJSON NodesStats where
4786− parseJSON = withObject "NodesStats" parse
4787− where
4788− parse o = do
4789− nodes <- o .: "nodes"
4790− stats <- forM (HM.toList nodes) $ \(fullNID, v) -> do
4791− node <- parseJSON v
4792− parseNodeStats (FullNodeId fullNID) node
4793− cn <- o .: "cluster_name"
4794− return (NodesStats stats cn)
4795−
4796−instance FromJSON NodeBreakerStats where
4797− parseJSON = withObject "NodeBreakerStats" parse
4798− where
4799− parse o = NodeBreakerStats <$> o .: "tripped"
4800− <*> o .: "overhead"
4801− <*> o .: "estimated_size_in_bytes"
4802− <*> o .: "limit_size_in_bytes"
4803−
4804−instance FromJSON NodeHTTPStats where
4805− parseJSON = withObject "NodeHTTPStats" parse
4806− where
4807− parse o = NodeHTTPStats <$> o .: "total_opened"
4808− <*> o .: "current_open"
4809−
4810−instance FromJSON NodeTransportStats where
4811− parseJSON = withObject "NodeTransportStats" parse
4812− where
4813− parse o = NodeTransportStats <$> o .: "tx_size_in_bytes"
4814− <*> o .: "tx_count"
4815− <*> o .: "rx_size_in_bytes"
4816− <*> o .: "rx_count"
4817− <*> o .: "server_open"
4818−
4819−instance FromJSON NodeFSStats where
4820− parseJSON = withObject "NodeFSStats" parse
4821− where
4822− parse o = NodeFSStats <$> o .: "data"
4823− <*> o .: "total"
4824− <*> (posixMS <$> o .: "timestamp")
4825−
4826−instance FromJSON NodeDataPathStats where
4827− parseJSON = withObject "NodeDataPathStats" parse
4828− where
4829− parse o =
4830− NodeDataPathStats <$> (fmap unStringlyTypedDouble <$> o .:? "disk_service_time")
4831− <*> (fmap unStringlyTypedDouble <$> o .:? "disk_queue")
4832− <*> o .:? "disk_io_size_in_bytes"
4833− <*> o .:? "disk_write_size_in_bytes"
4834− <*> o .:? "disk_read_size_in_bytes"
4835− <*> o .:? "disk_io_op"
4836− <*> o .:? "disk_writes"
4837− <*> o .:? "disk_reads"
4838− <*> o .: "available_in_bytes"
4839− <*> o .: "free_in_bytes"
4840− <*> o .: "total_in_bytes"
4841− <*> o .:? "type"
4842− <*> o .: "dev"
4843− <*> o .: "mount"
4844− <*> o .: "path"
4845−
4846−newtype StringlyTypedDouble = StringlyTypedDouble { unStringlyTypedDouble :: Double }
4847−
4848−
4849−instance FromJSON StringlyTypedDouble where
4850− parseJSON = fmap StringlyTypedDouble . parseJSON . unStringlyTypeJSON
4851−
4852−
4853−instance FromJSON NodeFSTotalStats where
4854− parseJSON = withObject "NodeFSTotalStats" parse
4855− where
4856− parse o = NodeFSTotalStats <$> (fmap unStringlyTypedDouble <$> o .:? "disk_service_time")
4857− <*> (fmap unStringlyTypedDouble <$> o .:? "disk_queue")
4858− <*> o .:? "disk_io_size_in_bytes"
4859− <*> o .:? "disk_write_size_in_bytes"
4860− <*> o .:? "disk_read_size_in_bytes"
4861− <*> o .:? "disk_io_op"
4862− <*> o .:? "disk_writes"
4863− <*> o .:? "disk_reads"
4864− <*> o .: "available_in_bytes"
4865− <*> o .: "free_in_bytes"
4866− <*> o .: "total_in_bytes"
4867−
4868−instance FromJSON NodeNetworkStats where
4869− parseJSON = withObject "NodeNetworkStats" parse
4870− where
4871− parse o = do
4872− tcp <- o .: "tcp"
4873− NodeNetworkStats <$> tcp .: "out_rsts"
4874− <*> tcp .: "in_errs"
4875− <*> tcp .: "attempt_fails"
4876− <*> tcp .: "estab_resets"
4877− <*> tcp .: "retrans_segs"
4878− <*> tcp .: "out_segs"
4879− <*> tcp .: "in_segs"
4880− <*> tcp .: "curr_estab"
4881− <*> tcp .: "passive_opens"
4882− <*> tcp .: "active_opens"
4883−
4884−instance FromJSON NodeThreadPoolsStats where
4885− parseJSON = withObject "NodeThreadPoolsStats" parse
4886− where
4887− parse o = NodeThreadPoolsStats <$> o .: "snapshot"
4888− <*> o .: "bulk"
4889− <*> o .: "merge"
4890− <*> o .: "get"
4891− <*> o .: "management"
4892− <*> o .:? "fetch_shard_store"
4893− <*> o .: "optimize"
4894− <*> o .: "flush"
4895− <*> o .: "search"
4896− <*> o .: "warmer"
4897− <*> o .: "generic"
4898− <*> o .: "suggest"
4899− <*> o .: "refresh"
4900− <*> o .: "index"
4901− <*> o .:? "listener"
4902− <*> o .:? "fetch_shard_started"
4903− <*> o .: "percolate"
4904−instance FromJSON NodeThreadPoolStats where
4905− parseJSON = withObject "NodeThreadPoolStats" parse
4906− where
4907− parse o = NodeThreadPoolStats <$> o .: "completed"
4908− <*> o .: "largest"
4909− <*> o .: "rejected"
4910− <*> o .: "active"
4911− <*> o .: "queue"
4912− <*> o .: "threads"
4913−
4914−instance FromJSON NodeJVMStats where
4915− parseJSON = withObject "NodeJVMStats" parse
4916− where
4917− parse o = do
4918− bufferPools <- o .: "buffer_pools"
4919− mapped <- bufferPools .: "mapped"
4920− direct <- bufferPools .: "direct"
4921− gc <- o .: "gc"
4922− collectors <- gc .: "collectors"
4923− oldC <- collectors .: "old"
4924− youngC <- collectors .: "young"
4925− threads <- o .: "threads"
4926− mem <- o .: "mem"
4927− pools <- mem .: "pools"
4928− oldM <- pools .: "old"
4929− survivorM <- pools .: "survivor"
4930− youngM <- pools .: "young"
4931− NodeJVMStats <$> pure mapped
4932− <*> pure direct
4933− <*> pure oldC
4934− <*> pure youngC
4935− <*> threads .: "peak_count"
4936− <*> threads .: "count"
4937− <*> pure oldM
4938− <*> pure survivorM
4939− <*> pure youngM
4940− <*> mem .: "non_heap_committed_in_bytes"
4941− <*> mem .: "non_heap_used_in_bytes"
4942− <*> mem .: "heap_max_in_bytes"
4943− <*> mem .: "heap_committed_in_bytes"
4944− <*> mem .: "heap_used_percent"
4945− <*> mem .: "heap_used_in_bytes"
4946− <*> (unMS <$> o .: "uptime_in_millis")
4947− <*> (posixMS <$> o .: "timestamp")
4948−
4949−instance FromJSON JVMBufferPoolStats where
4950− parseJSON = withObject "JVMBufferPoolStats" parse
4951− where
4952− parse o = JVMBufferPoolStats <$> o .: "total_capacity_in_bytes"
4953− <*> o .: "used_in_bytes"
4954− <*> o .: "count"
4955−
4956−instance FromJSON JVMGCStats where
4957− parseJSON = withObject "JVMGCStats" parse
4958− where
4959− parse o = JVMGCStats <$> (unMS <$> o .: "collection_time_in_millis")
4960− <*> o .: "collection_count"
4961−
4962−instance FromJSON JVMPoolStats where
4963− parseJSON = withObject "JVMPoolStats" parse
4964− where
4965− parse o = JVMPoolStats <$> o .: "peak_max_in_bytes"
4966− <*> o .: "peak_used_in_bytes"
4967− <*> o .: "max_in_bytes"
4968− <*> o .: "used_in_bytes"
4969−
4970−instance FromJSON NodeProcessStats where
4971− parseJSON = withObject "NodeProcessStats" parse
4972− where
4973− parse o = do
4974− mem <- o .: "mem"
4975− cpu <- o .: "cpu"
4976− NodeProcessStats <$> mem .: "total_virtual_in_bytes"
4977− <*> mem .: "share_in_bytes"
4978− <*> mem .: "resident_in_bytes"
4979− <*> (unMS <$> cpu .: "total_in_millis")
4980− <*> (unMS <$> cpu .: "user_in_millis")
4981− <*> (unMS <$> cpu .: "sys_in_millis")
4982− <*> cpu .: "percent"
4983− <*> o .: "open_file_descriptors"
4984− <*> (posixMS <$> o .: "timestamp")
4985−
4986−instance FromJSON NodeOSStats where
4987− parseJSON = withObject "NodeOSStats" parse
4988− where
4989− parse o = do
4990− swap <- o .: "swap"
4991− mem <- o .: "mem"
4992− cpu <- o .: "cpu"
4993− load <- o .:? "load_average"
4994− NodeOSStats <$> swap .: "free_in_bytes"
4995− <*> swap .: "used_in_bytes"
4996− <*> mem .: "actual_used_in_bytes"
4997− <*> mem .: "actual_free_in_bytes"
4998− <*> mem .: "used_percent"
4999− <*> mem .: "free_percent"
5000− <*> mem .: "used_in_bytes"
5001− <*> mem .: "free_in_bytes"
5002− <*> cpu .: "stolen"
5003− <*> cpu .: "usage"
5004− <*> cpu .: "idle"
5005− <*> cpu .: "user"
5006− <*> cpu .: "sys"
5007− <*> pure load
5008− <*> (unMS <$> o .: "uptime_in_millis")
5009− <*> (posixMS <$> o .: "timestamp")
5010−
5011−instance FromJSON LoadAvgs where
5012− parseJSON = withArray "LoadAvgs" parse
5013− where
5014− parse v = case V.toList v of
5015− [one, five, fifteen] -> LoadAvgs <$> parseJSON one
5016− <*> parseJSON five
5017− <*> parseJSON fifteen
5018− _ -> fail "Expecting a triple of Doubles"
5019−
5020−instance FromJSON NodeIndicesStats where
5021− parseJSON = withObject "NodeIndicesStats" parse
5022− where
5023− parse o = do
5024− let (.::) mv k = case mv of
5025− Just v -> Just <$> v .: k
5026− Nothing -> pure Nothing
5027− mRecovery <- o .:? "recovery"
5028− mQueryCache <- o .:? "query_cache"
5029− suggest <- o .: "suggest"
5030− translog <- o .: "translog"
5031− segments <- o .: "segments"
5032− completion <- o .: "completion"
5033− percolate <- o .: "percolate"
5034− fielddata <- o .: "fielddata"
5035− idCache <- o .: "id_cache"
5036− filterCache <- o .: "filter_cache"
5037− warmer <- o .: "warmer"
5038− flush <- o .: "flush"
5039− refresh <- o .: "refresh"
5040− merges <- o .: "merges"
5041− search <- o .: "search"
5042− getStats <- o .: "get"
5043− indexing <- o .: "indexing"
5044− store <- o .: "store"
5045− docs <- o .: "docs"
5046− NodeIndicesStats <$> (fmap unMS <$> mRecovery .:: "throttle_time_in_millis")
5047− <*> mRecovery .:: "current_as_target"
5048− <*> mRecovery .:: "current_as_source"
5049− <*> mQueryCache .:: "miss_count"
5050− <*> mQueryCache .:: "hit_count"
5051− <*> mQueryCache .:: "evictions"
5052− <*> mQueryCache .:: "memory_size_in_bytes"
5053− <*> suggest .: "current"
5054− <*> (unMS <$> suggest .: "time_in_millis")
5055− <*> suggest .: "total"
5056− <*> translog .: "size_in_bytes"
5057− <*> translog .: "operations"
5058− <*> segments .:? "fixed_bit_set_memory_in_bytes"
5059− <*> segments .: "version_map_memory_in_bytes"
5060− <*> segments .:? "index_writer_max_memory_in_bytes"
5061− <*> segments .: "index_writer_memory_in_bytes"
5062− <*> segments .: "memory_in_bytes"
5063− <*> segments .: "count"
5064− <*> completion .: "size_in_bytes"
5065− <*> percolate .: "queries"
5066− <*> percolate .: "memory_size_in_bytes"
5067− <*> percolate .: "current"
5068− <*> (unMS <$> percolate .: "time_in_millis")
5069− <*> percolate .: "total"
5070− <*> fielddata .: "evictions"
5071− <*> fielddata .: "memory_size_in_bytes"
5072− <*> idCache .: "memory_size_in_bytes"
5073− <*> filterCache .: "evictions"
5074− <*> filterCache .: "memory_size_in_bytes"
5075− <*> (unMS <$> warmer .: "total_time_in_millis")
5076− <*> warmer .: "total"
5077− <*> warmer .: "current"
5078− <*> (unMS <$> flush .: "total_time_in_millis")
5079− <*> flush .: "total"
5080− <*> (unMS <$> refresh .: "total_time_in_millis")
5081− <*> refresh .: "total"
5082− <*> merges .: "total_size_in_bytes"
5083− <*> merges .: "total_docs"
5084− <*> (unMS <$> merges .: "total_time_in_millis")
5085− <*> merges .: "total"
5086− <*> merges .: "current_size_in_bytes"
5087− <*> merges .: "current_docs"
5088− <*> merges .: "current"
5089− <*> search .: "fetch_current"
5090− <*> (unMS <$> search .: "fetch_time_in_millis")
5091− <*> search .: "fetch_total"
5092− <*> search .: "query_current"
5093− <*> (unMS <$> search .: "query_time_in_millis")
5094− <*> search .: "query_total"
5095− <*> search .: "open_contexts"
5096− <*> getStats .: "current"
5097− <*> (unMS <$> getStats .: "missing_time_in_millis")
5098− <*> getStats .: "missing_total"
5099− <*> (unMS <$> getStats .: "exists_time_in_millis")
5100− <*> getStats .: "exists_total"
5101− <*> (unMS <$> getStats .: "time_in_millis")
5102− <*> getStats .: "total"
5103− <*> (fmap unMS <$> indexing .:? "throttle_time_in_millis")
5104− <*> indexing .:? "is_throttled"
5105− <*> indexing .:? "noop_update_total"
5106− <*> indexing .: "delete_current"
5107− <*> (unMS <$> indexing .: "delete_time_in_millis")
5108− <*> indexing .: "delete_total"
5109− <*> indexing .: "index_current"
5110− <*> (unMS <$> indexing .: "index_time_in_millis")
5111− <*> indexing .: "index_total"
5112− <*> (unMS <$> store .: "throttle_time_in_millis")
5113− <*> store .: "size_in_bytes"
5114− <*> docs .: "deleted"
5115− <*> docs .: "count"
5116−
5117−instance FromJSON NodeBreakersStats where
5118− parseJSON = withObject "NodeBreakersStats" parse
5119− where
5120− parse o = NodeBreakersStats <$> o .: "parent"
5121− <*> o .: "request"
5122− <*> o .: "fielddata"
5123−
5124−parseNodeStats :: FullNodeId -> Object -> Parser NodeStats
5125−parseNodeStats fnid o = do
5126− NodeStats <$> o .: "name"
5127− <*> pure fnid
5128− <*> o .:? "breakers"
5129− <*> o .: "http"
5130− <*> o .: "transport"
5131− <*> o .: "fs"
5132− <*> o .: "network"
5133− <*> o .: "thread_pool"
5134− <*> o .: "jvm"
5135− <*> o .: "process"
5136− <*> o .: "os"
5137− <*> o .: "indices"
5138−
5139−parseNodeInfo :: FullNodeId -> Object -> Parser NodeInfo
5140−parseNodeInfo nid o =
5141− NodeInfo <$> o .: "http_address"
5142− <*> o .: "build"
5143− <*> o .: "version"
5144− <*> o .: "ip"
5145− <*> o .: "host"
5146− <*> o .: "transport_address"
5147− <*> o .: "name"
5148− <*> pure nid
5149− <*> o .: "plugins"
5150− <*> o .: "http"
5151− <*> o .: "transport"
5152− <*> o .: "network"
5153− <*> o .: "thread_pool"
5154− <*> o .: "jvm"
5155− <*> o .: "process"
5156− <*> o .: "os"
5157− <*> o .: "settings"
5158−
5159−instance FromJSON NodePluginInfo where
5160− parseJSON = withObject "NodePluginInfo" parse
5161− where
5162− parse o = NodePluginInfo <$> o .: "site"
5163− <*> o .: "jvm"
5164− <*> o .: "description"
5165− <*> o .: "version"
5166− <*> o .: "name"
5167−
5168−instance FromJSON NodeHTTPInfo where
5169− parseJSON = withObject "NodeHTTPInfo" parse
5170− where
5171− parse o = NodeHTTPInfo <$> o .: "max_content_length_in_bytes"
5172− <*> parseJSON (Object o)
5173−
5174−instance FromJSON BoundTransportAddress where
5175− parseJSON = withObject "BoundTransportAddress" parse
5176− where
5177− parse o = BoundTransportAddress <$> o .: "publish_address"
5178− <*> o .: "bound_address"
5179−
5180−instance FromJSON NodeOSInfo where
5181− parseJSON = withObject "NodeOSInfo" parse
5182− where
5183− parse o = do
5184− swap <- o .: "swap"
5185− mem <- o .: "mem"
5186− NodeOSInfo <$> swap .: "total_in_bytes"
5187− <*> mem .: "total_in_bytes"
5188− <*> o .: "cpu"
5189− <*> o .: "available_processors"
5190− <*> (unMS <$> o .: "refresh_interval_in_millis")
5191−
5192−
5193−instance FromJSON CPUInfo where
5194− parseJSON = withObject "CPUInfo" parse
5195− where
5196− parse o = CPUInfo <$> o .: "cache_size_in_bytes"
5197− <*> o .: "cores_per_socket"
5198− <*> o .: "total_sockets"
5199− <*> o .: "total_cores"
5200− <*> o .: "mhz"
5201− <*> o .: "model"
5202− <*> o .: "vendor"
5203−
5204−instance FromJSON NodeProcessInfo where
5205− parseJSON = withObject "NodeProcessInfo" parse
5206− where
5207− parse o = NodeProcessInfo <$> o .: "mlockall"
5208− <*> o .: "max_file_descriptors"
5209− <*> o .: "id"
5210− <*> (unMS <$> o .: "refresh_interval_in_millis")
5211−
5212−instance FromJSON NodeJVMInfo where
5213− parseJSON = withObject "NodeJVMInfo" parse
5214− where
5215− parse o = NodeJVMInfo <$> o .: "memory_pools"
5216− <*> o .: "gc_collectors"
5217− <*> o .: "mem"
5218− <*> (posixMS <$> o .: "start_time_in_millis")
5219− <*> o .: "vm_vendor"
5220− <*> o .: "vm_version"
5221− <*> o .: "vm_name"
5222− <*> (unJVMVersion <$> o .: "version")
5223− <*> o .: "pid"
5224−
5225−instance FromJSON JVMVersion where
5226− parseJSON (String t) =
5227− JVMVersion <$> parseJSON (String (T.replace "_" "." t))
5228− parseJSON v = JVMVersion <$> parseJSON v
5229−
5230−instance FromJSON JVMMemoryInfo where
5231− parseJSON = withObject "JVMMemoryInfo" parse
5232− where
5233− parse o = JVMMemoryInfo <$> o .: "direct_max_in_bytes"
5234− <*> o .: "non_heap_max_in_bytes"
5235− <*> o .: "non_heap_init_in_bytes"
5236− <*> o .: "heap_max_in_bytes"
5237− <*> o .: "heap_init_in_bytes"
5238−
5239−instance FromJSON NodeThreadPoolsInfo where
5240− parseJSON = withObject "NodeThreadPoolsInfo" parse
5241− where
5242− parse o = NodeThreadPoolsInfo <$> o .: "refresh"
5243− <*> o .: "management"
5244− <*> o .: "percolate"
5245− <*> o .:? "listener"
5246− <*> o .:? "fetch_shard_started"
5247− <*> o .: "search"
5248− <*> o .: "flush"
5249− <*> o .: "warmer"
5250− <*> o .: "optimize"
5251− <*> o .: "bulk"
5252− <*> o .: "suggest"
5253− <*> o .: "merge"
5254− <*> o .: "snapshot"
5255− <*> o .: "get"
5256− <*> o .:? "fetch_shard_store"
5257− <*> o .: "index"
5258− <*> o .: "generic"
5259−
5260−instance FromJSON NodeThreadPoolInfo where
5261− parseJSON = withObject "NodeThreadPoolInfo" parse
5262− where
5263− parse o = do
5264− ka <- maybe (return Nothing) (fmap Just . parseStringInterval) =<< o .:? "keep_alive"
5265− NodeThreadPoolInfo <$> (parseJSON . unStringlyTypeJSON =<< o .: "queue_size")
5266− <*> pure ka
5267− <*> o .:? "min"
5268− <*> o .:? "max"
5269− <*> o .: "type"
5270−
5271−parseStringInterval :: (Monad m) => String -> m NominalDiffTime
5272−parseStringInterval s = case span isNumber s of
5273− ("", _) -> fail "Invalid interval"
5274− (nS, unitS) -> case (readMay nS, readMay unitS) of
5275− (Just n, Just unit) -> return (fromInteger (n * unitNDT unit))
5276− (Nothing, _) -> fail "Invalid interval number"
5277− (_, Nothing) -> fail "Invalid interval unit"
5278− where
5279− unitNDT Seconds = 1
5280− unitNDT Minutes = 60
5281− unitNDT Hours = 60 * 60
5282− unitNDT Days = 24 * 60 * 60
5283− unitNDT Weeks = 7 * 24 * 60 * 60
5284−
5285−instance FromJSON ThreadPoolSize where
5286− parseJSON v = parseAsNumber v <|> parseAsString v
5287− where
5288− parseAsNumber = parseAsInt <=< parseJSON
5289− parseAsInt (-1) = return ThreadPoolUnbounded
5290− parseAsInt n
5291− | n >= 0 = return (ThreadPoolBounded n)
5292− | otherwise = fail "Thread pool size must be >= -1."
5293− parseAsString = withText "ThreadPoolSize" $ \t ->
5294− case first (readMay . T.unpack) (T.span isNumber t) of
5295− (Just n, "k") -> return (ThreadPoolBounded (n * 1000))
5296− (Just n, "") -> return (ThreadPoolBounded n)
5297− _ -> fail ("Invalid thread pool size " <> T.unpack t)
5298−
5299−instance FromJSON ThreadPoolType where
5300− parseJSON = withText "ThreadPoolType" parse
5301− where
5302− parse "scaling" = return ThreadPoolScaling
5303− parse "fixed" = return ThreadPoolFixed
5304− parse "cached" = return ThreadPoolCached
5305− parse e = fail ("Unexpected thread pool type" <> T.unpack e)
5306−
5307−instance FromJSON NodeTransportInfo where
5308− parseJSON = withObject "NodeTransportInfo" parse
5309− where
5310− parse o = NodeTransportInfo <$> (maybe (return mempty) parseProfiles =<< o .:? "profiles")
5311− <*> parseJSON (Object o)
5312− parseProfiles (Object o) | HM.null o = return []
5313− parseProfiles v@(Array _) = parseJSON v
5314− parseProfiles Null = return []
5315− parseProfiles _ = fail "Could not parse profiles"
5316−
5317−instance FromJSON NodeNetworkInfo where
5318− parseJSON = withObject "NodeNetworkInfo" parse
5319− where
5320− parse o = NodeNetworkInfo <$> o .: "primary_interface"
5321− <*> (unMS <$> o .: "refresh_interval_in_millis")
5322−
5323−
5324−instance FromJSON NodeNetworkInterface where
5325− parseJSON = withObject "NodeNetworkInterface" parse
5326− where
5327− parse o = NodeNetworkInterface <$> o .: "mac_address"
5328− <*> o .: "name"
5329− <*> o .: "address"
5330−
5331−newtype MaybeNA a = MaybeNA { unMaybeNA :: Maybe a }
5332− deriving (Show, Eq)
5333−
5334−instance FromJSON a => FromJSON (MaybeNA a) where
5335− parseJSON (String "NA") = pure $ MaybeNA Nothing
5336− parseJSON o = MaybeNA . Just <$> parseJSON o
5337−
5338−
5339−data Suggest = Suggest { suggestText :: Text
5340− , suggestName :: Text
5341− , suggestType :: SuggestType
5342− }
5343− deriving (Show, Generic, Eq, Read, Typeable)
5344−
5345−instance ToJSON Suggest where
5346− toJSON Suggest{..} = object [ "text" .= suggestText
5347− , suggestName .= suggestType
5348− ]
5349−
5350−instance FromJSON Suggest where
5351− parseJSON (Object o) = do
5352− suggestText' <- o .: "text"
5353− let dropTextList = HM.toList $ HM.filterWithKey (\x _ -> x /= "text") o
5354− suggestName' <- case dropTextList of
5355− [(x, _)] -> return x
5356− _ -> fail "error parsing Suggest field name"
5357− suggestType' <- o .: suggestName'
5358− return $ Suggest suggestText' suggestName' suggestType'
5359− parseJSON x = typeMismatch "Suggest" x
5360−
5361−data SuggestType = SuggestTypePhraseSuggester PhraseSuggester
5362− deriving (Show, Generic, Eq, Read, Typeable)
5363−
5364−instance ToJSON SuggestType where
5365− toJSON (SuggestTypePhraseSuggester x) = object ["phrase" .= x]
5366−
5367−instance FromJSON SuggestType where
5368− parseJSON = withObject "SuggestType" parse
5369− where parse o = phraseSuggester `taggedWith` "phrase"
5370− where taggedWith parser k = parser =<< o .: k
5371− phraseSuggester = pure . SuggestTypePhraseSuggester
5372−
5373−data PhraseSuggester =
5374− PhraseSuggester { phraseSuggesterField :: FieldName
5375− , phraseSuggesterGramSize :: Maybe Int
5376− , phraseSuggesterRealWordErrorLikelihood :: Maybe Int
5377− , phraseSuggesterConfidence :: Maybe Int
5378− , phraseSuggesterMaxErrors :: Maybe Int
5379− , phraseSuggesterSeparator :: Maybe Text
5380− , phraseSuggesterSize :: Maybe Size
5381− , phraseSuggesterAnalyzer :: Maybe Analyzer
5382− , phraseSuggesterShardSize :: Maybe Int
5383− , phraseSuggesterHighlight :: Maybe PhraseSuggesterHighlighter
5384− , phraseSuggesterCollate :: Maybe PhraseSuggesterCollate
5385− }
5386− deriving (Show, Generic, Eq, Read, Typeable)
5387−
5388−instance ToJSON PhraseSuggester where
5389− toJSON PhraseSuggester{..} = omitNulls [ "field" .= phraseSuggesterField
5390− , "gram_size" .= phraseSuggesterGramSize
5391− , "real_word_error_likelihood" .= phraseSuggesterRealWordErrorLikelihood
5392− , "confidence" .= phraseSuggesterConfidence
5393− , "max_errors" .= phraseSuggesterMaxErrors
5394− , "separator" .= phraseSuggesterSeparator
5395− , "size" .= phraseSuggesterSize
5396− , "analyzer" .= phraseSuggesterAnalyzer
5397− , "shard_size" .= phraseSuggesterShardSize
5398− , "highlight" .= phraseSuggesterHighlight
5399− , "collate" .= phraseSuggesterCollate
5400− ]
5401−
5402−instance FromJSON PhraseSuggester where
5403− parseJSON = withObject "PhraseSuggester" parse
5404− where parse o = PhraseSuggester
5405− <$> o .: "field"
5406− <*> o .:? "gram_size"
5407− <*> o .:? "real_word_error_likelihood"
5408− <*> o .:? "confidence"
5409− <*> o .:? "max_errors"
5410− <*> o .:? "separator"
5411− <*> o .:? "size"
5412− <*> o .:? "analyzer"
5413− <*> o .:? "shard_size"
5414− <*> o .:? "highlight"
5415− <*> o .:? "collate"
5416−
5417−mkPhraseSuggester :: FieldName -> PhraseSuggester
5418−mkPhraseSuggester fName =
5419− PhraseSuggester fName Nothing Nothing Nothing Nothing Nothing Nothing
5420− Nothing Nothing Nothing Nothing
5421−
5422−data PhraseSuggesterHighlighter =
5423− PhraseSuggesterHighlighter { phraseSuggesterHighlighterPreTag :: Text
5424− , phraseSuggesterHighlighterPostTag :: Text
5425− }
5426− deriving (Show, Generic, Eq, Read, Typeable)
5427−
5428−instance ToJSON PhraseSuggesterHighlighter where
5429− toJSON PhraseSuggesterHighlighter{..} =
5430− object [ "pre_tag" .= phraseSuggesterHighlighterPreTag
5431− , "post_tag" .= phraseSuggesterHighlighterPostTag
5432− ]
5433−
5434−instance FromJSON PhraseSuggesterHighlighter where
5435− parseJSON = withObject "PhraseSuggesterHighlighter" parse
5436− where parse o = PhraseSuggesterHighlighter
5437− <$> o .: "pre_tag"
5438− <*> o .: "post_tag"
5439−
5440−data PhraseSuggesterCollate =
5441− PhraseSuggesterCollate { phraseSuggesterCollateTemplateQuery :: TemplateQueryInline
5442− , phraseSuggesterCollatePrune :: Bool
5443− }
5444− deriving (Show, Generic, Eq, Read, Typeable)
5445−
5446−instance ToJSON PhraseSuggesterCollate where
5447− toJSON PhraseSuggesterCollate{..} = object [ "query" .= object
5448− [ "inline" .= (inline phraseSuggesterCollateTemplateQuery)
5449− ]
5450− , "params" .= (params phraseSuggesterCollateTemplateQuery)
5451− , "prune" .= phraseSuggesterCollatePrune
5452− ]
5453−
5454−instance FromJSON PhraseSuggesterCollate where
5455− parseJSON (Object o) = do
5456− query' <- o .: "query"
5457− inline' <- query' .: "inline"
5458− params' <- o .: "params"
5459− prune' <- o .:? "prune" .!= False
5460− return $ PhraseSuggesterCollate (TemplateQueryInline inline' params') prune'
5461− parseJSON x = typeMismatch "PhraseSuggesterCollate" x
5462−
5463−data SuggestOptions =
5464− SuggestOptions { suggestOptionsText :: Text
5465− , suggestOptionsScore :: Double
5466− , suggestOptionsFreq :: Maybe Int
5467− , suggestOptionsHighlighted :: Maybe Text
5468− }
5469− deriving (Eq, Read, Show)
5470−
5471−instance FromJSON SuggestOptions where
5472− parseJSON = withObject "SuggestOptions" parse
5473− where parse o = SuggestOptions
5474− <$> o .: "text"
5475− <*> o .: "score"
5476− <*> o .:? "freq"
5477− <*> o .:? "highlighted"
5478−
5479−data SuggestResponse =
5480− SuggestResponse { suggestResponseText :: Text
5481− , suggestResponseOffset :: Int
5482− , suggestResponseLength :: Int
5483− , suggestResponseOptions :: [SuggestOptions]
5484− }
5485− deriving (Eq, Read, Show)
5486−
5487−instance FromJSON SuggestResponse where
5488− parseJSON = withObject "SuggestResponse" parse
5489− where parse o = SuggestResponse
5490− <$> o .: "text"
5491− <*> o .: "offset"
5492− <*> o .: "length"
5493− <*> o .: "options"
5494−
5495−data NamedSuggestionResponse =
5496− NamedSuggestionResponse { nsrName :: Text
5497− , nsrResponses :: [SuggestResponse]
5498− }
5499− deriving (Eq, Read, Show)
5500−
5501−instance FromJSON NamedSuggestionResponse where
5502− parseJSON (Object o) = do
5503− suggestionName' <- case HM.toList o of
5504− [(x, _)] -> return x
5505− _ -> fail "error parsing NamedSuggestionResponse name"
5506− suggestionResponses' <- o .: suggestionName'
5507− return $ NamedSuggestionResponse suggestionName' suggestionResponses'
5508−
5509− parseJSON x = typeMismatch "NamedSuggestionResponse" x
src/Database/V1/Bloodhound/Types/Class.hsdeleted−17
@@ -1,17 +0,0 @@
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.hsdeleted−57
@@ -1,57 +0,0 @@
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.hsdeleted−10
@@ -1,10 +0,0 @@
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/V5/Bloodhound/Types.hsdeleted−5292
@@ -1,5292 +0,0 @@
1−{-# LANGUAGE DeriveDataTypeable #-}
2−{-# LANGUAGE DeriveGeneric #-}
3−{-# LANGUAGE FlexibleContexts #-}
4−{-# LANGUAGE FlexibleInstances #-}
5−{-# LANGUAGE GeneralizedNewtypeDeriving #-}
6−{-# LANGUAGE MultiParamTypeClasses #-}
7−-- {-# LANGUAGE NoMonomorphismRestriction #-}
8−{-# LANGUAGE NamedFieldPuns #-}
9−{-# LANGUAGE OverloadedStrings #-}
10−{-# LANGUAGE RecordWildCards #-}
11−{-# LANGUAGE UndecidableInstances #-}
12−
13−-------------------------------------------------------------------------------
14−-- |
15−-- Module : Database.Bloodhound.Types
16−-- Copyright : (C) 2014, 2015, 2016 Chris Allen
17−-- License : BSD-style (see the file LICENSE)
18−-- Maintainer : Chris Allen <cma@bitemyapp.com
19−-- Stability : provisional
20−-- Portability : DeriveGeneric, RecordWildCards
21−--
22−-- Data types for describing actions and data structures performed to interact
23−-- with Elasticsearch. The two main buckets your queries against Elasticsearch
24−-- will fall into are 'Query's and 'Filter's. 'Filter's are more like
25−-- traditional database constraints and often have preferable performance
26−-- properties. 'Query's support human-written textual queries, such as fuzzy
27−-- queries.
28−-------------------------------------------------------------------------------
29−
30−
31−
32−module Database.V5.Bloodhound.Types
33− ( defaultCache
34− , defaultIndexSettings
35− , defaultIndexDocumentSettings
36− , mkSort
37− , showText
38− , unpackId
39− , mkMatchQuery
40− , mkMultiMatchQuery
41− , mkBoolQuery
42− , mkRangeQuery
43− , mkQueryStringQuery
44− , mkAggregations
45− , mkTermsAggregation
46− , mkTermsScriptAggregation
47− , mkDateHistogram
48− , mkCardinalityAggregation
49− , mkDocVersion
50− , mkStatsAggregation
51− , mkExtendedStatsAggregation
52− , docVersionNumber
53− , toMissing
54− , toTerms
55− , toDateHistogram
56− , toTopHits
57− , omitNulls
58− , BH(..)
59− , runBH
60− , BHEnv
61− , bhServer
62− , bhManager
63− , bhRequestHook
64− , mkBHEnv
65− , MonadBH(..)
66− , Version(..)
67− , VersionNumber(..)
68− , MaybeNA(..)
69− , BuildHash(..)
70− , Status(..)
71− , Existence(..)
72− , NullValue(..)
73− , IndexSettings(..)
74− , UpdatableIndexSetting(..)
75− , IndexSettingsSummary(..)
76− , AllocationPolicy(..)
77− , ReplicaBounds(..)
78− , Bytes(..)
79− , gigabytes
80− , megabytes
81− , kilobytes
82− , FSType(..)
83− , InitialShardCount(..)
84− , NodeAttrFilter(..)
85− , NodeAttrName(..)
86− , CompoundFormat(..)
87− , IndexTemplate(..)
88− , Server(..)
89− , Reply
90− , EsResult(..)
91− , EsResultFound(..)
92− , EsError(..)
93− , EsProtocolException(..)
94− , IndexAlias(..)
95− , IndexAliasName(..)
96− , IndexAliasAction(..)
97− , IndexAliasCreate(..)
98− , IndexAliasSummary(..)
99− , IndexAliasesSummary(..)
100− , AliasRouting(..)
101− , SearchAliasRouting(..)
102− , IndexAliasRouting(..)
103− , RoutingValue(..)
104− , DocVersion
105− , ExternalDocVersion(..)
106− , VersionControl(..)
107− , DocumentParent(..)
108− , IndexDocumentSettings(..)
109− , Query(..)
110− , Search(..)
111− , SearchType(..)
112− , SearchResult(..)
113− , ScrollId(..)
114− , SearchHits(..)
115− , TrackSortScores
116− , From(..)
117− , Size(..)
118− , Source(..)
119− , PatternOrPatterns(..)
120− , Include(..)
121− , Exclude(..)
122− , Pattern(..)
123− , ShardResult(..)
124− , Hit(..)
125− , Filter(..)
126− , Seminearring(..)
127− , BoolMatch(..)
128− , Term(..)
129− , GeoPoint(..)
130− , GeoBoundingBoxConstraint(..)
131− , GeoBoundingBox(..)
132− , GeoFilterType(..)
133− , Distance(..)
134− , DistanceUnit(..)
135− , DistanceType(..)
136− , DistanceRange(..)
137− , OptimizeBbox(..)
138− , LatLon(..)
139− , RangeValue(..)
140− , RangeExecution(..)
141− , LessThan(..)
142− , LessThanEq(..)
143− , GreaterThan(..)
144− , GreaterThanEq(..)
145− , LessThanD(..)
146− , LessThanEqD(..)
147− , GreaterThanD(..)
148− , GreaterThanEqD(..)
149− , Regexp(..)
150− , RegexpFlags(..)
151− , RegexpFlag(..)
152− , FieldName(..)
153− , Script(..)
154− , IndexName(..)
155− , IndexSelection(..)
156− , NodeSelection(..)
157− , NodeSelector(..)
158− , ForceMergeIndexSettings(..)
159− , defaultForceMergeIndexSettings
160− , TemplateName(..)
161− , TemplatePattern(..)
162− , MappingName(..)
163− , DocId(..)
164− , CacheName(..)
165− , CacheKey(..)
166− , BulkOperation(..)
167− , ReplicaCount(..)
168− , ShardCount(..)
169− , Sort
170− , SortMode(..)
171− , SortOrder(..)
172− , SortSpec(..)
173− , DefaultSort(..)
174− , Missing(..)
175− , OpenCloseIndex(..)
176− , Method
177− , Boost(..)
178− , MatchQuery(..)
179− , MultiMatchQuery(..)
180− , BoolQuery(..)
181− , BoostingQuery(..)
182− , CommonTermsQuery(..)
183− , DisMaxQuery(..)
184− , FuzzyLikeThisQuery(..)
185− , FuzzyLikeFieldQuery(..)
186− , FuzzyQuery(..)
187− , HasChildQuery(..)
188− , HasParentQuery(..)
189− , IndicesQuery(..)
190− , MoreLikeThisQuery(..)
191− , MoreLikeThisFieldQuery(..)
192− , NestedQuery(..)
193− , PrefixQuery(..)
194− , QueryStringQuery(..)
195− , SimpleQueryStringQuery(..)
196− , RangeQuery(..)
197− , RegexpQuery(..)
198− , QueryString(..)
199− , TemplateQueryInline(..)
200− , TemplateQueryKeyValuePairs(..)
201− , BooleanOperator(..)
202− , ZeroTermsQuery(..)
203− , CutoffFrequency(..)
204− , Analyzer(..)
205− , MaxExpansions(..)
206− , Lenient(..)
207− , MatchQueryType(..)
208− , MultiMatchQueryType(..)
209− , Tiebreaker(..)
210− , MinimumMatch(..)
211− , DisableCoord(..)
212− , CommonMinimumMatch(..)
213− , MinimumMatchHighLow(..)
214− , PrefixLength(..)
215− , Fuzziness(..)
216− , IgnoreTermFrequency(..)
217− , MaxQueryTerms(..)
218− , ScoreType(..)
219− , Score
220− , Cache
221− , TypeName(..)
222− , BoostTerms(..)
223− , MaxWordLength(..)
224− , MinWordLength(..)
225− , MaxDocFrequency(..)
226− , MinDocFrequency(..)
227− , PhraseSlop(..)
228− , StopWord(..)
229− , QueryPath(..)
230− , MinimumTermFrequency(..)
231− , PercentMatch(..)
232− , FieldDefinition(..)
233− , MappingField(..)
234− , Mapping(..)
235− , AllowLeadingWildcard(..)
236− , LowercaseExpanded(..)
237− , GeneratePhraseQueries(..)
238− , Locale(..)
239− , AnalyzeWildcard(..)
240− , EnablePositionIncrements(..)
241− , SimpleQueryFlag(..)
242− , FieldOrFields(..)
243− , Monoid(..)
244− , ToJSON(..)
245− , Interval(..)
246− , TimeInterval(..)
247− , ExecutionHint(..)
248− , CollectionMode(..)
249− , TermOrder(..)
250− , TermInclusion(..)
251− , SnapshotRepoSelection(..)
252− , GenericSnapshotRepo(..)
253− , SnapshotRepo(..)
254− , SnapshotRepoConversionError(..)
255− , SnapshotRepoType(..)
256− , GenericSnapshotRepoSettings(..)
257− , SnapshotRepoUpdateSettings(..)
258− , defaultSnapshotRepoUpdateSettings
259− , SnapshotRepoName(..)
260− , SnapshotRepoPattern(..)
261− , SnapshotVerification(..)
262− , SnapshotNodeVerification(..)
263− , FullNodeId(..)
264− , NodeName(..)
265− , ClusterName(..)
266− , NodesInfo(..)
267− , NodesStats(..)
268− , NodeStats(..)
269− , NodeBreakersStats(..)
270− , NodeBreakerStats(..)
271− , NodeHTTPStats(..)
272− , NodeTransportStats(..)
273− , NodeFSStats(..)
274− , NodeDataPathStats(..)
275− , NodeFSTotalStats(..)
276− , NodeNetworkStats(..)
277− , NodeThreadPoolsStats(..)
278− , NodeThreadPoolStats(..)
279− , NodeJVMStats(..)
280− , JVMBufferPoolStats(..)
281− , JVMGCStats(..)
282− , JVMPoolStats(..)
283− , NodeProcessStats(..)
284− , NodeOSStats(..)
285− , LoadAvgs(..)
286− , NodeIndicesStats(..)
287− , EsAddress(..)
288− , PluginName(..)
289− , NodeInfo(..)
290− , NodePluginInfo(..)
291− , NodeHTTPInfo(..)
292− , NodeTransportInfo(..)
293− , BoundTransportAddress(..)
294− , NodeNetworkInfo(..)
295− , MacAddress(..)
296− , NetworkInterfaceName(..)
297− , NodeNetworkInterface(..)
298− , NodeThreadPoolsInfo(..)
299− , NodeThreadPoolInfo(..)
300− , ThreadPoolSize(..)
301− , ThreadPoolType(..)
302− , NodeJVMInfo(..)
303− , JVMMemoryPool(..)
304− , JVMGCCollector(..)
305− , JVMMemoryInfo(..)
306− , PID(..)
307− , NodeOSInfo(..)
308− , CPUInfo(..)
309− , NodeProcessInfo(..)
310− , FsSnapshotRepo(..)
311− , SnapshotCreateSettings(..)
312− , defaultSnapshotCreateSettings
313− , SnapshotSelection(..)
314− , SnapshotPattern(..)
315− , SnapshotInfo(..)
316− , SnapshotShardFailure(..)
317− , ShardId(..)
318− , SnapshotName(..)
319− , SnapshotState(..)
320− , SnapshotRestoreSettings(..)
321− , defaultSnapshotRestoreSettings
322− , RestoreRenamePattern(..)
323− , RestoreRenameToken(..)
324− , RRGroupRefNum
325− , rrGroupRefNum
326− , mkRRGroupRefNum
327− , RestoreIndexSettings(..)
328− , Suggest(..)
329− , SuggestType(..)
330− , PhraseSuggester(..)
331− , PhraseSuggesterHighlighter(..)
332− , PhraseSuggesterCollate(..)
333− , mkPhraseSuggester
334− , SuggestOptions(..)
335− , SuggestResponse(..)
336− , NamedSuggestionResponse(..)
337−
338− , Aggregation(..)
339− , Aggregations
340− , AggregationResults
341− , BucketValue(..)
342− , Bucket(..)
343− , BucketAggregation(..)
344− , TermsAggregation(..)
345− , MissingAggregation(..)
346− , ValueCountAggregation(..)
347− , FilterAggregation(..)
348− , CardinalityAggregation(..)
349− , DateHistogramAggregation(..)
350− , DateRangeAggregation(..)
351− , DateRangeAggRange(..)
352− , DateMathExpr(..)
353− , DateMathAnchor(..)
354− , DateMathModifier(..)
355− , DateMathUnit(..)
356− , TopHitsAggregation(..)
357− , StatisticsAggregation(..)
358−
359− , Highlights(..)
360− , FieldHighlight(..)
361− , HighlightSettings(..)
362− , PlainHighlight(..)
363− , PostingsHighlight(..)
364− , FastVectorHighlight(..)
365− , CommonHighlight(..)
366− , NonPostings(..)
367− , HighlightEncoder(..)
368− , HighlightTag(..)
369− , HitHighlight
370−
371− , MissingResult(..)
372− , TermsResult(..)
373− , DateHistogramResult(..)
374− , DateRangeResult(..)
375− , TopHitResult(..)
376−
377− , EsUsername(..)
378− , EsPassword(..)
379− ) where
380−
381−import Control.Applicative as A
382−import Control.Arrow (first)
383−import Control.Monad.Catch
384−import Control.Monad.Except
385−import Control.Monad.Reader (MonadReader (..),
386− ReaderT (..))
387−import Control.Monad.State (MonadState)
388−import Control.Monad.Writer (MonadWriter)
389−import Data.Aeson
390−import Data.Aeson.Types (Pair, Parser,
391− emptyObject,
392− parseEither, parseMaybe,
393− typeMismatch)
394−import qualified Data.ByteString.Lazy.Char8 as L
395−import Data.Char
396−import Data.Hashable (Hashable)
397−import qualified Data.HashMap.Strict as HM
398−import Data.List (foldl', intercalate,
399− nub)
400−import Data.List.NonEmpty (NonEmpty (..), toList)
401−import qualified Data.Map.Strict as M
402−import Data.Maybe
403−import Data.Scientific (Scientific)
404−import Data.Semigroup
405−import Data.Text (Text)
406−import qualified Data.Text as T
407−import Data.Time.Calendar
408−import Data.Time.Clock (NominalDiffTime,
409− UTCTime)
410−import Data.Time.Clock.POSIX
411−import qualified Data.Traversable as DT
412−import Data.Typeable (Typeable)
413−import qualified Data.Vector as V
414−import qualified Data.Version as Vers
415−import GHC.Enum
416−import GHC.Generics (Generic)
417−import Network.HTTP.Client
418−import qualified Network.HTTP.Types.Method as NHTM
419−import qualified Text.ParserCombinators.ReadP as RP
420−import qualified Text.Read as TR
421−
422−import Database.V5.Bloodhound.Types.Class
423−import Database.V5.Bloodhound.Types.Internal
424−
425−-- $setup
426−-- >>> :set -XOverloadedStrings
427−-- >>> import Data.Aeson
428−-- >>> import Database.V5.Bloodhound
429−-- >>> let testServer = (Server "http://localhost:9200")
430−-- >>> let testIndex = IndexName "twitter"
431−-- >>> let testMapping = MappingName "tweet"
432−-- >>> let defaultIndexSettings = IndexSettings (ShardCount 3) (ReplicaCount 2)
433−
434−-- defaultIndexSettings is exported by Database.Bloodhound as well
435−-- no trailing slashes in servers, library handles building the path.
436−
437−-- | Create a 'BHEnv' with all optional fields defaulted. HTTP hook
438−-- will be a noop. You can use the exported fields to customize it further, e.g.:
439−--
440−-- >> (mkBHEnv myServer myManager) { bhRequestHook = customHook }
441−mkBHEnv :: Server -> Manager -> BHEnv
442−mkBHEnv s m = BHEnv s m return
443−
444−newtype BH m a = BH {
445− unBH :: ReaderT BHEnv m a
446− } deriving ( Functor
447− , A.Applicative
448− , Monad
449− , MonadIO
450− , MonadState s
451− , MonadWriter w
452− , MonadError e
453− , Alternative
454− , MonadPlus
455− , MonadFix
456− , MonadThrow
457− , MonadCatch
458− , MonadMask)
459−
460−instance MonadTrans BH where
461− lift = BH . lift
462−
463−instance (MonadReader r m) => MonadReader r (BH m) where
464− ask = lift ask
465− local f (BH (ReaderT m)) = BH $ ReaderT $ \r ->
466− local f (m r)
467−
468−instance (Functor m, Applicative m, MonadIO m) => MonadBH (BH m) where
469− getBHEnv = BH getBHEnv
470−
471−runBH :: BHEnv -> BH m a -> m a
472−runBH e f = runReaderT (unBH f) e
473−
474−{-| 'Version' is embedded in 'Status' -}
475−data Version = Version { number :: VersionNumber
476− , build_hash :: BuildHash
477− , build_date :: UTCTime
478− , build_snapshot :: Bool
479− , lucene_version :: VersionNumber } deriving (Eq, Read, Show, Generic, Typeable)
480−
481−-- | Traditional software versioning number
482−newtype VersionNumber = VersionNumber { versionNumber :: Vers.Version
483− } deriving (Eq, Read, Show, Generic, Typeable, Ord)
484−
485−{-| 'Status' is a data type for describing the JSON body returned by
486− Elasticsearch when you query its status. This was deprecated in 1.2.0.
487−
488− <http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/indices-status.html#indices-status>
489−-}
490−
491−data Status = Status { name :: Text
492− , cluster_name :: Text
493− , cluster_uuid :: Text
494− , version :: Version
495− , tagline :: Text } deriving (Eq, Read, Show, Generic)
496−
497−{-| 'IndexSettings' is used to configure the shards and replicas when you create
498− an Elasticsearch Index.
499−
500− <http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/indices-create-index.html>
501−-}
502−
503−data IndexSettings =
504− IndexSettings { indexShards :: ShardCount
505− , indexReplicas :: ReplicaCount } deriving (Eq, Read, Show, Generic, Typeable)
506−
507−{-| 'defaultIndexSettings' is an 'IndexSettings' with 3 shards and 2 replicas. -}
508−defaultIndexSettings :: IndexSettings
509−defaultIndexSettings = IndexSettings (ShardCount 3) (ReplicaCount 2)
510−
511−
512−{-| 'ForceMergeIndexSettings' is used to configure index optimization. See
513− <https://www.elastic.co/guide/en/elasticsearch/reference/current/indices-forcemerge.html>
514− for more info.
515−-}
516−data ForceMergeIndexSettings =
517− ForceMergeIndexSettings { maxNumSegments :: Maybe Int
518− -- ^ 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.
519− , onlyExpungeDeletes :: Bool
520− -- ^ 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.
521− , flushAfterOptimize :: Bool
522− -- ^ Should a flush be performed after the optimize.
523− } deriving (Eq, Show, Generic, Typeable)
524−
525−
526−{-| 'defaultForceMergeIndexSettings' implements the default settings that
527− ElasticSearch uses for index optimization. 'maxNumSegments' is Nothing,
528− 'onlyExpungeDeletes' is False, and flushAfterOptimize is True.
529−-}
530−defaultForceMergeIndexSettings :: ForceMergeIndexSettings
531−defaultForceMergeIndexSettings = ForceMergeIndexSettings Nothing False True
532−
533−{-| 'UpdatableIndexSetting' are settings which may be updated after an index is created.
534−
535− <https://www.elastic.co/guide/en/elasticsearch/reference/current/indices-update-settings.html>
536−-}
537−data UpdatableIndexSetting = NumberOfReplicas ReplicaCount
538− -- ^ The number of replicas each shard has.
539− | AutoExpandReplicas ReplicaBounds
540− | BlocksReadOnly Bool
541− -- ^ Set to True to have the index read only. False to allow writes and metadata changes.
542− | BlocksRead Bool
543− -- ^ Set to True to disable read operations against the index.
544− | BlocksWrite Bool
545− -- ^ Set to True to disable write operations against the index.
546− | BlocksMetaData Bool
547− -- ^ Set to True to disable metadata operations against the index.
548− | RefreshInterval NominalDiffTime
549− -- ^ The async refresh interval of a shard
550− | IndexConcurrency Int
551− | FailOnMergeFailure Bool
552− | TranslogFlushThresholdOps Int
553− -- ^ When to flush on operations.
554− | TranslogFlushThresholdSize Bytes
555− -- ^ When to flush based on translog (bytes) size.
556− | TranslogFlushThresholdPeriod NominalDiffTime
557− -- ^ When to flush based on a period of not flushing.
558− | TranslogDisableFlush Bool
559− -- ^ Disables flushing. Note, should be set for a short interval and then enabled.
560− | CacheFilterMaxSize (Maybe Bytes)
561− -- ^ The maximum size of filter cache (per segment in shard).
562− | CacheFilterExpire (Maybe NominalDiffTime)
563− -- ^ The expire after access time for filter cache.
564− | GatewaySnapshotInterval NominalDiffTime
565− -- ^ The gateway snapshot interval (only applies to shared gateways).
566− | RoutingAllocationInclude (NonEmpty NodeAttrFilter)
567− -- ^ A node matching any rule will be allowed to host shards from the index.
568− | RoutingAllocationExclude (NonEmpty NodeAttrFilter)
569− -- ^ A node matching any rule will NOT be allowed to host shards from the index.
570− | RoutingAllocationRequire (NonEmpty NodeAttrFilter)
571− -- ^ Only nodes matching all rules will be allowed to host shards from the index.
572− | RoutingAllocationEnable AllocationPolicy
573− -- ^ Enables shard allocation for a specific index.
574− | RoutingAllocationShardsPerNode ShardCount
575− -- ^ Controls the total number of shards (replicas and primaries) allowed to be allocated on a single node.
576− | RecoveryInitialShards InitialShardCount
577− -- ^ When using local gateway a particular shard is recovered only if there can be allocated quorum shards in the cluster.
578− | GCDeletes NominalDiffTime
579− | TTLDisablePurge Bool
580− -- ^ Disables temporarily the purge of expired docs.
581− | TranslogFSType FSType
582− | IndexCompoundFormat CompoundFormat
583− | IndexCompoundOnFlush Bool
584− | WarmerEnabled Bool
585− | MappingTotalFieldsLimit Int
586− deriving (Eq, Show, Generic, Typeable)
587−
588−data AllocationPolicy = AllocAll
589− -- ^ Allows shard allocation for all shards.
590− | AllocPrimaries
591− -- ^ Allows shard allocation only for primary shards.
592− | AllocNewPrimaries
593− -- ^ Allows shard allocation only for primary shards for new indices.
594− | AllocNone
595− -- ^ No shard allocation is allowed
596− deriving (Eq, Read, Show, Generic, Typeable)
597−
598−data ReplicaBounds = ReplicasBounded Int Int
599− | ReplicasLowerBounded Int
600− | ReplicasUnbounded
601− deriving (Eq, Read, Show, Generic, Typeable)
602−
603−-- | A measure of bytes used for various configurations. You may want
604−-- to use smart constructors like 'gigabytes' for larger values.
605−--
606−-- >>> gigabytes 9
607−-- Bytes 9000000000
608−--
609−-- >>> megabytes 9
610−-- Bytes 9000000
611−--
612−-- >>> kilobytes 9
613−-- Bytes 9000
614−newtype Bytes = Bytes Int deriving (Eq, Read, Show, Generic, Typeable, Ord, ToJSON, FromJSON)
615−
616−gigabytes :: Int -> Bytes
617−gigabytes n = megabytes (1000 * n)
618−
619−
620−megabytes :: Int -> Bytes
621−megabytes n = kilobytes (1000 * n)
622−
623−
624−kilobytes :: Int -> Bytes
625−kilobytes n = Bytes (1000 * n)
626−
627−
628−data FSType = FSSimple
629− | FSBuffered deriving (Eq, Read, Show, Generic, Typeable, Ord)
630−
631−data InitialShardCount = QuorumShards
632− | QuorumMinus1Shards
633− | FullShards
634− | FullMinus1Shards
635− | ExplicitShards Int
636− deriving (Eq, Read, Show, Generic, Typeable)
637−
638−data NodeAttrFilter = NodeAttrFilter { nodeAttrFilterName :: NodeAttrName
639− , nodeAttrFilterValues :: NonEmpty Text}
640− deriving (Eq, Read, Show, Generic, Ord, Typeable)
641−
642−newtype NodeAttrName = NodeAttrName Text deriving (Eq, Read, Show, Ord, Generic, Typeable)
643−
644−data CompoundFormat = CompoundFileFormat Bool
645− | MergeSegmentVsTotalIndex Double
646− -- ^ percentage between 0 and 1 where 0 is false, 1 is true
647− deriving (Eq, Read, Show, Generic, Typeable)
648−
649−newtype NominalDiffTimeJSON = NominalDiffTimeJSON { ndtJSON :: NominalDiffTime }
650−
651−data IndexSettingsSummary = IndexSettingsSummary { sSummaryIndexName :: IndexName
652− , sSummaryFixedSettings :: IndexSettings
653− , sSummaryUpdateable :: [UpdatableIndexSetting]}
654− deriving (Eq, Show, Generic, Typeable)
655−
656−{-| 'Reply' and 'Method' are type synonyms from 'Network.HTTP.Types.Method.Method' -}
657−type Reply = Network.HTTP.Client.Response L.ByteString
658−type Method = NHTM.Method
659−
660−{-| 'OpenCloseIndex' is a sum type for opening and closing indices.
661−
662− <http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/indices-open-close.html>
663−-}
664−data OpenCloseIndex = OpenIndex | CloseIndex deriving (Eq, Read, Show, Generic, Typeable)
665−
666−data FieldType = GeoPointType
667− | GeoShapeType
668− | FloatType
669− | IntegerType
670− | LongType
671− | ShortType
672− | ByteType deriving (Eq, Read, Show, Generic, Typeable)
673−
674−data FieldDefinition =
675− FieldDefinition { fieldType :: FieldType } deriving (Eq, Read, Show, Generic, Typeable)
676−
677−{-| An 'IndexTemplate' defines a template that will automatically be
678− applied to new indices created. The templates include both
679− 'IndexSettings' and mappings, and a simple 'TemplatePattern' that
680− controls if the template will be applied to the index created.
681− Specify mappings as follows: @[toJSON TweetMapping, ...]@
682−
683− https://www.elastic.co/guide/en/elasticsearch/reference/1.7/indices-templates.html
684−-}
685−data IndexTemplate =
686− IndexTemplate { templatePattern :: TemplatePattern
687− , templateSettings :: Maybe IndexSettings
688− , templateMappings :: [Value]
689− }
690−
691−data MappingField =
692− MappingField { mappingFieldName :: FieldName
693− , fieldDefinition :: FieldDefinition } deriving (Eq, Read, Show, Generic, Typeable)
694−
695−{-| Support for type reification of 'Mapping's is currently incomplete, for
696− now the mapping API verbiage expects a 'ToJSON'able blob.
697−
698− Indexes have mappings, mappings are schemas for the documents contained in the
699− index. I'd recommend having only one mapping per index, always having a mapping,
700− and keeping different kinds of documents separated if possible.
701−-}
702−data Mapping = Mapping { typeName :: TypeName
703− , mappingFields :: [MappingField] } deriving (Eq, Read, Show, Generic, Typeable)
704−
705−{-| 'BulkOperation' is a sum type for expressing the four kinds of bulk
706− operation index, create, delete, and update. 'BulkIndex' behaves like an
707− "upsert", 'BulkCreate' will fail if a document already exists at the DocId.
708−
709− <http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/docs-bulk.html#docs-bulk>
710−-}
711−data BulkOperation =
712− BulkIndex IndexName MappingName DocId Value
713− | BulkCreate IndexName MappingName DocId Value
714− | BulkCreateEncoding IndexName MappingName DocId Encoding
715− | BulkDelete IndexName MappingName DocId
716− | BulkUpdate IndexName MappingName DocId Value deriving (Eq, Show, Generic, Typeable)
717−
718−{-| 'EsResult' describes the standard wrapper JSON document that you see in
719− successful Elasticsearch lookups or lookups that couldn't find the document.
720−-}
721−data EsResult a = EsResult { _index :: Text
722− , _type :: Text
723− , _id :: Text
724− , foundResult :: Maybe (EsResultFound a)} deriving (Eq, Read, Show, Generic, Typeable)
725−
726−{-| 'EsResultFound' contains the document and its metadata inside of an
727− 'EsResult' when the document was successfully found.
728−-}
729−data EsResultFound a = EsResultFound { _version :: DocVersion
730− , _source :: a } deriving (Eq, Read, Show, Generic, Typeable)
731−
732−{-| 'EsError' is the generic type that will be returned when there was a
733− problem. If you can't parse the expected response, its a good idea to
734− try parsing this.
735−-}
736−data EsError = EsError { errorStatus :: Int
737− , errorMessage :: Text } deriving (Eq, Read, Show, Generic, Typeable)
738−
739−{-| 'EsProtocolException' will be thrown if Bloodhound cannot parse a response
740−returned by the ElasticSearch server. If you encounter this error, please
741−verify that your domain data types and FromJSON instances are working properly
742−(for example, the 'a' of '[Hit a]' in 'SearchResult.searchHits.hits'). If you're
743−sure that your mappings are correct, then this error may be an indication of an
744−incompatibility between Bloodhound and ElasticSearch. Please open a bug report
745−and be sure to include the exception body.
746−-}
747−data EsProtocolException = EsProtocolException { esProtoExBody :: L.ByteString }
748− deriving (Eq, Read, Show, Generic, Typeable)
749−
750−instance Exception EsProtocolException
751−
752−data IndexAlias = IndexAlias { srcIndex :: IndexName
753− , indexAlias :: IndexAliasName } deriving (Eq, Read, Show, Generic, Typeable)
754−
755−newtype IndexAliasName = IndexAliasName { indexAliasName :: IndexName } deriving (Eq, Read, Show, Generic, ToJSON)
756−
757−data IndexAliasAction = AddAlias IndexAlias IndexAliasCreate
758− | RemoveAlias IndexAlias deriving (Read, Show, Eq, Generic, Typeable)
759−
760−data IndexAliasCreate = IndexAliasCreate { aliasCreateRouting :: Maybe AliasRouting
761− , aliasCreateFilter :: Maybe Filter}
762− deriving (Read, Show, Eq, Generic, Typeable)
763−
764−data AliasRouting = AllAliasRouting RoutingValue
765− | GranularAliasRouting (Maybe SearchAliasRouting) (Maybe IndexAliasRouting)
766− deriving (Read, Show, Eq, Generic, Typeable)
767−
768−newtype SearchAliasRouting = SearchAliasRouting (NonEmpty RoutingValue) deriving (Read, Show, Eq, Generic, Typeable)
769−
770−newtype IndexAliasRouting = IndexAliasRouting RoutingValue deriving (Read, Show, Eq, Generic, ToJSON, FromJSON, Typeable)
771−
772−newtype RoutingValue = RoutingValue { routingValue :: Text } deriving (Read, Show, Eq, Generic, ToJSON, FromJSON, Typeable)
773−
774−newtype IndexAliasesSummary = IndexAliasesSummary { indexAliasesSummary :: [IndexAliasSummary] } deriving (Read, Show, Eq, Generic, Typeable)
775−
776−{-| 'IndexAliasSummary' is a summary of an index alias configured for a server. -}
777−data IndexAliasSummary = IndexAliasSummary { indexAliasSummaryAlias :: IndexAlias
778− , indexAliasSummaryCreate :: IndexAliasCreate} deriving (Read, Show, Eq, Generic, Typeable)
779−
780−{-| 'DocVersion' is an integer version number for a document between 1
781−and 9.2e+18 used for <<https://www.elastic.co/guide/en/elasticsearch/guide/current/optimistic-concurrency-control.html optimistic concurrency control>>.
782−-}
783−newtype DocVersion = DocVersion {
784− docVersionNumber :: Int
785− } deriving (Eq, Read, Show, Generic, Ord, ToJSON)
786−
787−-- | Smart constructor for in-range doc version
788−mkDocVersion :: Int -> Maybe DocVersion
789−mkDocVersion i
790− | i >= (docVersionNumber minBound) && i <= (docVersionNumber maxBound) =
791− Just $ DocVersion i
792− | otherwise = Nothing
793−
794−
795−{-| 'ExternalDocVersion' is a convenience wrapper if your code uses its
796−own version numbers instead of ones from ES.
797−-}
798−newtype ExternalDocVersion = ExternalDocVersion DocVersion
799− deriving (Eq, Read, Show, Generic, Ord, Bounded, Enum, ToJSON)
800−
801−{-| 'VersionControl' is specified when indexing documents as a
802−optimistic concurrency control.
803−-}
804−data VersionControl = NoVersionControl
805− -- ^ Don't send a version. This is a pure overwrite.
806− | InternalVersion DocVersion
807− -- ^ Use the default ES versioning scheme. Only
808− -- index the document if the version is the same
809− -- as the one specified. Only applicable to
810− -- updates, as you should be getting Version from
811− -- a search result.
812− | ExternalGT ExternalDocVersion
813− -- ^ Use your own version numbering. Only index
814− -- the document if the version is strictly higher
815− -- OR the document doesn't exist. The given
816− -- version will be used as the new version number
817− -- for the stored document. N.B. All updates must
818− -- increment this number, meaning there is some
819− -- global, external ordering of updates.
820− | ExternalGTE ExternalDocVersion
821− -- ^ Use your own version numbering. Only index
822− -- the document if the version is equal or higher
823− -- than the stored version. Will succeed if there
824− -- is no existing document. The given version will
825− -- be used as the new version number for the
826− -- stored document. Use with care, as this could
827− -- result in data loss.
828− | ForceVersion ExternalDocVersion
829− -- ^ The document will always be indexed and the
830− -- given version will be the new version. This is
831− -- typically used for correcting errors. Use with
832− -- care, as this could result in data loss.
833− deriving (Read, Show, Eq, Generic, Ord)
834−
835−{-| 'DocumentParent' is used to specify a parent document.
836−-}
837−newtype DocumentParent = DocumentParent DocId
838− deriving (Eq, Read, Show, Generic, Typeable)
839−
840−{-| 'IndexDocumentSettings' are special settings supplied when indexing
841−a document. For the best backwards compatiblity when new fields are
842−added, you should probably prefer to start with 'defaultIndexDocumentSettings'
843−-}
844−data IndexDocumentSettings =
845− IndexDocumentSettings { idsVersionControl :: VersionControl
846− , idsParent :: Maybe DocumentParent
847− } deriving (Eq, Read, Show, Generic, Typeable)
848−
849−{-| Reasonable default settings. Chooses no version control and no parent.
850−-}
851−defaultIndexDocumentSettings :: IndexDocumentSettings
852−defaultIndexDocumentSettings = IndexDocumentSettings NoVersionControl Nothing
853−
854−{-| 'Sort' is a synonym for a list of 'SortSpec's. Sort behavior is order
855− dependent with later sorts acting as tie-breakers for earlier sorts.
856−-}
857−type Sort = [SortSpec]
858−
859−{-| The two main kinds of 'SortSpec' are 'DefaultSortSpec' and
860− 'GeoDistanceSortSpec'. The latter takes a 'SortOrder', 'GeoPoint', and
861− 'DistanceUnit' to express "nearness" to a single geographical point as a
862− sort specification.
863−
864−<http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/search-request-sort.html#search-request-sort>
865−-}
866−data SortSpec = DefaultSortSpec DefaultSort
867− | GeoDistanceSortSpec SortOrder GeoPoint DistanceUnit deriving (Eq, Read, Show, Generic, Typeable)
868−
869−{-| 'DefaultSort' is usually the kind of 'SortSpec' you'll want. There's a
870− 'mkSort' convenience function for when you want to specify only the most
871− common parameters.
872−
873− The `ignoreUnmapped`, when `Just` field is used to set the elastic 'unmapped_type'
874−
875−<http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/search-request-sort.html#search-request-sort>
876−-}
877−data DefaultSort =
878− DefaultSort { sortFieldName :: FieldName
879− , sortOrder :: SortOrder
880− -- default False
881− , ignoreUnmapped :: Maybe Text
882− , sortMode :: Maybe SortMode
883− , missingSort :: Maybe Missing
884− , nestedFilter :: Maybe Filter } deriving (Eq, Read, Show, Generic, Typeable)
885−
886−{-| 'SortOrder' is 'Ascending' or 'Descending', as you might expect. These get
887− encoded into "asc" or "desc" when turned into JSON.
888−
889−<http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/search-request-sort.html#search-request-sort>
890−-}
891−data SortOrder = Ascending
892− | Descending deriving (Eq, Read, Show, Generic, Typeable)
893−
894−{-| 'Missing' prescribes how to handle missing fields. A missing field can be
895− sorted last, first, or using a custom value as a substitute.
896−
897−<http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/search-request-sort.html#_missing_values>
898−-}
899−data Missing = LastMissing
900− | FirstMissing
901− | CustomMissing Text deriving (Eq, Read, Show, Generic, Typeable)
902−
903−{-| 'SortMode' prescribes how to handle sorting array/multi-valued fields.
904−
905−http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/search-request-sort.html#_sort_mode_option
906−-}
907−data SortMode = SortMin
908− | SortMax
909− | SortSum
910− | SortAvg deriving (Eq, Read, Show, Generic, Typeable)
911−
912−{-| 'mkSort' defaults everything but the 'FieldName' and the 'SortOrder' so
913− that you can concisely describe the usual kind of 'SortSpec's you want.
914−-}
915−mkSort :: FieldName -> SortOrder -> DefaultSort
916−mkSort fieldName sOrder = DefaultSort fieldName sOrder Nothing Nothing Nothing Nothing
917−
918−{-| 'Cache' is for telling ES whether it should cache a 'Filter' not.
919− 'Query's cannot be cached.
920−-}
921−type Cache = Bool -- caching on/off
922−defaultCache :: Cache
923−defaultCache = False
924−
925−{-| 'PrefixValue' is used in 'PrefixQuery' as the main query component.
926−-}
927−-- type PrefixValue = Text
928−
929−{-| 'BooleanOperator' is the usual And/Or operators with an ES compatible
930− JSON encoding baked in. Used all over the place.
931−-}
932−data BooleanOperator = And | Or deriving (Eq, Read, Show, Generic, Typeable)
933−
934−{-| 'ShardCount' is part of 'IndexSettings'
935−-}
936−newtype ShardCount = ShardCount Int deriving (Eq, Read, Show, Generic, ToJSON, Typeable)
937−
938−{-| 'ReplicaCount' is part of 'IndexSettings'
939−-}
940−newtype ReplicaCount = ReplicaCount Int deriving (Eq, Read, Show, Generic, ToJSON, Typeable)
941−
942−{-| 'IndexName' is used to describe which index to query/create/delete
943−-}
944−newtype IndexName = IndexName Text deriving (Eq, Generic, Read, Show, ToJSON, FromJSON, Typeable)
945−
946−{-| 'IndexSelection' is used for APIs which take a single index, a list of
947− indexes, or the special @_all@ index.
948−-}
949−--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.
950−data IndexSelection = IndexList (NonEmpty IndexName)
951− | AllIndexes deriving (Eq, Generic, Show, Typeable)
952−
953−{-| '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.
954−-}
955−data NodeSelection = LocalNode
956− -- ^ Whatever node receives this request
957− | NodeList (NonEmpty NodeSelector)
958− | AllNodes deriving (Eq, Generic, Show, Typeable)
959−
960−
961−-- | An exact match or pattern to identify a node. Note that All of
962−-- these options support wildcarding, so your node name, server, attr
963−-- name can all contain * characters to be a fuzzy match.
964−data NodeSelector = NodeByName NodeName
965− | NodeByFullNodeId FullNodeId
966− | NodeByHost Server
967− -- ^ e.g. 10.0.0.1 or even 10.0.0.*
968− | NodeByAttribute NodeAttrName Text
969− -- ^ NodeAttrName can be a pattern, e.g. rack*. The value can too.
970− deriving (Eq, Generic, Show, Typeable)
971−
972−{-| 'TemplateName' is used to describe which template to query/create/delete
973−-}
974−newtype TemplateName = TemplateName Text deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
975−
976−{-| 'TemplatePattern' represents a pattern which is matched against index names
977−-}
978−newtype TemplatePattern = TemplatePattern Text deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
979−
980−{-| 'MappingName' is part of mappings which are how ES describes and schematizes
981− the data in the indices.
982−-}
983−newtype MappingName = MappingName Text deriving (Eq, Generic, Read, Show, ToJSON, FromJSON, Typeable)
984−
985−{-| 'DocId' is a generic wrapper value for expressing unique Document IDs.
986− Can be set by the user or created by ES itself. Often used in client
987− functions for poking at specific documents.
988−-}
989−newtype DocId = DocId Text deriving (Eq, Generic, Read, Show, ToJSON, FromJSON, Typeable)
990−
991−{-| 'QueryString' is used to wrap query text bodies, be they human written or not.
992−-}
993−newtype QueryString = QueryString Text deriving (Eq, Generic, Read, Show, ToJSON, FromJSON, Typeable)
994−
995−{-| 'FieldName' is used all over the place wherever a specific field within
996− a document needs to be specified, usually in 'Query's or 'Filter's.
997−-}
998−newtype FieldName = FieldName Text deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
999−
1000−
1001−{-| 'Script' is often used in place of 'FieldName' to specify more
1002−complex ways of extracting a value from a document.
1003−-}
1004−newtype Script = Script { scriptText :: Text } deriving (Eq, Read, Show, Generic, Typeable)
1005−
1006−{-| 'CacheName' is used in 'RegexpFilter' for describing the
1007− 'CacheKey' keyed caching behavior.
1008−-}
1009−newtype CacheName = CacheName Text deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1010−
1011−{-| 'CacheKey' is used in 'RegexpFilter' to key regex caching.
1012−-}
1013−newtype CacheKey =
1014− CacheKey Text deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1015−newtype Existence =
1016− Existence Bool deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1017−newtype NullValue =
1018− NullValue Bool deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1019−newtype CutoffFrequency =
1020− CutoffFrequency Double deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1021−newtype Analyzer =
1022− Analyzer Text deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1023−newtype MaxExpansions =
1024− MaxExpansions Int deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1025−
1026−{-| 'Lenient', if set to true, will cause format based failures to be
1027− ignored. I don't know what the bloody default is, Elasticsearch
1028− documentation didn't say what it was. Let me know if you figure it out.
1029−-}
1030−newtype Lenient =
1031− Lenient Bool deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1032−newtype Tiebreaker =
1033− Tiebreaker Double deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1034−newtype Boost =
1035− Boost Double deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1036−newtype BoostTerms =
1037− BoostTerms Double deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1038−
1039−{-| 'MinimumMatch' controls how many should clauses in the bool query should
1040− match. Can be an absolute value (2) or a percentage (30%) or a
1041− combination of both.
1042−-}
1043−newtype MinimumMatch =
1044− MinimumMatch Int deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1045−newtype DisableCoord =
1046− DisableCoord Bool deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1047−newtype IgnoreTermFrequency =
1048− IgnoreTermFrequency Bool deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1049−newtype MinimumTermFrequency =
1050− MinimumTermFrequency Int deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1051−newtype MaxQueryTerms =
1052− MaxQueryTerms Int deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1053−newtype Fuzziness =
1054− Fuzziness Double deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1055−
1056−{-| 'PrefixLength' is the prefix length used in queries, defaults to 0. -}
1057−newtype PrefixLength =
1058− PrefixLength Int deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1059−newtype TypeName =
1060− TypeName Text deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1061−newtype PercentMatch =
1062− PercentMatch Double deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1063−newtype StopWord =
1064− StopWord Text deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1065−newtype QueryPath =
1066− QueryPath Text deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1067−
1068−{-| Allowing a wildcard at the beginning of a word (eg "*ing") is particularly
1069− heavy, because all terms in the index need to be examined, just in case
1070− they match. Leading wildcards can be disabled by setting
1071− 'AllowLeadingWildcard' to false. -}
1072−newtype AllowLeadingWildcard =
1073− AllowLeadingWildcard Bool deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1074−newtype LowercaseExpanded =
1075− LowercaseExpanded Bool deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1076−newtype EnablePositionIncrements =
1077− EnablePositionIncrements Bool deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1078−
1079−{-| By default, wildcard terms in a query are not analyzed.
1080− Setting 'AnalyzeWildcard' to true enables best-effort analysis.
1081−-}
1082−newtype AnalyzeWildcard = AnalyzeWildcard Bool deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1083−
1084−{-| 'GeneratePhraseQueries' defaults to false.
1085−-}
1086−newtype GeneratePhraseQueries =
1087− GeneratePhraseQueries Bool deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1088−
1089−{-| 'Locale' is used for string conversions - defaults to ROOT.
1090−-}
1091−newtype Locale = Locale Text deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1092−newtype MaxWordLength = MaxWordLength Int deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1093−newtype MinWordLength = MinWordLength Int deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1094−
1095−{-| 'PhraseSlop' sets the default slop for phrases, 0 means exact
1096− phrase matches. Default is 0.
1097−-}
1098−newtype PhraseSlop = PhraseSlop Int deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1099−newtype MinDocFrequency = MinDocFrequency Int deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1100−newtype MaxDocFrequency = MaxDocFrequency Int deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1101−
1102−-- | Newtype wrapper to parse ES's concerning tendency to in some APIs return a floating point number of milliseconds since epoch ಠ_ಠ
1103−newtype POSIXMS = POSIXMS { posixMS :: UTCTime }
1104−
1105−{-| 'unpackId' is a silly convenience function that gets used once.
1106−-}
1107−unpackId :: DocId -> Text
1108−unpackId (DocId docId) = docId
1109−
1110−type TrackSortScores = Bool
1111−newtype From = From Int deriving (Eq, Read, Show, Generic, ToJSON)
1112−newtype Size = Size Int deriving (Eq, Read, Show, Generic, ToJSON, FromJSON)
1113−
1114−data Search = Search { queryBody :: Maybe Query
1115− , filterBody :: Maybe Filter
1116− , sortBody :: Maybe Sort
1117− , aggBody :: Maybe Aggregations
1118− , highlight :: Maybe Highlights
1119− -- default False
1120− , trackSortScores :: TrackSortScores
1121− , from :: From
1122− , size :: Size
1123− , searchType :: SearchType
1124− , fields :: Maybe [FieldName]
1125− , source :: Maybe Source
1126− , suggestBody :: Maybe Suggest -- ^ Only one Suggestion request / response per Search is supported.
1127− } deriving (Eq, Read, Show, Generic, Typeable)
1128−
1129−data SearchType = SearchTypeQueryThenFetch
1130− | SearchTypeDfsQueryThenFetch
1131− deriving (Eq, Read, Show, Generic, Typeable)
1132−
1133−data Source =
1134− NoSource
1135− | SourcePatterns PatternOrPatterns
1136− | SourceIncludeExclude Include Exclude
1137− deriving (Read, Show, Eq, Generic, Typeable)
1138−
1139−data PatternOrPatterns = PopPattern Pattern
1140− | PopPatterns [Pattern] deriving (Eq, Read, Show, Generic, Typeable)
1141−
1142−data Include = Include [Pattern] deriving (Eq, Read, Show, Generic, Typeable)
1143−data Exclude = Exclude [Pattern] deriving (Eq, Read, Show, Generic, Typeable)
1144−
1145−newtype Pattern = Pattern Text deriving (Eq, Read, Show, Generic, Typeable)
1146−
1147−data Highlights = Highlights { globalsettings :: Maybe HighlightSettings
1148− , highlightFields :: [FieldHighlight]
1149− } deriving (Read, Show, Eq, Generic, Typeable)
1150−
1151−data FieldHighlight = FieldHighlight FieldName (Maybe HighlightSettings)
1152− deriving (Read, Show, Eq, Generic, Typeable)
1153−
1154−
1155−data HighlightSettings = Plain PlainHighlight
1156− | Postings PostingsHighlight
1157− | FastVector FastVectorHighlight
1158− deriving (Read, Show, Eq, Generic, Typeable)
1159−data PlainHighlight =
1160− PlainHighlight { plainCommon :: Maybe CommonHighlight
1161− , plainNonPost :: Maybe NonPostings } deriving (Read, Show, Eq, Generic, Typeable)
1162−
1163− -- This requires that index_options are set to 'offset' in the mapping.
1164−data PostingsHighlight = PostingsHighlight (Maybe CommonHighlight) deriving (Read, Show, Eq, Generic, Typeable)
1165−
1166−-- This requires that term_vector is set to 'with_positions_offsets' in the mapping.
1167−data FastVectorHighlight =
1168− FastVectorHighlight { fvCommon :: Maybe CommonHighlight
1169− , fvNonPostSettings :: Maybe NonPostings
1170− , boundaryChars :: Maybe Text
1171− , boundaryMaxScan :: Maybe Int
1172− , fragmentOffset :: Maybe Int
1173− , matchedFields :: [Text]
1174− , phraseLimit :: Maybe Int
1175− } deriving (Read, Show, Eq, Generic, Typeable)
1176−
1177−data CommonHighlight =
1178− CommonHighlight { order :: Maybe Text
1179− , forceSource :: Maybe Bool
1180− , tag :: Maybe HighlightTag
1181− , encoder :: Maybe HighlightEncoder
1182− , noMatchSize :: Maybe Int
1183− , highlightQuery :: Maybe Query
1184− , requireFieldMatch :: Maybe Bool
1185− } deriving (Read, Show, Eq, Generic, Typeable)
1186−
1187−-- Settings that are only applicable to FastVector and Plain highlighters.
1188−data NonPostings =
1189− NonPostings { fragmentSize :: Maybe Int
1190− , numberOfFragments :: Maybe Int} deriving (Read, Show, Eq, Generic, Typeable)
1191−
1192−data HighlightEncoder = DefaultEncoder
1193− | HTMLEncoder
1194− deriving (Read, Show, Eq, Generic, Typeable)
1195−
1196−-- NOTE: Should the tags use some kind of HTML type, rather than Text?
1197−data HighlightTag = TagSchema Text
1198− | CustomTags ([Text], [Text]) -- Only uses more than the first value in the lists if fvh
1199− deriving (Read, Show, Eq, Generic, Typeable)
1200−
1201−
1202−data Query =
1203− TermQuery Term (Maybe Boost)
1204− | TermsQuery Text (NonEmpty Text)
1205− | QueryMatchQuery MatchQuery
1206− | QueryMultiMatchQuery MultiMatchQuery
1207− | QueryBoolQuery BoolQuery
1208− | QueryBoostingQuery BoostingQuery
1209− | QueryCommonTermsQuery CommonTermsQuery
1210− | ConstantScoreQuery Query Boost
1211− | QueryDisMaxQuery DisMaxQuery
1212− | QueryFuzzyLikeThisQuery FuzzyLikeThisQuery
1213− | QueryFuzzyLikeFieldQuery FuzzyLikeFieldQuery
1214− | QueryFuzzyQuery FuzzyQuery
1215− | QueryHasChildQuery HasChildQuery
1216− | QueryHasParentQuery HasParentQuery
1217− | IdsQuery MappingName [DocId]
1218− | QueryIndicesQuery IndicesQuery
1219− | MatchAllQuery (Maybe Boost)
1220− | QueryMoreLikeThisQuery MoreLikeThisQuery
1221− | QueryMoreLikeThisFieldQuery MoreLikeThisFieldQuery
1222− | QueryNestedQuery NestedQuery
1223− | QueryPrefixQuery PrefixQuery
1224− | QueryQueryStringQuery QueryStringQuery
1225− | QuerySimpleQueryStringQuery SimpleQueryStringQuery
1226− | QueryRangeQuery RangeQuery
1227− | QueryRegexpQuery RegexpQuery
1228− | QueryExistsQuery FieldName
1229− | QueryMatchNoneQuery
1230− | QueryTemplateQueryInline TemplateQueryInline
1231− deriving (Eq, Read, Show, Generic, Typeable)
1232−
1233−-- | As of Elastic 2.0, 'Filters' are just 'Queries' housed in a Bool Query, and
1234−-- flagged in a different context.
1235−newtype Filter = Filter { unFilter :: Query }
1236− deriving (Eq, Read, Show, Generic, Typeable)
1237−
1238−instance ToJSON Filter where
1239− toJSON = toJSON . unFilter
1240−
1241−instance FromJSON Filter where
1242− parseJSON v = Filter <$> parseJSON v
1243−
1244−data RegexpQuery =
1245− RegexpQuery { regexpQueryField :: FieldName
1246− , regexpQuery :: Regexp
1247− , regexpQueryFlags :: RegexpFlags
1248− , regexpQueryBoost :: Maybe Boost
1249− } deriving (Eq, Read, Show, Generic, Typeable)
1250−
1251−data RangeQuery =
1252− RangeQuery { rangeQueryField :: FieldName
1253− , rangeQueryRange :: RangeValue
1254− , rangeQueryBoost :: Boost } deriving (Eq, Read, Show, Generic, Typeable)
1255−
1256−mkRangeQuery :: FieldName -> RangeValue -> RangeQuery
1257−mkRangeQuery f r = RangeQuery f r (Boost 1.0)
1258−
1259−data SimpleQueryStringQuery =
1260− SimpleQueryStringQuery
1261− { simpleQueryStringQuery :: QueryString
1262− , simpleQueryStringField :: Maybe FieldOrFields
1263− , simpleQueryStringOperator :: Maybe BooleanOperator
1264− , simpleQueryStringAnalyzer :: Maybe Analyzer
1265− , simpleQueryStringFlags :: Maybe (NonEmpty SimpleQueryFlag)
1266− , simpleQueryStringLowercaseExpanded :: Maybe LowercaseExpanded
1267− , simpleQueryStringLocale :: Maybe Locale
1268− } deriving (Eq, Read, Show, Generic, Typeable)
1269−
1270−data SimpleQueryFlag =
1271− SimpleQueryAll
1272− | SimpleQueryNone
1273− | SimpleQueryAnd
1274− | SimpleQueryOr
1275− | SimpleQueryPrefix
1276− | SimpleQueryPhrase
1277− | SimpleQueryPrecedence
1278− | SimpleQueryEscape
1279− | SimpleQueryWhitespace
1280− | SimpleQueryFuzzy
1281− | SimpleQueryNear
1282− | SimpleQuerySlop deriving (Eq, Read, Show, Generic, Typeable)
1283−
1284−-- use_dis_max and tie_breaker when fields are plural?
1285−data QueryStringQuery =
1286− QueryStringQuery
1287− { queryStringQuery :: QueryString
1288− , queryStringDefaultField :: Maybe FieldName
1289− , queryStringOperator :: Maybe BooleanOperator
1290− , queryStringAnalyzer :: Maybe Analyzer
1291− , queryStringAllowLeadingWildcard :: Maybe AllowLeadingWildcard
1292− , queryStringLowercaseExpanded :: Maybe LowercaseExpanded
1293− , queryStringEnablePositionIncrements :: Maybe EnablePositionIncrements
1294− , queryStringFuzzyMaxExpansions :: Maybe MaxExpansions
1295− , queryStringFuzziness :: Maybe Fuzziness
1296− , queryStringFuzzyPrefixLength :: Maybe PrefixLength
1297− , queryStringPhraseSlop :: Maybe PhraseSlop
1298− , queryStringBoost :: Maybe Boost
1299− , queryStringAnalyzeWildcard :: Maybe AnalyzeWildcard
1300− , queryStringGeneratePhraseQueries :: Maybe GeneratePhraseQueries
1301− , queryStringMinimumShouldMatch :: Maybe MinimumMatch
1302− , queryStringLenient :: Maybe Lenient
1303− , queryStringLocale :: Maybe Locale
1304− } deriving (Eq, Read, Show, Generic, Typeable)
1305−
1306−mkQueryStringQuery :: QueryString -> QueryStringQuery
1307−mkQueryStringQuery qs =
1308− QueryStringQuery qs Nothing Nothing
1309− Nothing Nothing Nothing Nothing
1310− Nothing Nothing Nothing Nothing
1311− Nothing Nothing Nothing Nothing
1312− Nothing Nothing
1313−
1314−data FieldOrFields = FofField FieldName
1315− | FofFields (NonEmpty FieldName) deriving (Eq, Read, Show, Generic, Typeable)
1316−
1317−data PrefixQuery =
1318− PrefixQuery
1319− { prefixQueryField :: FieldName
1320− , prefixQueryPrefixValue :: Text
1321− , prefixQueryBoost :: Maybe Boost } deriving (Eq, Read, Show, Generic, Typeable)
1322−
1323−data NestedQuery =
1324− NestedQuery
1325− { nestedQueryPath :: QueryPath
1326− , nestedQueryScoreType :: ScoreType
1327− , nestedQuery :: Query } deriving (Eq, Read, Show, Generic, Typeable)
1328−
1329−data MoreLikeThisFieldQuery =
1330− MoreLikeThisFieldQuery
1331− { moreLikeThisFieldText :: Text
1332− , moreLikeThisFieldFields :: FieldName
1333− -- default 0.3 (30%)
1334− , moreLikeThisFieldPercentMatch :: Maybe PercentMatch
1335− , moreLikeThisFieldMinimumTermFreq :: Maybe MinimumTermFrequency
1336− , moreLikeThisFieldMaxQueryTerms :: Maybe MaxQueryTerms
1337− , moreLikeThisFieldStopWords :: Maybe (NonEmpty StopWord)
1338− , moreLikeThisFieldMinDocFrequency :: Maybe MinDocFrequency
1339− , moreLikeThisFieldMaxDocFrequency :: Maybe MaxDocFrequency
1340− , moreLikeThisFieldMinWordLength :: Maybe MinWordLength
1341− , moreLikeThisFieldMaxWordLength :: Maybe MaxWordLength
1342− , moreLikeThisFieldBoostTerms :: Maybe BoostTerms
1343− , moreLikeThisFieldBoost :: Maybe Boost
1344− , moreLikeThisFieldAnalyzer :: Maybe Analyzer
1345− } deriving (Eq, Read, Show, Generic, Typeable)
1346−
1347−data MoreLikeThisQuery =
1348− MoreLikeThisQuery
1349− { moreLikeThisText :: Text
1350− , moreLikeThisFields :: Maybe (NonEmpty FieldName)
1351− -- default 0.3 (30%)
1352− , moreLikeThisPercentMatch :: Maybe PercentMatch
1353− , moreLikeThisMinimumTermFreq :: Maybe MinimumTermFrequency
1354− , moreLikeThisMaxQueryTerms :: Maybe MaxQueryTerms
1355− , moreLikeThisStopWords :: Maybe (NonEmpty StopWord)
1356− , moreLikeThisMinDocFrequency :: Maybe MinDocFrequency
1357− , moreLikeThisMaxDocFrequency :: Maybe MaxDocFrequency
1358− , moreLikeThisMinWordLength :: Maybe MinWordLength
1359− , moreLikeThisMaxWordLength :: Maybe MaxWordLength
1360− , moreLikeThisBoostTerms :: Maybe BoostTerms
1361− , moreLikeThisBoost :: Maybe Boost
1362− , moreLikeThisAnalyzer :: Maybe Analyzer
1363− } deriving (Eq, Read, Show, Generic, Typeable)
1364−
1365−data IndicesQuery =
1366− IndicesQuery
1367− { indicesQueryIndices :: [IndexName]
1368− , indicesQuery :: Query
1369− -- default "all"
1370− , indicesQueryNoMatch :: Maybe Query } deriving (Eq, Read, Show, Generic, Typeable)
1371−
1372−data HasParentQuery =
1373− HasParentQuery
1374− { hasParentQueryType :: TypeName
1375− , hasParentQuery :: Query
1376− , hasParentQueryScoreType :: Maybe ScoreType } deriving (Eq, Read, Show, Generic, Typeable)
1377−
1378−data HasChildQuery =
1379− HasChildQuery
1380− { hasChildQueryType :: TypeName
1381− , hasChildQuery :: Query
1382− , hasChildQueryScoreType :: Maybe ScoreType } deriving (Eq, Read, Show, Generic, Typeable)
1383−
1384−data ScoreType =
1385− ScoreTypeMax
1386− | ScoreTypeSum
1387− | ScoreTypeAvg
1388− | ScoreTypeNone deriving (Eq, Read, Show, Generic, Typeable)
1389−
1390−data FuzzyQuery =
1391− FuzzyQuery { fuzzyQueryField :: FieldName
1392− , fuzzyQueryValue :: Text
1393− , fuzzyQueryPrefixLength :: PrefixLength
1394− , fuzzyQueryMaxExpansions :: MaxExpansions
1395− , fuzzyQueryFuzziness :: Fuzziness
1396− , fuzzyQueryBoost :: Maybe Boost
1397− } deriving (Eq, Read, Show, Generic, Typeable)
1398−
1399−data FuzzyLikeFieldQuery =
1400− FuzzyLikeFieldQuery
1401− { fuzzyLikeField :: FieldName
1402− -- anaphora is good for the soul.
1403− , fuzzyLikeFieldText :: Text
1404− , fuzzyLikeFieldMaxQueryTerms :: MaxQueryTerms
1405− , fuzzyLikeFieldIgnoreTermFrequency :: IgnoreTermFrequency
1406− , fuzzyLikeFieldFuzziness :: Fuzziness
1407− , fuzzyLikeFieldPrefixLength :: PrefixLength
1408− , fuzzyLikeFieldBoost :: Boost
1409− , fuzzyLikeFieldAnalyzer :: Maybe Analyzer
1410− } deriving (Eq, Read, Show, Generic, Typeable)
1411−
1412−data FuzzyLikeThisQuery =
1413− FuzzyLikeThisQuery
1414− { fuzzyLikeFields :: [FieldName]
1415− , fuzzyLikeText :: Text
1416− , fuzzyLikeMaxQueryTerms :: MaxQueryTerms
1417− , fuzzyLikeIgnoreTermFrequency :: IgnoreTermFrequency
1418− , fuzzyLikeFuzziness :: Fuzziness
1419− , fuzzyLikePrefixLength :: PrefixLength
1420− , fuzzyLikeBoost :: Boost
1421− , fuzzyLikeAnalyzer :: Maybe Analyzer
1422− } deriving (Eq, Read, Show, Generic, Typeable)
1423−
1424−data DisMaxQuery =
1425− DisMaxQuery { disMaxQueries :: [Query]
1426− -- default 0.0
1427− , disMaxTiebreaker :: Tiebreaker
1428− , disMaxBoost :: Maybe Boost
1429− } deriving (Eq, Read, Show, Generic, Typeable)
1430−
1431−data MatchQuery =
1432− MatchQuery { matchQueryField :: FieldName
1433− , matchQueryQueryString :: QueryString
1434− , matchQueryOperator :: BooleanOperator
1435− , matchQueryZeroTerms :: ZeroTermsQuery
1436− , matchQueryCutoffFrequency :: Maybe CutoffFrequency
1437− , matchQueryMatchType :: Maybe MatchQueryType
1438− , matchQueryAnalyzer :: Maybe Analyzer
1439− , matchQueryMaxExpansions :: Maybe MaxExpansions
1440− , matchQueryLenient :: Maybe Lenient
1441− , matchQueryBoost :: Maybe Boost } deriving (Eq, Read, Show, Generic, Typeable)
1442−
1443−{-| 'mkMatchQuery' is a convenience function that defaults the less common parameters,
1444− enabling you to provide only the 'FieldName' and 'QueryString' to make a 'MatchQuery'
1445−-}
1446−mkMatchQuery :: FieldName -> QueryString -> MatchQuery
1447−mkMatchQuery field query = MatchQuery field query Or ZeroTermsNone Nothing Nothing Nothing Nothing Nothing Nothing
1448−
1449−data MatchQueryType =
1450− MatchPhrase
1451− | MatchPhrasePrefix deriving (Eq, Read, Show, Generic, Typeable)
1452−
1453−data MultiMatchQuery =
1454− MultiMatchQuery { multiMatchQueryFields :: [FieldName]
1455− , multiMatchQueryString :: QueryString
1456− , multiMatchQueryOperator :: BooleanOperator
1457− , multiMatchQueryZeroTerms :: ZeroTermsQuery
1458− , multiMatchQueryTiebreaker :: Maybe Tiebreaker
1459− , multiMatchQueryType :: Maybe MultiMatchQueryType
1460− , multiMatchQueryCutoffFrequency :: Maybe CutoffFrequency
1461− , multiMatchQueryAnalyzer :: Maybe Analyzer
1462− , multiMatchQueryMaxExpansions :: Maybe MaxExpansions
1463− , multiMatchQueryLenient :: Maybe Lenient } deriving (Eq, Read, Show, Generic, Typeable)
1464−
1465−{-| 'mkMultiMatchQuery' is a convenience function that defaults the less common parameters,
1466− enabling you to provide only the list of 'FieldName's and 'QueryString' to
1467− make a 'MultiMatchQuery'.
1468−-}
1469−
1470−mkMultiMatchQuery :: [FieldName] -> QueryString -> MultiMatchQuery
1471−mkMultiMatchQuery matchFields query =
1472− MultiMatchQuery matchFields query
1473− Or ZeroTermsNone Nothing Nothing Nothing Nothing Nothing Nothing
1474−
1475−data MultiMatchQueryType =
1476− MultiMatchBestFields
1477− | MultiMatchMostFields
1478− | MultiMatchCrossFields
1479− | MultiMatchPhrase
1480− | MultiMatchPhrasePrefix deriving (Eq, Read, Show, Generic, Typeable)
1481−
1482−data BoolQuery =
1483− BoolQuery { boolQueryMustMatch :: [Query]
1484− , boolQueryFilter :: [Filter]
1485− , boolQueryMustNotMatch :: [Query]
1486− , boolQueryShouldMatch :: [Query]
1487− , boolQueryMinimumShouldMatch :: Maybe MinimumMatch
1488− , boolQueryBoost :: Maybe Boost
1489− , boolQueryDisableCoord :: Maybe DisableCoord
1490− } deriving (Eq, Read, Show, Generic, Typeable)
1491−
1492−mkBoolQuery :: [Query] -> [Filter] -> [Query] -> [Query] -> BoolQuery
1493−mkBoolQuery must filt mustNot should =
1494− BoolQuery must filt mustNot should Nothing Nothing Nothing
1495−
1496−data BoostingQuery =
1497− BoostingQuery { positiveQuery :: Query
1498− , negativeQuery :: Query
1499− , negativeBoost :: Boost } deriving (Eq, Read, Show, Generic, Typeable)
1500−
1501−data CommonTermsQuery =
1502− CommonTermsQuery { commonField :: FieldName
1503− , commonQuery :: QueryString
1504− , commonCutoffFrequency :: CutoffFrequency
1505− , commonLowFreqOperator :: BooleanOperator
1506− , commonHighFreqOperator :: BooleanOperator
1507− , commonMinimumShouldMatch :: Maybe CommonMinimumMatch
1508− , commonBoost :: Maybe Boost
1509− , commonAnalyzer :: Maybe Analyzer
1510− , commonDisableCoord :: Maybe DisableCoord
1511− } deriving (Eq, Read, Show, Generic, Typeable)
1512−
1513−data CommonMinimumMatch =
1514− CommonMinimumMatchHighLow MinimumMatchHighLow
1515− | CommonMinimumMatch MinimumMatch
1516− deriving (Eq, Read, Show, Generic, Typeable)
1517−
1518−data MinimumMatchHighLow =
1519− MinimumMatchHighLow { lowFreq :: MinimumMatch
1520− , highFreq :: MinimumMatch } deriving (Eq, Read, Show, Generic, Typeable)
1521−
1522−data ZeroTermsQuery = ZeroTermsNone
1523− | ZeroTermsAll deriving (Eq, Read, Show, Generic, Typeable)
1524−
1525−data RangeExecution = RangeExecutionIndex
1526− | RangeExecutionFielddata deriving (Eq, Read, Show, Generic, Typeable)
1527−
1528−newtype Regexp = Regexp Text deriving (Eq, Read, Show, Generic, Typeable, FromJSON)
1529−
1530−data RegexpFlags = AllRegexpFlags
1531− | NoRegexpFlags
1532− | SomeRegexpFlags (NonEmpty RegexpFlag) deriving (Eq, Read, Show, Generic, Typeable)
1533−
1534−data RegexpFlag = AnyString
1535− | Automaton
1536− | Complement
1537− | Empty
1538− | Intersection
1539− | Interval deriving (Eq, Read, Show, Generic, Typeable)
1540−
1541−newtype LessThan = LessThan Double deriving (Eq, Read, Show, Generic, Typeable)
1542−newtype LessThanEq = LessThanEq Double deriving (Eq, Read, Show, Generic, Typeable)
1543−newtype GreaterThan = GreaterThan Double deriving (Eq, Read, Show, Generic, Typeable)
1544−newtype GreaterThanEq = GreaterThanEq Double deriving (Eq, Read, Show, Generic, Typeable)
1545−
1546−newtype LessThanD = LessThanD UTCTime deriving (Eq, Read, Show, Generic, Typeable)
1547−newtype LessThanEqD = LessThanEqD UTCTime deriving (Eq, Read, Show, Generic, Typeable)
1548−newtype GreaterThanD = GreaterThanD UTCTime deriving (Eq, Read, Show, Generic, Typeable)
1549−newtype GreaterThanEqD = GreaterThanEqD UTCTime deriving (Eq, Read, Show, Generic, Typeable)
1550−
1551−data RangeValue = RangeDateLte LessThanEqD
1552− | RangeDateLt LessThanD
1553− | RangeDateGte GreaterThanEqD
1554− | RangeDateGt GreaterThanD
1555− | RangeDateGtLt GreaterThanD LessThanD
1556− | RangeDateGteLte GreaterThanEqD LessThanEqD
1557− | RangeDateGteLt GreaterThanEqD LessThanD
1558− | RangeDateGtLte GreaterThanD LessThanEqD
1559− | RangeDoubleLte LessThanEq
1560− | RangeDoubleLt LessThan
1561− | RangeDoubleGte GreaterThanEq
1562− | RangeDoubleGt GreaterThan
1563− | RangeDoubleGtLt GreaterThan LessThan
1564− | RangeDoubleGteLte GreaterThanEq LessThanEq
1565− | RangeDoubleGteLt GreaterThanEq LessThan
1566− | RangeDoubleGtLte GreaterThan LessThanEq
1567− deriving (Eq, Read, Show, Generic, Typeable)
1568−
1569−rangeValueToPair :: RangeValue -> [Pair]
1570−rangeValueToPair rv = case rv of
1571− RangeDateLte (LessThanEqD t) -> ["lte" .= t]
1572− RangeDateGte (GreaterThanEqD t) -> ["gte" .= t]
1573− RangeDateLt (LessThanD t) -> ["lt" .= t]
1574− RangeDateGt (GreaterThanD t) -> ["gt" .= t]
1575− RangeDateGteLte (GreaterThanEqD l) (LessThanEqD g) -> ["gte" .= l, "lte" .= g]
1576− RangeDateGtLte (GreaterThanD l) (LessThanEqD g) -> ["gt" .= l, "lte" .= g]
1577− RangeDateGteLt (GreaterThanEqD l) (LessThanD g) -> ["gte" .= l, "lt" .= g]
1578− RangeDateGtLt (GreaterThanD l) (LessThanD g) -> ["gt" .= l, "lt" .= g]
1579− RangeDoubleLte (LessThanEq t) -> ["lte" .= t]
1580− RangeDoubleGte (GreaterThanEq t) -> ["gte" .= t]
1581− RangeDoubleLt (LessThan t) -> ["lt" .= t]
1582− RangeDoubleGt (GreaterThan t) -> ["gt" .= t]
1583− RangeDoubleGteLte (GreaterThanEq l) (LessThanEq g) -> ["gte" .= l, "lte" .= g]
1584− RangeDoubleGtLte (GreaterThan l) (LessThanEq g) -> ["gt" .= l, "lte" .= g]
1585− RangeDoubleGteLt (GreaterThanEq l) (LessThan g) -> ["gte" .= l, "lt" .= g]
1586− RangeDoubleGtLt (GreaterThan l) (LessThan g) -> ["gt" .= l, "lt" .= g]
1587−
1588−data Term = Term { termField :: Text
1589− , termValue :: Text } deriving (Eq, Read, Show, Generic, Typeable)
1590−
1591−data BoolMatch = MustMatch Term Cache
1592− | MustNotMatch Term Cache
1593− | ShouldMatch [Term] Cache deriving (Eq, Read, Show, Generic, Typeable)
1594−
1595−-- "memory" or "indexed"
1596−data GeoFilterType = GeoFilterMemory
1597− | GeoFilterIndexed deriving (Eq, Read, Show, Generic, Typeable)
1598−
1599−data LatLon = LatLon { lat :: Double
1600− , lon :: Double } deriving (Eq, Read, Show, Generic, Typeable)
1601−
1602−data GeoBoundingBox =
1603− GeoBoundingBox { topLeft :: LatLon
1604− , bottomRight :: LatLon } deriving (Eq, Read, Show, Generic, Typeable)
1605−
1606−data GeoBoundingBoxConstraint =
1607− GeoBoundingBoxConstraint { geoBBField :: FieldName
1608− , constraintBox :: GeoBoundingBox
1609− , bbConstraintcache :: Cache
1610− , geoType :: GeoFilterType
1611− } deriving (Eq, Read, Show, Generic, Typeable)
1612−
1613−data GeoPoint =
1614− GeoPoint { geoField :: FieldName
1615− , latLon :: LatLon} deriving (Eq, Read, Show, Generic, Typeable)
1616−
1617−data DistanceUnit = Miles
1618− | Yards
1619− | Feet
1620− | Inches
1621− | Kilometers
1622− | Meters
1623− | Centimeters
1624− | Millimeters
1625− | NauticalMiles deriving (Eq, Read, Show, Generic, Typeable)
1626−
1627−data DistanceType = Arc
1628− | SloppyArc -- doesn't exist <1.0
1629− | Plane deriving (Eq, Read, Show, Generic, Typeable)
1630−
1631−data OptimizeBbox = OptimizeGeoFilterType GeoFilterType
1632− | NoOptimizeBbox deriving (Eq, Read, Show, Generic, Typeable)
1633−
1634−data Distance =
1635− Distance { coefficient :: Double
1636− , unit :: DistanceUnit } deriving (Eq, Read, Show, Generic, Typeable)
1637−
1638−data DistanceRange =
1639− DistanceRange { distanceFrom :: Distance
1640− , distanceTo :: Distance } deriving (Eq, Read, Show, Generic, Typeable)
1641−
1642−type TemplateQueryKey = Text
1643−type TemplateQueryValue = Text
1644−
1645−newtype TemplateQueryKeyValuePairs = TemplateQueryKeyValuePairs (HM.HashMap TemplateQueryKey TemplateQueryValue)
1646− deriving (Eq, Read, Show, Generic)
1647−
1648−instance ToJSON TemplateQueryKeyValuePairs where
1649− toJSON (TemplateQueryKeyValuePairs x) = Object $ HM.map toJSON x
1650−
1651−instance FromJSON TemplateQueryKeyValuePairs where
1652− parseJSON (Object o) = pure . TemplateQueryKeyValuePairs $ HM.mapMaybe getValue o
1653− where getValue (String x) = Just x
1654− getValue _ = Nothing
1655− parseJSON _ = fail "error parsing TemplateQueryKeyValuePairs"
1656−
1657−data TemplateQueryInline =
1658− TemplateQueryInline { inline :: Query
1659− , params :: TemplateQueryKeyValuePairs
1660− }
1661− deriving (Eq, Read, Show, Generic, Typeable)
1662−
1663−instance ToJSON TemplateQueryInline where
1664− toJSON TemplateQueryInline{..} = object [ "inline" .= inline
1665− , "params" .= params
1666− ]
1667−
1668−instance FromJSON TemplateQueryInline where
1669− parseJSON = withObject "TemplateQueryInline" parse
1670− where parse o = TemplateQueryInline
1671− <$> o .: "inline"
1672− <*> o .: "params"
1673−
1674−
1675−data SearchResult a =
1676− SearchResult { took :: Int
1677− , timedOut :: Bool
1678− , shards :: ShardResult
1679− , searchHits :: SearchHits a
1680− , aggregations :: Maybe AggregationResults
1681− , scrollId :: Maybe ScrollId
1682− , suggest :: Maybe NamedSuggestionResponse -- ^ Only one Suggestion request / response per Search is supported.
1683− }
1684− deriving (Eq, Read, Show, Generic, Typeable)
1685−
1686−newtype ScrollId = ScrollId Text deriving (Eq, Read, Show, Generic, Ord, ToJSON, FromJSON)
1687−
1688−type Score = Maybe Double
1689−
1690−data SearchHits a =
1691− SearchHits { hitsTotal :: Int
1692− , maxScore :: Score
1693− , hits :: [Hit a] } deriving (Eq, Read, Show, Generic, Typeable)
1694−
1695−instance Semigroup (SearchHits a) where
1696− (SearchHits ta ma ha) <> (SearchHits tb mb hb) = SearchHits (ta + tb) (max ma mb) (ha <> hb)
1697−
1698−instance Monoid (SearchHits a) where
1699− mempty = SearchHits 0 Nothing mempty
1700− mappend = (<>)
1701−
1702−data Hit a =
1703− Hit { hitIndex :: IndexName
1704− , hitType :: MappingName
1705− , hitDocId :: DocId
1706− , hitScore :: Score
1707− , hitSource :: Maybe a
1708− , hitHighlight :: Maybe HitHighlight } deriving (Eq, Read, Show, Generic, Typeable)
1709−
1710−data ShardResult =
1711− ShardResult { shardTotal :: Int
1712− , shardsSuccessful :: Int
1713− , shardsFailed :: Int } deriving (Eq, Read, Show, Generic, Typeable)
1714−
1715−type HitHighlight = M.Map Text [Text]
1716−
1717−showText :: Show a => a -> Text
1718−showText = T.pack . show
1719−
1720−readMay :: Read a => String -> Maybe a
1721−readMay s = case reads s of
1722− (a, ""):_ -> Just a
1723− _ -> Nothing
1724−
1725−parseReadText :: Read a => Text -> Parser a
1726−parseReadText = maybe mzero return . readMay . T.unpack
1727−
1728−type Aggregations = M.Map Text Aggregation
1729−
1730−emptyAggregations :: Aggregations
1731−emptyAggregations = M.empty
1732−
1733−mkAggregations :: Text -> Aggregation -> Aggregations
1734−mkAggregations name aggregation = M.insert name aggregation emptyAggregations
1735−
1736−data TermOrder = TermOrder{ termSortField :: Text
1737− , termSortOrder :: SortOrder } deriving (Eq, Read, Show, Generic, Typeable)
1738−
1739−data TermInclusion = TermInclusion Text
1740− | TermPattern Text Text deriving (Eq, Read, Show, Generic, Typeable)
1741−
1742−data CollectionMode = BreadthFirst
1743− | DepthFirst deriving (Eq, Read, Show, Generic, Typeable)
1744−
1745−data ExecutionHint = Ordinals
1746− | GlobalOrdinals
1747− | GlobalOrdinalsHash
1748− | GlobalOrdinalsLowCardinality
1749− | Map deriving (Eq, Read, Show, Generic, Typeable)
1750−
1751−data TimeInterval = Weeks
1752− | Days
1753− | Hours
1754− | Minutes
1755− | Seconds deriving Eq
1756−
1757−data Interval = Year
1758− | Quarter
1759− | Month
1760− | Week
1761− | Day
1762− | Hour
1763− | Minute
1764− | Second deriving (Eq, Read, Show, Generic, Typeable)
1765−
1766−data Aggregation = TermsAgg TermsAggregation
1767− | CardinalityAgg CardinalityAggregation
1768− | DateHistogramAgg DateHistogramAggregation
1769− | ValueCountAgg ValueCountAggregation
1770− | FilterAgg FilterAggregation
1771− | DateRangeAgg DateRangeAggregation
1772− | MissingAgg MissingAggregation
1773− | TopHitsAgg TopHitsAggregation
1774− | StatsAgg StatisticsAggregation
1775− deriving (Eq, Read, Show, Generic, Typeable)
1776−
1777−data TopHitsAggregation = TopHitsAggregation
1778− { taFrom :: Maybe From
1779− , taSize :: Maybe Size
1780− , taSort :: Maybe Sort
1781− } deriving (Eq, Read, Show)
1782−
1783−data MissingAggregation = MissingAggregation
1784− { maField :: Text
1785− } deriving (Eq, Read, Show, Generic, Typeable)
1786−
1787−data TermsAggregation = TermsAggregation { term :: Either Text Text
1788− , termInclude :: Maybe TermInclusion
1789− , termExclude :: Maybe TermInclusion
1790− , termOrder :: Maybe TermOrder
1791− , termMinDocCount :: Maybe Int
1792− , termSize :: Maybe Int
1793− , termShardSize :: Maybe Int
1794− , termCollectMode :: Maybe CollectionMode
1795− , termExecutionHint :: Maybe ExecutionHint
1796− , termAggs :: Maybe Aggregations
1797− } deriving (Eq, Read, Show, Generic, Typeable)
1798−
1799−data CardinalityAggregation = CardinalityAggregation { cardinalityField :: FieldName,
1800− precisionThreshold :: Maybe Int
1801− } deriving (Eq, Read, Show, Generic, Typeable)
1802−
1803−data DateHistogramAggregation = DateHistogramAggregation { dateField :: FieldName
1804− , dateInterval :: Interval
1805− , dateFormat :: Maybe Text
1806− -- pre and post deprecated in 1.5
1807− , datePreZone :: Maybe Text
1808− , datePostZone :: Maybe Text
1809− , datePreOffset :: Maybe Text
1810− , datePostOffset :: Maybe Text
1811− , dateAggs :: Maybe Aggregations
1812− } deriving (Eq, Read, Show, Generic, Typeable)
1813−
1814−
1815−data DateRangeAggregation = DateRangeAggregation { draField :: FieldName
1816− , draFormat :: Maybe Text
1817− , draRanges :: NonEmpty DateRangeAggRange
1818− } deriving (Eq, Read, Show, Generic, Typeable)
1819−
1820−data DateRangeAggRange = DateRangeFrom DateMathExpr
1821− | DateRangeTo DateMathExpr
1822− | DateRangeFromAndTo DateMathExpr DateMathExpr deriving (Eq, Read, Show, Generic, Typeable)
1823−
1824−-- | See <https://www.elastic.co/guide/en/elasticsearch/reference/current/common-options.html#date-math> for more information.
1825−data DateMathExpr = DateMathExpr DateMathAnchor [DateMathModifier] deriving (Eq, Read, Show, Generic, Typeable)
1826−
1827−
1828−-- | Starting point for a date range. This along with the 'DateMathModifiers' gets you the date ES will start from.
1829−data DateMathAnchor = DMNow
1830− | DMDate Day deriving (Eq, Read, Show, Generic, Typeable)
1831−
1832−data DateMathModifier = AddTime Int DateMathUnit
1833− | SubtractTime Int DateMathUnit
1834− | RoundDownTo DateMathUnit deriving (Eq, Read, Show, Generic, Typeable)
1835−
1836−data DateMathUnit = DMYear
1837− | DMMonth
1838− | DMWeek
1839− | DMDay
1840− | DMHour
1841− | DMMinute
1842− | DMSecond deriving (Eq, Read, Show, Generic, Typeable)
1843−
1844−-- | See <https://www.elastic.co/guide/en/elasticsearch/reference/current/search-aggregations-metrics-valuecount-aggregation.html> for more information.
1845−data ValueCountAggregation = FieldValueCount FieldName
1846− | ScriptValueCount Script deriving (Eq, Read, Show, Generic, Typeable)
1847−
1848−-- | 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.
1849−data FilterAggregation = FilterAggregation { faFilter :: Filter
1850− , faAggs :: Maybe Aggregations} deriving (Eq, Read, Show, Generic, Typeable)
1851−
1852−data StatisticsAggregation = StatisticsAggregation { statsType :: StatsType
1853− , statsField :: FieldName } deriving (Eq, Read, Show, Generic, Typeable)
1854−
1855−data StatsType
1856− = Basic
1857− | Extended
1858− deriving (Eq, Read, Show, Generic, Typeable)
1859−
1860−mkTermsAggregation :: Text -> TermsAggregation
1861−mkTermsAggregation t = TermsAggregation (Left t) Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing
1862−
1863−mkTermsScriptAggregation :: Text -> TermsAggregation
1864−mkTermsScriptAggregation t = TermsAggregation (Right t) Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing
1865−
1866−mkDateHistogram :: FieldName -> Interval -> DateHistogramAggregation
1867−mkDateHistogram t i = DateHistogramAggregation t i Nothing Nothing Nothing Nothing Nothing Nothing
1868−
1869−mkCardinalityAggregation :: FieldName -> CardinalityAggregation
1870−mkCardinalityAggregation t = CardinalityAggregation t Nothing
1871−
1872−mkStatsAggregation :: FieldName -> StatisticsAggregation
1873−mkStatsAggregation = StatisticsAggregation Basic
1874−
1875−mkExtendedStatsAggregation :: FieldName -> StatisticsAggregation
1876−mkExtendedStatsAggregation = StatisticsAggregation Extended
1877−
1878−instance ToJSON Version where
1879− toJSON Version {..} = object ["number" .= number
1880− ,"build_hash" .= build_hash
1881− ,"build_date" .= build_date
1882− ,"build_snapshot" .= build_snapshot
1883− ,"lucene_version" .= lucene_version]
1884−
1885−instance FromJSON Version where
1886− parseJSON = withObject "Version" parse
1887− where parse o = Version
1888− <$> o .: "number"
1889− <*> o .: "build_hash"
1890− <*> o .: "build_date"
1891− <*> o .: "build_snapshot"
1892− <*> o .: "lucene_version"
1893−
1894−instance ToJSON VersionNumber where
1895− toJSON = toJSON . Vers.showVersion . versionNumber
1896−
1897−instance FromJSON VersionNumber where
1898− parseJSON = withText "VersionNumber" (parse . T.unpack)
1899− where
1900− parse s = case filter (null . snd)(RP.readP_to_S Vers.parseVersion s) of
1901− [(v, _)] -> pure (VersionNumber v)
1902− [] -> fail ("Invalid version string " ++ s)
1903− xs -> fail ("Ambiguous version string " ++ s ++ " (" ++ intercalate ", " (Vers.showVersion . fst <$> xs) ++ ")")
1904−
1905−instance ToJSON TermOrder where
1906− toJSON (TermOrder termSortField termSortOrder) = object [termSortField .= termSortOrder]
1907−
1908−instance ToJSON TermInclusion where
1909− toJSON (TermInclusion x) = toJSON x
1910− toJSON (TermPattern pattern flags) = omitNulls [ "pattern" .= pattern,
1911− "flags" .= flags]
1912−
1913−instance ToJSON CollectionMode where
1914− toJSON BreadthFirst = "breadth_first"
1915− toJSON DepthFirst = "depth_first"
1916−
1917−instance ToJSON ExecutionHint where
1918− toJSON Ordinals = "ordinals"
1919− toJSON GlobalOrdinals = "global_ordinals"
1920− toJSON GlobalOrdinalsHash = "global_ordinals_hash"
1921− toJSON GlobalOrdinalsLowCardinality = "global_ordinals_low_cardinality"
1922− toJSON Map = "map"
1923−
1924−instance ToJSON Interval where
1925− toJSON Year = "year"
1926− toJSON Quarter = "quarter"
1927− toJSON Month = "month"
1928− toJSON Week = "week"
1929− toJSON Day = "day"
1930− toJSON Hour = "hour"
1931− toJSON Minute = "minute"
1932− toJSON Second = "second"
1933−
1934−instance Show TimeInterval where
1935− show Weeks = "w"
1936− show Days = "d"
1937− show Hours = "h"
1938− show Minutes = "m"
1939− show Seconds = "s"
1940−
1941−instance Read TimeInterval where
1942− readPrec = f =<< TR.get
1943− where
1944− f 'w' = return Weeks
1945− f 'd' = return Days
1946− f 'h' = return Hours
1947− f 'm' = return Minutes
1948− f 's' = return Seconds
1949− f _ = fail "TimeInterval expected one of w, d, h, m, s"
1950−
1951−instance ToJSON Aggregation where
1952− toJSON (TermsAgg (TermsAggregation term include exclude order minDocCount size shardSize collectMode executionHint termAggs)) =
1953− omitNulls ["terms" .= omitNulls [ toJSON' term,
1954− "include" .= include,
1955− "exclude" .= exclude,
1956− "order" .= order,
1957− "min_doc_count" .= minDocCount,
1958− "size" .= size,
1959− "shard_size" .= shardSize,
1960− "collect_mode" .= collectMode,
1961− "execution_hint" .= executionHint
1962− ],
1963− "aggs" .= termAggs ]
1964− where
1965− toJSON' x = case x of { Left y -> "field" .= y; Right y -> "script" .= y }
1966−
1967− toJSON (CardinalityAgg (CardinalityAggregation field precisionThreshold)) =
1968− object ["cardinality" .= omitNulls [ "field" .= field,
1969− "precisionThreshold" .= precisionThreshold
1970− ]
1971− ]
1972−
1973− toJSON (DateHistogramAgg (DateHistogramAggregation field interval format preZone postZone preOffset postOffset dateHistoAggs)) =
1974− omitNulls ["date_histogram" .= omitNulls [ "field" .= field,
1975− "interval" .= interval,
1976− "format" .= format,
1977− "pre_zone" .= preZone,
1978− "post_zone" .= postZone,
1979− "pre_offset" .= preOffset,
1980− "post_offset" .= postOffset
1981− ],
1982− "aggs" .= dateHistoAggs ]
1983− toJSON (ValueCountAgg a) = object ["value_count" .= v]
1984− where v = case a of
1985− (FieldValueCount (FieldName n)) -> object ["field" .= n]
1986− (ScriptValueCount (Script s)) -> object ["script" .= s]
1987− toJSON (FilterAgg (FilterAggregation filt ags)) =
1988− omitNulls [ "filter" .= filt
1989− , "aggs" .= ags]
1990− toJSON (DateRangeAgg a) = object [ "date_range" .= a
1991− ]
1992− toJSON (MissingAgg (MissingAggregation{..})) =
1993− object ["missing" .= object ["field" .= maField]]
1994−
1995− toJSON (TopHitsAgg (TopHitsAggregation mfrom msize msort)) =
1996− omitNulls ["top_hits" .= omitNulls [ "size" .= msize
1997− , "from" .= mfrom
1998− , "sort" .= msort
1999− ]
2000− ]
2001−
2002− toJSON (StatsAgg (StatisticsAggregation typ field)) =
2003− object [stType .= omitNulls [ "field" .= field ]]
2004− where
2005− stType | typ == Basic = "stats"
2006− | otherwise = "extended_stats"
2007−
2008−instance ToJSON DateRangeAggregation where
2009− toJSON DateRangeAggregation {..} =
2010− omitNulls [ "field" .= draField
2011− , "format" .= draFormat
2012− , "ranges" .= toList draRanges
2013− ]
2014−
2015−instance ToJSON DateRangeAggRange where
2016− toJSON (DateRangeFrom e) = object [ "from" .= e ]
2017− toJSON (DateRangeTo e) = object [ "to" .= e ]
2018− toJSON (DateRangeFromAndTo f t) = object [ "from" .= f, "to" .= t ]
2019−
2020−instance ToJSON DateMathExpr where
2021− toJSON (DateMathExpr a mods) = String (fmtA a <> mconcat (fmtMod <$> mods))
2022− where fmtA DMNow = "now"
2023− fmtA (DMDate date) = (T.pack $ showGregorian date) <> "||"
2024− fmtMod (AddTime n u) = "+" <> showText n <> fmtU u
2025− fmtMod (SubtractTime n u) = "-" <> showText n <> fmtU u
2026− fmtMod (RoundDownTo u) = "/" <> fmtU u
2027− fmtU DMYear = "y"
2028− fmtU DMMonth = "M"
2029− fmtU DMWeek = "w"
2030− fmtU DMDay = "d"
2031− fmtU DMHour = "h"
2032− fmtU DMMinute = "m"
2033− fmtU DMSecond = "s"
2034−
2035−
2036−type AggregationResults = M.Map Text Value
2037−
2038−class BucketAggregation a where
2039− key :: a -> BucketValue
2040− docCount :: a -> Int
2041− aggs :: a -> Maybe AggregationResults
2042−
2043−
2044−data Bucket a = Bucket { buckets :: [a]} deriving (Read, Show)
2045−
2046−data BucketValue = TextValue Text
2047− | ScientificValue Scientific
2048− | BoolValue Bool deriving (Read, Show)
2049−
2050−data MissingResult = MissingResult { missingDocCount :: Int } deriving (Show)
2051−
2052−data TopHitResult a = TopHitResult { tarHits :: (SearchHits a)
2053− } deriving Show
2054−
2055−data TermsResult = TermsResult { termKey :: BucketValue
2056− , termsDocCount :: Int
2057− , termsAggs :: Maybe AggregationResults } deriving (Read, Show)
2058−
2059−data DateHistogramResult = DateHistogramResult { dateKey :: Int
2060− , dateKeyStr :: Maybe Text
2061− , dateDocCount :: Int
2062− , dateHistogramAggs :: Maybe AggregationResults } deriving (Read, Show)
2063−
2064−data DateRangeResult = DateRangeResult { dateRangeKey :: Text
2065− , dateRangeFrom :: Maybe UTCTime
2066− , dateRangeFromAsString :: Maybe Text
2067− , dateRangeTo :: Maybe UTCTime
2068− , dateRangeToAsString :: Maybe Text
2069− , dateRangeDocCount :: Int
2070− , dateRangeAggs :: Maybe AggregationResults } deriving (Read, Show, Eq, Generic, Typeable)
2071−
2072−toTerms :: Text -> AggregationResults -> Maybe (Bucket TermsResult)
2073−toTerms = toAggResult
2074−
2075−toDateHistogram :: Text -> AggregationResults -> Maybe (Bucket DateHistogramResult)
2076−toDateHistogram = toAggResult
2077−
2078−toMissing :: Text -> AggregationResults -> Maybe MissingResult
2079−toMissing = toAggResult
2080−
2081−toTopHits :: (FromJSON a) => Text -> AggregationResults -> Maybe (TopHitResult a)
2082−toTopHits = toAggResult
2083−
2084−toAggResult :: (FromJSON a) => Text -> AggregationResults -> Maybe a
2085−toAggResult t a = M.lookup t a >>= deserialize
2086− where deserialize = parseMaybe parseJSON
2087−
2088−instance BucketAggregation TermsResult where
2089− key = termKey
2090− docCount = termsDocCount
2091− aggs = termsAggs
2092−
2093−instance BucketAggregation DateHistogramResult where
2094− key = TextValue . showText . dateKey
2095− docCount = dateDocCount
2096− aggs = dateHistogramAggs
2097−
2098−instance BucketAggregation DateRangeResult where
2099− key = TextValue . dateRangeKey
2100− docCount = dateRangeDocCount
2101− aggs = dateRangeAggs
2102−
2103−instance (FromJSON a) => FromJSON (Bucket a) where
2104− parseJSON (Object v) = Bucket <$>
2105− v .: "buckets"
2106− parseJSON _ = mempty
2107−
2108−instance FromJSON BucketValue where
2109− parseJSON (String t) = return $ TextValue t
2110− parseJSON (Number s) = return $ ScientificValue s
2111− parseJSON (Bool b) = return $ BoolValue b
2112− parseJSON _ = mempty
2113−
2114−instance FromJSON MissingResult where
2115− parseJSON = withObject "MissingResult" parse
2116− where parse v = MissingResult <$> v .: "doc_count"
2117−
2118−instance FromJSON TermsResult where
2119− parseJSON (Object v) = TermsResult <$>
2120− v .: "key" <*>
2121− v .: "doc_count" <*>
2122− (pure $ getNamedSubAgg v ["key", "doc_count"])
2123− parseJSON _ = mempty
2124−
2125−instance FromJSON DateHistogramResult where
2126− parseJSON (Object v) = DateHistogramResult <$>
2127− v .: "key" <*>
2128− v .:? "key_as_string" <*>
2129− v .: "doc_count" <*>
2130− (pure $ getNamedSubAgg v [ "key"
2131− , "doc_count"
2132− , "key_as_string"
2133− ]
2134− )
2135− parseJSON _ = mempty
2136−
2137−instance FromJSON DateRangeResult where
2138− parseJSON = withObject "DateRangeResult" parse
2139− where parse v = DateRangeResult <$>
2140− v .: "key" <*>
2141− (fmap posixMS <$> v .:? "from") <*>
2142− v .:? "from_as_string" <*>
2143− (fmap posixMS <$> v .:? "to") <*>
2144− v .:? "to_as_string" <*>
2145− v .: "doc_count" <*>
2146− (pure $ getNamedSubAgg v [ "key"
2147− , "from"
2148− , "from_as_string"
2149− , "to"
2150− , "to_as_string"
2151− , "doc_count"
2152− ]
2153− )
2154−
2155−instance FromJSON POSIXMS where
2156− parseJSON = withScientific "POSIXMS" (return . parse)
2157− where parse n = let n' = truncate n :: Integer
2158− in POSIXMS (posixSecondsToUTCTime (fromInteger (n' `div` 1000)))
2159−
2160−instance (FromJSON a) => FromJSON (TopHitResult a) where
2161− parseJSON (Object v) = TopHitResult <$>
2162− v .: "hits"
2163− parseJSON _ = fail "Failure in FromJSON (TopHitResult a)"
2164−
2165−fieldTagged :: Monad m => (FieldName -> Object -> m a) -> Object -> m a
2166−fieldTagged f o = case HM.toList o of
2167− [(k, Object o')] -> f (FieldName k) o'
2168− _ -> fail "Expected object with 1 field-named key"
2169−
2170−-- Try to get an AggregationResults when we don't know the
2171−-- field name. We filter out the known keys to try to minimize the noise.
2172−getNamedSubAgg :: Object -> [Text] -> Maybe AggregationResults
2173−getNamedSubAgg o knownKeys = maggRes
2174− where unknownKeys = HM.filterWithKey (\k _ -> k `notElem` knownKeys) o
2175− maggRes
2176− | HM.null unknownKeys = Nothing
2177− | otherwise = Just . M.fromList $ HM.toList unknownKeys
2178−
2179−instance ToJSON GeoPoint where
2180− toJSON (GeoPoint (FieldName geoPointField) geoPointLatLon) =
2181− object [ geoPointField .= geoPointLatLon ]
2182−
2183−
2184−instance ToJSON Query where
2185− toJSON (TermQuery (Term termQueryField termQueryValue) boost) =
2186− object [ "term" .=
2187− object [termQueryField .= object merged]]
2188− where
2189− base = [ "value" .= termQueryValue ]
2190− boosted = maybe [] (return . ("boost" .=)) boost
2191− merged = mappend base boosted
2192−
2193− toJSON (TermsQuery fieldName terms) =
2194− object [ "terms" .= object conjoined ]
2195− where conjoined = [fieldName .= terms]
2196−
2197− toJSON (IdsQuery idsQueryMappingName docIds) =
2198− object [ "ids" .= object conjoined ]
2199− where conjoined = [ "type" .= idsQueryMappingName
2200− , "values" .= fmap toJSON docIds ]
2201−
2202− toJSON (QueryQueryStringQuery qQueryStringQuery) =
2203− object [ "query_string" .= qQueryStringQuery ]
2204−
2205− toJSON (QueryMatchQuery matchQuery) =
2206− object [ "match" .= matchQuery ]
2207−
2208− toJSON (QueryMultiMatchQuery multiMatchQuery) =
2209− toJSON multiMatchQuery
2210−
2211− toJSON (QueryBoolQuery boolQuery) =
2212− object [ "bool" .= boolQuery ]
2213−
2214− toJSON (QueryBoostingQuery boostingQuery) =
2215− object [ "boosting" .= boostingQuery ]
2216−
2217− toJSON (QueryCommonTermsQuery commonTermsQuery) =
2218− object [ "common" .= commonTermsQuery ]
2219−
2220− toJSON (ConstantScoreQuery query boost) =
2221− object ["constant_score" .= object ["query" .= query
2222− , "boost" .= boost]]
2223−
2224− toJSON (QueryDisMaxQuery disMaxQuery) =
2225− object [ "dis_max" .= disMaxQuery ]
2226−
2227− toJSON (QueryFuzzyLikeThisQuery fuzzyQuery) =
2228− object [ "fuzzy_like_this" .= fuzzyQuery ]
2229−
2230− toJSON (QueryFuzzyLikeFieldQuery fuzzyFieldQuery) =
2231− object [ "fuzzy_like_this_field" .= fuzzyFieldQuery ]
2232−
2233− toJSON (QueryFuzzyQuery fuzzyQuery) =
2234− object [ "fuzzy" .= fuzzyQuery ]
2235−
2236− toJSON (QueryHasChildQuery childQuery) =
2237− object [ "has_child" .= childQuery ]
2238−
2239− toJSON (QueryHasParentQuery parentQuery) =
2240− object [ "has_parent" .= parentQuery ]
2241−
2242− toJSON (QueryIndicesQuery qIndicesQuery) =
2243− object [ "indices" .= qIndicesQuery ]
2244−
2245− toJSON (MatchAllQuery boost) =
2246− object [ "match_all" .= omitNulls [ "boost" .= boost ] ]
2247−
2248− toJSON (QueryMoreLikeThisQuery query) =
2249− object [ "more_like_this" .= query ]
2250−
2251− toJSON (QueryMoreLikeThisFieldQuery query) =
2252− object [ "more_like_this_field" .= query ]
2253−
2254− toJSON (QueryNestedQuery query) =
2255− object [ "nested" .= query ]
2256−
2257− toJSON (QueryPrefixQuery query) =
2258− object [ "prefix" .= query ]
2259−
2260− toJSON (QueryRangeQuery query) =
2261− object [ "range" .= query ]
2262−
2263− toJSON (QueryRegexpQuery query) =
2264− object [ "regexp" .= query ]
2265−
2266− toJSON (QuerySimpleQueryStringQuery query) =
2267− object [ "simple_query_string" .= query ]
2268−
2269− toJSON (QueryExistsQuery (FieldName fieldName)) =
2270− object ["exists" .= object
2271− ["field" .= fieldName]
2272− ]
2273− toJSON QueryMatchNoneQuery =
2274− object ["match_none" .= object []]
2275−
2276− toJSON (QueryTemplateQueryInline templateQuery) =
2277− object [ "template" .= templateQuery ]
2278−
2279−instance FromJSON Query where
2280− parseJSON v = withObject "Query" parse v
2281− where parse o = termQuery `taggedWith` "term"
2282− <|> termsQuery `taggedWith` "terms"
2283− <|> idsQuery `taggedWith` "ids"
2284− <|> queryQueryStringQuery `taggedWith` "query_string"
2285− <|> queryMatchQuery `taggedWith` "match"
2286− <|> queryMultiMatchQuery
2287− <|> queryBoolQuery `taggedWith` "bool"
2288− <|> queryBoostingQuery `taggedWith` "boosting"
2289− <|> queryCommonTermsQuery `taggedWith` "common"
2290− <|> constantScoreQuery `taggedWith` "constant_score"
2291− <|> queryDisMaxQuery `taggedWith` "dis_max"
2292− <|> queryFuzzyLikeThisQuery `taggedWith` "fuzzy_like_this"
2293− <|> queryFuzzyLikeFieldQuery `taggedWith` "fuzzy_like_this_field"
2294− <|> queryFuzzyQuery `taggedWith` "fuzzy"
2295− <|> queryHasChildQuery `taggedWith` "has_child"
2296− <|> queryHasParentQuery `taggedWith` "has_parent"
2297− <|> queryIndicesQuery `taggedWith` "indices"
2298− <|> matchAllQuery `taggedWith` "match_all"
2299− <|> queryMoreLikeThisQuery `taggedWith` "more_like_this"
2300− <|> queryMoreLikeThisFieldQuery `taggedWith` "more_like_this_field"
2301− <|> queryNestedQuery `taggedWith` "nested"
2302− <|> queryPrefixQuery `taggedWith` "prefix"
2303− <|> queryRangeQuery `taggedWith` "range"
2304− <|> queryRegexpQuery `taggedWith` "regexp"
2305− <|> querySimpleQueryStringQuery `taggedWith` "simple_query_string"
2306− <|> queryTemplateQueryInline `taggedWith` "template"
2307− where taggedWith parser k = parser =<< o .: k
2308− termQuery = fieldTagged $ \(FieldName fn) o ->
2309− TermQuery <$> (Term fn <$> o .: "value") <*> o .:? "boost"
2310− termsQuery o = case HM.toList o of
2311− [(fn, vs)] -> do vals <- parseJSON vs
2312− case vals of
2313− x:xs -> return (TermsQuery fn (x :| xs))
2314− _ -> fail "Expected non empty list of values"
2315− _ -> fail "Expected object with 1 field-named key"
2316− idsQuery o = IdsQuery <$> o .: "type"
2317− <*> o .: "values"
2318− queryQueryStringQuery = pure . QueryQueryStringQuery
2319− queryMatchQuery = pure . QueryMatchQuery
2320− queryMultiMatchQuery = QueryMultiMatchQuery <$> parseJSON v
2321− queryBoolQuery = pure . QueryBoolQuery
2322− queryBoostingQuery = pure . QueryBoostingQuery
2323− queryCommonTermsQuery = pure . QueryCommonTermsQuery
2324− constantScoreQuery o = case HM.lookup "query" o of
2325− Just x -> ConstantScoreQuery <$> parseJSON x
2326− <*> o .: "boost"
2327− _ -> fail "Does not appear to be a ConstantScoreQuery"
2328− queryDisMaxQuery = pure . QueryDisMaxQuery
2329− queryFuzzyLikeThisQuery = pure . QueryFuzzyLikeThisQuery
2330− queryFuzzyLikeFieldQuery = pure . QueryFuzzyLikeFieldQuery
2331− queryFuzzyQuery = pure . QueryFuzzyQuery
2332− queryHasChildQuery = pure . QueryHasChildQuery
2333− queryHasParentQuery = pure . QueryHasParentQuery
2334− queryIndicesQuery = pure . QueryIndicesQuery
2335− matchAllQuery o = MatchAllQuery <$> o .:? "boost"
2336− queryMoreLikeThisQuery = pure . QueryMoreLikeThisQuery
2337− queryMoreLikeThisFieldQuery = pure . QueryMoreLikeThisFieldQuery
2338− queryNestedQuery = pure . QueryNestedQuery
2339− queryPrefixQuery = pure . QueryPrefixQuery
2340− queryRangeQuery = pure . QueryRangeQuery
2341− queryRegexpQuery = pure . QueryRegexpQuery
2342− querySimpleQueryStringQuery = pure . QuerySimpleQueryStringQuery
2343− -- queryExistsQuery o = QueryExistsQuery <$> o .: "field"
2344− queryTemplateQueryInline = pure . QueryTemplateQueryInline
2345−
2346−
2347−omitNulls :: [(Text, Value)] -> Value
2348−omitNulls = object . filter notNull where
2349− notNull (_, Null) = False
2350− notNull (_, Array a) = (not . V.null) a
2351− notNull _ = True
2352−
2353−instance ToJSON SimpleQueryStringQuery where
2354− toJSON SimpleQueryStringQuery {..} =
2355− omitNulls (base ++ maybeAdd)
2356− where base = [ "query" .= simpleQueryStringQuery ]
2357− maybeAdd = [ "fields" .= simpleQueryStringField
2358− , "default_operator" .= simpleQueryStringOperator
2359− , "analyzer" .= simpleQueryStringAnalyzer
2360− , "flags" .= simpleQueryStringFlags
2361− , "lowercase_expanded_terms" .= simpleQueryStringLowercaseExpanded
2362− , "locale" .= simpleQueryStringLocale ]
2363−
2364−instance FromJSON SimpleQueryStringQuery where
2365− parseJSON = withObject "SimpleQueryStringQuery" parse
2366− where parse o = SimpleQueryStringQuery <$> o .: "query"
2367− <*> o .:? "fields"
2368− <*> o .:? "default_operator"
2369− <*> o .:? "analyzer"
2370− <*> (parseFlags <$> o .:? "flags")
2371− <*> o .:? "lowercase_expanded_terms"
2372− <*> o .:? "locale"
2373− parseFlags (Just (x:xs)) = Just (x :| xs)
2374− parseFlags _ = Nothing
2375−
2376−instance ToJSON FieldOrFields where
2377− toJSON (FofField fieldName) =
2378− toJSON fieldName
2379− toJSON (FofFields fieldNames) =
2380− toJSON fieldNames
2381−
2382−instance FromJSON FieldOrFields where
2383− parseJSON v = FofField <$> parseJSON v
2384− <|> FofFields <$> (parseNEJSON =<< parseJSON v)
2385−
2386−instance ToJSON SimpleQueryFlag where
2387− toJSON SimpleQueryAll = "ALL"
2388− toJSON SimpleQueryNone = "NONE"
2389− toJSON SimpleQueryAnd = "AND"
2390− toJSON SimpleQueryOr = "OR"
2391− toJSON SimpleQueryPrefix = "PREFIX"
2392− toJSON SimpleQueryPhrase = "PHRASE"
2393− toJSON SimpleQueryPrecedence = "PRECEDENCE"
2394− toJSON SimpleQueryEscape = "ESCAPE"
2395− toJSON SimpleQueryWhitespace = "WHITESPACE"
2396− toJSON SimpleQueryFuzzy = "FUZZY"
2397− toJSON SimpleQueryNear = "NEAR"
2398− toJSON SimpleQuerySlop = "SLOP"
2399−
2400−instance FromJSON SimpleQueryFlag where
2401− parseJSON = withText "SimpleQueryFlag" parse
2402− where parse "ALL" = pure SimpleQueryAll
2403− parse "NONE" = pure SimpleQueryNone
2404− parse "AND" = pure SimpleQueryAnd
2405− parse "OR" = pure SimpleQueryOr
2406− parse "PREFIX" = pure SimpleQueryPrefix
2407− parse "PHRASE" = pure SimpleQueryPhrase
2408− parse "PRECEDENCE" = pure SimpleQueryPrecedence
2409− parse "ESCAPE" = pure SimpleQueryEscape
2410− parse "WHITESPACE" = pure SimpleQueryWhitespace
2411− parse "FUZZY" = pure SimpleQueryFuzzy
2412− parse "NEAR" = pure SimpleQueryNear
2413− parse "SLOP" = pure SimpleQuerySlop
2414− parse f = fail ("Unexpected SimpleQueryFlag: " <> show f)
2415−
2416−instance ToJSON RegexpQuery where
2417− toJSON (RegexpQuery (FieldName rqQueryField)
2418− (Regexp regexpQueryQuery) rqQueryFlags
2419− rqQueryBoost) =
2420− object [ rqQueryField .= omitNulls base ]
2421− where base = [ "value" .= regexpQueryQuery
2422− , "flags" .= rqQueryFlags
2423− , "boost" .= rqQueryBoost ]
2424−
2425−instance FromJSON RegexpQuery where
2426− parseJSON = withObject "RegexpQuery" parse
2427− where parse = fieldTagged $ \fn o ->
2428− RegexpQuery fn
2429− <$> o .: "value"
2430− <*> o .: "flags"
2431− <*> o .:? "boost"
2432−
2433−instance ToJSON QueryStringQuery where
2434− toJSON (QueryStringQuery qsQueryString
2435− qsDefaultField qsOperator
2436− qsAnalyzer qsAllowWildcard
2437− qsLowercaseExpanded qsEnablePositionIncrements
2438− qsFuzzyMaxExpansions qsFuzziness
2439− qsFuzzyPrefixLength qsPhraseSlop
2440− qsBoost qsAnalyzeWildcard
2441− qsGeneratePhraseQueries qsMinimumShouldMatch
2442− qsLenient qsLocale) =
2443− omitNulls base
2444− where
2445− base = [ "query" .= qsQueryString
2446− , "default_field" .= qsDefaultField
2447− , "default_operator" .= qsOperator
2448− , "analyzer" .= qsAnalyzer
2449− , "allow_leading_wildcard" .= qsAllowWildcard
2450− , "lowercase_expanded_terms" .= qsLowercaseExpanded
2451− , "enable_position_increments" .= qsEnablePositionIncrements
2452− , "fuzzy_max_expansions" .= qsFuzzyMaxExpansions
2453− , "fuzziness" .= qsFuzziness
2454− , "fuzzy_prefix_length" .= qsFuzzyPrefixLength
2455− , "phrase_slop" .= qsPhraseSlop
2456− , "boost" .= qsBoost
2457− , "analyze_wildcard" .= qsAnalyzeWildcard
2458− , "auto_generate_phrase_queries" .= qsGeneratePhraseQueries
2459− , "minimum_should_match" .= qsMinimumShouldMatch
2460− , "lenient" .= qsLenient
2461− , "locale" .= qsLocale ]
2462−
2463−instance FromJSON QueryStringQuery where
2464− parseJSON = withObject "QueryStringQuery" parse
2465− where parse o = QueryStringQuery
2466− <$> o .: "query"
2467− <*> o .:? "default_field"
2468− <*> o .:? "default_operator"
2469− <*> o .:? "analyzer"
2470− <*> o .:? "allow_leading_wildcard"
2471− <*> o .:? "lowercase_expanded_terms"
2472− <*> o .:? "enable_position_increments"
2473− <*> o .:? "fuzzy_max_expansions"
2474− <*> o .:? "fuzziness"
2475− <*> o .:? "fuzzy_prefix_length"
2476− <*> o .:? "phrase_slop"
2477− <*> o .:? "boost"
2478− <*> o .:? "analyze_wildcard"
2479− <*> o .:? "auto_generate_phrase_queries"
2480− <*> o .:? "minimum_should_match"
2481− <*> o .:? "lenient"
2482− <*> o .:? "locale"
2483−
2484−instance ToJSON RangeQuery where
2485− toJSON (RangeQuery (FieldName fieldName) range boost) =
2486− object [ fieldName .= object conjoined ]
2487− where conjoined = [ "boost" .= boost ] ++ (rangeValueToPair range)
2488−
2489−instance FromJSON RangeQuery where
2490− parseJSON = withObject "RangeQuery" parse
2491− where parse = fieldTagged $ \fn o ->
2492− RangeQuery fn
2493− <$> parseJSON (Object o)
2494− <*> o .: "boost"
2495−
2496−instance FromJSON RangeValue where
2497− parseJSON = withObject "RangeValue" parse
2498− where parse o = parseDate o
2499− <|> parseDouble o
2500− parseDate o = do lt <- o .:? "lt"
2501− lte <- o .:? "lte"
2502− gt <- o .:? "gt"
2503− gte <- o .:? "gte"
2504− case (lt, lte, gt, gte) of
2505− (Just a, _, Just b, _) -> return (RangeDateGtLt (GreaterThanD b) (LessThanD a))
2506− (Just a, _, _, Just b)-> return (RangeDateGteLt (GreaterThanEqD b) (LessThanD a))
2507− (_, Just a, Just b, _)-> return (RangeDateGtLte (GreaterThanD b) (LessThanEqD a))
2508− (_, Just a, _, Just b)-> return (RangeDateGteLte (GreaterThanEqD b) (LessThanEqD a))
2509− (_, _, Just a, _)-> return (RangeDateGt (GreaterThanD a))
2510− (Just a, _, _, _)-> return (RangeDateLt (LessThanD a))
2511− (_, _, _, Just a)-> return (RangeDateGte (GreaterThanEqD a))
2512− (_, Just a, _, _)-> return (RangeDateLte (LessThanEqD a))
2513− (Nothing, Nothing, Nothing, Nothing) -> mzero
2514− parseDouble o = do lt <- o .:? "lt"
2515− lte <- o .:? "lte"
2516− gt <- o .:? "gt"
2517− gte <- o .:? "gte"
2518− case (lt, lte, gt, gte) of
2519− (Just a, _, Just b, _) -> return (RangeDoubleGtLt (GreaterThan b) (LessThan a))
2520− (Just a, _, _, Just b)-> return (RangeDoubleGteLt (GreaterThanEq b) (LessThan a))
2521− (_, Just a, Just b, _)-> return (RangeDoubleGtLte (GreaterThan b) (LessThanEq a))
2522− (_, Just a, _, Just b)-> return (RangeDoubleGteLte (GreaterThanEq b) (LessThanEq a))
2523− (_, _, Just a, _)-> return (RangeDoubleGt (GreaterThan a))
2524− (Just a, _, _, _)-> return (RangeDoubleLt (LessThan a))
2525− (_, _, _, Just a)-> return (RangeDoubleGte (GreaterThanEq a))
2526− (_, Just a, _, _)-> return (RangeDoubleLte (LessThanEq a))
2527− (Nothing, Nothing, Nothing, Nothing) -> mzero
2528−
2529−instance ToJSON PrefixQuery where
2530− toJSON (PrefixQuery (FieldName fieldName) queryValue boost) =
2531− object [ fieldName .= omitNulls base ]
2532− where base = [ "value" .= queryValue
2533− , "boost" .= boost ]
2534−
2535−instance FromJSON PrefixQuery where
2536− parseJSON = withObject "PrefixQuery" parse
2537− where parse = fieldTagged $ \fn o ->
2538− PrefixQuery fn
2539− <$> o .: "value"
2540− <*> o .:? "boost"
2541−
2542−instance ToJSON NestedQuery where
2543− toJSON (NestedQuery nqPath nqScoreType nqQuery) =
2544− object [ "path" .= nqPath
2545− , "score_mode" .= nqScoreType
2546− , "query" .= nqQuery ]
2547−
2548−instance FromJSON NestedQuery where
2549− parseJSON = withObject "NestedQuery" parse
2550− where parse o = NestedQuery
2551− <$> o .: "path"
2552− <*> o .: "score_mode"
2553− <*> o .: "query"
2554−
2555−instance ToJSON MoreLikeThisFieldQuery where
2556− toJSON (MoreLikeThisFieldQuery text (FieldName fieldName)
2557− percent mtf mqt stopwords mindf maxdf
2558− minwl maxwl boostTerms boost analyzer) =
2559− object [ fieldName .= omitNulls base ]
2560− where base = [ "like_text" .= text
2561− , "percent_terms_to_match" .= percent
2562− , "min_term_freq" .= mtf
2563− , "max_query_terms" .= mqt
2564− , "stop_words" .= stopwords
2565− , "min_doc_freq" .= mindf
2566− , "max_doc_freq" .= maxdf
2567− , "min_word_length" .= minwl
2568− , "max_word_length" .= maxwl
2569− , "boost_terms" .= boostTerms
2570− , "boost" .= boost
2571− , "analyzer" .= analyzer ]
2572−
2573−instance FromJSON MoreLikeThisFieldQuery where
2574− parseJSON = withObject "MoreLikeThisFieldQuery" parse
2575− where parse = fieldTagged $ \fn o ->
2576− MoreLikeThisFieldQuery
2577− <$> o .: "like_text"
2578− <*> pure fn
2579− <*> o .:? "percent_terms_to_match"
2580− <*> o .:? "min_term_freq"
2581− <*> o .:? "max_query_terms"
2582− -- <*> (optionalNE =<< o .:? "stop_words")
2583− <*> o .:? "stop_words"
2584− <*> o .:? "min_doc_freq"
2585− <*> o .:? "max_doc_freq"
2586− <*> o .:? "min_word_length"
2587− <*> o .:? "max_word_length"
2588− <*> o .:? "boost_terms"
2589− <*> o .:? "boost"
2590− <*> o .:? "analyzer"
2591− -- optionalNE = maybe (pure Nothing) (fmap Just . parseNEJSON)
2592−
2593−instance ToJSON MoreLikeThisQuery where
2594− toJSON (MoreLikeThisQuery text fields percent
2595− mtf mqt stopwords mindf maxdf
2596− minwl maxwl boostTerms boost analyzer) =
2597− omitNulls base
2598− where base = [ "like_text" .= text
2599− , "fields" .= fields
2600− , "percent_terms_to_match" .= percent
2601− , "min_term_freq" .= mtf
2602− , "max_query_terms" .= mqt
2603− , "stop_words" .= stopwords
2604− , "min_doc_freq" .= mindf
2605− , "max_doc_freq" .= maxdf
2606− , "min_word_length" .= minwl
2607− , "max_word_length" .= maxwl
2608− , "boost_terms" .= boostTerms
2609− , "boost" .= boost
2610− , "analyzer" .= analyzer ]
2611−
2612−instance FromJSON MoreLikeThisQuery where
2613− parseJSON = withObject "MoreLikeThisQuery" parse
2614− where parse o = MoreLikeThisQuery
2615− <$> o .: "like_text"
2616− -- <*> (optionalNE =<< o .:? "fields")
2617− <*> o .:? "fields"
2618− <*> o .:? "percent_terms_to_match"
2619− <*> o .:? "min_term_freq"
2620− <*> o .:? "max_query_terms"
2621− -- <*> (optionalNE =<< o .:? "stop_words")
2622− <*> o .:? "stop_words"
2623− <*> o .:? "min_doc_freq"
2624− <*> o .:? "max_doc_freq"
2625− <*> o .:? "min_word_length"
2626− <*> o .:? "max_word_length"
2627− <*> o .:? "boost_terms"
2628− <*> o .:? "boost"
2629− <*> o .:? "analyzer"
2630− -- optionalNE = maybe (pure Nothing) (fmap Just . parseNEJSON)
2631−
2632−instance ToJSON IndicesQuery where
2633− toJSON (IndicesQuery indices query noMatch) =
2634− omitNulls [ "indices" .= indices
2635− , "no_match_query" .= noMatch
2636− , "query" .= query ]
2637−
2638−instance FromJSON IndicesQuery where
2639− parseJSON = withObject "IndicesQuery" parse
2640− where parse o = IndicesQuery
2641− <$> o .:? "indices" .!= []
2642− <*> o .: "query"
2643− <*> o .:? "no_match_query"
2644−
2645−instance ToJSON HasParentQuery where
2646− toJSON (HasParentQuery queryType query scoreType) =
2647− omitNulls [ "parent_type" .= queryType
2648− , "score_type" .= scoreType
2649− , "query" .= query ]
2650−
2651−instance FromJSON HasParentQuery where
2652− parseJSON = withObject "HasParentQuery" parse
2653− where parse o = HasParentQuery
2654− <$> o .: "parent_type"
2655− <*> o .: "query"
2656− <*> o .:? "score_type"
2657−
2658−instance ToJSON HasChildQuery where
2659− toJSON (HasChildQuery queryType query scoreType) =
2660− omitNulls [ "query" .= query
2661− , "score_type" .= scoreType
2662− , "type" .= queryType ]
2663−
2664−instance FromJSON HasChildQuery where
2665− parseJSON = withObject "HasChildQuery" parse
2666− where parse o = HasChildQuery
2667− <$> o .: "type"
2668− <*> o .: "query"
2669− <*> o .:? "score_type"
2670−
2671−instance ToJSON FuzzyQuery where
2672− toJSON (FuzzyQuery (FieldName fieldName) queryText
2673− prefixLength maxEx fuzziness boost) =
2674− object [ fieldName .= omitNulls base ]
2675− where base = [ "value" .= queryText
2676− , "fuzziness" .= fuzziness
2677− , "prefix_length" .= prefixLength
2678− , "boost" .= boost
2679− , "max_expansions" .= maxEx ]
2680−
2681−instance FromJSON FuzzyQuery where
2682− parseJSON = withObject "FuzzyQuery" parse
2683− where parse = fieldTagged $ \fn o ->
2684− FuzzyQuery fn
2685− <$> o .: "value"
2686− <*> o .: "prefix_length"
2687− <*> o .: "max_expansions"
2688− <*> o .: "fuzziness"
2689− <*> o .:? "boost"
2690−
2691−instance ToJSON FuzzyLikeFieldQuery where
2692− toJSON (FuzzyLikeFieldQuery (FieldName fieldName)
2693− fieldText maxTerms ignoreFreq fuzziness prefixLength
2694− boost analyzer) =
2695− object [ fieldName .=
2696− omitNulls [ "like_text" .= fieldText
2697− , "max_query_terms" .= maxTerms
2698− , "ignore_tf" .= ignoreFreq
2699− , "fuzziness" .= fuzziness
2700− , "prefix_length" .= prefixLength
2701− , "analyzer" .= analyzer
2702− , "boost" .= boost ]]
2703−
2704−instance FromJSON FuzzyLikeFieldQuery where
2705− parseJSON = withObject "FuzzyLikeFieldQuery" parse
2706− where parse = fieldTagged $ \fn o ->
2707− FuzzyLikeFieldQuery fn
2708− <$> o .: "like_text"
2709− <*> o .: "max_query_terms"
2710− <*> o .: "ignore_tf"
2711− <*> o .: "fuzziness"
2712− <*> o .: "prefix_length"
2713− <*> o .: "boost"
2714− <*> o .:? "analyzer"
2715−
2716−instance ToJSON FuzzyLikeThisQuery where
2717− toJSON (FuzzyLikeThisQuery fields text maxTerms
2718− ignoreFreq fuzziness prefixLength boost analyzer) =
2719− omitNulls base
2720− where base = [ "fields" .= fields
2721− , "like_text" .= text
2722− , "max_query_terms" .= maxTerms
2723− , "ignore_tf" .= ignoreFreq
2724− , "fuzziness" .= fuzziness
2725− , "prefix_length" .= prefixLength
2726− , "analyzer" .= analyzer
2727− , "boost" .= boost ]
2728−
2729−instance FromJSON FuzzyLikeThisQuery where
2730− parseJSON = withObject "FuzzyLikeThisQuery" parse
2731− where parse o = FuzzyLikeThisQuery
2732− <$> o .:? "fields" .!= []
2733− <*> o .: "like_text"
2734− <*> o .: "max_query_terms"
2735− <*> o .: "ignore_tf"
2736− <*> o .: "fuzziness"
2737− <*> o .: "prefix_length"
2738− <*> o .: "boost"
2739− <*> o .:? "analyzer"
2740−
2741−instance ToJSON DisMaxQuery where
2742− toJSON (DisMaxQuery queries tiebreaker boost) =
2743− omitNulls base
2744− where base = [ "queries" .= queries
2745− , "boost" .= boost
2746− , "tie_breaker" .= tiebreaker ]
2747−
2748−instance FromJSON DisMaxQuery where
2749− parseJSON = withObject "DisMaxQuery" parse
2750− where parse o = DisMaxQuery
2751− <$> o .:? "queries" .!= []
2752− <*> o .: "tie_breaker"
2753− <*> o .:? "boost"
2754−
2755−instance ToJSON CommonTermsQuery where
2756− toJSON (CommonTermsQuery (FieldName fieldName)
2757− (QueryString query) cf lfo hfo msm
2758− boost analyzer disableCoord) =
2759− object [fieldName .= omitNulls base ]
2760− where base = [ "query" .= query
2761− , "cutoff_frequency" .= cf
2762− , "low_freq_operator" .= lfo
2763− , "minimum_should_match" .= msm
2764− , "boost" .= boost
2765− , "analyzer" .= analyzer
2766− , "disable_coord" .= disableCoord
2767− , "high_freq_operator" .= hfo ]
2768−
2769−instance FromJSON CommonTermsQuery where
2770− parseJSON = withObject "CommonTermsQuery" parse
2771− where parse = fieldTagged $ \fn o ->
2772− CommonTermsQuery fn
2773− <$> o .: "query"
2774− <*> o .: "cutoff_frequency"
2775− <*> o .: "low_freq_operator"
2776− <*> o .: "high_freq_operator"
2777− <*> o .:? "minimum_should_match"
2778− <*> o .:? "boost"
2779− <*> o .:? "analyzer"
2780− <*> o .:? "disable_coord"
2781−
2782−instance ToJSON CommonMinimumMatch where
2783− toJSON (CommonMinimumMatch mm) = toJSON mm
2784− toJSON (CommonMinimumMatchHighLow (MinimumMatchHighLow lowF highF)) =
2785− object [ "low_freq" .= lowF
2786− , "high_freq" .= highF ]
2787−
2788−instance FromJSON CommonMinimumMatch where
2789− parseJSON v = parseMinimum v
2790− <|> parseMinimumHighLow v
2791− where parseMinimum = fmap CommonMinimumMatch . parseJSON
2792− parseMinimumHighLow = fmap CommonMinimumMatchHighLow . withObject "CommonMinimumMatchHighLow" (\o ->
2793− MinimumMatchHighLow
2794− <$> o .: "low_freq"
2795− <*> o .: "high_freq")
2796−
2797−
2798−instance ToJSON BoostingQuery where
2799− toJSON (BoostingQuery bqPositiveQuery bqNegativeQuery bqNegativeBoost) =
2800− object [ "positive" .= bqPositiveQuery
2801− , "negative" .= bqNegativeQuery
2802− , "negative_boost" .= bqNegativeBoost ]
2803−
2804−instance FromJSON BoostingQuery where
2805− parseJSON = withObject "BoostingQuery" parse
2806− where parse o = BoostingQuery
2807− <$> o .: "positive"
2808− <*> o .: "negative"
2809− <*> o .: "negative_boost"
2810−
2811−instance ToJSON BoolQuery where
2812− toJSON (BoolQuery mustM filterM' notM shouldM bqMin boost disableCoord) =
2813− omitNulls base
2814− where base = [ "must" .= mustM
2815− , "filter" .= filterM'
2816− , "must_not" .= notM
2817− , "should" .= shouldM
2818− , "minimum_should_match" .= bqMin
2819− , "boost" .= boost
2820− , "disable_coord" .= disableCoord ]
2821−
2822−instance FromJSON BoolQuery where
2823− parseJSON = withObject "BoolQuery" parse
2824− where parse o = BoolQuery
2825− <$> o .:? "must" .!= []
2826− <*> o .:? "filter" .!= []
2827− <*> o .:? "must_not" .!= []
2828− <*> o .:? "should" .!= []
2829− <*> o .:? "minimum_should_match"
2830− <*> o .:? "boost"
2831− <*> o .:? "disable_coord"
2832−
2833−instance ToJSON MatchQuery where
2834− toJSON (MatchQuery (FieldName fieldName)
2835− (QueryString mqQueryString) booleanOperator
2836− zeroTermsQuery cutoffFrequency matchQueryType
2837− analyzer maxExpansions lenient boost) =
2838− object [ fieldName .= omitNulls base ]
2839− where base = [ "query" .= mqQueryString
2840− , "operator" .= booleanOperator
2841− , "zero_terms_query" .= zeroTermsQuery
2842− , "cutoff_frequency" .= cutoffFrequency
2843− , "type" .= matchQueryType
2844− , "analyzer" .= analyzer
2845− , "max_expansions" .= maxExpansions
2846− , "lenient" .= lenient
2847− , "boost" .= boost ]
2848−
2849−instance FromJSON MatchQuery where
2850− parseJSON = withObject "MatchQuery" parse
2851− where parse = fieldTagged $ \fn o ->
2852− MatchQuery fn
2853− <$> o .: "query"
2854− <*> o .: "operator"
2855− <*> o .: "zero_terms_query"
2856− <*> o .:? "cutoff_frequency"
2857− <*> o .:? "type"
2858− <*> o .:? "analyzer"
2859− <*> o .:? "max_expansions"
2860− <*> o .:? "lenient"
2861− <*> o .:? "boost"
2862−
2863−instance ToJSON MultiMatchQuery where
2864− toJSON (MultiMatchQuery fields (QueryString query) boolOp
2865− ztQ tb mmqt cf analyzer maxEx lenient) =
2866− object ["multi_match" .= omitNulls base]
2867− where base = [ "fields" .= fmap toJSON fields
2868− , "query" .= query
2869− , "operator" .= boolOp
2870− , "zero_terms_query" .= ztQ
2871− , "tie_breaker" .= tb
2872− , "type" .= mmqt
2873− , "cutoff_frequency" .= cf
2874− , "analyzer" .= analyzer
2875− , "max_expansions" .= maxEx
2876− , "lenient" .= lenient ]
2877−
2878−instance FromJSON MultiMatchQuery where
2879− parseJSON = withObject "MultiMatchQuery" parse
2880− where parse raw = do o <- raw .: "multi_match"
2881− MultiMatchQuery
2882− <$> o .:? "fields" .!= []
2883− <*> o .: "query"
2884− <*> o .: "operator"
2885− <*> o .: "zero_terms_query"
2886− <*> o .:? "tie_breaker"
2887− <*> o .:? "type"
2888− <*> o .:? "cutoff_frequency"
2889− <*> o .:? "analyzer"
2890− <*> o .:? "max_expansions"
2891− <*> o .:? "lenient"
2892−
2893−instance ToJSON MultiMatchQueryType where
2894− toJSON MultiMatchBestFields = "best_fields"
2895− toJSON MultiMatchMostFields = "most_fields"
2896− toJSON MultiMatchCrossFields = "cross_fields"
2897− toJSON MultiMatchPhrase = "phrase"
2898− toJSON MultiMatchPhrasePrefix = "phrase_prefix"
2899−
2900−instance FromJSON MultiMatchQueryType where
2901− parseJSON = withText "MultiMatchPhrasePrefix" parse
2902− where parse "best_fields" = pure MultiMatchBestFields
2903− parse "most_fields" = pure MultiMatchMostFields
2904− parse "cross_fields" = pure MultiMatchCrossFields
2905− parse "phrase" = pure MultiMatchPhrase
2906− parse "phrase_prefix" = pure MultiMatchPhrasePrefix
2907− parse t = fail ("Unexpected MultiMatchPhrasePrefix: " <> show t)
2908−
2909−instance ToJSON BooleanOperator where
2910− toJSON And = String "and"
2911− toJSON Or = String "or"
2912−
2913−instance FromJSON BooleanOperator where
2914− parseJSON = withText "BooleanOperator" parse
2915− where parse "and" = pure And
2916− parse "or" = pure Or
2917− parse o = fail ("Unexpected BooleanOperator: " <> show o)
2918−
2919−instance ToJSON ZeroTermsQuery where
2920− toJSON ZeroTermsNone = String "none"
2921− toJSON ZeroTermsAll = String "all"
2922−
2923−instance FromJSON ZeroTermsQuery where
2924− parseJSON = withText "ZeroTermsQuery" parse
2925− where parse "none" = pure ZeroTermsNone
2926− parse "all" = pure ZeroTermsAll
2927− parse q = fail ("Unexpected ZeroTermsQuery: " <> show q)
2928−
2929−instance ToJSON MatchQueryType where
2930− toJSON MatchPhrase = "phrase"
2931− toJSON MatchPhrasePrefix = "phrase_prefix"
2932−
2933−instance FromJSON MatchQueryType where
2934− parseJSON = withText "MatchQueryType" parse
2935− where parse "phrase" = pure MatchPhrase
2936− parse "phrase_prefix" = pure MatchPhrasePrefix
2937− parse t = fail ("Unexpected MatchQueryType: " <> show t)
2938−
2939−instance FromJSON Status where
2940− parseJSON (Object v) = Status <$>
2941− v .: "name" <*>
2942− v .: "cluster_name" <*>
2943− v .: "cluster_uuid" <*>
2944− v .: "version" <*>
2945− v .: "tagline"
2946− parseJSON _ = empty
2947−
2948−
2949−instance ToJSON IndexSettings where
2950− toJSON (IndexSettings s r) = object ["settings" .=
2951− object ["index" .=
2952− object ["number_of_shards" .= s, "number_of_replicas" .= r]
2953− ]
2954− ]
2955−
2956−instance FromJSON IndexSettings where
2957− parseJSON = withObject "IndexSettings" parse
2958− where parse o = do s <- o .: "settings"
2959− i <- s .: "index"
2960− IndexSettings <$> i .: "number_of_shards"
2961− <*> i .: "number_of_replicas"
2962−
2963−instance ToJSON UpdatableIndexSetting where
2964− toJSON (NumberOfReplicas x) = oPath ("index" :| ["number_of_replicas"]) x
2965− toJSON (AutoExpandReplicas x) = oPath ("index" :| ["auto_expand_replicas"]) x
2966− toJSON (RefreshInterval x) = oPath ("index" :| ["refresh_interval"]) (NominalDiffTimeJSON x)
2967− toJSON (IndexConcurrency x) = oPath ("index" :| ["concurrency"]) x
2968− toJSON (FailOnMergeFailure x) = oPath ("index" :| ["fail_on_merge_failure"]) x
2969− toJSON (TranslogFlushThresholdOps x) = oPath ("index" :| ["translog", "flush_threshold_ops"]) x
2970− toJSON (TranslogFlushThresholdSize x) = oPath ("index" :| ["translog", "flush_threshold_size"]) x
2971− toJSON (TranslogFlushThresholdPeriod x) = oPath ("index" :| ["translog", "flush_threshold_period"]) (NominalDiffTimeJSON x)
2972− toJSON (TranslogDisableFlush x) = oPath ("index" :| ["translog", "disable_flush"]) x
2973− toJSON (CacheFilterMaxSize x) = oPath ("index" :| ["cache", "filter", "max_size"]) x
2974− toJSON (CacheFilterExpire x) = oPath ("index" :| ["cache", "filter", "expire"]) (NominalDiffTimeJSON <$> x)
2975− toJSON (GatewaySnapshotInterval x) = oPath ("index" :| ["gateway", "snapshot_interval"]) (NominalDiffTimeJSON x)
2976− toJSON (RoutingAllocationInclude fs) = oPath ("index" :| ["routing", "allocation", "include"]) (attrFilterJSON fs)
2977− toJSON (RoutingAllocationExclude fs) = oPath ("index" :| ["routing", "allocation", "exclude"]) (attrFilterJSON fs)
2978− toJSON (RoutingAllocationRequire fs) = oPath ("index" :| ["routing", "allocation", "require"]) (attrFilterJSON fs)
2979− toJSON (RoutingAllocationEnable x) = oPath ("index" :| ["routing", "allocation", "enable"]) x
2980− toJSON (RoutingAllocationShardsPerNode x) = oPath ("index" :| ["routing", "allocation", "total_shards_per_node"]) x
2981− toJSON (RecoveryInitialShards x) = oPath ("index" :| ["recovery", "initial_shards"]) x
2982− toJSON (GCDeletes x) = oPath ("index" :| ["gc_deletes"]) (NominalDiffTimeJSON x)
2983− toJSON (TTLDisablePurge x) = oPath ("index" :| ["ttl", "disable_purge"]) x
2984− toJSON (TranslogFSType x) = oPath ("index" :| ["translog", "fs", "type"]) x
2985− toJSON (IndexCompoundFormat x) = oPath ("index" :| ["compound_format"]) x
2986− toJSON (IndexCompoundOnFlush x) = oPath ("index" :| ["compound_on_flush"]) x
2987− toJSON (WarmerEnabled x) = oPath ("index" :| ["warmer", "enabled"]) x
2988− toJSON (BlocksReadOnly x) = oPath ("blocks" :| ["read_only"]) x
2989− toJSON (BlocksRead x) = oPath ("blocks" :| ["read"]) x
2990− toJSON (BlocksWrite x) = oPath ("blocks" :| ["write"]) x
2991− toJSON (BlocksMetaData x) = oPath ("blocks" :| ["metadata"]) x
2992− toJSON (MappingTotalFieldsLimit x) = oPath ("index" :| ["mapping","total_fields","limit"]) x
2993−
2994−instance FromJSON UpdatableIndexSetting where
2995− parseJSON = withObject "UpdatableIndexSetting" parse
2996− where parse o = numberOfReplicas `taggedAt` ["index", "number_of_replicas"]
2997− <|> autoExpandReplicas `taggedAt` ["index", "auto_expand_replicas"]
2998− <|> refreshInterval `taggedAt` ["index", "refresh_interval"]
2999− <|> indexConcurrency `taggedAt` ["index", "concurrency"]
3000− <|> failOnMergeFailure `taggedAt` ["index", "fail_on_merge_failure"]
3001− <|> translogFlushThresholdOps `taggedAt` ["index", "translog", "flush_threshold_ops"]
3002− <|> translogFlushThresholdSize `taggedAt` ["index", "translog", "flush_threshold_size"]
3003− <|> translogFlushThresholdPeriod `taggedAt` ["index", "translog", "flush_threshold_period"]
3004− <|> translogDisableFlush `taggedAt` ["index", "translog", "disable_flush"]
3005− <|> cacheFilterMaxSize `taggedAt` ["index", "cache", "filter", "max_size"]
3006− <|> cacheFilterExpire `taggedAt` ["index", "cache", "filter", "expire"]
3007− <|> gatewaySnapshotInterval `taggedAt` ["index", "gateway", "snapshot_interval"]
3008− <|> routingAllocationInclude `taggedAt` ["index", "routing", "allocation", "include"]
3009− <|> routingAllocationExclude `taggedAt` ["index", "routing", "allocation", "exclude"]
3010− <|> routingAllocationRequire `taggedAt` ["index", "routing", "allocation", "require"]
3011− <|> routingAllocationEnable `taggedAt` ["index", "routing", "allocation", "enable"]
3012− <|> routingAllocationShardsPerNode `taggedAt` ["index", "routing", "allocation", "total_shards_per_node"]
3013− <|> recoveryInitialShards `taggedAt` ["index", "recovery", "initial_shards"]
3014− <|> gcDeletes `taggedAt` ["index", "gc_deletes"]
3015− <|> ttlDisablePurge `taggedAt` ["index", "ttl", "disable_purge"]
3016− <|> translogFSType `taggedAt` ["index", "translog", "fs", "type"]
3017− <|> compoundFormat `taggedAt` ["index", "compound_format"]
3018− <|> compoundOnFlush `taggedAt` ["index", "compound_on_flush"]
3019− <|> warmerEnabled `taggedAt` ["index", "warmer", "enabled"]
3020− <|> blocksReadOnly `taggedAt` ["blocks", "read_only"]
3021− <|> blocksRead `taggedAt` ["blocks", "read"]
3022− <|> blocksWrite `taggedAt` ["blocks", "write"]
3023− <|> blocksMetaData `taggedAt` ["blocks", "metadata"]
3024− <|> mappingTotalFieldsLimit `taggedAt` ["index", "mapping", "total_fields", "limit"]
3025− where taggedAt f ks = taggedAt' f (Object o) ks
3026− taggedAt' f v [] = f =<< (parseJSON v <|> (parseJSON (unStringlyTypeJSON v)))
3027− taggedAt' f v (k:ks) = withObject "Object" (\o -> do v' <- o .: k
3028− taggedAt' f v' ks) v
3029− numberOfReplicas = pure . NumberOfReplicas
3030− autoExpandReplicas = pure . AutoExpandReplicas
3031− refreshInterval = pure . RefreshInterval . ndtJSON
3032− indexConcurrency = pure . IndexConcurrency
3033− failOnMergeFailure = pure . FailOnMergeFailure
3034− translogFlushThresholdOps = pure . TranslogFlushThresholdOps
3035− translogFlushThresholdSize = pure . TranslogFlushThresholdSize
3036− translogFlushThresholdPeriod = pure . TranslogFlushThresholdPeriod . ndtJSON
3037− translogDisableFlush = pure . TranslogDisableFlush
3038− cacheFilterMaxSize = pure . CacheFilterMaxSize
3039− cacheFilterExpire = pure . CacheFilterExpire . fmap ndtJSON
3040− gatewaySnapshotInterval = pure . GatewaySnapshotInterval . ndtJSON
3041− routingAllocationInclude = fmap RoutingAllocationInclude . parseAttrFilter
3042− routingAllocationExclude = fmap RoutingAllocationExclude . parseAttrFilter
3043− routingAllocationRequire = fmap RoutingAllocationRequire . parseAttrFilter
3044− routingAllocationEnable = pure . RoutingAllocationEnable
3045− routingAllocationShardsPerNode = pure . RoutingAllocationShardsPerNode
3046− recoveryInitialShards = pure . RecoveryInitialShards
3047− gcDeletes = pure . GCDeletes . ndtJSON
3048− ttlDisablePurge = pure . TTLDisablePurge
3049− translogFSType = pure . TranslogFSType
3050− compoundFormat = pure . IndexCompoundFormat
3051− compoundOnFlush = pure . IndexCompoundOnFlush
3052− warmerEnabled = pure . WarmerEnabled
3053− blocksReadOnly = pure . BlocksReadOnly
3054− blocksRead = pure . BlocksRead
3055− blocksWrite = pure . BlocksWrite
3056− blocksMetaData = pure . BlocksMetaData
3057− mappingTotalFieldsLimit = pure . MappingTotalFieldsLimit
3058−
3059−instance FromJSON IndexSettingsSummary where
3060− parseJSON = withObject "IndexSettingsSummary" parse
3061− where parse o = case HM.toList o of
3062− [(ixn, v@(Object o'))] -> IndexSettingsSummary (IndexName ixn)
3063− <$> parseJSON v
3064− <*> (fmap (filter (not . redundant)) . parseSettings =<< o' .: "settings")
3065− _ -> fail "Expected single-key object with index name"
3066− redundant (NumberOfReplicas _) = True
3067− redundant _ = False
3068−
3069−-- | For some reason in several settings APIs, all leaf values get returned
3070−-- as strings. This function attepmts to recover from this for all
3071−-- non-recursive JSON types. If nothing can be done, the value is left alone.
3072−unStringlyTypeJSON :: Value -> Value
3073−unStringlyTypeJSON (String "true") = Bool True
3074−unStringlyTypeJSON (String "false") = Bool False
3075−unStringlyTypeJSON (String "null") = Null
3076−unStringlyTypeJSON v@(String t) = case readMay (T.unpack t) of
3077− Just n -> Number n
3078− Nothing -> v
3079−unStringlyTypeJSON v = v
3080−
3081−
3082−parseSettings :: Object -> Parser [UpdatableIndexSetting]
3083−parseSettings o = do
3084− o' <- o .: "index"
3085− -- slice the index object into singleton hashmaps and try to parse each
3086− parses <- forM (HM.toList o') $ \(k, v) -> do
3087− -- blocks are now nested into the "index" key, which is not how they're serialized
3088− let atRoot = Object (HM.singleton k v)
3089− let atIndex = Object (HM.singleton "index" atRoot)
3090− optional (parseJSON atRoot <|> parseJSON atIndex)
3091− return (catMaybes parses)
3092−
3093−oPath :: ToJSON a => NonEmpty Text -> a -> Value
3094−oPath (k :| []) v = object [k .= v]
3095−oPath (k:| (h:t)) v = object [k .= oPath (h :| t) v]
3096−
3097−attrFilterJSON :: NonEmpty NodeAttrFilter -> Value
3098−attrFilterJSON fs = object [ n .= T.intercalate "," (toList vs)
3099− | NodeAttrFilter (NodeAttrName n) vs <- toList fs]
3100−
3101−parseAttrFilter :: Value -> Parser (NonEmpty NodeAttrFilter)
3102−parseAttrFilter = withObject "NonEmpty NodeAttrFilter" parse
3103− where parse o = case HM.toList o of
3104− [] -> fail "Expected non-empty list of NodeAttrFilters"
3105− x:xs -> DT.mapM (uncurry parse') (x :| xs)
3106− parse' n = withText "Text" $ \t ->
3107− case T.splitOn "," t of
3108− fv:fvs -> return (NodeAttrFilter (NodeAttrName n) (fv :| fvs))
3109− [] -> fail "Expected non-empty list of filter values"
3110−
3111−instance ToJSON ReplicaBounds where
3112− toJSON (ReplicasBounded a b) = String (showText a <> "-" <> showText b)
3113− toJSON (ReplicasLowerBounded a) = String (showText a <> "-all")
3114− toJSON ReplicasUnbounded = Bool False
3115−
3116−instance FromJSON ReplicaBounds where
3117− parseJSON v = withText "ReplicaBounds" parseText v
3118− <|> withBool "ReplicaBounds" parseBool v
3119− where parseText t = case T.splitOn "-" t of
3120− [a, "all"] -> ReplicasLowerBounded <$> parseReadText a
3121− [a, b] -> ReplicasBounded <$> parseReadText a
3122− <*> parseReadText b
3123− _ -> fail ("Could not parse ReplicaBounds: " <> show t)
3124− parseBool False = pure ReplicasUnbounded
3125− parseBool _ = fail "ReplicasUnbounded cannot be represented with True"
3126−
3127−instance ToJSON AllocationPolicy where
3128− toJSON AllocAll = String "all"
3129− toJSON AllocPrimaries = String "primaries"
3130− toJSON AllocNewPrimaries = String "new_primaries"
3131− toJSON AllocNone = String "none"
3132−
3133−instance FromJSON AllocationPolicy where
3134− parseJSON = withText "AllocationPolicy" parse
3135− where parse "all" = pure AllocAll
3136− parse "primaries" = pure AllocPrimaries
3137− parse "new_primaries" = pure AllocNewPrimaries
3138− parse "none" = pure AllocNone
3139− parse t = fail ("Invlaid AllocationPolicy: " <> show t)
3140−
3141−instance ToJSON InitialShardCount where
3142− toJSON QuorumShards = String "quorum"
3143− toJSON QuorumMinus1Shards = String "quorum-1"
3144− toJSON FullShards = String "full"
3145− toJSON FullMinus1Shards = String "full-1"
3146− toJSON (ExplicitShards x) = toJSON x
3147−
3148−instance FromJSON InitialShardCount where
3149− parseJSON v = withText "InitialShardCount" parseText v
3150− <|> ExplicitShards <$> parseJSON v
3151− where parseText "quorum" = pure QuorumShards
3152− parseText "quorum-1" = pure QuorumMinus1Shards
3153− parseText "full" = pure FullShards
3154− parseText "full-1" = pure FullMinus1Shards
3155− parseText _ = mzero
3156−
3157−instance ToJSON FSType where
3158− toJSON FSSimple = "simple"
3159− toJSON FSBuffered = "buffered"
3160−
3161−instance FromJSON FSType where
3162− parseJSON = withText "FSType" parse
3163− where parse "simple" = pure FSSimple
3164− parse "buffered" = pure FSBuffered
3165− parse t = fail ("Invalid FSType: " <> show t)
3166−
3167−instance ToJSON CompoundFormat where
3168− toJSON (CompoundFileFormat x) = Bool x
3169− toJSON (MergeSegmentVsTotalIndex x) = toJSON x
3170−
3171−instance FromJSON CompoundFormat where
3172− parseJSON v = CompoundFileFormat <$> parseJSON v
3173− <|> MergeSegmentVsTotalIndex <$> parseJSON v
3174−
3175−instance ToJSON NominalDiffTimeJSON where
3176− toJSON (NominalDiffTimeJSON t) = String (showText (round t :: Integer) <> "s")
3177−
3178−instance FromJSON NominalDiffTimeJSON where
3179− parseJSON = withText "NominalDiffTime" parse
3180− where parse t = case T.takeEnd 1 t of
3181− "s" -> NominalDiffTimeJSON . fromInteger <$> parseReadText (T.dropEnd 1 t)
3182− _ -> fail "Invalid or missing NominalDiffTime unit (expected s)"
3183−
3184−instance ToJSON IndexTemplate where
3185− toJSON (IndexTemplate p s m) = merge
3186− (object [ "template" .= p
3187− , "mappings" .= foldl' merge (object []) m
3188− ])
3189− (toJSON s)
3190− where
3191− merge (Object o1) (Object o2) = toJSON $ HM.union o1 o2
3192− merge o Null = o
3193− merge _ _ = undefined
3194−
3195−instance (FromJSON a) => FromJSON (EsResult a) where
3196− parseJSON jsonVal@(Object v) = do
3197− found <- v .:? "found" .!= False
3198− fr <- if found
3199− then parseJSON jsonVal
3200− else return Nothing
3201− EsResult <$> v .: "_index" <*>
3202− v .: "_type" <*>
3203− v .: "_id" <*>
3204− pure fr
3205− parseJSON _ = empty
3206−
3207−instance (FromJSON a) => FromJSON (EsResultFound a) where
3208− parseJSON (Object v) = EsResultFound <$>
3209− v .: "_version" <*>
3210− v .: "_source"
3211− parseJSON _ = empty
3212−
3213−instance FromJSON EsError where
3214− parseJSON (Object v) = EsError <$>
3215− v .: "status" <*>
3216− (v .: "error" <|> (v .: "error" >>= (.: "reason")))
3217− parseJSON _ = empty
3218−
3219−instance FromJSON IndexAliasesSummary where
3220− parseJSON = withObject "IndexAliasesSummary" parse
3221− where parse o = IndexAliasesSummary . mconcat <$> mapM (uncurry go) (HM.toList o)
3222− go ixn = withObject "index aliases" $ \ia -> do
3223− aliases <- ia .:? "aliases" .!= mempty
3224− forM (HM.toList aliases) $ \(aName, v) -> do
3225− let indexAlias = IndexAlias (IndexName ixn) (IndexAliasName (IndexName aName))
3226− IndexAliasSummary indexAlias <$> parseJSON v
3227−
3228−
3229−instance ToJSON IndexAliasAction where
3230− toJSON (AddAlias ia opts) = object ["add" .= (iaObj <> optsObj)]
3231− where Object iaObj = toJSON ia
3232− Object optsObj = toJSON opts
3233− toJSON (RemoveAlias ia) = object ["remove" .= iaObj]
3234− where Object iaObj = toJSON ia
3235−
3236−instance ToJSON IndexAlias where
3237− toJSON IndexAlias {..} = object ["index" .= srcIndex
3238− , "alias" .= indexAlias
3239− ]
3240−
3241−instance ToJSON IndexAliasCreate where
3242− toJSON IndexAliasCreate {..} = Object (filterObj <> routingObj)
3243− where filterObj = maybe mempty (HM.singleton "filter" . toJSON) aliasCreateFilter
3244− Object routingObj = maybe (Object mempty) toJSON aliasCreateRouting
3245−
3246−instance ToJSON AliasRouting where
3247− toJSON (AllAliasRouting v) = object ["routing" .= v]
3248− toJSON (GranularAliasRouting srch idx) = object (catMaybes prs)
3249− where prs = [("search_routing" .=) <$> srch
3250− ,("index_routing" .=) <$> idx]
3251−
3252−instance FromJSON AliasRouting where
3253− parseJSON = withObject "AliasRouting" parse
3254− where parse o = parseAll o <|> parseGranular o
3255− parseAll o = AllAliasRouting <$> o .: "routing"
3256− parseGranular o = do
3257− sr <- o .:? "search_routing"
3258− ir <- o .:? "index_routing"
3259− if isNothing sr && isNothing ir
3260− then fail "Both search_routing and index_routing can't be blank"
3261− else return (GranularAliasRouting sr ir)
3262−
3263−instance FromJSON IndexAliasCreate where
3264− parseJSON v = withObject "IndexAliasCreate" parse v
3265− where parse o = IndexAliasCreate <$> optional (parseJSON v)
3266− <*> o .:? "filter"
3267−
3268−instance ToJSON SearchAliasRouting where
3269− toJSON (SearchAliasRouting rvs) = toJSON (T.intercalate "," (routingValue <$> toList rvs))
3270−
3271−instance FromJSON SearchAliasRouting where
3272− parseJSON = withText "SearchAliasRouting" parse
3273− where parse t = SearchAliasRouting <$> parseNEJSON (String <$> T.splitOn "," t)
3274−
3275−instance ToJSON Search where
3276− toJSON (Search mquery sFilter sort searchAggs highlight sTrackSortScores sFrom sSize _ sFields sSource sSuggest) =
3277− omitNulls [ "query" .= query'
3278− , "sort" .= sort
3279− , "aggregations" .= searchAggs
3280− , "highlight" .= highlight
3281− , "from" .= sFrom
3282− , "size" .= sSize
3283− , "track_scores" .= sTrackSortScores
3284− , "fields" .= sFields
3285− , "_source" .= sSource
3286− , "suggest" .= sSuggest]
3287−
3288− where query' = case sFilter of
3289− Nothing -> mquery
3290− Just x -> Just . QueryBoolQuery $ mkBoolQuery (maybeToList mquery) [x] [] []
3291−
3292−instance ToJSON Source where
3293− toJSON NoSource = toJSON False
3294− toJSON (SourcePatterns patterns) = toJSON patterns
3295− toJSON (SourceIncludeExclude incl excl) = object [ "includes" .= incl, "excludes" .= excl ]
3296−
3297−instance ToJSON PatternOrPatterns where
3298− toJSON (PopPattern pattern) = toJSON pattern
3299− toJSON (PopPatterns patterns) = toJSON patterns
3300−
3301−instance ToJSON Include where
3302− toJSON (Include patterns) = toJSON patterns
3303−
3304−instance ToJSON Exclude where
3305− toJSON (Exclude patterns) = toJSON patterns
3306−
3307−instance ToJSON Pattern where
3308− toJSON (Pattern pattern) = toJSON pattern
3309−
3310−
3311−instance ToJSON FieldHighlight where
3312− toJSON (FieldHighlight (FieldName fName) (Just fSettings)) =
3313− object [ fName .= fSettings ]
3314− toJSON (FieldHighlight (FieldName fName) Nothing) =
3315− object [ fName .= emptyObject ]
3316−
3317−instance ToJSON Highlights where
3318− toJSON (Highlights global fields) =
3319− omitNulls (("fields" .= fields)
3320− : highlightSettingsPairs global)
3321−
3322−instance ToJSON HighlightSettings where
3323− toJSON hs = omitNulls (highlightSettingsPairs (Just hs))
3324−
3325−highlightSettingsPairs :: Maybe HighlightSettings -> [Pair]
3326−highlightSettingsPairs Nothing = []
3327−highlightSettingsPairs (Just (Plain plh)) = plainHighPairs (Just plh)
3328−highlightSettingsPairs (Just (Postings ph)) = postHighPairs (Just ph)
3329−highlightSettingsPairs (Just (FastVector fvh)) = fastVectorHighPairs (Just fvh)
3330−
3331−
3332−plainHighPairs :: Maybe PlainHighlight -> [Pair]
3333−plainHighPairs Nothing = []
3334−plainHighPairs (Just (PlainHighlight plCom plNonPost)) =
3335− [ "type" .= String "plain"]
3336− ++ commonHighlightPairs plCom
3337− ++ nonPostingsToPairs plNonPost
3338−
3339−postHighPairs :: Maybe PostingsHighlight -> [Pair]
3340−postHighPairs Nothing = []
3341−postHighPairs (Just (PostingsHighlight pCom)) =
3342− ("type" .= String "postings")
3343− : commonHighlightPairs pCom
3344−
3345−fastVectorHighPairs :: Maybe FastVectorHighlight -> [Pair]
3346−fastVectorHighPairs Nothing = []
3347−fastVectorHighPairs (Just
3348− (FastVectorHighlight fvCom fvNonPostSettings fvBoundChars
3349− fvBoundMaxScan fvFragOff fvMatchedFields
3350− fvPhraseLim)) =
3351− [ "type" .= String "fvh"
3352− , "boundary_chars" .= fvBoundChars
3353− , "boundary_max_scan" .= fvBoundMaxScan
3354− , "fragment_offset" .= fvFragOff
3355− , "matched_fields" .= fvMatchedFields
3356− , "phraseLimit" .= fvPhraseLim]
3357− ++ commonHighlightPairs fvCom
3358− ++ nonPostingsToPairs fvNonPostSettings
3359−
3360−deleteSeveral :: (Eq k, Hashable k) => [k] -> HM.HashMap k v -> HM.HashMap k v
3361−deleteSeveral ks hm = foldr HM.delete hm ks
3362−
3363−commonHighlightPairs :: Maybe CommonHighlight -> [Pair]
3364−commonHighlightPairs Nothing = []
3365−commonHighlightPairs (Just (CommonHighlight chScore chForceSource chTag chEncoder
3366− chNoMatchSize chHighlightQuery
3367− chRequireFieldMatch)) =
3368− [ "order" .= chScore
3369− , "force_source" .= chForceSource
3370− , "encoder" .= chEncoder
3371− , "no_match_size" .= chNoMatchSize
3372− , "highlight_query" .= chHighlightQuery
3373− , "require_fieldMatch" .= chRequireFieldMatch]
3374− ++ highlightTagToPairs chTag
3375−
3376−
3377−nonPostingsToPairs :: Maybe NonPostings -> [Pair]
3378−nonPostingsToPairs Nothing = []
3379−nonPostingsToPairs (Just (NonPostings npFragSize npNumOfFrags)) =
3380− [ "fragment_size" .= npFragSize
3381− , "number_of_fragments" .= npNumOfFrags]
3382−
3383−parseNEJSON :: (FromJSON a) => [Value] -> Parser (NonEmpty a)
3384−parseNEJSON [] = fail "Expected non-empty list"
3385−parseNEJSON (x:xs) = DT.mapM parseJSON (x :| xs)
3386−
3387−
3388−instance ToJSON HighlightEncoder where
3389− toJSON DefaultEncoder = String "default"
3390− toJSON HTMLEncoder = String "html"
3391−
3392−highlightTagToPairs :: Maybe HighlightTag -> [Pair]
3393−highlightTagToPairs (Just (TagSchema _)) = [ "scheme" .= String "default"]
3394−highlightTagToPairs (Just (CustomTags (pre, post))) = [ "pre_tags" .= pre
3395− , "post_tags" .= post]
3396−highlightTagToPairs Nothing = []
3397−
3398−instance ToJSON SortSpec where
3399− toJSON (DefaultSortSpec
3400− (DefaultSort (FieldName dsSortFieldName) dsSortOrder dsIgnoreUnmapped
3401− dsSortMode dsMissingSort dsNestedFilter)) =
3402− object [dsSortFieldName .= omitNulls base] where
3403− base = [ "order" .= dsSortOrder
3404− , "unmapped_type" .= dsIgnoreUnmapped
3405− , "mode" .= dsSortMode
3406− , "missing" .= dsMissingSort
3407− , "nested_filter" .= dsNestedFilter ]
3408−
3409− toJSON (GeoDistanceSortSpec gdsSortOrder (GeoPoint (FieldName field) gdsLatLon) units) =
3410− object [ "unit" .= units
3411− , field .= gdsLatLon
3412− , "order" .= gdsSortOrder ]
3413−
3414−
3415−instance ToJSON SortOrder where
3416− toJSON Ascending = String "asc"
3417− toJSON Descending = String "desc"
3418−
3419−
3420−instance ToJSON SortMode where
3421− toJSON SortMin = String "min"
3422− toJSON SortMax = String "max"
3423− toJSON SortSum = String "sum"
3424− toJSON SortAvg = String "avg"
3425−
3426−
3427−instance ToJSON Missing where
3428− toJSON LastMissing = String "_last"
3429− toJSON FirstMissing = String "_first"
3430− toJSON (CustomMissing txt) = String txt
3431−
3432−
3433−instance ToJSON ScoreType where
3434− toJSON ScoreTypeMax = "max"
3435− toJSON ScoreTypeAvg = "avg"
3436− toJSON ScoreTypeSum = "sum"
3437− toJSON ScoreTypeNone = "none"
3438−
3439−instance FromJSON ScoreType where
3440− parseJSON = withText "ScoreType" parse
3441− where parse "max" = pure ScoreTypeMax
3442− parse "avg" = pure ScoreTypeAvg
3443− parse "sum" = pure ScoreTypeSum
3444− parse "none" = pure ScoreTypeNone
3445− parse t = fail ("Unexpected ScoreType: " <> show t)
3446−
3447−instance ToJSON Distance where
3448− toJSON (Distance dCoefficient dUnit) =
3449− String boltedTogether where
3450− coefText = showText dCoefficient
3451− (String unitText) = toJSON dUnit
3452− boltedTogether = mappend coefText unitText
3453−
3454−instance FromJSON Distance where
3455− parseJSON = withText "Distance" parse
3456− where parse t = Distance <$> parseCoeff nT
3457− <*> parseJSON (String unitT)
3458− where (nT, unitT) = T.span validForNumber t
3459− -- may be a better way to do this
3460− validForNumber '-' = True
3461− validForNumber '.' = True
3462− validForNumber 'e' = True
3463− validForNumber c = isNumber c
3464− parseCoeff "" = fail "Empty string cannot be parsed as number"
3465− parseCoeff s = return (read (T.unpack s))
3466−
3467−instance ToJSON DistanceUnit where
3468− toJSON Miles = String "mi"
3469− toJSON Yards = String "yd"
3470− toJSON Feet = String "ft"
3471− toJSON Inches = String "in"
3472− toJSON Kilometers = String "km"
3473− toJSON Meters = String "m"
3474− toJSON Centimeters = String "cm"
3475− toJSON Millimeters = String "mm"
3476− toJSON NauticalMiles = String "nmi"
3477−
3478−
3479−instance FromJSON DistanceUnit where
3480− parseJSON = withText "DistanceUnit" parse
3481− where parse "mi" = pure Miles
3482− parse "yd" = pure Yards
3483− parse "ft" = pure Feet
3484− parse "in" = pure Inches
3485− parse "km" = pure Kilometers
3486− parse "m" = pure Meters
3487− parse "cm" = pure Centimeters
3488− parse "mm" = pure Millimeters
3489− parse "nmi" = pure NauticalMiles
3490− parse u = fail ("Unrecognized DistanceUnit: " <> show u)
3491−
3492−instance ToJSON DistanceType where
3493− toJSON Arc = String "arc"
3494− toJSON SloppyArc = String "sloppy_arc"
3495− toJSON Plane = String "plane"
3496−
3497−instance FromJSON DistanceType where
3498− parseJSON = withText "DistanceType" parse
3499− where parse "arc" = pure Arc
3500− parse "sloppy_arc" = pure SloppyArc
3501− parse "plane" = pure Plane
3502− parse t = fail ("Unrecognized DistanceType: " <> show t)
3503−
3504−
3505−instance ToJSON OptimizeBbox where
3506− toJSON NoOptimizeBbox = String "none"
3507− toJSON (OptimizeGeoFilterType gft) = toJSON gft
3508−
3509−instance FromJSON OptimizeBbox where
3510− parseJSON v = withText "NoOptimizeBbox" parseNoOptimize v
3511− <|> parseOptimize v
3512− where parseNoOptimize "none" = pure NoOptimizeBbox
3513− parseNoOptimize _ = mzero
3514− parseOptimize = fmap OptimizeGeoFilterType . parseJSON
3515−
3516−instance ToJSON GeoBoundingBoxConstraint where
3517− toJSON (GeoBoundingBoxConstraint
3518− (FieldName gbbcGeoBBField) gbbcConstraintBox cache type') =
3519− object [gbbcGeoBBField .= gbbcConstraintBox
3520− , "_cache" .= cache
3521− , "type" .= type']
3522−
3523−instance FromJSON GeoBoundingBoxConstraint where
3524− parseJSON = withObject "GeoBoundingBoxConstraint" parse
3525− where parse o = case HM.toList (deleteSeveral ["type", "_cache"] o) of
3526− [(fn, v)] -> GeoBoundingBoxConstraint (FieldName fn)
3527− <$> parseJSON v
3528− <*> o .:? "_cache" .!= defaultCache
3529− <*> o .: "type"
3530− _ -> fail "Could not find field name for GeoBoundingBoxConstraint"
3531−
3532−instance ToJSON GeoFilterType where
3533− toJSON GeoFilterMemory = String "memory"
3534− toJSON GeoFilterIndexed = String "indexed"
3535−
3536−instance FromJSON GeoFilterType where
3537− parseJSON = withText "GeoFilterType" parse
3538− where parse "memory" = pure GeoFilterMemory
3539− parse "indexed" = pure GeoFilterIndexed
3540− parse t = fail ("Unrecognized GeoFilterType: " <> show t)
3541−
3542−instance ToJSON GeoBoundingBox where
3543− toJSON (GeoBoundingBox gbbTopLeft gbbBottomRight) =
3544− object ["top_left" .= gbbTopLeft
3545− , "bottom_right" .= gbbBottomRight]
3546−
3547−instance FromJSON GeoBoundingBox where
3548− parseJSON = withObject "GeoBoundingBox" parse
3549− where parse o = GeoBoundingBox
3550− <$> o .: "top_left"
3551− <*> o .: "bottom_right"
3552−
3553−instance ToJSON LatLon where
3554− toJSON (LatLon lLat lLon) =
3555− object ["lat" .= lLat
3556− , "lon" .= lLon]
3557−
3558−instance FromJSON LatLon where
3559− parseJSON = withObject "LatLon" parse
3560− where parse o = LatLon <$> o .: "lat"
3561− <*> o .: "lon"
3562−
3563−-- index for smaller ranges, fielddata for longer ranges
3564−instance ToJSON RangeExecution where
3565− toJSON RangeExecutionIndex = "index"
3566− toJSON RangeExecutionFielddata = "fielddata"
3567−
3568−
3569−instance FromJSON RangeExecution where
3570− parseJSON = withText "RangeExecution" parse
3571− where parse "index" = pure RangeExecutionIndex
3572− parse "fielddata" = pure RangeExecutionFielddata
3573− parse t = error ("Unrecognized RangeExecution " <> show t)
3574−
3575−instance ToJSON RegexpFlags where
3576− toJSON AllRegexpFlags = String "ALL"
3577− toJSON NoRegexpFlags = String "NONE"
3578− toJSON (SomeRegexpFlags (h :| fs)) = String $ T.intercalate "|" flagStrs
3579− where flagStrs = map flagStr . nub $ h:fs
3580− flagStr AnyString = "ANYSTRING"
3581− flagStr Automaton = "AUTOMATON"
3582− flagStr Complement = "COMPLEMENT"
3583− flagStr Empty = "EMPTY"
3584− flagStr Intersection = "INTERSECTION"
3585− flagStr Interval = "INTERVAL"
3586−
3587−instance FromJSON RegexpFlags where
3588− parseJSON = withText "RegexpFlags" parse
3589− where parse "ALL" = pure AllRegexpFlags
3590− parse "NONE" = pure NoRegexpFlags
3591− parse t = SomeRegexpFlags <$> parseNEJSON (String <$> T.splitOn "|" t)
3592−
3593−instance FromJSON RegexpFlag where
3594− parseJSON = withText "RegexpFlag" parse
3595− where parse "ANYSTRING" = pure AnyString
3596− parse "AUTOMATON" = pure Automaton
3597− parse "COMPLEMENT" = pure Complement
3598− parse "EMPTY" = pure Empty
3599− parse "INTERSECTION" = pure Intersection
3600− parse "INTERVAL" = pure Interval
3601− parse f = fail ("Unknown RegexpFlag: " <> show f)
3602−
3603−instance ToJSON Term where
3604− toJSON (Term field value) = object ["term" .= object
3605− [field .= value]]
3606−
3607−instance FromJSON Term where
3608− parseJSON = withObject "Term" parse
3609− where parse o = do termObj <- o .: "term"
3610− case HM.toList termObj of
3611− [(fn, v)] -> Term fn <$> parseJSON v
3612− _ -> fail "Expected object with 1 field-named key"
3613−
3614−instance ToJSON BoolMatch where
3615− toJSON (MustMatch term cache) = object ["must" .= term,
3616− "_cache" .= cache]
3617− toJSON (MustNotMatch term cache) = object ["must_not" .= term,
3618− "_cache" .= cache]
3619− toJSON (ShouldMatch terms cache) = object ["should" .= fmap toJSON terms,
3620− "_cache" .= cache]
3621−
3622−instance FromJSON BoolMatch where
3623− parseJSON = withObject "BoolMatch" parse
3624− where parse o = mustMatch `taggedWith` "must"
3625− <|> mustNotMatch `taggedWith` "must_not"
3626− <|> shouldMatch `taggedWith` "should"
3627− where taggedWith parser k = parser =<< o .: k
3628− mustMatch t = MustMatch t <$> o .:? "_cache" .!= defaultCache
3629− mustNotMatch t = MustNotMatch t <$> o .:? "_cache" .!= defaultCache
3630− shouldMatch t = ShouldMatch t <$> o .:? "_cache" .!= defaultCache
3631−
3632−instance (FromJSON a) => FromJSON (SearchResult a) where
3633− parseJSON (Object v) = SearchResult <$>
3634− v .: "took" <*>
3635− v .: "timed_out" <*>
3636− v .: "_shards" <*>
3637− v .: "hits" <*>
3638− v .:? "aggregations" <*>
3639− v .:? "_scroll_id" <*>
3640− v .:? "suggest"
3641− parseJSON _ = empty
3642−
3643−instance (FromJSON a) => FromJSON (SearchHits a) where
3644− parseJSON (Object v) = SearchHits <$>
3645− v .: "total" <*>
3646− v .: "max_score" <*>
3647− v .: "hits"
3648− parseJSON _ = empty
3649−
3650−instance (FromJSON a) => FromJSON (Hit a) where
3651− parseJSON (Object v) = Hit <$>
3652− v .: "_index" <*>
3653− v .: "_type" <*>
3654− v .: "_id" <*>
3655− v .: "_score" <*>
3656− v .:? "_source" <*>
3657− v .:? "highlight"
3658− parseJSON _ = empty
3659−
3660−instance FromJSON ShardResult where
3661− parseJSON (Object v) = ShardResult <$>
3662− v .: "total" <*>
3663− v .: "successful" <*>
3664− v .: "failed"
3665− parseJSON _ = empty
3666−
3667−
3668−instance FromJSON DocVersion where
3669− parseJSON v = do
3670− i <- parseJSON v
3671− maybe (fail "DocVersion out of range") return $ mkDocVersion i
3672−
3673−-- This insanity is because ES *sometimes* returns Replica/Shard counts as strings
3674−instance FromJSON ReplicaCount where
3675− parseJSON v = parseAsInt v
3676− <|> parseAsString v
3677− where parseAsInt = fmap ReplicaCount . parseJSON
3678− parseAsString = withText "ReplicaCount" (fmap ReplicaCount . parseReadText)
3679−
3680−instance FromJSON ShardCount where
3681− parseJSON v = parseAsInt v
3682− <|> parseAsString v
3683− where parseAsInt = fmap ShardCount . parseJSON
3684− parseAsString = withText "ShardCount" (fmap ShardCount . parseReadText)
3685−
3686−instance Bounded DocVersion where
3687− minBound = DocVersion 1
3688− maxBound = DocVersion 9200000000000000000 -- 9.2e+18
3689−
3690−instance Enum DocVersion where
3691− succ x
3692− | x /= maxBound = DocVersion (succ $ docVersionNumber x)
3693− | otherwise = succError "DocVersion"
3694− pred x
3695− | x /= minBound = DocVersion (pred $ docVersionNumber x)
3696− | otherwise = predError "DocVersion"
3697− toEnum i =
3698− fromMaybe (error $ show i ++ " out of DocVersion range") $ mkDocVersion i
3699− fromEnum = docVersionNumber
3700− enumFrom = boundedEnumFrom
3701− enumFromThen = boundedEnumFromThen
3702−
3703−-- | Username type used for HTTP Basic authentication. See 'basicAuthHook'.
3704−newtype EsUsername = EsUsername { esUsername :: Text } deriving (Read, Show, Eq)
3705−
3706−-- | Password type used for HTTP Basic authentication. See 'basicAuthHook'.
3707−newtype EsPassword = EsPassword { esPassword :: Text } deriving (Read, Show, Eq)
3708−
3709−
3710−data SnapshotRepoSelection = SnapshotRepoList (NonEmpty SnapshotRepoPattern)
3711− | AllSnapshotRepos deriving (Eq, Generic, Show, Typeable)
3712−
3713−
3714−-- | Either specifies an exact repo name or one with globs in it,
3715−-- e.g. @RepoPattern "foo*"@ __NOTE__: Patterns are not supported on ES < 1.7
3716−data SnapshotRepoPattern = ExactRepo SnapshotRepoName
3717− | RepoPattern Text
3718− deriving (Eq, Generic, Show, Typeable)
3719−
3720−-- | The unique name of a snapshot repository.
3721−newtype SnapshotRepoName = SnapshotRepoName { snapshotRepoName :: Text }
3722− deriving (Eq, Ord, Generic, Show, Typeable, ToJSON, FromJSON)
3723−
3724−
3725−-- | A generic representation of a snapshot repo. This is what gets
3726−-- sent to and parsed from the server. For repo types enabled by
3727−-- plugins that aren't exported by this library, consider making a
3728−-- custom type which implements 'SnapshotRepo'. If it is a common repo
3729−-- type, consider submitting a pull request to have it included in the
3730−-- library proper
3731−data GenericSnapshotRepo = GenericSnapshotRepo {
3732− gSnapshotRepoName :: SnapshotRepoName
3733− , gSnapshotRepoType :: SnapshotRepoType
3734− , gSnapshotRepoSettings :: GenericSnapshotRepoSettings
3735− } deriving (Eq, Generic, Show, Typeable)
3736−
3737−
3738−instance SnapshotRepo GenericSnapshotRepo where
3739− toGSnapshotRepo = id
3740− fromGSnapshotRepo = Right
3741−
3742−
3743−newtype SnapshotRepoType = SnapshotRepoType { snapshotRepoType :: Text }
3744− deriving (Eq, Ord, Generic, Show, Typeable, ToJSON, FromJSON)
3745−
3746−
3747−-- | Opaque representation of snapshot repo settings. Instances of
3748−-- 'SnapshotRepo' will produce this.
3749−newtype GenericSnapshotRepoSettings = GenericSnapshotRepoSettings { gSnapshotRepoSettingsObject :: Object }
3750− deriving (Eq, Generic, Show, Typeable, ToJSON)
3751−
3752−
3753− -- Regardless of whether you send strongly typed json, my version of
3754− -- ES sends back stringly typed json in the settings, e.g. booleans
3755− -- as strings, so we'll try to convert them.
3756−instance FromJSON GenericSnapshotRepoSettings where
3757− parseJSON = fmap (GenericSnapshotRepoSettings . fmap unStringlyTypeJSON). parseJSON
3758−
3759−-- | The result of running 'verifySnapshotRepo'.
3760−newtype SnapshotVerification = SnapshotVerification { snapshotNodeVerifications :: [SnapshotNodeVerification] }
3761− deriving (Eq, Generic, Show, Typeable)
3762−
3763−
3764−instance FromJSON SnapshotVerification where
3765− parseJSON = withObject "SnapshotVerification" parse
3766− where
3767− parse o = do
3768− o2 <- o .: "nodes"
3769− SnapshotVerification <$> mapM (uncurry parse') (HM.toList o2)
3770− parse' rawFullId = withObject "SnapshotNodeVerification" $ \o ->
3771− SnapshotNodeVerification (FullNodeId rawFullId) <$> o .: "name"
3772−
3773−
3774−-- | A node that has verified a snapshot
3775−data SnapshotNodeVerification = SnapshotNodeVerification {
3776− snvFullId :: FullNodeId
3777− , snvNodeName :: NodeName
3778− } deriving (Eq, Generic, Show, Typeable)
3779−
3780−
3781−-- | Unique, automatically-generated name assigned to nodes that are
3782−-- usually returned in node-oriented APIs.
3783−newtype FullNodeId = FullNodeId { fullNodeId :: Text }
3784− deriving (Eq, Ord, Generic, Show, Typeable, FromJSON)
3785−
3786−
3787−-- | A human-readable node name that is supplied by the user in the
3788−-- node config or automatically generated by ElasticSearch.
3789−newtype NodeName = NodeName { nodeName :: Text }
3790− deriving (Eq, Ord, Generic, Show, Typeable, FromJSON)
3791−
3792−newtype ClusterName = ClusterName { clusterName :: Text }
3793− deriving (Eq, Ord, Generic, Show, Typeable, FromJSON)
3794−
3795−data NodesInfo = NodesInfo {
3796− nodesInfo :: [NodeInfo]
3797− , nodesClusterName :: ClusterName
3798− } deriving (Eq, Show, Generic, Typeable)
3799−
3800−data NodesStats = NodesStats {
3801− nodesStats :: [NodeStats]
3802− , nodesStatsClusterName :: ClusterName
3803− } deriving (Eq, Show, Generic, Typeable)
3804−
3805−data NodeStats = NodeStats {
3806− nodeStatsName :: NodeName
3807− , nodeStatsFullId :: FullNodeId
3808− , nodeStatsBreakersStats :: Maybe NodeBreakersStats
3809− , nodeStatsHTTP :: NodeHTTPStats
3810− , nodeStatsTransport :: NodeTransportStats
3811− , nodeStatsFS :: NodeFSStats
3812− , nodeStatsNetwork :: Maybe NodeNetworkStats
3813− , nodeStatsThreadPool :: NodeThreadPoolsStats
3814− , nodeStatsJVM :: NodeJVMStats
3815− , nodeStatsProcess :: NodeProcessStats
3816− , nodeStatsOS :: NodeOSStats
3817− , nodeStatsIndices :: NodeIndicesStats
3818− } deriving (Eq, Show, Generic, Typeable)
3819−
3820−data NodeBreakersStats = NodeBreakersStats {
3821− nodeStatsParentBreaker :: NodeBreakerStats
3822− , nodeStatsRequestBreaker :: NodeBreakerStats
3823− , nodeStatsFieldDataBreaker :: NodeBreakerStats
3824− } deriving (Eq, Show, Generic, Typeable)
3825−
3826−data NodeBreakerStats = NodeBreakerStats {
3827− nodeBreakersTripped :: Int
3828− , nodeBreakersOverhead :: Double
3829− , nodeBreakersEstSize :: Bytes
3830− , nodeBreakersLimitSize :: Bytes
3831− } deriving (Eq, Show, Generic, Typeable)
3832−
3833−data NodeHTTPStats = NodeHTTPStats {
3834− nodeHTTPTotalOpened :: Int
3835− , nodeHTTPCurrentOpen :: Int
3836− } deriving (Eq, Show, Generic, Typeable)
3837−
3838−data NodeTransportStats = NodeTransportStats {
3839− nodeTransportTXSize :: Bytes
3840− , nodeTransportCount :: Int
3841− , nodeTransportRXSize :: Bytes
3842− , nodeTransportRXCount :: Int
3843− , nodeTransportServerOpen :: Int
3844− } deriving (Eq, Show, Generic, Typeable)
3845−
3846−data NodeFSStats = NodeFSStats {
3847− nodeFSDataPaths :: [NodeDataPathStats]
3848− , nodeFSTotal :: NodeFSTotalStats
3849− , nodeFSTimestamp :: UTCTime
3850− } deriving (Eq, Show, Generic, Typeable)
3851−
3852−data NodeDataPathStats = NodeDataPathStats {
3853− nodeDataPathDiskServiceTime :: Maybe Double
3854− , nodeDataPathDiskQueue :: Maybe Double
3855− , nodeDataPathIOSize :: Maybe Bytes
3856− , nodeDataPathWriteSize :: Maybe Bytes
3857− , nodeDataPathReadSize :: Maybe Bytes
3858− , nodeDataPathIOOps :: Maybe Int
3859− , nodeDataPathWrites :: Maybe Int
3860− , nodeDataPathReads :: Maybe Int
3861− , nodeDataPathAvailable :: Bytes
3862− , nodeDataPathFree :: Bytes
3863− , nodeDataPathTotal :: Bytes
3864− , nodeDataPathType :: Maybe Text
3865− , nodeDataPathDevice :: Maybe Text
3866− , nodeDataPathMount :: Text
3867− , nodeDataPathPath :: Text
3868− } deriving (Eq, Show, Generic, Typeable)
3869−
3870−data NodeFSTotalStats = NodeFSTotalStats {
3871− nodeFSTotalDiskServiceTime :: Maybe Double
3872− , nodeFSTotalDiskQueue :: Maybe Double
3873− , nodeFSTotalIOSize :: Maybe Bytes
3874− , nodeFSTotalWriteSize :: Maybe Bytes
3875− , nodeFSTotalReadSize :: Maybe Bytes
3876− , nodeFSTotalIOOps :: Maybe Int
3877− , nodeFSTotalWrites :: Maybe Int
3878− , nodeFSTotalReads :: Maybe Int
3879− , nodeFSTotalAvailable :: Bytes
3880− , nodeFSTotalFree :: Bytes
3881− , nodeFSTotalTotal :: Bytes
3882− } deriving (Eq, Show, Generic, Typeable)
3883−
3884−data NodeNetworkStats = NodeNetworkStats {
3885− nodeNetTCPOutRSTs :: Int
3886− , nodeNetTCPInErrs :: Int
3887− , nodeNetTCPAttemptFails :: Int
3888− , nodeNetTCPEstabResets :: Int
3889− , nodeNetTCPRetransSegs :: Int
3890− , nodeNetTCPOutSegs :: Int
3891− , nodeNetTCPInSegs :: Int
3892− , nodeNetTCPCurrEstab :: Int
3893− , nodeNetTCPPassiveOpens :: Int
3894− , nodeNetTCPActiveOpens :: Int
3895− } deriving (Eq, Show, Generic, Typeable)
3896−
3897−data NodeThreadPoolsStats = NodeThreadPoolsStats {
3898− nodeThreadPoolsStatsSnapshot :: NodeThreadPoolStats
3899− , nodeThreadPoolsStatsBulk :: NodeThreadPoolStats
3900− , nodeThreadPoolsStatsMerge :: NodeThreadPoolStats
3901− , nodeThreadPoolsStatsGet :: NodeThreadPoolStats
3902− , nodeThreadPoolsStatsManagement :: NodeThreadPoolStats
3903− , nodeThreadPoolsStatsFetchShardStore :: Maybe NodeThreadPoolStats
3904− , nodeThreadPoolsStatsOptimize :: Maybe NodeThreadPoolStats
3905− , nodeThreadPoolsStatsFlush :: NodeThreadPoolStats
3906− , nodeThreadPoolsStatsSearch :: NodeThreadPoolStats
3907− , nodeThreadPoolsStatsWarmer :: NodeThreadPoolStats
3908− , nodeThreadPoolsStatsGeneric :: NodeThreadPoolStats
3909− , nodeThreadPoolsStatsSuggest :: Maybe NodeThreadPoolStats
3910− , nodeThreadPoolsStatsRefresh :: NodeThreadPoolStats
3911− , nodeThreadPoolsStatsIndex :: NodeThreadPoolStats
3912− , nodeThreadPoolsStatsListener :: Maybe NodeThreadPoolStats
3913− , nodeThreadPoolsStatsFetchShardStarted :: Maybe NodeThreadPoolStats
3914− , nodeThreadPoolsStatsPercolate :: Maybe NodeThreadPoolStats
3915− } deriving (Eq, Show, Generic, Typeable)
3916−
3917−data NodeThreadPoolStats = NodeThreadPoolStats {
3918− nodeThreadPoolCompleted :: Int
3919− , nodeThreadPoolLargest :: Int
3920− , nodeThreadPoolRejected :: Int
3921− , nodeThreadPoolActive :: Int
3922− , nodeThreadPoolQueue :: Int
3923− , nodeThreadPoolThreads :: Int
3924− } deriving (Eq, Show, Generic, Typeable)
3925−
3926−data NodeJVMStats = NodeJVMStats {
3927− nodeJVMStatsMappedBufferPool :: JVMBufferPoolStats
3928− , nodeJVMStatsDirectBufferPool :: JVMBufferPoolStats
3929− , nodeJVMStatsGCOldCollector :: JVMGCStats
3930− , nodeJVMStatsGCYoungCollector :: JVMGCStats
3931− , nodeJVMStatsPeakThreadsCount :: Int
3932− , nodeJVMStatsThreadsCount :: Int
3933− , nodeJVMStatsOldPool :: JVMPoolStats
3934− , nodeJVMStatsSurvivorPool :: JVMPoolStats
3935− , nodeJVMStatsYoungPool :: JVMPoolStats
3936− , nodeJVMStatsNonHeapCommitted :: Bytes
3937− , nodeJVMStatsNonHeapUsed :: Bytes
3938− , nodeJVMStatsHeapMax :: Bytes
3939− , nodeJVMStatsHeapCommitted :: Bytes
3940− , nodeJVMStatsHeapUsedPercent :: Int
3941− , nodeJVMStatsHeapUsed :: Bytes
3942− , nodeJVMStatsUptime :: NominalDiffTime
3943− , nodeJVMStatsTimestamp :: UTCTime
3944− } deriving (Eq, Show, Generic, Typeable)
3945−
3946−data JVMBufferPoolStats = JVMBufferPoolStats {
3947− jvmBufferPoolStatsTotalCapacity :: Bytes
3948− , jvmBufferPoolStatsUsed :: Bytes
3949− , jvmBufferPoolStatsCount :: Int
3950− } deriving (Eq, Show, Generic, Typeable)
3951−
3952−data JVMGCStats = JVMGCStats {
3953− jvmGCStatsCollectionTime :: NominalDiffTime
3954− , jvmGCStatsCollectionCount :: Int
3955− } deriving (Eq, Show, Generic, Typeable)
3956−
3957−data JVMPoolStats = JVMPoolStats {
3958− jvmPoolStatsPeakMax :: Bytes
3959− , jvmPoolStatsPeakUsed :: Bytes
3960− , jvmPoolStatsMax :: Bytes
3961− , jvmPoolStatsUsed :: Bytes
3962− } deriving (Eq, Show, Generic, Typeable)
3963−
3964−data NodeProcessStats = NodeProcessStats {
3965− nodeProcessTimestamp :: UTCTime
3966− , nodeProcessOpenFDs :: Int
3967− , nodeProcessMaxFDs :: Int
3968− , nodeProcessCPUPercent :: Int
3969− , nodeProcessCPUTotal :: NominalDiffTime
3970− , nodeProcessMemTotalVirtual :: Bytes
3971− } deriving (Eq, Show, Generic, Typeable)
3972−
3973−data NodeOSStats = NodeOSStats {
3974− nodeOSTimestamp :: UTCTime
3975− , nodeOSCPUPercent :: Int
3976− , nodeOSLoad :: Maybe LoadAvgs
3977− , nodeOSMemTotal :: Bytes
3978− , nodeOSMemFree :: Bytes
3979− , nodeOSMemFreePercent :: Int
3980− , nodeOSMemUsed :: Bytes
3981− , nodeOSMemUsedPercent :: Int
3982− , nodeOSSwapTotal :: Bytes
3983− , nodeOSSwapFree :: Bytes
3984− , nodeOSSwapUsed :: Bytes
3985− } deriving (Eq, Show, Generic, Typeable)
3986−
3987−data LoadAvgs = LoadAvgs {
3988− loadAvg1Min :: Double
3989− , loadAvg5Min :: Double
3990− , loadAvg15Min :: Double
3991− } deriving (Eq, Show, Generic, Typeable)
3992−
3993−data NodeIndicesStats = NodeIndicesStats {
3994− nodeIndicesStatsRecoveryThrottleTime :: Maybe NominalDiffTime
3995− , nodeIndicesStatsRecoveryCurrentAsTarget :: Maybe Int
3996− , nodeIndicesStatsRecoveryCurrentAsSource :: Maybe Int
3997− , nodeIndicesStatsQueryCacheMisses :: Maybe Int
3998− , nodeIndicesStatsQueryCacheHits :: Maybe Int
3999− , nodeIndicesStatsQueryCacheEvictions :: Maybe Int
4000− , nodeIndicesStatsQueryCacheSize :: Maybe Bytes
4001− , nodeIndicesStatsSuggestCurrent :: Maybe Int
4002− , nodeIndicesStatsSuggestTime :: Maybe NominalDiffTime
4003− , nodeIndicesStatsSuggestTotal :: Maybe Int
4004− , nodeIndicesStatsTranslogSize :: Bytes
4005− , nodeIndicesStatsTranslogOps :: Int
4006− , nodeIndicesStatsSegFixedBitSetMemory :: Maybe Bytes
4007− , nodeIndicesStatsSegVersionMapMemory :: Bytes
4008− , nodeIndicesStatsSegIndexWriterMaxMemory :: Maybe Bytes
4009− , nodeIndicesStatsSegIndexWriterMemory :: Bytes
4010− , nodeIndicesStatsSegMemory :: Bytes
4011− , nodeIndicesStatsSegCount :: Int
4012− , nodeIndicesStatsCompletionSize :: Bytes
4013− , nodeIndicesStatsPercolateQueries :: Maybe Int
4014− , nodeIndicesStatsPercolateMemory :: Maybe Bytes
4015− , nodeIndicesStatsPercolateCurrent :: Maybe Int
4016− , nodeIndicesStatsPercolateTime :: Maybe NominalDiffTime
4017− , nodeIndicesStatsPercolateTotal :: Maybe Int
4018− , nodeIndicesStatsFieldDataEvictions :: Int
4019− , nodeIndicesStatsFieldDataMemory :: Bytes
4020− , nodeIndicesStatsWarmerTotalTime :: NominalDiffTime
4021− , nodeIndicesStatsWarmerTotal :: Int
4022− , nodeIndicesStatsWarmerCurrent :: Int
4023− , nodeIndicesStatsFlushTotalTime :: NominalDiffTime
4024− , nodeIndicesStatsFlushTotal :: Int
4025− , nodeIndicesStatsRefreshTotalTime :: NominalDiffTime
4026− , nodeIndicesStatsRefreshTotal :: Int
4027− , nodeIndicesStatsMergesTotalSize :: Bytes
4028− , nodeIndicesStatsMergesTotalDocs :: Int
4029− , nodeIndicesStatsMergesTotalTime :: NominalDiffTime
4030− , nodeIndicesStatsMergesTotal :: Int
4031− , nodeIndicesStatsMergesCurrentSize :: Bytes
4032− , nodeIndicesStatsMergesCurrentDocs :: Int
4033− , nodeIndicesStatsMergesCurrent :: Int
4034− , nodeIndicesStatsSearchFetchCurrent :: Int
4035− , nodeIndicesStatsSearchFetchTime :: NominalDiffTime
4036− , nodeIndicesStatsSearchFetchTotal :: Int
4037− , nodeIndicesStatsSearchQueryCurrent :: Int
4038− , nodeIndicesStatsSearchQueryTime :: NominalDiffTime
4039− , nodeIndicesStatsSearchQueryTotal :: Int
4040− , nodeIndicesStatsSearchOpenContexts :: Int
4041− , nodeIndicesStatsGetCurrent :: Int
4042− , nodeIndicesStatsGetMissingTime :: NominalDiffTime
4043− , nodeIndicesStatsGetMissingTotal :: Int
4044− , nodeIndicesStatsGetExistsTime :: NominalDiffTime
4045− , nodeIndicesStatsGetExistsTotal :: Int
4046− , nodeIndicesStatsGetTime :: NominalDiffTime
4047− , nodeIndicesStatsGetTotal :: Int
4048− , nodeIndicesStatsIndexingThrottleTime :: Maybe NominalDiffTime
4049− , nodeIndicesStatsIndexingIsThrottled :: Maybe Bool
4050− , nodeIndicesStatsIndexingNoopUpdateTotal :: Maybe Int
4051− , nodeIndicesStatsIndexingDeleteCurrent :: Int
4052− , nodeIndicesStatsIndexingDeleteTime :: NominalDiffTime
4053− , nodeIndicesStatsIndexingDeleteTotal :: Int
4054− , nodeIndicesStatsIndexingIndexCurrent :: Int
4055− , nodeIndicesStatsIndexingIndexTime :: NominalDiffTime
4056− , nodeIndicesStatsIndexingTotal :: Int
4057− , nodeIndicesStatsStoreThrottleTime :: NominalDiffTime
4058− , nodeIndicesStatsStoreSize :: Bytes
4059− , nodeIndicesStatsDocsDeleted :: Int
4060− , nodeIndicesStatsDocsCount :: Int
4061− } deriving (Eq, Show, Generic, Typeable)
4062−
4063−-- | A quirky address format used throughout ElasticSearch. An example
4064−-- would be inet[/1.1.1.1:9200]. inet may be a placeholder for a
4065−-- <https://en.wikipedia.org/wiki/Fully_qualified_domain_name FQDN>.
4066−newtype EsAddress = EsAddress { esAddress :: Text }
4067− deriving (Eq, Ord, Generic, Show, Typeable, FromJSON)
4068−
4069−-- | Typically a 7 character hex string.
4070−newtype BuildHash = BuildHash { buildHash :: Text }
4071− deriving (Eq, Ord, Generic, Read, Show, Typeable, FromJSON, ToJSON)
4072−
4073−newtype PluginName = PluginName { pluginName :: Text }
4074− deriving (Eq, Ord, Generic, Show, Typeable, FromJSON)
4075−
4076−data NodeInfo = NodeInfo {
4077− nodeInfoHTTPAddress :: Maybe EsAddress
4078− , nodeInfoBuild :: BuildHash
4079− , nodeInfoESVersion :: VersionNumber
4080− , nodeInfoIP :: Server
4081− , nodeInfoHost :: Server
4082− , nodeInfoTransportAddress :: EsAddress
4083− , nodeInfoName :: NodeName
4084− , nodeInfoFullId :: FullNodeId
4085− , nodeInfoPlugins :: [NodePluginInfo]
4086− , nodeInfoHTTP :: NodeHTTPInfo
4087− , nodeInfoTransport :: NodeTransportInfo
4088− , nodeInfoNetwork :: Maybe NodeNetworkInfo
4089− , nodeInfoThreadPool :: NodeThreadPoolsInfo
4090− , nodeInfoJVM :: NodeJVMInfo
4091− , nodeInfoProcess :: NodeProcessInfo
4092− , nodeInfoOS :: NodeOSInfo
4093− , nodeInfoSettings :: Object
4094− -- ^ The members of the settings objects are not consistent,
4095− -- dependent on plugins, etc.
4096− } deriving (Eq, Show, Generic, Typeable)
4097−
4098−data NodePluginInfo = NodePluginInfo {
4099− nodePluginSite :: Maybe Bool
4100− -- ^ Is this a site plugin?
4101− , nodePluginJVM :: Maybe Bool
4102− -- ^ Is this plugin running on the JVM
4103− , nodePluginDescription :: Text
4104− , nodePluginVersion :: MaybeNA VersionNumber
4105− , nodePluginName :: PluginName
4106− } deriving (Eq, Show, Generic, Typeable)
4107−
4108−data NodeHTTPInfo = NodeHTTPInfo {
4109− nodeHTTPMaxContentLength :: Bytes
4110− , nodeHTTPTransportAddress :: BoundTransportAddress
4111− } deriving (Eq, Show, Generic, Typeable)
4112−
4113−data NodeTransportInfo = NodeTransportInfo {
4114− nodeTransportProfiles :: [BoundTransportAddress]
4115− , nodeTransportAddress :: BoundTransportAddress
4116− } deriving (Eq, Show, Generic, Typeable)
4117−
4118−data BoundTransportAddress = BoundTransportAddress {
4119− publishAddress :: EsAddress
4120− , boundAddress :: [EsAddress]
4121− } deriving (Eq, Show, Generic, Typeable)
4122−
4123−data NodeNetworkInfo = NodeNetworkInfo {
4124− nodeNetworkPrimaryInterface :: NodeNetworkInterface
4125− , nodeNetworkRefreshInterval :: NominalDiffTime
4126− } deriving (Eq, Show, Generic, Typeable)
4127−
4128−newtype MacAddress = MacAddress { macAddress :: Text }
4129− deriving (Eq, Ord, Generic, Show, Typeable, FromJSON)
4130−
4131−newtype NetworkInterfaceName = NetworkInterfaceName { networkInterfaceName :: Text }
4132− deriving (Eq, Ord, Generic, Show, Typeable, FromJSON)
4133−
4134−data NodeNetworkInterface = NodeNetworkInterface {
4135− nodeNetIfaceMacAddress :: MacAddress
4136− , nodeNetIfaceName :: NetworkInterfaceName
4137− , nodeNetIfaceAddress :: Server
4138− } deriving (Eq, Show, Generic, Typeable)
4139−
4140−data NodeThreadPoolsInfo = NodeThreadPoolsInfo {
4141− nodeThreadPoolsRefresh :: NodeThreadPoolInfo
4142− , nodeThreadPoolsManagement :: NodeThreadPoolInfo
4143− , nodeThreadPoolsPercolate :: Maybe NodeThreadPoolInfo
4144− , nodeThreadPoolsListener :: Maybe NodeThreadPoolInfo
4145− , nodeThreadPoolsFetchShardStarted :: Maybe NodeThreadPoolInfo
4146− , nodeThreadPoolsSearch :: NodeThreadPoolInfo
4147− , nodeThreadPoolsFlush :: NodeThreadPoolInfo
4148− , nodeThreadPoolsWarmer :: NodeThreadPoolInfo
4149− , nodeThreadPoolsOptimize :: Maybe NodeThreadPoolInfo
4150− , nodeThreadPoolsBulk :: NodeThreadPoolInfo
4151− , nodeThreadPoolsSuggest :: Maybe NodeThreadPoolInfo
4152− , nodeThreadPoolsMerge :: NodeThreadPoolInfo
4153− , nodeThreadPoolsSnapshot :: NodeThreadPoolInfo
4154− , nodeThreadPoolsGet :: NodeThreadPoolInfo
4155− , nodeThreadPoolsFetchShardStore :: Maybe NodeThreadPoolInfo
4156− , nodeThreadPoolsIndex :: NodeThreadPoolInfo
4157− , nodeThreadPoolsGeneric :: NodeThreadPoolInfo
4158− } deriving (Eq, Show, Generic, Typeable)
4159−
4160−data NodeThreadPoolInfo = NodeThreadPoolInfo {
4161− nodeThreadPoolQueueSize :: ThreadPoolSize
4162− , nodeThreadPoolKeepalive :: Maybe NominalDiffTime
4163− , nodeThreadPoolMin :: Maybe Int
4164− , nodeThreadPoolMax :: Maybe Int
4165− , nodeThreadPoolType :: ThreadPoolType
4166− } deriving (Eq, Show, Generic, Typeable)
4167−
4168−data ThreadPoolSize = ThreadPoolBounded Int
4169− | ThreadPoolUnbounded
4170− deriving (Eq, Show, Generic, Typeable)
4171−
4172−data ThreadPoolType = ThreadPoolScaling
4173− | ThreadPoolFixed
4174− | ThreadPoolCached
4175− deriving (Eq, Show, Generic, Typeable)
4176−
4177−data NodeJVMInfo = NodeJVMInfo {
4178− nodeJVMInfoMemoryPools :: [JVMMemoryPool]
4179− , nodeJVMInfoMemoryPoolsGCCollectors :: [JVMGCCollector]
4180− , nodeJVMInfoMemoryInfo :: JVMMemoryInfo
4181− , nodeJVMInfoStartTime :: UTCTime
4182− , nodeJVMInfoVMVendor :: Text
4183− , nodeJVMVMVersion :: VersionNumber
4184− -- ^ JVM doesn't seme to follow normal version conventions
4185− , nodeJVMVMName :: Text
4186− , nodeJVMVersion :: VersionNumber
4187− , nodeJVMPID :: PID
4188− } deriving (Eq, Show, Generic, Typeable)
4189−
4190−-- | Handles quirks in the way JVM versions are rendered (1.7.0_101 -> 1.7.0.101)
4191−newtype JVMVersion = JVMVersion { unJVMVersion :: VersionNumber }
4192−
4193−data JVMMemoryInfo = JVMMemoryInfo {
4194− jvmMemoryInfoDirectMax :: Bytes
4195− , jvmMemoryInfoNonHeapMax :: Bytes
4196− , jvmMemoryInfoNonHeapInit :: Bytes
4197− , jvmMemoryInfoHeapMax :: Bytes
4198− , jvmMemoryInfoHeapInit :: Bytes
4199− } deriving (Eq, Show, Generic, Typeable)
4200−
4201−newtype JVMMemoryPool = JVMMemoryPool {
4202− jvmMemoryPool :: Text
4203− } deriving (Eq, Show, Generic, Typeable, FromJSON)
4204−
4205−newtype JVMGCCollector = JVMGCCollector {
4206− jvmGCCollector :: Text
4207− } deriving (Eq, Show, Generic, Typeable, FromJSON)
4208−
4209−newtype PID = PID {
4210− pid :: Int
4211− } deriving (Eq, Show, Generic, Typeable, FromJSON)
4212−
4213−data NodeOSInfo = NodeOSInfo {
4214− nodeOSRefreshInterval :: NominalDiffTime
4215− , nodeOSName :: Text
4216− , nodeOSArch :: Text
4217− , nodeOSVersion :: VersionNumber
4218− , nodeOSAvailableProcessors :: Int
4219− , nodeOSAllocatedProcessors :: Int
4220− } deriving (Eq, Show, Generic, Typeable)
4221−
4222−data CPUInfo = CPUInfo {
4223− cpuCacheSize :: Bytes
4224− , cpuCoresPerSocket :: Int
4225− , cpuTotalSockets :: Int
4226− , cpuTotalCores :: Int
4227− , cpuMHZ :: Int
4228− , cpuModel :: Text
4229− , cpuVendor :: Text
4230− } deriving (Eq, Show, Generic, Typeable)
4231−
4232−data NodeProcessInfo = NodeProcessInfo {
4233− nodeProcessMLockAll :: Bool
4234− -- ^ See <https://www.elastic.co/guide/en/elasticsearch/reference/current/setup-configuration.html>
4235− , nodeProcessMaxFileDescriptors :: Maybe Int
4236− , nodeProcessId :: PID
4237− , nodeProcessRefreshInterval :: NominalDiffTime
4238− } deriving (Eq, Show, Generic, Typeable)
4239−
4240−data SnapshotRepoUpdateSettings = SnapshotRepoUpdateSettings {
4241− repoUpdateVerify :: Bool
4242− -- ^ After creation/update, synchronously check that nodes can
4243− -- write to this repo. Defaults to True. You may use False if you
4244− -- need a faster response and plan on verifying manually later
4245− -- with 'verifySnapshotRepo'.
4246− } deriving (Eq, Show, Generic, Typeable)
4247−
4248−
4249−-- | Reasonable defaults for repo creation/update
4250−--
4251−-- * repoUpdateVerify True
4252−defaultSnapshotRepoUpdateSettings :: SnapshotRepoUpdateSettings
4253−defaultSnapshotRepoUpdateSettings = SnapshotRepoUpdateSettings True
4254−
4255−
4256−-- | A filesystem-based snapshot repo that ships with
4257−-- ElasticSearch. This is an instance of 'SnapshotRepo' so it can be
4258−-- used with 'updateSnapshotRepo'
4259−data FsSnapshotRepo = FsSnapshotRepo {
4260− fsrName :: SnapshotRepoName
4261− , fsrLocation :: FilePath
4262− , fsrCompressMetadata :: Bool
4263− , fsrChunkSize :: Maybe Bytes
4264− -- ^ Size by which to split large files during snapshotting.
4265− , fsrMaxRestoreBytesPerSec :: Maybe Bytes
4266− -- ^ Throttle node restore rate. If not supplied, defaults to 40mb/sec
4267− , fsrMaxSnapshotBytesPerSec :: Maybe Bytes
4268− -- ^ Throttle node snapshot rate. If not supplied, defaults to 40mb/sec
4269− } deriving (Eq, Generic, Show, Typeable)
4270−
4271−
4272−instance SnapshotRepo FsSnapshotRepo where
4273− toGSnapshotRepo FsSnapshotRepo {..} =
4274− GenericSnapshotRepo fsrName fsRepoType (GenericSnapshotRepoSettings settings)
4275− where
4276− Object settings = object $ [ "location" .= fsrLocation
4277− , "compress" .= fsrCompressMetadata
4278− ] ++ optionalPairs
4279− optionalPairs = catMaybes [ ("chunk_size" .=) <$> fsrChunkSize
4280− , ("max_restore_bytes_per_sec" .=) <$> fsrMaxRestoreBytesPerSec
4281− , ("max_snapshot_bytes_per_sec" .=) <$> fsrMaxSnapshotBytesPerSec
4282− ]
4283− fromGSnapshotRepo GenericSnapshotRepo {..}
4284− | gSnapshotRepoType == fsRepoType = do
4285− let o = gSnapshotRepoSettingsObject gSnapshotRepoSettings
4286− parseRepo $ do
4287− FsSnapshotRepo gSnapshotRepoName <$> o .: "location"
4288− <*> o .:? "compress" .!= False
4289− <*> o .:? "chunk_size"
4290− <*> o .:? "max_restore_bytes_per_sec"
4291− <*> o .:? "max_snapshot_bytes_per_sec"
4292− | otherwise = Left (RepoTypeMismatch fsRepoType gSnapshotRepoType)
4293−
4294−
4295−parseRepo :: Parser a -> Either SnapshotRepoConversionError a
4296−parseRepo parser = case parseEither (const parser) () of
4297− Left e -> Left (OtherRepoConversionError (T.pack e))
4298− Right a -> Right a
4299−
4300−
4301−fsRepoType :: SnapshotRepoType
4302−fsRepoType = SnapshotRepoType "fs"
4303−
4304−-- | Law: fromGSnapshotRepo (toGSnapshotRepo r) == Right r
4305−class SnapshotRepo r where
4306− toGSnapshotRepo :: r -> GenericSnapshotRepo
4307− fromGSnapshotRepo :: GenericSnapshotRepo -> Either SnapshotRepoConversionError r
4308−
4309−
4310−data SnapshotRepoConversionError = RepoTypeMismatch SnapshotRepoType SnapshotRepoType
4311− -- ^ Expected type and actual type
4312− | OtherRepoConversionError Text
4313− deriving (Show, Eq, Generic, Typeable)
4314−
4315−
4316−instance Exception SnapshotRepoConversionError
4317−
4318−
4319−data SnapshotCreateSettings = SnapshotCreateSettings {
4320− snapWaitForCompletion :: Bool
4321− -- ^ Should the API call return immediately after initializing
4322− -- the snapshot or wait until completed? Note that if this is
4323− -- enabled it could wait a long time, so you should adjust your
4324− -- 'ManagerSettings' accordingly to set long timeouts or
4325− -- explicitly handle timeouts.
4326− , snapIndices :: Maybe IndexSelection
4327− -- ^ Nothing will snapshot all indices. Just [] is permissable and
4328− -- will essentially be a no-op snapshot.
4329− , snapIgnoreUnavailable :: Bool
4330− -- ^ If set to True, any matched indices that don't exist will be
4331− -- ignored. Otherwise it will be an error and fail.
4332− , snapIncludeGlobalState :: Bool
4333− , snapPartial :: Bool
4334− -- ^ If some indices failed to snapshot (e.g. if not all primary
4335− -- shards are available), should the process proceed?
4336− } deriving (Eq, Generic, Show, Typeable)
4337−
4338−
4339−-- | Reasonable defaults for snapshot creation
4340−--
4341−-- * snapWaitForCompletion False
4342−-- * snapIndices Nothing
4343−-- * snapIgnoreUnavailable False
4344−-- * snapIncludeGlobalState True
4345−-- * snapPartial False
4346−defaultSnapshotCreateSettings :: SnapshotCreateSettings
4347−defaultSnapshotCreateSettings = SnapshotCreateSettings {
4348− snapWaitForCompletion = False
4349− , snapIndices = Nothing
4350− , snapIgnoreUnavailable = False
4351− , snapIncludeGlobalState = True
4352− , snapPartial = False
4353− }
4354−
4355−
4356−data SnapshotSelection = SnapshotList (NonEmpty SnapshotPattern)
4357− | AllSnapshots deriving (Eq, Generic, Show, Typeable)
4358−
4359−
4360−-- | Either specifies an exact snapshot name or one with globs in it,
4361−-- e.g. @SnapPattern "foo*"@ __NOTE__: Patterns are not supported on
4362−-- ES < 1.7
4363−data SnapshotPattern = ExactSnap SnapshotName
4364− | SnapPattern Text
4365− deriving (Eq, Generic, Show, Typeable)
4366−
4367−
4368−-- | General information about the state of a snapshot. Has some
4369−-- redundancies with 'SnapshotStatus'
4370−data SnapshotInfo = SnapshotInfo {
4371− snapInfoShards :: ShardResult
4372− , snapInfoFailures :: [SnapshotShardFailure]
4373− , snapInfoDuration :: NominalDiffTime
4374− , snapInfoEndTime :: UTCTime
4375− , snapInfoStartTime :: UTCTime
4376− , snapInfoState :: SnapshotState
4377− , snapInfoIndices :: [IndexName]
4378− , snapInfoName :: SnapshotName
4379− } deriving (Eq, Generic, Show, Typeable)
4380−
4381−
4382−instance FromJSON SnapshotInfo where
4383− parseJSON = withObject "SnapshotInfo" parse
4384− where
4385− parse o = SnapshotInfo <$> o .: "shards"
4386− <*> o .: "failures"
4387− <*> (unMS <$> o .: "duration_in_millis")
4388− <*> (posixMS <$> o .: "end_time_in_millis")
4389− <*> (posixMS <$> o .: "start_time_in_millis")
4390− <*> o .: "state"
4391− <*> o .: "indices"
4392− <*> o .: "snapshot"
4393−
4394−data SnapshotShardFailure = SnapshotShardFailure {
4395− snapShardFailureIndex :: IndexName
4396− , snapShardFailureNodeId :: Maybe NodeName -- I'm not 100% sure this isn't actually 'FullNodeId'
4397− , snapShardFailureReason :: Text
4398− , snapShardFailureShardId :: ShardId
4399− } deriving (Eq, Show, Generic, Typeable)
4400−
4401−
4402−instance FromJSON SnapshotShardFailure where
4403− parseJSON = withObject "SnapshotShardFailure" parse
4404− where
4405− parse o = SnapshotShardFailure <$> o .: "index"
4406− <*> o .:? "node_id"
4407− <*> o .: "reason"
4408− <*> o .: "shard_id"
4409−
4410−
4411−newtype ShardId = ShardId { shardId :: Int }
4412− deriving (Eq, Show, Generic, Typeable, FromJSON)
4413−
4414−-- | Milliseconds
4415−newtype MS = MS NominalDiffTime
4416−
4417−
4418−-- keeps the unexported constructor warnings at bay
4419−unMS :: MS -> NominalDiffTime
4420−unMS (MS t) = t
4421−
4422−
4423−instance FromJSON MS where
4424− parseJSON = withScientific "MS" (return . MS . parse)
4425− where
4426− parse n = fromInteger ((truncate n) * 1000)
4427−
4428−
4429−data SnapshotState = SnapshotInit
4430− | SnapshotStarted
4431− | SnapshotSuccess
4432− | SnapshotFailed
4433− | SnapshotAborted
4434− | SnapshotMissing
4435− | SnapshotWaiting
4436− deriving (Show, Eq, Generic, Typeable)
4437−
4438−instance FromJSON SnapshotState where
4439− parseJSON = withText "SnapshotState" parse
4440− where
4441− parse "INIT" = return SnapshotInit
4442− parse "STARTED" = return SnapshotStarted
4443− parse "SUCCESS" = return SnapshotSuccess
4444− parse "FAILED" = return SnapshotFailed
4445− parse "ABORTED" = return SnapshotAborted
4446− parse "MISSING" = return SnapshotMissing
4447− parse "WAITING" = return SnapshotWaiting
4448− parse t = fail ("Invalid snapshot state " <> T.unpack t)
4449−
4450−
4451−newtype SnapshotName = SnapshotName { snapshotName :: Text }
4452− deriving (Show, Eq, Ord, Generic, Typeable, ToJSON, FromJSON)
4453−
4454−
4455−data SnapshotRestoreSettings = SnapshotRestoreSettings {
4456− snapRestoreWaitForCompletion :: Bool
4457− -- ^ Should the API call return immediately after initializing
4458− -- the restore or wait until completed? Note that if this is
4459− -- enabled, it could wait a long time, so you should adjust your
4460− -- 'ManagerSettings' accordingly to set long timeouts or
4461− -- explicitly handle timeouts.
4462− , snapRestoreIndices :: Maybe IndexSelection
4463− -- ^ Nothing will restore all indices in the snapshot. Just [] is
4464− -- permissable and will essentially be a no-op restore.
4465− , snapRestoreIgnoreUnavailable :: Bool
4466− -- ^ If set to True, any indices that do not exist will be ignored
4467− -- during snapshot rather than failing the restore.
4468− , snapRestoreIncludeGlobalState :: Bool
4469− -- ^ If set to false, will ignore any global state in the snapshot
4470− -- and will not restore it.
4471− , snapRestoreRenamePattern :: Maybe RestoreRenamePattern
4472− -- ^ A regex pattern for matching indices. Used with
4473− -- 'snapRestoreRenameReplacement', the restore can reference the
4474− -- matched index and create a new index name upon restore.
4475− , snapRestoreRenameReplacement :: Maybe (NonEmpty RestoreRenameToken)
4476− -- ^ Expression of how index renames should be constructed.
4477− , snapRestorePartial :: Bool
4478− -- ^ If some indices fail to restore, should the process proceed?
4479− , snapRestoreIncludeAliases :: Bool
4480− -- ^ Should the restore also restore the aliases captured in the
4481− -- snapshot.
4482− , snapRestoreIndexSettingsOverrides :: Maybe RestoreIndexSettings
4483− -- ^ Settings to apply during the restore process. __NOTE:__ This
4484− -- option is not supported in ES < 1.5 and should be set to
4485− -- Nothing in that case.
4486− , snapRestoreIgnoreIndexSettings :: Maybe (NonEmpty Text)
4487− -- ^ This type could be more rich but it isn't clear which
4488− -- settings are allowed to be ignored during restore, so we're
4489− -- going with including this feature in a basic form rather than
4490− -- omitting it. One example here would be
4491− -- "index.refresh_interval". Any setting specified here will
4492− -- revert back to the server default during the restore process.
4493− } deriving (Eq, Generic, Show, Typeable)
4494−
4495−-- | Regex-stype pattern, e.g. "index_(.+)" to match index names
4496−newtype RestoreRenamePattern = RestoreRenamePattern { rrPattern :: Text }
4497− deriving (Show, Eq, Generic, Typeable, Ord, ToJSON)
4498−
4499−
4500−-- | A single token in a index renaming scheme for a restore. These
4501−-- are concatenated into a string before being sent to
4502−-- ElasticSearch. Check out these Java
4503−-- <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.
4504−data RestoreRenameToken = RRTLit Text
4505− -- ^ Just a literal string of characters
4506− | RRSubWholeMatch
4507− -- ^ Equivalent to $0. The entire matched pattern, not any subgroup
4508− | RRSubGroup RRGroupRefNum
4509− -- ^ A specific reference to a group number
4510− deriving (Show, Eq, Generic, Typeable)
4511−
4512−
4513−-- | A group number for regex matching. Only values from 1-9 are
4514−-- supported. Construct with 'mkRRGroupRefNum'
4515−newtype RRGroupRefNum = RRGroupRefNum { rrGroupRefNum :: Int }
4516− deriving (Show, Eq, Generic, Typeable, Ord)
4517−
4518−instance Bounded RRGroupRefNum where
4519− minBound = RRGroupRefNum 1
4520− maxBound = RRGroupRefNum 9
4521−
4522−
4523−-- | Only allows valid group number references (1-9).
4524−mkRRGroupRefNum :: Int -> Maybe RRGroupRefNum
4525−mkRRGroupRefNum i
4526− | i >= (rrGroupRefNum minBound) && i <= (rrGroupRefNum maxBound) =
4527− Just $ RRGroupRefNum i
4528− | otherwise = Nothing
4529−
4530−
4531−-- | Reasonable defaults for snapshot restores
4532−--
4533−-- * snapRestoreWaitForCompletion False
4534−-- * snapRestoreIndices Nothing
4535−-- * snapRestoreIgnoreUnavailable False
4536−-- * snapRestoreIncludeGlobalState True
4537−-- * snapRestoreRenamePattern Nothing
4538−-- * snapRestoreRenameReplacement Nothing
4539−-- * snapRestorePartial False
4540−-- * snapRestoreIncludeAliases True
4541−-- * snapRestoreIndexSettingsOverrides Nothing
4542−-- * snapRestoreIgnoreIndexSettings Nothing
4543−defaultSnapshotRestoreSettings :: SnapshotRestoreSettings
4544−defaultSnapshotRestoreSettings = SnapshotRestoreSettings {
4545− snapRestoreWaitForCompletion = False
4546− , snapRestoreIndices = Nothing
4547− , snapRestoreIgnoreUnavailable = False
4548− , snapRestoreIncludeGlobalState = True
4549− , snapRestoreRenamePattern = Nothing
4550− , snapRestoreRenameReplacement = Nothing
4551− , snapRestorePartial = False
4552− , snapRestoreIncludeAliases = True
4553− , snapRestoreIndexSettingsOverrides = Nothing
4554− , snapRestoreIgnoreIndexSettings = Nothing
4555− }
4556−
4557−
4558−-- | Index settings that can be overridden. The docs only mention you
4559−-- can update number of replicas, but there may be more. You
4560−-- definitely cannot override shard count.
4561−data RestoreIndexSettings = RestoreIndexSettings {
4562− restoreOverrideReplicas :: Maybe ReplicaCount
4563− } deriving (Show, Eq, Generic, Typeable)
4564−
4565−
4566−instance ToJSON RestoreIndexSettings where
4567− toJSON RestoreIndexSettings {..} = object prs
4568− where
4569− prs = catMaybes [("index.number_of_replicas" .=) <$> restoreOverrideReplicas]
4570−
4571−
4572−instance FromJSON NodesInfo where
4573− parseJSON = withObject "NodesInfo" parse
4574− where
4575− parse o = do
4576− nodes <- o .: "nodes"
4577− infos <- forM (HM.toList nodes) $ \(fullNID, v) -> do
4578− node <- parseJSON v
4579− parseNodeInfo (FullNodeId fullNID) node
4580− cn <- o .: "cluster_name"
4581− return (NodesInfo infos cn)
4582−
4583−instance FromJSON NodesStats where
4584− parseJSON = withObject "NodesStats" parse
4585− where
4586− parse o = do
4587− nodes <- o .: "nodes"
4588− stats <- forM (HM.toList nodes) $ \(fullNID, v) -> do
4589− node <- parseJSON v
4590− parseNodeStats (FullNodeId fullNID) node
4591− cn <- o .: "cluster_name"
4592− return (NodesStats stats cn)
4593−
4594−instance FromJSON NodeBreakerStats where
4595− parseJSON = withObject "NodeBreakerStats" parse
4596− where
4597− parse o = NodeBreakerStats <$> o .: "tripped"
4598− <*> o .: "overhead"
4599− <*> o .: "estimated_size_in_bytes"
4600− <*> o .: "limit_size_in_bytes"
4601−
4602−instance FromJSON NodeHTTPStats where
4603− parseJSON = withObject "NodeHTTPStats" parse
4604− where
4605− parse o = NodeHTTPStats <$> o .: "total_opened"
4606− <*> o .: "current_open"
4607−
4608−instance FromJSON NodeTransportStats where
4609− parseJSON = withObject "NodeTransportStats" parse
4610− where
4611− parse o = NodeTransportStats <$> o .: "tx_size_in_bytes"
4612− <*> o .: "tx_count"
4613− <*> o .: "rx_size_in_bytes"
4614− <*> o .: "rx_count"
4615− <*> o .: "server_open"
4616−
4617−instance FromJSON NodeFSStats where
4618− parseJSON = withObject "NodeFSStats" parse
4619− where
4620− parse o = NodeFSStats <$> o .: "data"
4621− <*> o .: "total"
4622− <*> (posixMS <$> o .: "timestamp")
4623−
4624−instance FromJSON NodeDataPathStats where
4625− parseJSON = withObject "NodeDataPathStats" parse
4626− where
4627− parse o =
4628− NodeDataPathStats <$> (fmap unStringlyTypedDouble <$> o .:? "disk_service_time")
4629− <*> (fmap unStringlyTypedDouble <$> o .:? "disk_queue")
4630− <*> o .:? "disk_io_size_in_bytes"
4631− <*> o .:? "disk_write_size_in_bytes"
4632− <*> o .:? "disk_read_size_in_bytes"
4633− <*> o .:? "disk_io_op"
4634− <*> o .:? "disk_writes"
4635− <*> o .:? "disk_reads"
4636− <*> o .: "available_in_bytes"
4637− <*> o .: "free_in_bytes"
4638− <*> o .: "total_in_bytes"
4639− <*> o .:? "type"
4640− <*> o .:? "dev"
4641− <*> o .: "mount"
4642− <*> o .: "path"
4643−
4644−newtype StringlyTypedDouble = StringlyTypedDouble { unStringlyTypedDouble :: Double }
4645−
4646−
4647−instance FromJSON StringlyTypedDouble where
4648− parseJSON = fmap StringlyTypedDouble . parseJSON . unStringlyTypeJSON
4649−
4650−
4651−instance FromJSON NodeFSTotalStats where
4652− parseJSON = withObject "NodeFSTotalStats" parse
4653− where
4654− parse o = NodeFSTotalStats <$> (fmap unStringlyTypedDouble <$> o .:? "disk_service_time")
4655− <*> (fmap unStringlyTypedDouble <$> o .:? "disk_queue")
4656− <*> o .:? "disk_io_size_in_bytes"
4657− <*> o .:? "disk_write_size_in_bytes"
4658− <*> o .:? "disk_read_size_in_bytes"
4659− <*> o .:? "disk_io_op"
4660− <*> o .:? "disk_writes"
4661− <*> o .:? "disk_reads"
4662− <*> o .: "available_in_bytes"
4663− <*> o .: "free_in_bytes"
4664− <*> o .: "total_in_bytes"
4665−
4666−instance FromJSON NodeNetworkStats where
4667− parseJSON = withObject "NodeNetworkStats" parse
4668− where
4669− parse o = do
4670− tcp <- o .: "tcp"
4671− NodeNetworkStats <$> tcp .: "out_rsts"
4672− <*> tcp .: "in_errs"
4673− <*> tcp .: "attempt_fails"
4674− <*> tcp .: "estab_resets"
4675− <*> tcp .: "retrans_segs"
4676− <*> tcp .: "out_segs"
4677− <*> tcp .: "in_segs"
4678− <*> tcp .: "curr_estab"
4679− <*> tcp .: "passive_opens"
4680− <*> tcp .: "active_opens"
4681−
4682−instance FromJSON NodeThreadPoolsStats where
4683− parseJSON = withObject "NodeThreadPoolsStats" parse
4684− where
4685− parse o = NodeThreadPoolsStats <$> o .: "snapshot"
4686− <*> o .: "bulk"
4687− <*> o .: "force_merge"
4688− <*> o .: "get"
4689− <*> o .: "management"
4690− <*> o .:? "fetch_shard_store"
4691− <*> o .:? "optimize"
4692− <*> o .: "flush"
4693− <*> o .: "search"
4694− <*> o .: "warmer"
4695− <*> o .: "generic"
4696− <*> o .:? "suggest"
4697− <*> o .: "refresh"
4698− <*> o .: "index"
4699− <*> o .:? "listener"
4700− <*> o .:? "fetch_shard_started"
4701− <*> o .:? "percolate"
4702−instance FromJSON NodeThreadPoolStats where
4703− parseJSON = withObject "NodeThreadPoolStats" parse
4704− where
4705− parse o = NodeThreadPoolStats <$> o .: "completed"
4706− <*> o .: "largest"
4707− <*> o .: "rejected"
4708− <*> o .: "active"
4709− <*> o .: "queue"
4710− <*> o .: "threads"
4711−
4712−instance FromJSON NodeJVMStats where
4713− parseJSON = withObject "NodeJVMStats" parse
4714− where
4715− parse o = do
4716− bufferPools <- o .: "buffer_pools"
4717− mapped <- bufferPools .: "mapped"
4718− direct <- bufferPools .: "direct"
4719− gc <- o .: "gc"
4720− collectors <- gc .: "collectors"
4721− oldC <- collectors .: "old"
4722− youngC <- collectors .: "young"
4723− threads <- o .: "threads"
4724− mem <- o .: "mem"
4725− pools <- mem .: "pools"
4726− oldM <- pools .: "old"
4727− survivorM <- pools .: "survivor"
4728− youngM <- pools .: "young"
4729− NodeJVMStats <$> pure mapped
4730− <*> pure direct
4731− <*> pure oldC
4732− <*> pure youngC
4733− <*> threads .: "peak_count"
4734− <*> threads .: "count"
4735− <*> pure oldM
4736− <*> pure survivorM
4737− <*> pure youngM
4738− <*> mem .: "non_heap_committed_in_bytes"
4739− <*> mem .: "non_heap_used_in_bytes"
4740− <*> mem .: "heap_max_in_bytes"
4741− <*> mem .: "heap_committed_in_bytes"
4742− <*> mem .: "heap_used_percent"
4743− <*> mem .: "heap_used_in_bytes"
4744− <*> (unMS <$> o .: "uptime_in_millis")
4745− <*> (posixMS <$> o .: "timestamp")
4746−
4747−instance FromJSON JVMBufferPoolStats where
4748− parseJSON = withObject "JVMBufferPoolStats" parse
4749− where
4750− parse o = JVMBufferPoolStats <$> o .: "total_capacity_in_bytes"
4751− <*> o .: "used_in_bytes"
4752− <*> o .: "count"
4753−
4754−instance FromJSON JVMGCStats where
4755− parseJSON = withObject "JVMGCStats" parse
4756− where
4757− parse o = JVMGCStats <$> (unMS <$> o .: "collection_time_in_millis")
4758− <*> o .: "collection_count"
4759−
4760−instance FromJSON JVMPoolStats where
4761− parseJSON = withObject "JVMPoolStats" parse
4762− where
4763− parse o = JVMPoolStats <$> o .: "peak_max_in_bytes"
4764− <*> o .: "peak_used_in_bytes"
4765− <*> o .: "max_in_bytes"
4766− <*> o .: "used_in_bytes"
4767−
4768−instance FromJSON NodeProcessStats where
4769− parseJSON = withObject "NodeProcessStats" parse
4770− where
4771− parse o = do
4772− mem <- o .: "mem"
4773− cpu <- o .: "cpu"
4774− NodeProcessStats <$> (posixMS <$> o .: "timestamp")
4775− <*> o .: "open_file_descriptors"
4776− <*> o .: "max_file_descriptors"
4777− <*> cpu .: "percent"
4778− <*> (unMS <$> cpu .: "total_in_millis")
4779− <*> mem .: "total_virtual_in_bytes"
4780−
4781−instance FromJSON NodeOSStats where
4782− parseJSON = withObject "NodeOSStats" parse
4783− where
4784− parse o = do
4785− swap <- o .: "swap"
4786− mem <- o .: "mem"
4787− cpu <- o .: "cpu"
4788− load <- o .:? "load_average"
4789− NodeOSStats <$> (posixMS <$> o .: "timestamp")
4790− <*> cpu .: "percent"
4791− <*> pure load
4792− <*> mem .: "total_in_bytes"
4793− <*> mem .: "free_in_bytes"
4794− <*> mem .: "free_percent"
4795− <*> mem .: "used_in_bytes"
4796− <*> mem .: "used_percent"
4797− <*> swap .: "total_in_bytes"
4798− <*> swap .: "free_in_bytes"
4799− <*> swap .: "used_in_bytes"
4800−
4801−instance FromJSON LoadAvgs where
4802− parseJSON = withArray "LoadAvgs" parse
4803− where
4804− parse v = case V.toList v of
4805− [one, five, fifteen] -> LoadAvgs <$> parseJSON one
4806− <*> parseJSON five
4807− <*> parseJSON fifteen
4808− _ -> fail "Expecting a triple of Doubles"
4809−
4810−instance FromJSON NodeIndicesStats where
4811− parseJSON = withObject "NodeIndicesStats" parse
4812− where
4813− parse o = do
4814− let (.::) mv k = case mv of
4815− Just v -> Just <$> v .: k
4816− Nothing -> pure Nothing
4817− mRecovery <- o .:? "recovery"
4818− mQueryCache <- o .:? "query_cache"
4819− mSuggest <- o .:? "suggest"
4820− translog <- o .: "translog"
4821− segments <- o .: "segments"
4822− completion <- o .: "completion"
4823− mPercolate <- o .:? "percolate"
4824− fielddata <- o .: "fielddata"
4825− warmer <- o .: "warmer"
4826− flush <- o .: "flush"
4827− refresh <- o .: "refresh"
4828− merges <- o .: "merges"
4829− search <- o .: "search"
4830− getStats <- o .: "get"
4831− indexing <- o .: "indexing"
4832− store <- o .: "store"
4833− docs <- o .: "docs"
4834− NodeIndicesStats <$> (fmap unMS <$> mRecovery .:: "throttle_time_in_millis")
4835− <*> mRecovery .:: "current_as_target"
4836− <*> mRecovery .:: "current_as_source"
4837− <*> mQueryCache .:: "miss_count"
4838− <*> mQueryCache .:: "hit_count"
4839− <*> mQueryCache .:: "evictions"
4840− <*> mQueryCache .:: "memory_size_in_bytes"
4841− <*> mSuggest .:: "current"
4842− <*> (fmap unMS <$> mSuggest .:: "time_in_millis")
4843− <*> mSuggest .:: "total"
4844− <*> translog .: "size_in_bytes"
4845− <*> translog .: "operations"
4846− <*> segments .:? "fixed_bit_set_memory_in_bytes"
4847− <*> segments .: "version_map_memory_in_bytes"
4848− <*> segments .:? "index_writer_max_memory_in_bytes"
4849− <*> segments .: "index_writer_memory_in_bytes"
4850− <*> segments .: "memory_in_bytes"
4851− <*> segments .: "count"
4852− <*> completion .: "size_in_bytes"
4853− <*> mPercolate .:: "queries"
4854− <*> mPercolate .:: "memory_size_in_bytes"
4855− <*> mPercolate .:: "current"
4856− <*> (fmap unMS <$> mPercolate .:: "time_in_millis")
4857− <*> mPercolate .:: "total"
4858− <*> fielddata .: "evictions"
4859− <*> fielddata .: "memory_size_in_bytes"
4860− <*> (unMS <$> warmer .: "total_time_in_millis")
4861− <*> warmer .: "total"
4862− <*> warmer .: "current"
4863− <*> (unMS <$> flush .: "total_time_in_millis")
4864− <*> flush .: "total"
4865− <*> (unMS <$> refresh .: "total_time_in_millis")
4866− <*> refresh .: "total"
4867− <*> merges .: "total_size_in_bytes"
4868− <*> merges .: "total_docs"
4869− <*> (unMS <$> merges .: "total_time_in_millis")
4870− <*> merges .: "total"
4871− <*> merges .: "current_size_in_bytes"
4872− <*> merges .: "current_docs"
4873− <*> merges .: "current"
4874− <*> search .: "fetch_current"
4875− <*> (unMS <$> search .: "fetch_time_in_millis")
4876− <*> search .: "fetch_total"
4877− <*> search .: "query_current"
4878− <*> (unMS <$> search .: "query_time_in_millis")
4879− <*> search .: "query_total"
4880− <*> search .: "open_contexts"
4881− <*> getStats .: "current"
4882− <*> (unMS <$> getStats .: "missing_time_in_millis")
4883− <*> getStats .: "missing_total"
4884− <*> (unMS <$> getStats .: "exists_time_in_millis")
4885− <*> getStats .: "exists_total"
4886− <*> (unMS <$> getStats .: "time_in_millis")
4887− <*> getStats .: "total"
4888− <*> (fmap unMS <$> indexing .:? "throttle_time_in_millis")
4889− <*> indexing .:? "is_throttled"
4890− <*> indexing .:? "noop_update_total"
4891− <*> indexing .: "delete_current"
4892− <*> (unMS <$> indexing .: "delete_time_in_millis")
4893− <*> indexing .: "delete_total"
4894− <*> indexing .: "index_current"
4895− <*> (unMS <$> indexing .: "index_time_in_millis")
4896− <*> indexing .: "index_total"
4897− <*> (unMS <$> store .: "throttle_time_in_millis")
4898− <*> store .: "size_in_bytes"
4899− <*> docs .: "deleted"
4900− <*> docs .: "count"
4901−
4902−instance FromJSON NodeBreakersStats where
4903− parseJSON = withObject "NodeBreakersStats" parse
4904− where
4905− parse o = NodeBreakersStats <$> o .: "parent"
4906− <*> o .: "request"
4907− <*> o .: "fielddata"
4908−
4909−parseNodeStats :: FullNodeId -> Object -> Parser NodeStats
4910−parseNodeStats fnid o = do
4911− NodeStats <$> o .: "name"
4912− <*> pure fnid
4913− <*> o .:? "breakers"
4914− <*> o .: "http"
4915− <*> o .: "transport"
4916− <*> o .: "fs"
4917− <*> o .:? "network"
4918− <*> o .: "thread_pool"
4919− <*> o .: "jvm"
4920− <*> o .: "process"
4921− <*> o .: "os"
4922− <*> o .: "indices"
4923−
4924−parseNodeInfo :: FullNodeId -> Object -> Parser NodeInfo
4925−parseNodeInfo nid o =
4926− NodeInfo <$> o .:? "http_address"
4927− <*> o .: "build_hash"
4928− <*> o .: "version"
4929− <*> o .: "ip"
4930− <*> o .: "host"
4931− <*> o .: "transport_address"
4932− <*> o .: "name"
4933− <*> pure nid
4934− <*> o .: "plugins"
4935− <*> o .: "http"
4936− <*> o .: "transport"
4937− <*> o .:? "network"
4938− <*> o .: "thread_pool"
4939− <*> o .: "jvm"
4940− <*> o .: "process"
4941− <*> o .: "os"
4942− <*> o .: "settings"
4943−
4944−instance FromJSON NodePluginInfo where
4945− parseJSON = withObject "NodePluginInfo" parse
4946− where
4947− parse o = NodePluginInfo <$> o .:? "site"
4948− <*> o .:? "jvm"
4949− <*> o .: "description"
4950− <*> o .: "version"
4951− <*> o .: "name"
4952−
4953−instance FromJSON NodeHTTPInfo where
4954− parseJSON = withObject "NodeHTTPInfo" parse
4955− where
4956− parse o = NodeHTTPInfo <$> o .: "max_content_length_in_bytes"
4957− <*> parseJSON (Object o)
4958−
4959−instance FromJSON BoundTransportAddress where
4960− parseJSON = withObject "BoundTransportAddress" parse
4961− where
4962− parse o = BoundTransportAddress <$> o .: "publish_address"
4963− <*> o .: "bound_address"
4964−
4965−instance FromJSON NodeOSInfo where
4966− parseJSON = withObject "NodeOSInfo" parse
4967− where
4968− parse o = do
4969− NodeOSInfo <$> (unMS <$> o .: "refresh_interval_in_millis")
4970− <*> o .: "name"
4971− <*> o .: "arch"
4972− <*> o .: "version"
4973− <*> o .: "available_processors"
4974− <*> o .: "allocated_processors"
4975−
4976−
4977−instance FromJSON CPUInfo where
4978− parseJSON = withObject "CPUInfo" parse
4979− where
4980− parse o = CPUInfo <$> o .: "cache_size_in_bytes"
4981− <*> o .: "cores_per_socket"
4982− <*> o .: "total_sockets"
4983− <*> o .: "total_cores"
4984− <*> o .: "mhz"
4985− <*> o .: "model"
4986− <*> o .: "vendor"
4987−
4988−instance FromJSON NodeProcessInfo where
4989− parseJSON = withObject "NodeProcessInfo" parse
4990− where
4991− parse o = NodeProcessInfo <$> o .: "mlockall"
4992− <*> o .:? "max_file_descriptors"
4993− <*> o .: "id"
4994− <*> (unMS <$> o .: "refresh_interval_in_millis")
4995−
4996−instance FromJSON NodeJVMInfo where
4997− parseJSON = withObject "NodeJVMInfo" parse
4998− where
4999− parse o = NodeJVMInfo <$> o .: "memory_pools"
5000− <*> o .: "gc_collectors"
5001− <*> o .: "mem"
5002− <*> (posixMS <$> o .: "start_time_in_millis")
5003− <*> o .: "vm_vendor"
5004− <*> o .: "vm_version"
5005− <*> o .: "vm_name"
5006− <*> (unJVMVersion <$> o .: "version")
5007− <*> o .: "pid"
5008−
5009−instance FromJSON JVMVersion where
5010− parseJSON (String t) =
5011− JVMVersion <$> parseJSON (String (T.replace "_" "." t))
5012− parseJSON v = JVMVersion <$> parseJSON v
5013−
5014−instance FromJSON JVMMemoryInfo where
5015− parseJSON = withObject "JVMMemoryInfo" parse
5016− where
5017− parse o = JVMMemoryInfo <$> o .: "direct_max_in_bytes"
5018− <*> o .: "non_heap_max_in_bytes"
5019− <*> o .: "non_heap_init_in_bytes"
5020− <*> o .: "heap_max_in_bytes"
5021− <*> o .: "heap_init_in_bytes"
5022−
5023−instance FromJSON NodeThreadPoolsInfo where
5024− parseJSON = withObject "NodeThreadPoolsInfo" parse
5025− where
5026− parse o = NodeThreadPoolsInfo <$> o .: "refresh"
5027− <*> o .: "management"
5028− <*> o .:? "percolate"
5029− <*> o .:? "listener"
5030− <*> o .:? "fetch_shard_started"
5031− <*> o .: "search"
5032− <*> o .: "flush"
5033− <*> o .: "warmer"
5034− <*> o .:? "optimize"
5035− <*> o .: "bulk"
5036− <*> o .:? "suggest"
5037− <*> o .: "force_merge"
5038− <*> o .: "snapshot"
5039− <*> o .: "get"
5040− <*> o .:? "fetch_shard_store"
5041− <*> o .: "index"
5042− <*> o .: "generic"
5043−
5044−instance FromJSON NodeThreadPoolInfo where
5045− parseJSON = withObject "NodeThreadPoolInfo" parse
5046− where
5047− parse o = do
5048− ka <- maybe (return Nothing) (fmap Just . parseStringInterval) =<< o .:? "keep_alive"
5049− NodeThreadPoolInfo <$> (parseJSON . unStringlyTypeJSON =<< o .: "queue_size")
5050− <*> pure ka
5051− <*> o .:? "min"
5052− <*> o .:? "max"
5053− <*> o .: "type"
5054−
5055−parseStringInterval :: (Monad m) => String -> m NominalDiffTime
5056−parseStringInterval s = case span isNumber s of
5057− ("", _) -> fail "Invalid interval"
5058− (nS, unitS) -> case (readMay nS, readMay unitS) of
5059− (Just n, Just unit) -> return (fromInteger (n * unitNDT unit))
5060− (Nothing, _) -> fail "Invalid interval number"
5061− (_, Nothing) -> fail "Invalid interval unit"
5062− where
5063− unitNDT Seconds = 1
5064− unitNDT Minutes = 60
5065− unitNDT Hours = 60 * 60
5066− unitNDT Days = 24 * 60 * 60
5067− unitNDT Weeks = 7 * 24 * 60 * 60
5068−
5069−instance FromJSON ThreadPoolSize where
5070− parseJSON v = parseAsNumber v <|> parseAsString v
5071− where
5072− parseAsNumber = parseAsInt <=< parseJSON
5073− parseAsInt (-1) = return ThreadPoolUnbounded
5074− parseAsInt n
5075− | n >= 0 = return (ThreadPoolBounded n)
5076− | otherwise = fail "Thread pool size must be >= -1."
5077− parseAsString = withText "ThreadPoolSize" $ \t ->
5078− case first (readMay . T.unpack) (T.span isNumber t) of
5079− (Just n, "k") -> return (ThreadPoolBounded (n * 1000))
5080− (Just n, "") -> return (ThreadPoolBounded n)
5081− _ -> fail ("Invalid thread pool size " <> T.unpack t)
5082−
5083−instance FromJSON ThreadPoolType where
5084− parseJSON = withText "ThreadPoolType" parse
5085− where
5086− parse "scaling" = return ThreadPoolScaling
5087− parse "fixed" = return ThreadPoolFixed
5088− parse "cached" = return ThreadPoolCached
5089− parse e = fail ("Unexpected thread pool type" <> T.unpack e)
5090−
5091−instance FromJSON NodeTransportInfo where
5092− parseJSON = withObject "NodeTransportInfo" parse
5093− where
5094− parse o = NodeTransportInfo <$> (maybe (return mempty) parseProfiles =<< o .:? "profiles")
5095− <*> parseJSON (Object o)
5096− parseProfiles (Object o) | HM.null o = return []
5097− parseProfiles v@(Array _) = parseJSON v
5098− parseProfiles Null = return []
5099− parseProfiles _ = fail "Could not parse profiles"
5100−
5101−instance FromJSON NodeNetworkInfo where
5102− parseJSON = withObject "NodeNetworkInfo" parse
5103− where
5104− parse o = NodeNetworkInfo <$> o .: "primary_interface"
5105− <*> (unMS <$> o .: "refresh_interval_in_millis")
5106−
5107−
5108−instance FromJSON NodeNetworkInterface where
5109− parseJSON = withObject "NodeNetworkInterface" parse
5110− where
5111− parse o = NodeNetworkInterface <$> o .: "mac_address"
5112− <*> o .: "name"
5113− <*> o .: "address"
5114−
5115−newtype MaybeNA a = MaybeNA { unMaybeNA :: Maybe a }
5116− deriving (Show, Eq)
5117−
5118−instance FromJSON a => FromJSON (MaybeNA a) where
5119− parseJSON (String "NA") = pure $ MaybeNA Nothing
5120− parseJSON o = MaybeNA . Just <$> parseJSON o
5121−
5122−data Suggest = Suggest { suggestText :: Text
5123− , suggestName :: Text
5124− , suggestType :: SuggestType
5125− }
5126− deriving (Show, Generic, Eq, Read)
5127−
5128−instance ToJSON Suggest where
5129− toJSON Suggest{..} = object [ "text" .= suggestText
5130− , suggestName .= suggestType
5131− ]
5132−
5133−instance FromJSON Suggest where
5134− parseJSON (Object o) = do
5135− suggestText' <- o .: "text"
5136− let dropTextList = HM.toList $ HM.filterWithKey (\x _ -> x /= "text") o
5137− suggestName' <- case dropTextList of
5138− [(x, _)] -> return x
5139− _ -> fail "error parsing Suggest field name"
5140− suggestType' <- o .: suggestName'
5141− return $ Suggest suggestText' suggestName' suggestType'
5142− parseJSON x = typeMismatch "Suggest" x
5143−
5144−data SuggestType = SuggestTypePhraseSuggester PhraseSuggester
5145− deriving (Show, Generic, Eq, Read)
5146−
5147−instance ToJSON SuggestType where
5148− toJSON (SuggestTypePhraseSuggester x) = object ["phrase" .= x]
5149−
5150−instance FromJSON SuggestType where
5151− parseJSON = withObject "SuggestType" parse
5152− where parse o = phraseSuggester `taggedWith` "phrase"
5153− where taggedWith parser k = parser =<< o .: k
5154− phraseSuggester = pure . SuggestTypePhraseSuggester
5155−
5156−data PhraseSuggester =
5157− PhraseSuggester { phraseSuggesterField :: FieldName
5158− , phraseSuggesterGramSize :: Maybe Int
5159− , phraseSuggesterRealWordErrorLikelihood :: Maybe Int
5160− , phraseSuggesterConfidence :: Maybe Int
5161− , phraseSuggesterMaxErrors :: Maybe Int
5162− , phraseSuggesterSeparator :: Maybe Text
5163− , phraseSuggesterSize :: Maybe Size
5164− , phraseSuggesterAnalyzer :: Maybe Analyzer
5165− , phraseSuggesterShardSize :: Maybe Int
5166− , phraseSuggesterHighlight :: Maybe PhraseSuggesterHighlighter
5167− , phraseSuggesterCollate :: Maybe PhraseSuggesterCollate
5168− }
5169− deriving (Show, Generic, Eq, Read)
5170−
5171−instance ToJSON PhraseSuggester where
5172− toJSON PhraseSuggester{..} = omitNulls [ "field" .= phraseSuggesterField
5173− , "gram_size" .= phraseSuggesterGramSize
5174− , "real_word_error_likelihood" .= phraseSuggesterRealWordErrorLikelihood
5175− , "confidence" .= phraseSuggesterConfidence
5176− , "max_errors" .= phraseSuggesterMaxErrors
5177− , "separator" .= phraseSuggesterSeparator
5178− , "size" .= phraseSuggesterSize
5179− , "analyzer" .= phraseSuggesterAnalyzer
5180− , "shard_size" .= phraseSuggesterShardSize
5181− , "highlight" .= phraseSuggesterHighlight
5182− , "collate" .= phraseSuggesterCollate
5183− ]
5184−
5185−instance FromJSON PhraseSuggester where
5186− parseJSON = withObject "PhraseSuggester" parse
5187− where parse o = PhraseSuggester
5188− <$> o .: "field"
5189− <*> o .:? "gram_size"
5190− <*> o .:? "real_word_error_likelihood"
5191− <*> o .:? "confidence"
5192− <*> o .:? "max_errors"
5193− <*> o .:? "separator"
5194− <*> o .:? "size"
5195− <*> o .:? "analyzer"
5196− <*> o .:? "shard_size"
5197− <*> o .:? "highlight"
5198− <*> o .:? "collate"
5199−
5200−mkPhraseSuggester :: FieldName -> PhraseSuggester
5201−mkPhraseSuggester fName =
5202− PhraseSuggester fName Nothing Nothing Nothing Nothing Nothing Nothing
5203− Nothing Nothing Nothing Nothing
5204−
5205−data PhraseSuggesterHighlighter =
5206− PhraseSuggesterHighlighter { phraseSuggesterHighlighterPreTag :: Text
5207− , phraseSuggesterHighlighterPostTag :: Text
5208− }
5209− deriving (Show, Generic, Eq, Read)
5210−
5211−instance ToJSON PhraseSuggesterHighlighter where
5212− toJSON PhraseSuggesterHighlighter{..} =
5213− object [ "pre_tag" .= phraseSuggesterHighlighterPreTag
5214− , "post_tag" .= phraseSuggesterHighlighterPostTag
5215− ]
5216−
5217−instance FromJSON PhraseSuggesterHighlighter where
5218− parseJSON = withObject "PhraseSuggesterHighlighter" parse
5219− where parse o = PhraseSuggesterHighlighter
5220− <$> o .: "pre_tag"
5221− <*> o .: "post_tag"
5222−
5223−data PhraseSuggesterCollate =
5224− PhraseSuggesterCollate { phraseSuggesterCollateTemplateQuery :: TemplateQueryInline
5225− , phraseSuggesterCollatePrune :: Bool
5226− }
5227− deriving (Show, Generic, Eq, Read)
5228−
5229−instance ToJSON PhraseSuggesterCollate where
5230− toJSON PhraseSuggesterCollate{..} = object [ "query" .= object
5231− [ "inline" .= (inline phraseSuggesterCollateTemplateQuery)
5232− ]
5233− , "params" .= (params phraseSuggesterCollateTemplateQuery)
5234− , "prune" .= phraseSuggesterCollatePrune
5235− ]
5236−
5237−instance FromJSON PhraseSuggesterCollate where
5238− parseJSON (Object o) = do
5239− query' <- o .: "query"
5240− inline' <- query' .: "inline"
5241− params' <- o .: "params"
5242− prune' <- o .:? "prune" .!= False
5243− return $ PhraseSuggesterCollate (TemplateQueryInline inline' params') prune'
5244− parseJSON x = typeMismatch "PhraseSuggesterCollate" x
5245−
5246−data SuggestOptions =
5247− SuggestOptions { suggestOptionsText :: Text
5248− , suggestOptionsScore :: Double
5249− , suggestOptionsFreq :: Maybe Int
5250− , suggestOptionsHighlighted :: Maybe Text
5251− }
5252− deriving (Eq, Read, Show)
5253−
5254−instance FromJSON SuggestOptions where
5255− parseJSON = withObject "SuggestOptions" parse
5256− where parse o = SuggestOptions
5257− <$> o .: "text"
5258− <*> o .: "score"
5259− <*> o .:? "freq"
5260− <*> o .:? "highlighted"
5261−
5262−data SuggestResponse =
5263− SuggestResponse { suggestResponseText :: Text
5264− , suggestResponseOffset :: Int
5265− , suggestResponseLength :: Int
5266− , suggestResponseOptions :: [SuggestOptions]
5267− }
5268− deriving (Eq, Read, Show)
5269−
5270−instance FromJSON SuggestResponse where
5271− parseJSON = withObject "SuggestResponse" parse
5272− where parse o = SuggestResponse
5273− <$> o .: "text"
5274− <*> o .: "offset"
5275− <*> o .: "length"
5276− <*> o .: "options"
5277−
5278−data NamedSuggestionResponse =
5279− NamedSuggestionResponse { nsrName :: Text
5280− , nsrResponses :: [SuggestResponse]
5281− }
5282− deriving (Eq, Read, Show)
5283−
5284−instance FromJSON NamedSuggestionResponse where
5285− parseJSON (Object o) = do
5286− suggestionName' <- case HM.toList o of
5287− [(x, _)] -> return x
5288− _ -> fail "error parsing NamedSuggestionResponse name"
5289− suggestionResponses' <- o .: suggestionName'
5290− return $ NamedSuggestionResponse suggestionName' suggestionResponses'
5291−
5292− parseJSON x = typeMismatch "NamedSuggestionResponse" x
src/Database/V5/Bloodhound/Types/Class.hsdeleted−17
@@ -1,17 +0,0 @@
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.hsdeleted−57
@@ -1,57 +0,0 @@
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.yamldeleted−18
@@ -1,18 +0,0 @@
1−flags:
2− bloodhound-examples:
3− werror: true
4−packages:
5−- '.'
6−- './examples'
7−extra-deps:
8−- http-client-0.5.0
9−- aeson-1.2.0.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.3
15−- uri-bytestring-0.1.9
16−- temporary-resourcet-0.1.0.0
17−- transformers-compat-0.5.1.4
18−resolver: lts-6.12
stack-7.8.yamldeleted−22
@@ -1,22 +0,0 @@
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−- unordered-containers-0.2.6.0
22−resolver: lts-2.18
stack-8.0.yaml+3−11
@@ -5,16 +5,8 @@ flags:
5packages:
5packages:
6- '.'
6- '.'
7- './examples'
7- './examples'
8−# extra-deps:
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
9+ - quickcheck-properties-0.1
15−# - semigroups-0.18.3
10+ - quickcheck-arbitrary-template-0.2.0.0
16−# - uri-bytestring-0.1.9
17−# - temporary-resourcet-0.1.0.0
18−# - transformers-compat-0.5.1.4
19
11
20resolver: lts-8.14
12resolver: lts-8.14
stack-8.2.yaml+9−38
@@ -1,44 +1,15 @@
1−compiler: ghc-8.2.0.20170507
2−compiler-check: match-exact
3−resolver: lts-8.13
4−setup-info:
5− ghc:
6− linux64:
7− 8.2.0.20170507:
8− url: https://downloads.haskell.org/~ghc/8.2.1-rc2/ghc-8.2.0.20170507-x86_64-deb8-linux.tar.xz
9− content-length: 141011788
10− sha1: ff886437c1d2ddfa5686d6c9efb0819a957c3dde
11− macosx:
12− 8.2.0.20170507:
13− url: https://downloads.haskell.org/~ghc/8.2.1-rc2/ghc-8.2.0.20170507-x86_64-apple-darwin.tar.xz
14− content-length: 126192308
15− sha1: f059fe6f8a898d5619ab03e06e0ff0912a5f3340
16− windows64:
17− 8.2.0.20170507:
18− url: https://downloads.haskell.org/~ghc/8.2.1-rc2/ghc-8.2.0.20170507-x86_64-unknown-mingw32.tar.xz
19− content-length: 177295548
20− sha1: 87646ca3a89278775ceb7be429faafac3cf738d8
21−
22−ghc-options: { "*": -XTypeSynonymInstances }
23−
24flags:
1flags:
25 bloodhound-examples:
2 bloodhound-examples:
26− werror: false
3+ werror: true
27−
28−allow-newer: true
29
4
30packages:
5packages:
31−- '.'
6+ - '.'
32−- './examples'
7+ - './examples'
33
8
34extra-deps:
9extra-deps:
35−- http-client-0.5.0
36−- aeson-1.2.0.0
10+ - aeson-1.3.0.0
37−- fail-4.9.0.0
38−- http-types-0.9
11+ - http-types-0.12.1
39−- attoparsec-0.13.0.1
12+ - quickcheck-arbitrary-template-0.2.0.0
40−- quickcheck-properties-0.1
13+ - quickcheck-properties-0.1
41−- semigroups-0.18.3
14+
42−- uri-bytestring-0.1.9
15+resolver: lts-11.6
43−- temporary-resourcet-0.1.0.0
44−- transformers-compat-0.5.1.4
stack-8.2.yaml.locknew file+40
@@ -0,0 +1,40 @@
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.yamlnew file+15
@@ -0,0 +1,15 @@
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.locknew file+12
@@ -0,0 +1,12 @@
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.yamlnew file+14
@@ -0,0 +1,14 @@
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.locknew file+33
@@ -0,0 +1,33 @@
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 100644 → 120000+1−13
@@ -1,13 +0,0 @@
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
@@ -0,0 +1 @@
1+stack-8.6.yaml
stack.yaml.locknew file+12
@@ -0,0 +1,12 @@
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.hsnew file+147
@@ -0,0 +1,147 @@
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.hsnew file+63
@@ -0,0 +1,63 @@
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.hsnew file+95

This diff is too big to show here.

tests/Test/Common.hsnew file+292

This diff is too big to show here.

tests/Test/Documents.hsnew file+51

This diff is too big to show here.

tests/Test/Generators.hsnew file+563

This diff is too big to show here.

tests/Test/Highlights.hsnew file+32

This diff is too big to show here.

tests/Test/Import.hsnew file+58

This diff is too big to show here.

tests/Test/Indices.hsnew file+173

This diff is too big to show here.

tests/Test/JSON.hsnew file+213

This diff is too big to show here.

tests/Test/Query.hsnew file+132

This diff is too big to show here.

tests/Test/Script.hsnew file+36

This diff is too big to show here.

tests/Test/Snapshots.hsnew file+201

This diff is too big to show here.

tests/Test/Sorting.hsnew file+22

This diff is too big to show here.

tests/Test/SourceFiltering.hsnew file+38

This diff is too big to show here.

tests/Test/Suggest.hsnew file+23

This diff is too big to show here.

tests/Test/Templates.hsnew file+26

This diff is too big to show here.

tests/V1/tests.hsdeleted−1949

This diff is too big to show here.

tests/V5/tests.hsdeleted−1763

This diff is too big to show here.

tests/tests.hsnew file+136

This diff is too big to show here.