git.iko.soy/typeable/bloodhound
on master help sign in
69 files changed+9516−16216
since splitsnapshots
unifiedsplit
.gitignore+2 .hlint.yaml+66 .travis.yml+9−18 DSL.org+1−1 Makefile+109−31 README.md+7−7 bloodhound.cabal−100 changelog.md+52 docker-compose.yml+35 elasticsearch/Dockerfile+3 elasticsearch/config/elasticsearch.yml+3 examples/README.md+1−1 examples/Tweet.hs+3−6 examples/package.yaml−1 package.yaml+74 src/Bloodhound/Import.hs+85 src/Database/Bloodhound.hs+10 src/Database/V5/Bloodhound/Client.hs → src/Database/Bloodhound/Client.hs+102−56 src/Database/Bloodhound/Common/Script.hs+220 src/Database/Bloodhound/Internal/Aggregation.hs+479 src/Database/Bloodhound/Internal/Analysis.hs+379 src/Database/Bloodhound/Internal/Client.hs+2431 src/Database/Bloodhound/Internal/Highlight.hs+164 src/Database/Bloodhound/Internal/Newtypes.hs+237 src/Database/Bloodhound/Internal/Query.hs+1640 src/Database/Bloodhound/Internal/Sort.hs+107 src/Database/Bloodhound/Internal/StringlyTyped.hs+51 src/Database/Bloodhound/Internal/Suggest.hs+270 src/Database/Bloodhound/Types.hs+542 src/Database/V1/Bloodhound.hs−10 src/Database/V1/Bloodhound/Client.hs−920 src/Database/V1/Bloodhound/Types.hs−5580 src/Database/V1/Bloodhound/Types/Class.hs−17 src/Database/V1/Bloodhound/Types/Internal.hs−57 src/Database/V5/Bloodhound.hs−10 src/Database/V5/Bloodhound/Types.hs−5491 src/Database/V5/Bloodhound/Types/Class.hs−17 src/Database/V5/Bloodhound/Types/Internal.hs−57 stack-7.10.yaml−18 stack-7.8.yaml−22 stack-8.0.yaml+1 stack-8.2.yaml+5−2 stack-8.2.yaml.lock+40 stack-8.4.yaml+15 stack-8.4.yaml.lock+12 stack-8.6.yaml+14 stack-8.6.yaml.lock+33 stack.yaml+1−1 stack.yaml.lock+12 tests/Test/Aggregation.hs+147 tests/Test/ApproxEq.hs+63 tests/Test/BulkAPI.hs+95 tests/Test/Common.hs+292 tests/Test/Documents.hs+51 tests/Test/Generators.hs+563 tests/Test/Highlights.hs+32 tests/Test/Import.hs+58 tests/Test/Indices.hs+173 tests/Test/JSON.hs+213 tests/Test/Query.hs+132 tests/Test/Script.hs+36 tests/Test/Snapshots.hs+201 tests/Test/Sorting.hs+22 tests/Test/SourceFiltering.hs+38 tests/Test/Suggest.hs+23 tests/Test/Templates.hs+26 tests/V1/tests.hs−1966 tests/V5/tests.hs−1827 tests/tests.hs+136
.gitignore+2
@@ -18,3 +18,5 @@ bloodhound.iml
1818.hgignore
1919examples/bloodhound-examples.cabal
2020/.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−18
@@ -1,33 +1,24 @@
11sudo: false
22language: generic
33
4+jdk:
5+ - oraclejdk11
6+
47addons:
58 apt:
69 packages:
710 - libgmp-dev
8− - oracle-java8-installer
911
1012env:
11− global:
12− - JAVA_HOME=/usr/lib/jvm/java-8-oracle
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-8.0.yaml ESFLAG=ES1 DLINK=https://download.elastic.co/elasticsearch/elasticsearch/elasticsearch
20− - GHCVER=8.0 ESVER=5.0.2 STACK_YAML=stack-8.0.yaml ESFLAG=ES5 DLINK=https://artifacts.elastic.co/downloads/elasticsearch/elasticsearch ES_JAVA_OPTS="-Xms500m -Xmx750m"
21− - GHCVER=8.2 ESVER=1.7.6 STACK_YAML=stack.yaml ESFLAG=ES1 DLINK=https://download.elastic.co/elasticsearch/elasticsearch/elasticsearch
22− - GHCVER=8.2 ESVER=5.0.2 STACK_YAML=stack.yaml ESFLAG=ES5 DLINK=https://artifacts.elastic.co/downloads/elasticsearch/elasticsearch ES_JAVA_OPTS="-Xms500m -Xmx750m"
13+ matrix:
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"
2315
2416install:
2517 # stack
2618 - mkdir -p ~/.local/bin
27− - travis_retry curl -L https://github.com/commercialhaskell/stack/releases/download/v1.6.1/stack-1.6.1-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'
2820 - export PATH=~/.local/bin:$PATH
2921 - stack --no-terminal --version
30−
3122 # elasticsearch
3223 - wget --no-check-certificate $DLINK-$ESVER.tar.gz
3324 - tar xzf elasticsearch-$ESVER.tar.gz
@@ -39,11 +30,11 @@ script:
3930 - stack setup --no-terminal
4031 - stack update --no-terminal
4132 - stack build -j2 --fast --no-terminal
42− - travis_wait 45 sleep 1800 &
43− - stack test --fast --no-terminal bloodhound:tests --test-arguments="--qc-max-success 500" --flag bloodhound:$ESFLAG
33+ - travis_wait 60 sleep 1800 &
34+ - stack test --fast --no-terminal bloodhound:bloodhound-tests --test-arguments="--qc-max-success 500"
4435
4536cache:
46− timeout: 2000
37+ timeout: 1500
4738 directories:
4839 - $HOME/.cabal
4940 - $HOME/.ghc
DSL.org+1−1
@@ -1,4 +1,4 @@
1−* ElasticSearch DSL
1+* Elasticsearch DSL
22
33** Grouping
44
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
120build:
2− stack build
21+ $(stack) $(build)
322
4−mod-build:
5− stack build --ghc-options '+RTS -A128M -RTS'
23+## build with validation options (Wall, Werror)
24+build-validate:
25+ $(stack) build --fast --ghc-options '-Wall -Werror +RTS -A128M -RTS'
626
7−echo-warn:
8− echo "Make certain you have an elasticsearch instance on localhost:9200 !"
27+## run ghci
28+ghci:
29+ $(stack) $(ghci)
930
31+## run tests
1032test: echo-warn
11− stack test
33+ $(stack) $(test)
1234
13−7.8-build:
14− STACK_YAML="stack-7.8.yaml" stack build
35+## run tests with forced re-run via "-r"
36+test-rerun: echo-warn
37+ $(stack) $(test) --test-arguments "-r"
1538
16−7.8-test: echo-warn
17− STACK_YAML="stack-7.8.yaml" stack test
39+## run ghci with test stanza
40+test-ghci:
41+ $(stack) $(ghci) bloodhound:test:bloodhound-tests
1842
19−7.10-build:
20− STACK_YAML="stack-7.10.yaml" stack build
43+## run ghcid
44+ghcid:
45+ ghcid -c "$(stack) ghci bloodhound:lib --test --ghci-options='-fobject-code -fno-warn-unused-do-bind' --main-is bloodhound:test:bloodhound-tests"
2146
22−7.10-test: echo-warn
23− STACK_YAML="stack-7.10.yaml" stack test
47+## run ghcid with validate options (Werror, etc.)
48+ghcid-validate:
49+ ghcid -c "$(stack) ghci bloodhound:lib --test --ghci-options='-Werror -fobject-code -fno-warn-unused-do-bind' --main-is bloodhound:test:bloodhound-tests"
2450
25−7.10-test-ES1:
26− STACK_YAML="stack-7.10.yaml" stack test --fast bloodhound:tests --test-arguments="--qc-max-success 500" --flag bloodhound:ES1
51+## run weeder
52+weeder:
53+ weeder . --build
2754
28−7.10-test-ES5:
29− STACK_YAML="stack-7.10.yaml" stack test --fast bloodhound:tests --test-arguments="--qc-max-success 500" --flag bloodhound:ES5
55+## run hlint
56+hlint:
57+ hlint .
3058
31−8.0-test-ES1:
32− STACK_YAML="stack.yaml" stack test --fast bloodhound:tests --test-arguments="--qc-max-success 500" --flag bloodhound:ES1
59+## hlint watch with `sos`
60+hlint-watch:
61+ sos src/ -c "hlint ." -p "src/(.*)\.hs"
3362
34−8.0-test-ES5:
35− STACK_YAML="stack-8.0.yaml" stack test --fast bloodhound:tests --test-arguments="--qc-max-success 500" --flag bloodhound:ES5
63+# mod-build:
64+# stack build --ghc-options '+RTS -A128M -RTS'
3665
37−8.0-build:
38− STACK_YAML="stack-8.0.yaml" stack build
66+echo-warn:
67+ @echo "Make certain you have an elasticsearch instance on localhost:9200 !"
3968
40−8.2-build:
41− STACK_YAML="stack-8.2.yaml" stack build
69+## Test with GHC 8.0 and ES 5.x
70+test-8.0:
71+ STACK_YAML="stack-8.0.yaml" stack test --fast bloodhound:test:bloodhound-tests --test-arguments="--qc-max-success 500"
4272
43−module-touch:
44− touch src/Database/V1/Bloodhound/Types.hs
45− touch src/Database/V5/Bloodhound/Types.hs
73+## Test with GHC 8.2 and ES 5.x
74+test-8.2:
75+ STACK_YAML="stack.yaml" stack test --fast bloodhound:test:bloodhound-tests --test-arguments="--qc-max-success 500"
4676
47−ghci:
48− stack ghci
77+## Build with the GHC 8.0 Stack YAML
78+build-8.0:
79+ $(stack-8.0) $(build)
80+
81+## Build with the GHC 8.2 Stack YAML
82+build-8.2:
83+ $(stack-8.2) $(build)
4984
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
5094upload:
5195 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
2222---------------------
2323
2424As 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
2626for your use case. If you would like to add support for another major
2727version, open a ticket expressing your intend and follow the pattern
2828used for other versions. We weighed the idea of sharing code between
2929versions 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
3131would allow the persons responsible for a particular protocol version
3232to maintain that version while avoiding conflict with other versions.
3333
3434See 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.
3636
3737
3838Stability
@@ -43,15 +43,15 @@ Bloodhound is stable for production use. I will strive to avoid breaking API com
4343Testing
4444---------
4545
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.
4747
4848Steps 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.
5050 2. Install [Stack] (http://docs.haskellstack.org/en/stable/README.html#how-to-install)
5151 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.
5353 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`.
5555
5656
5757Hackage page and Haddock documentation
bloodhound.cabaldeleted−100
@@ -1,100 +0,0 @@
1−name: bloodhound
2−version: 0.16.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− -- We do this to avoid package check errors when uploading to hackage
19− tests/V1/tests.hs
20− tests/V5/tests.hs
21−
22−source-repository head
23− type: git
24− location: https://github.com/bitemyapp/bloodhound.git
25−
26−Flag ES1
27− Description: Run the test suite against an Elasticsearch 1.x server
28− Default: False
29−
30−Flag ES5
31− Description: Run the test suite against an Elasticsearch 5.x server
32− Default: True
33−
34−library
35− ghc-options: -Wall
36− exposed-modules: Database.V1.Bloodhound
37− Database.V1.Bloodhound.Client
38− Database.V1.Bloodhound.Types
39− Database.V1.Bloodhound.Types.Class
40− Database.V1.Bloodhound.Types.Internal
41− Database.V5.Bloodhound
42− Database.V5.Bloodhound.Client
43− Database.V5.Bloodhound.Types
44− Database.V5.Bloodhound.Types.Class
45− Database.V5.Bloodhound.Types.Internal
46− hs-source-dirs: src
47− build-depends: base >= 4.3 && <5,
48− bytestring >= 0.10.0 && <0.11,
49− containers >= 0.5.0.0 && <0.6,
50− aeson >= 0.11.1 && <1.3,
51− http-client >= 0.4.30 && <0.6,
52− network-uri >= 2.6 && <2.7,
53− semigroups >= 0.15 && <0.19,
54− time >= 1.4 && <1.9,
55− text >= 0.11 && <1.3,
56− mtl >= 1.0 && <2.3,
57− transformers >= 0.2 && <0.6,
58− http-types >= 0.8 && <0.11,
59− vector >= 0.10.9 && <0.13,
60− scientific >= 0.3.0.0 && <0.4.0.0,
61− exceptions,
62− data-default-class,
63− blaze-builder,
64− unordered-containers,
65− mtl-compat,
66− hashable
67− default-language: Haskell2010
68−
69−test-suite tests
70− ghc-options: -Wall -fno-warn-orphans
71− type: exitcode-stdio-1.0
72− main-is: tests.hs
73− if flag(ES1)
74− hs-source-dirs: tests/V1
75− else
76− hs-source-dirs: tests/V5
77−
78− build-depends: base,
79− bloodhound,
80− bytestring,
81− http-client,
82− http-types,
83− containers,
84− hspec >= 1.8,
85− text,
86− time,
87− aeson,
88− semigroups,
89− QuickCheck,
90− vector,
91− unordered-containers >= 0.2.5.0 && <0.3,
92− mtl,
93− quickcheck-properties,
94− generics-sop >=0.2 && <0.4,
95− errors,
96− exceptions,
97− temporary,
98− unix-compat,
99− network-uri
100− 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+
1530.15.0.0
254===================
355
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 @@
11# Bloodhound Examples
22
33These 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`
55
66Run with `stack exec tweet-example`
examples/Tweet.hs+3−6
@@ -5,7 +5,6 @@ module Main
55 ) where
66
77
8−-------------------------------------------------------------------------------
98import Control.Monad.IO.Class (liftIO)
109import Data.Aeson (FromJSON (..), defaultOptions,
1110 genericParseJSON, genericToJSON,
@@ -15,10 +14,9 @@ import Data.Text (Text)
1514import Data.Time.Calendar (Day (..))
1615import Data.Time.Clock (UTCTime (..), secondsToDiffTime)
1716import qualified Data.Vector as V
18−import Database.V5.Bloodhound
17+import Database.Bloodhound
1918import GHC.Generics (Generic)
2019import Network.HTTP.Client (defaultManagerSettings)
21−-------------------------------------------------------------------------------
2220
2321
2422data TweetMapping = TweetMapping deriving (Eq, Show)
@@ -29,7 +27,7 @@ instance ToJSON TweetMapping where
2927 [ "properties" .=
3028 object ["location" .= object ["type" .= ("geo_point" :: Text)]]
3129 ]
32−-------------------------------------------------------------------------------
30+
3331data Tweet = Tweet
3432 { user :: Text
3533 , postDate :: UTCTime
@@ -39,7 +37,6 @@ data Tweet = Tweet
3937 } deriving (Eq, Generic, Show)
4038
4139
42−-------------------------------------------------------------------------------
4340exampleTweet :: Tweet
4441exampleTweet =
4542 Tweet
@@ -86,7 +83,7 @@ main = runBH' $ do
8683 True <- indexExists aliasName
8784
8885 -- 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]]
9087 let templateName = TemplateName "tweet-tpl"
9188 _ <- putTemplate idxTpl templateName
9289 True <- templateExists templateName
examples/package.yaml−1
@@ -17,7 +17,6 @@ dependencies:
1717- http-client
1818- vector
1919- semigroups
20−- transformers
2120ghc-options:
2221- -Wall
2322- -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+102−56
@@ -5,7 +5,7 @@
55-------------------------------------------------------------------------------
66-- |
77-- Module : Database.Bloodhound.Client
8−-- Copyright : (C) 2014 Chris Allen
8+-- Copyright : (C) 2014, 2018 Chris Allen
99-- License : BSD-style (see the file LICENSE)
1010-- Maintainer : Chris Allen <cma@bitemyapp.com>
1111-- Stability : provisional
@@ -15,7 +15,7 @@
1515--
1616-------------------------------------------------------------------------------
1717
18−module Database.V5.Bloodhound.Client
18+module Database.Bloodhound.Client
1919 ( -- * Bloodhound client functions
2020 -- | The examples in this module assume the following code has been run.
2121 -- The :{ and :} will only work in GHCi. You'll only need the data types
@@ -26,6 +26,7 @@ module Database.V5.Bloodhound.Client
2626 -- ** Indices
2727 , createIndex
2828 , createIndexWith
29+ , flushIndex
2930 , deleteIndex
3031 , updateIndexSettings
3132 , getIndexSettings
@@ -54,6 +55,7 @@ module Database.V5.Bloodhound.Client
5455 -- ** Searching
5556 , searchAll
5657 , searchByIndex
58+ , searchByIndices
5759 , searchByType
5860 , scanSearch
5961 , getInitialScroll
@@ -123,12 +125,12 @@ import qualified Network.HTTP.Types.URI as NHTU
123125import qualified Network.URI as URI
124126import Prelude hiding (filter, head)
125127
126−import Database.V5.Bloodhound.Types
128+import Database.Bloodhound.Types
127129
128130-- $setup
129131-- >>> :set -XOverloadedStrings
130132-- >>> :set -XDeriveGeneric
131−-- >>> import Database.V5.Bloodhound
133+-- >>> import Database.Bloodhound
132134-- >>> import Network.HTTP.Client
133135-- >>> let testServer = (Server "http://localhost:9200")
134136-- >>> let runBH' = withBH defaultManagerSettings testServer
@@ -215,6 +217,7 @@ dispatch dMethod url body = do
215217 $ setRequestIgnoreStatus
216218 $ initReq { method = dMethod
217219 , requestHeaders =
220+ -- "application/x-ndjson" for bulk
218221 ("Content-Type", "application/json") : requestHeaders initReq
219222 , requestBody = reqBody }
220223 -- req <- liftIO $ reqHook $ setRequestIgnoreStatus $ initReq { method = dMethod
@@ -315,7 +318,7 @@ instance FromJSON GSRs where
315318 parseJSON = withObject "Collection of GenericSnapshotRepo" parse
316319 where
317320 parse = fmap GSRs . mapM (uncurry go) . HM.toList
318− go rawName = withObject "GenericSnapshotRepo" $ \o -> do
321+ go rawName = withObject "GenericSnapshotRepo" $ \o ->
319322 GenericSnapshotRepo (SnapshotRepoName rawName) <$> o .: "type"
320323 <*> o .: "settings"
321324
@@ -344,7 +347,7 @@ updateSnapshotRepo SnapshotRepoUpdateSettings {..} repo =
344347
345348
346349-- | Verify if a snapshot repo is working. __NOTE:__ this API did not
347−-- 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,
348351-- you will get an error here.
349352verifySnapshotRepo
350353 :: ( MonadBH m
@@ -520,23 +523,25 @@ createIndex indexSettings (IndexName indexName) =
520523createIndexWith :: MonadBH m
521524 => [UpdatableIndexSetting]
522525 -> Int -- ^ shard count
523− -> IndexName
526+ -> IndexName
524527 -> m Reply
525528createIndexWith updates shards (IndexName indexName) =
526529 bindM2 put url (return (Just body))
527530 where url = joinPath [indexName]
528531 body = encode $ object
529− ["settings" .= deepMerge
532+ ["settings" .= deepMerge
530533 ( HM.singleton "index.number_of_shards" (toJSON shards) :
531534 [u | Object u <- toJSON <$> updates]
532535 )
533536 ]
534537
535−oPath :: ToJSON a => NonEmpty Text -> a -> Value
536−oPath (k :| []) v = object [k .= v]
537−oPath (k:| (h:t)) v = object [k .= oPath (h :| t) v]
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
538543
539−-- | 'deleteIndex' will delete an index given a 'Server', and an 'IndexName'.
544+-- | 'deleteIndex' will delete an index given a 'Server' and an 'IndexName'.
540545--
541546-- >>> _ <- runBH' $ createIndex defaultIndexSettings (IndexName "didimakeanindex")
542547-- >>> response <- runBH' $ deleteIndex (IndexName "didimakeanindex")
@@ -557,19 +562,21 @@ deleteIndex (IndexName indexName) =
557562updateIndexSettings :: MonadBH m => NonEmpty UpdatableIndexSetting -> IndexName -> m Reply
558563updateIndexSettings updates (IndexName indexName) =
559564 bindM2 put url (return body)
560− where url = joinPath [indexName, "_settings"]
561− body = Just (encode jsonBody)
562− jsonBody = Object (deepMerge [u | Object u <- toJSON <$> toList updates])
565+ where
566+ url = joinPath [indexName, "_settings"]
567+ body = Just (encode jsonBody)
568+ jsonBody = Object (deepMerge [u | Object u <- toJSON <$> toList updates])
563569
564570
565571getIndexSettings :: (MonadBH m, MonadThrow m) => IndexName
566572 -> m (Either EsError IndexSettingsSummary)
567−getIndexSettings (IndexName indexName) = do
573+getIndexSettings (IndexName indexName) =
568574 parseEsResponse =<< get =<< url
569− where url = joinPath [indexName, "_settings"]
575+ where
576+ url = joinPath [indexName, "_settings"]
570577
571−-- | 'forceMergeIndex'
572−--
578+-- | 'forceMergeIndex'
579+--
573580-- The force merge API allows to force merging of one or more indices through
574581-- an API. The merge relates to the number of segments a Lucene index holds
575582-- within each shard. The force merge operation allows to reduce the number of
@@ -631,20 +638,25 @@ existentialQuery url = do
631638-- responses from elasticsearch should fall into these two
632639-- categories. If they don't, a 'EsProtocolException' will be
633640-- thrown. If you encounter this, please report the full body it
634−-- reports along with your ElasticSearch verison.
635−parseEsResponse :: (MonadThrow m, FromJSON a) => Reply
641+-- reports along with your Elasticsearch verison.
642+parseEsResponse :: ( MonadThrow m
643+ , FromJSON a
644+ )
645+ => Reply
636646 -> m (Either EsError a)
637647parseEsResponse reply
638648 | respIsTwoHunna reply = case eitherDecode body of
639649 Right a -> return (Right a)
640− Left _ -> tryParseError
641− | otherwise = tryParseError
650+ Left err ->
651+ tryParseError err
652+ | otherwise = tryParseError "Non-200 status code"
642653 where body = responseBody reply
643− tryParseError = case eitherDecode body of
644− Right e -> return (Left e)
645− -- this case should not be possible
646− Left _ -> explode
647− explode = throwM (EsProtocolException body)
654+ tryParseError originalError
655+ = case eitherDecode body of
656+ Right e -> return (Left e)
657+ -- Failed to parse the error message.
658+ Left err -> explode ("Original error was: " <> originalError <> " Error parse failure was: " <> err)
659+ explode errorMsg = throwM (EsProtocolException (T.pack errorMsg) body)
648660
649661-- | 'indexExists' enables you to check if an index exists. Returns 'Bool'
650662-- in IO
@@ -703,14 +715,16 @@ listIndices :: (MonadThrow m, MonadBH m) => m [IndexName]
703715listIndices =
704716 parse . responseBody =<< get =<< url
705717 where
706− url = joinPath ["_cat/indices?v"]
707− -- parses the tabular format the indices api provides
708− parse body = case T.lines (T.decodeUtf8 (L.toStrict body)) of
709− (hdr:rows) -> let ks = T.words hdr
710− keyedRows = [ HM.fromList (zip ks (T.words row)) | row <- rows ]
711− names = catMaybes (HM.lookup "index" <$> keyedRows)
712− in return (IndexName <$> names)
713− [] -> throwM (EsProtocolException body)
718+ url = joinPath ["_cat/indices?format=json"]
719+ parse body = either (\msg -> (throwM (EsProtocolException (T.pack msg) body))) return $ do
720+ vals <- eitherDecode body
721+ forM vals $ \val ->
722+ case val of
723+ Object obj ->
724+ case HM.lookup "index" obj of
725+ (Just (String txt)) -> Right (IndexName txt)
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
714728
715729-- | 'updateIndexAliases' updates the server's index alias
716730-- table. Operations are atomic. Explained in further detail at
@@ -810,7 +824,7 @@ versionCtlParams cfg =
810824-- Elasticsearch. The document itself is simply something we can
811825-- convert into a JSON 'Value'. The 'DocId' will function as the
812826-- primary key for the document. You are encouraged to generate
813−-- your own id's and not rely on ElasticSearch's automatic id
827+-- your own id's and not rely on Elasticsearch's automatic id
814828-- generation. Read more about it here:
815829-- https://github.com/bitemyapp/bloodhound/issues/107
816830--
@@ -860,9 +874,11 @@ deleteDocument (IndexName indexName)
860874-- >>> _ <- runBH' $ bulk stream
861875-- >>> _ <- runBH' $ refreshIndex testIndex
862876bulk :: MonadBH m => V.Vector BulkOperation -> m Reply
863−bulk bulkOps = bindM2 post url (return body)
864− where url = joinPath ["_bulk"]
865− body = Just $ encodeBulkOperations bulkOps
877+bulk bulkOps =
878+ bindM2 post url (return body)
879+ where
880+ url = joinPath ["_bulk"]
881+ body = Just $ encodeBulkOperations bulkOps
866882
867883-- | 'encodeBulkOperations' is a convenience function for dumping a vector of 'BulkOperation'
868884-- into an 'L.ByteString'
@@ -872,12 +888,15 @@ bulk bulkOps = bindM2 post url (return body)
872888-- "\n{\"index\":{\"_type\":\"tweet\",\"_id\":\"2\",\"_index\":\"twitter\"}}\n{\"name\":\"blah\"}\n"
873889encodeBulkOperations :: V.Vector BulkOperation -> L.ByteString
874890encodeBulkOperations stream = collapsed where
875− blobs = fmap encodeBulkOperation stream
876− mashedTaters = mash (mempty :: Builder) blobs
877− collapsed = toLazyByteString $ mappend mashedTaters (byteString "\n")
891+ blobs =
892+ fmap encodeBulkOperation stream
893+ mashedTaters =
894+ mash (mempty :: Builder) blobs
895+ collapsed =
896+ toLazyByteString $ mappend mashedTaters (byteString "\n")
878897
879898mash :: Builder -> V.Vector L.ByteString -> Builder
880−mash = V.foldl' (\b x -> b `mappend` (byteString "\n") `mappend` (lazyByteString x))
899+mash = V.foldl' (\b x -> b <> byteString "\n" <> lazyByteString x)
881900
882901mkBulkStreamValue :: Text -> Text -> Text -> Text -> Value
883902mkBulkStreamValue operation indexName mappingName docId =
@@ -886,6 +905,12 @@ mkBulkStreamValue operation indexName mappingName docId =
886905 , "_type" .= mappingName
887906 , "_id" .= docId]]
888907
908+mkBulkStreamValueAuto :: Text -> Text -> Text -> Value
909+mkBulkStreamValueAuto operation indexName mappingName =
910+ object [operation .=
911+ object [ "_index" .= indexName
912+ , "_type" .= mappingName]]
913+
889914-- | 'encodeBulkOperation' is a convenience function for dumping a single 'BulkOperation'
890915-- into an 'L.ByteString'
891916--
@@ -899,6 +924,18 @@ encodeBulkOperation (BulkIndex (IndexName indexName)
899924 where metadata = mkBulkStreamValue "index" indexName mappingName docId
900925 blob = encode metadata `mappend` "\n" `mappend` encode value
901926
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+
902939encodeBulkOperation (BulkCreate (IndexName indexName)
903940 (MappingName mappingName)
904941 (DocId docId) value) = blob
@@ -973,6 +1010,15 @@ searchByIndex :: MonadBH m => IndexName -> Search -> m Reply
9731010searchByIndex (IndexName indexName) = bindM2 dispatchSearch url . return
9741011 where url = joinPath [indexName, "_search"]
9751012
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+
9761022-- | 'searchByType', given a 'Search', 'IndexName', and 'MappingName', will perform that
9771023-- search against a specific mapping within an index on an Elasticsearch server.
9781024--
@@ -989,10 +1035,10 @@ searchByType (IndexName indexName)
9891035-- search results. Note that the search is put into 'SearchTypeScan'
9901036-- mode and thus results will not be sorted. Combine this with
9911037-- 'advanceScroll' to efficiently stream through the full result set
992−getInitialScroll ::
993− (FromJSON a, MonadThrow m, MonadBH m) => IndexName ->
994− MappingName ->
995− Search ->
1038+getInitialScroll ::
1039+ (FromJSON a, MonadThrow m, MonadBH m) => IndexName ->
1040+ MappingName ->
1041+ Search ->
9961042 m (Either EsError (SearchResult a))
9971043getInitialScroll (IndexName indexName) (MappingName mappingName) search' = do
9981044 let url = addQuery params <$> joinPath [indexName, mappingName, "_search"]
@@ -1017,7 +1063,7 @@ getInitialSortedScroll (IndexName indexName) (MappingName mappingName) search =
10171063 resp' <- bindM2 dispatchSearch url (return search)
10181064 parseEsResponse resp'
10191065
1020−scroll' :: (FromJSON a, MonadBH m, MonadThrow m) => Maybe ScrollId ->
1066+scroll' :: (FromJSON a, MonadBH m, MonadThrow m) => Maybe ScrollId ->
10211067 m ([Hit a], Maybe ScrollId)
10221068scroll' Nothing = return ([], Nothing)
10231069scroll' (Just sid) = do
@@ -1044,13 +1090,13 @@ advanceScroll (ScrollId sid) scroll = do
10441090 where scrollTime = showText secs <> "s"
10451091 secs :: Integer
10461092 secs = round scroll
1047−
1093+
10481094 scrollObject = object [ "scroll" .= scrollTime
10491095 , "scroll_id" .= sid
10501096 ]
10511097
1052−simpleAccumulator ::
1053− (FromJSON a, MonadBH m, MonadThrow m) =>
1098+simpleAccumulator ::
1099+ (FromJSON a, MonadBH m, MonadThrow m) =>
10541100 [Hit a] ->
10551101 ([Hit a], Maybe ScrollId) ->
10561102 m ([Hit a], Maybe ScrollId)
@@ -1088,9 +1134,9 @@ scanSearch indexName mappingName search = do
10881134--
10891135-- >>> let query = TermQuery (Term "user" "bitemyapp") Nothing
10901136-- >>> mkSearch (Just query) Nothing
1091−-- 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}
10921138mkSearch :: Maybe Query -> Maybe Filter -> Search
1093−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
10941140
10951141-- | 'mkAggregateSearch' is a helper function that defaults everything in a 'Search' except for
10961142-- the 'Query' and the 'Aggregation'.
@@ -1100,7 +1146,7 @@ mkSearch query filter = Search query filter Nothing Nothing Nothing False (From
11001146-- TermsAgg (TermsAggregation {term = Left "user", termInclude = Nothing, termExclude = Nothing, termOrder = Nothing, termMinDocCount = Nothing, termSize = Nothing, termShardSize = Nothing, termCollectMode = Just BreadthFirst, termExecutionHint = Nothing, termAggs = Nothing})
11011147-- >>> let myAggregation = mkAggregateSearch Nothing $ mkAggregations "users" terms
11021148mkAggregateSearch :: Maybe Query -> Aggregations -> Search
1103−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
11041150
11051151-- | 'mkHighlightSearch' is a helper function that defaults everything in a 'Search' except for
11061152-- the 'Query' and the 'Aggregation'.
@@ -1109,7 +1155,7 @@ mkAggregateSearch query mkSearchAggs = Search query Nothing Nothing (Just mkSear
11091155-- >>> let testHighlight = Highlights Nothing [FieldHighlight (FieldName "message") Nothing]
11101156-- >>> let search = mkHighlightSearch (Just query) testHighlight
11111157mkHighlightSearch :: Maybe Query -> Highlights -> Search
1112−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
11131159
11141160-- | 'pageSearch' is a helper function that takes a search and assigns the from
11151161-- 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−5580
@@ -1,5580 +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− , DirectGenerators(..)
337− , mkDirectGenerators
338− , DirectGeneratorSuggestModeTypes (..)
339−
340− , Aggregation(..)
341− , Aggregations
342− , AggregationResults
343− , BucketValue(..)
344− , Bucket(..)
345− , BucketAggregation(..)
346− , TermsAggregation(..)
347− , MissingAggregation(..)
348− , ValueCountAggregation(..)
349− , FilterAggregation(..)
350− , CardinalityAggregation(..)
351− , DateHistogramAggregation(..)
352− , DateRangeAggregation(..)
353− , DateRangeAggRange(..)
354− , DateMathExpr(..)
355− , DateMathAnchor(..)
356− , DateMathModifier(..)
357− , DateMathUnit(..)
358− , TopHitsAggregation(..)
359−
360− , Highlights(..)
361− , FieldHighlight(..)
362− , HighlightSettings(..)
363− , PlainHighlight(..)
364− , PostingsHighlight(..)
365− , FastVectorHighlight(..)
366− , CommonHighlight(..)
367− , NonPostings(..)
368− , HighlightEncoder(..)
369− , HighlightTag(..)
370− , HitHighlight
371−
372− , MissingResult(..)
373− , TermsResult(..)
374− , DateHistogramResult(..)
375− , DateRangeResult(..)
376− , TopHitResult(..)
377−
378− , EsUsername(..)
379− , EsPassword(..)
380− ) where
381−
382−import Control.Applicative as A
383−import Control.Arrow (first)
384−import Control.Monad.Catch
385−import Control.Monad.Except
386−import Control.Monad.Reader (MonadReader (..),
387− ReaderT (..))
388−import Control.Monad.State (MonadState)
389−import Control.Monad.Writer (MonadWriter)
390−import Data.Aeson
391−import Data.Aeson.Types (Pair, Parser,
392− emptyObject,
393− parseEither, parseMaybe,
394− typeMismatch)
395−import qualified Data.ByteString.Lazy.Char8 as L
396−import Data.Char
397−import Data.Hashable (Hashable)
398−import qualified Data.HashMap.Strict as HM
399−import Data.List (foldl', intercalate,
400− nub)
401−import Data.List.NonEmpty (NonEmpty (..), toList)
402−import qualified Data.Map.Strict as M
403−import Data.Maybe
404−import Data.Scientific (Scientific)
405−import Data.Semigroup
406−import Data.Text (Text)
407−import qualified Data.Text as T
408−import Data.Time.Calendar
409−import Data.Time.Clock (NominalDiffTime,
410− UTCTime)
411−import Data.Time.Clock.POSIX
412−import qualified Data.Traversable as DT
413−import Data.Typeable (Typeable)
414−import qualified Data.Vector as V
415−import qualified Data.Version as Vers
416−import GHC.Enum
417−import GHC.Generics (Generic)
418−import Network.HTTP.Client
419−import qualified Network.HTTP.Types.Method as NHTM
420−import qualified Text.ParserCombinators.ReadP as RP
421−import qualified Text.Read as TR
422−
423−import Database.V1.Bloodhound.Types.Class
424−import Database.V1.Bloodhound.Types.Internal
425−
426−-- $setup
427−-- >>> :set -XOverloadedStrings
428−-- >>> import Data.Aeson
429−-- >>> import Database.V1.Bloodhound
430−-- >>> let testServer = (Server "http://localhost:9200")
431−-- >>> let testIndex = IndexName "twitter"
432−-- >>> let testMapping = MappingName "tweet"
433−-- >>> let defaultIndexSettings = IndexSettings (ShardCount 3) (ReplicaCount 2)
434−
435−-- defaultIndexSettings is exported by Database.Bloodhound as well
436−-- no trailing slashes in servers, library handles building the path.
437−
438−-- | Create a 'BHEnv' with all optional fields defaulted. HTTP hook
439−-- will be a noop. You can use the exported fields to customize it further, e.g.:
440−--
441−-- >> (mkBHEnv myServer myManager) { bhRequestHook = customHook }
442−mkBHEnv :: Server -> Manager -> BHEnv
443−mkBHEnv s m = BHEnv s m return
444−
445−newtype BH m a = BH {
446− unBH :: ReaderT BHEnv m a
447− } deriving ( Functor
448− , A.Applicative
449− , Monad
450− , MonadIO
451− , MonadState s
452− , MonadWriter w
453− , MonadError e
454− , Alternative
455− , MonadPlus
456− , MonadFix
457− , MonadThrow
458− , MonadCatch
459− , MonadMask)
460−
461−instance MonadTrans BH where
462− lift = BH . lift
463−
464−instance (MonadReader r m) => MonadReader r (BH m) where
465− ask = lift ask
466− local f (BH (ReaderT m)) = BH $ ReaderT $ \r ->
467− local f (m r)
468−
469−instance (Functor m, Applicative m, MonadIO m) => MonadBH (BH m) where
470− getBHEnv = BH getBHEnv
471−
472−runBH :: BHEnv -> BH m a -> m a
473−runBH e f = runReaderT (unBH f) e
474−
475−{-| 'Version' is embedded in 'Status' -}
476−data Version = Version { number :: VersionNumber
477− , build_hash :: BuildHash
478− , build_timestamp :: UTCTime
479− , build_snapshot :: Bool
480− , lucene_version :: VersionNumber } deriving (Eq, Read, Show, Generic, Typeable)
481−
482−-- | Traditional software versioning number
483−newtype VersionNumber = VersionNumber { versionNumber :: Vers.Version
484− } deriving (Eq, Read, Show, Generic, Typeable, Ord)
485−
486−{-| 'Status' is a data type for describing the JSON body returned by
487− Elasticsearch when you query its status. This was deprecated in 1.2.0.
488−
489− <http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/indices-status.html#indices-status>
490−-}
491−
492−data Status = Status { ok :: Maybe Bool
493− , status :: Int
494− , name :: Text
495− , version :: Version
496− , tagline :: Text } deriving (Eq, Read, Show, Generic)
497−
498−{-| 'IndexSettings' is used to configure the shards and replicas when you create
499− an Elasticsearch Index.
500−
501− <http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/indices-create-index.html>
502−-}
503−
504−data IndexSettings =
505− IndexSettings { indexShards :: ShardCount
506− , indexReplicas :: ReplicaCount } deriving (Eq, Read, Show, Generic, Typeable)
507−
508−{-| 'defaultIndexSettings' is an 'IndexSettings' with 3 shards and 2 replicas. -}
509−defaultIndexSettings :: IndexSettings
510−defaultIndexSettings = IndexSettings (ShardCount 3) (ReplicaCount 2)
511−
512−
513−{-| 'IndexOptimizationSettings' is used to configure index optimization. See
514− <https://www.elastic.co/guide/en/elasticsearch/reference/1.7/indices-optimize.html>
515− for more info.
516−-}
517−data IndexOptimizationSettings =
518− IndexOptimizationSettings { maxNumSegments :: Maybe Int
519− -- ^ 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.
520− , onlyExpungeDeletes :: Bool
521− -- ^ 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.
522− , flushAfterOptimize :: Bool
523− -- ^ Should a flush be performed after the optimize.
524− } deriving (Eq, Show, Generic, Typeable)
525−
526−
527−{-| 'defaultIndexOptimizationSettings' implements the default settings that
528− ElasticSearch uses for index optimization. 'maxNumSegments' is Nothing,
529− 'onlyExpungeDeletes' is False, and flushAfterOptimize is True.
530−-}
531−defaultIndexOptimizationSettings :: IndexOptimizationSettings
532−defaultIndexOptimizationSettings = IndexOptimizationSettings Nothing False True
533−
534−{-| 'UpdatableIndexSetting' are settings which may be updated after an index is created.
535−
536− <https://www.elastic.co/guide/en/elasticsearch/reference/current/indices-update-settings.html>
537−-}
538−data UpdatableIndexSetting = NumberOfReplicas ReplicaCount
539− -- ^ The number of replicas each shard has.
540− | AutoExpandReplicas ReplicaBounds
541− | BlocksReadOnly Bool
542− -- ^ Set to True to have the index read only. False to allow writes and metadata changes.
543− | BlocksRead Bool
544− -- ^ Set to True to disable read operations against the index.
545− | BlocksWrite Bool
546− -- ^ Set to True to disable write operations against the index.
547− | BlocksMetaData Bool
548− -- ^ Set to True to disable metadata operations against the index.
549− | RefreshInterval NominalDiffTime
550− -- ^ The async refresh interval of a shard
551− | IndexConcurrency Int
552− | FailOnMergeFailure Bool
553− | TranslogFlushThresholdOps Int
554− -- ^ When to flush on operations.
555− | TranslogFlushThresholdSize Bytes
556− -- ^ When to flush based on translog (bytes) size.
557− | TranslogFlushThresholdPeriod NominalDiffTime
558− -- ^ When to flush based on a period of not flushing.
559− | TranslogDisableFlush Bool
560− -- ^ Disables flushing. Note, should be set for a short interval and then enabled.
561− | CacheFilterMaxSize (Maybe Bytes)
562− -- ^ The maximum size of filter cache (per segment in shard).
563− | CacheFilterExpire (Maybe NominalDiffTime)
564− -- ^ The expire after access time for filter cache.
565− | GatewaySnapshotInterval NominalDiffTime
566− -- ^ The gateway snapshot interval (only applies to shared gateways).
567− | RoutingAllocationInclude (NonEmpty NodeAttrFilter)
568− -- ^ A node matching any rule will be allowed to host shards from the index.
569− | RoutingAllocationExclude (NonEmpty NodeAttrFilter)
570− -- ^ A node matching any rule will NOT be allowed to host shards from the index.
571− | RoutingAllocationRequire (NonEmpty NodeAttrFilter)
572− -- ^ Only nodes matching all rules will be allowed to host shards from the index.
573− | RoutingAllocationEnable AllocationPolicy
574− -- ^ Enables shard allocation for a specific index.
575− | RoutingAllocationShardsPerNode ShardCount
576− -- ^ Controls the total number of shards (replicas and primaries) allowed to be allocated on a single node.
577− | RecoveryInitialShards InitialShardCount
578− -- ^ When using local gateway a particular shard is recovered only if there can be allocated quorum shards in the cluster.
579− | GCDeletes NominalDiffTime
580− | TTLDisablePurge Bool
581− -- ^ Disables temporarily the purge of expired docs.
582− | TranslogFSType FSType
583− | IndexCompoundFormat CompoundFormat
584− | IndexCompoundOnFlush Bool
585− | WarmerEnabled Bool
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− | BulkDelete IndexName MappingName DocId
715− | BulkUpdate IndexName MappingName DocId Value deriving (Eq, Read, Show, Generic, Typeable)
716−
717−{-| 'EsResult' describes the standard wrapper JSON document that you see in
718− successful Elasticsearch lookups or lookups that couldn't find the document.
719−-}
720−data EsResult a = EsResult { _index :: Text
721− , _type :: Text
722− , _id :: Text
723− , foundResult :: Maybe (EsResultFound a)} deriving (Eq, Read, Show, Generic, Typeable)
724−
725−{-| 'EsResultFound' contains the document and its metadata inside of an
726− 'EsResult' when the document was successfully found.
727−-}
728−data EsResultFound a = EsResultFound { _version :: DocVersion
729− , _source :: a } deriving (Eq, Read, Show, Generic, Typeable)
730−
731−{-| 'EsError' is the generic type that will be returned when there was a
732− problem. If you can't parse the expected response, its a good idea to
733− try parsing this.
734−-}
735−data EsError = EsError { errorStatus :: Int
736− , errorMessage :: Text } deriving (Eq, Read, Show, Generic, Typeable)
737−
738−{-| 'EsProtocolException' will be thrown if Bloodhound cannot parse a response
739−returned by the ElasticSearch server. If you encounter this error, please
740−verify that your domain data types and FromJSON instances are working properly
741−(for example, the 'a' of '[Hit a]' in 'SearchResult.searchHits.hits'). If you're
742−sure that your mappings are correct, then this error may be an indication of an
743−incompatibility between Bloodhound and ElasticSearch. Please open a bug report
744−and be sure to include the exception body.
745−-}
746−data EsProtocolException = EsProtocolException { esProtoExBody :: L.ByteString }
747− deriving (Eq, Read, Show, Generic, Typeable)
748−
749−instance Exception EsProtocolException
750−
751−data IndexAlias = IndexAlias { srcIndex :: IndexName
752− , indexAlias :: IndexAliasName } deriving (Eq, Read, Show, Generic, Typeable)
753−
754−newtype IndexAliasName = IndexAliasName { indexAliasName :: IndexName } deriving (Eq, Read, Show, Generic, ToJSON)
755−
756−data IndexAliasAction = AddAlias IndexAlias IndexAliasCreate
757− | RemoveAlias IndexAlias deriving (Read, Show, Eq, Generic, Typeable)
758−
759−data IndexAliasCreate = IndexAliasCreate { aliasCreateRouting :: Maybe AliasRouting
760− , aliasCreateFilter :: Maybe Filter}
761− deriving (Read, Show, Eq, Generic, Typeable)
762−
763−data AliasRouting = AllAliasRouting RoutingValue
764− | GranularAliasRouting (Maybe SearchAliasRouting) (Maybe IndexAliasRouting)
765− deriving (Read, Show, Eq, Generic, Typeable)
766−
767−newtype SearchAliasRouting = SearchAliasRouting (NonEmpty RoutingValue) deriving (Read, Show, Eq, Generic, Typeable)
768−
769−newtype IndexAliasRouting = IndexAliasRouting RoutingValue deriving (Read, Show, Eq, Generic, ToJSON, FromJSON, Typeable)
770−
771−newtype RoutingValue = RoutingValue { routingValue :: Text } deriving (Read, Show, Eq, Generic, ToJSON, FromJSON, Typeable)
772−
773−newtype IndexAliasesSummary = IndexAliasesSummary { indexAliasesSummary :: [IndexAliasSummary] } deriving (Read, Show, Eq, Generic, Typeable)
774−
775−{-| 'IndexAliasSummary' is a summary of an index alias configured for a server. -}
776−data IndexAliasSummary = IndexAliasSummary { indexAliasSummaryAlias :: IndexAlias
777− , indexAliasSummaryCreate :: IndexAliasCreate} deriving (Read, Show, Eq, Generic, Typeable)
778−
779−{-| 'DocVersion' is an integer version number for a document between 1
780−and 9.2e+18 used for <<https://www.elastic.co/guide/en/elasticsearch/guide/current/optimistic-concurrency-control.html optimistic concurrency control>>.
781−-}
782−newtype DocVersion = DocVersion {
783− docVersionNumber :: Int
784− } deriving (Eq, Read, Show, Generic, Ord, ToJSON)
785−
786−-- | Smart constructor for in-range doc version
787−mkDocVersion :: Int -> Maybe DocVersion
788−mkDocVersion i
789− | i >= (docVersionNumber minBound) && i <= (docVersionNumber maxBound) =
790− Just $ DocVersion i
791− | otherwise = Nothing
792−
793−
794−{-| 'ExternalDocVersion' is a convenience wrapper if your code uses its
795−own version numbers instead of ones from ES.
796−-}
797−newtype ExternalDocVersion = ExternalDocVersion DocVersion
798− deriving (Eq, Read, Show, Generic, Ord, Bounded, Enum, ToJSON)
799−
800−{-| 'VersionControl' is specified when indexing documents as a
801−optimistic concurrency control.
802−-}
803−data VersionControl = NoVersionControl
804− -- ^ Don't send a version. This is a pure overwrite.
805− | InternalVersion DocVersion
806− -- ^ Use the default ES versioning scheme. Only
807− -- index the document if the version is the same
808− -- as the one specified. Only applicable to
809− -- updates, as you should be getting Version from
810− -- a search result.
811− | ExternalGT ExternalDocVersion
812− -- ^ Use your own version numbering. Only index
813− -- the document if the version is strictly higher
814− -- OR the document doesn't exist. The given
815− -- version will be used as the new version number
816− -- for the stored document. N.B. All updates must
817− -- increment this number, meaning there is some
818− -- global, external ordering of updates.
819− | ExternalGTE ExternalDocVersion
820− -- ^ Use your own version numbering. Only index
821− -- the document if the version is equal or higher
822− -- than the stored version. Will succeed if there
823− -- is no existing document. The given version will
824− -- be used as the new version number for the
825− -- stored document. Use with care, as this could
826− -- result in data loss.
827− | ForceVersion ExternalDocVersion
828− -- ^ The document will always be indexed and the
829− -- given version will be the new version. This is
830− -- typically used for correcting errors. Use with
831− -- care, as this could result in data loss.
832− deriving (Read, Show, Eq, Generic, Ord)
833−
834−{-| 'DocumentParent' is used to specify a parent document.
835−-}
836−newtype DocumentParent = DocumentParent DocId
837− deriving (Eq, Read, Show, Generic, Typeable)
838−
839−{-| 'IndexDocumentSettings' are special settings supplied when indexing
840−a document. For the best backwards compatiblity when new fields are
841−added, you should probably prefer to start with 'defaultIndexDocumentSettings'
842−-}
843−data IndexDocumentSettings =
844− IndexDocumentSettings { idsVersionControl :: VersionControl
845− , idsParent :: Maybe DocumentParent
846− } deriving (Eq, Read, Show, Generic, Typeable)
847−
848−{-| Reasonable default settings. Chooses no version control and no parent.
849−-}
850−defaultIndexDocumentSettings :: IndexDocumentSettings
851−defaultIndexDocumentSettings = IndexDocumentSettings NoVersionControl Nothing
852−
853−{-| 'Sort' is a synonym for a list of 'SortSpec's. Sort behavior is order
854− dependent with later sorts acting as tie-breakers for earlier sorts.
855−-}
856−type Sort = [SortSpec]
857−
858−{-| The two main kinds of 'SortSpec' are 'DefaultSortSpec' and
859− 'GeoDistanceSortSpec'. The latter takes a 'SortOrder', 'GeoPoint', and
860− 'DistanceUnit' to express "nearness" to a single geographical point as a
861− sort specification.
862−
863−<http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/search-request-sort.html#search-request-sort>
864−-}
865−data SortSpec = DefaultSortSpec DefaultSort
866− | GeoDistanceSortSpec SortOrder GeoPoint DistanceUnit deriving (Eq, Read, Show, Generic, Typeable)
867−
868−{-| 'DefaultSort' is usually the kind of 'SortSpec' you'll want. There's a
869− 'mkSort' convenience function for when you want to specify only the most
870− common parameters.
871−
872−<http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/search-request-sort.html#search-request-sort>
873−-}
874−data DefaultSort =
875− DefaultSort { sortFieldName :: FieldName
876− , sortOrder :: SortOrder
877− -- default False
878− , ignoreUnmapped :: Bool
879− , sortMode :: Maybe SortMode
880− , missingSort :: Maybe Missing
881− , nestedFilter :: Maybe Filter } deriving (Eq, Read, Show, Generic, Typeable)
882−
883−{-| 'SortOrder' is 'Ascending' or 'Descending', as you might expect. These get
884− encoded into "asc" or "desc" when turned into JSON.
885−
886−<http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/search-request-sort.html#search-request-sort>
887−-}
888−data SortOrder = Ascending
889− | Descending deriving (Eq, Read, Show, Generic, Typeable)
890−
891−{-| 'Missing' prescribes how to handle missing fields. A missing field can be
892− sorted last, first, or using a custom value as a substitute.
893−
894−<http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/search-request-sort.html#_missing_values>
895−-}
896−data Missing = LastMissing
897− | FirstMissing
898− | CustomMissing Text deriving (Eq, Read, Show, Generic, Typeable)
899−
900−{-| 'SortMode' prescribes how to handle sorting array/multi-valued fields.
901−
902−http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/search-request-sort.html#_sort_mode_option
903−-}
904−data SortMode = SortMin
905− | SortMax
906− | SortSum
907− | SortAvg deriving (Eq, Read, Show, Generic, Typeable)
908−
909−{-| 'mkSort' defaults everything but the 'FieldName' and the 'SortOrder' so
910− that you can concisely describe the usual kind of 'SortSpec's you want.
911−-}
912−mkSort :: FieldName -> SortOrder -> DefaultSort
913−mkSort fieldName sOrder = DefaultSort fieldName sOrder False Nothing Nothing Nothing
914−
915−{-| 'Cache' is for telling ES whether it should cache a 'Filter' not.
916− 'Query's cannot be cached.
917−-}
918−type Cache = Bool -- caching on/off
919−defaultCache :: Cache
920−defaultCache = False
921−
922−{-| 'PrefixValue' is used in 'PrefixQuery' as the main query component.
923−-}
924−type PrefixValue = Text
925−
926−{-| 'BooleanOperator' is the usual And/Or operators with an ES compatible
927− JSON encoding baked in. Used all over the place.
928−-}
929−data BooleanOperator = And | Or deriving (Eq, Read, Show, Generic, Typeable)
930−
931−{-| 'ShardCount' is part of 'IndexSettings'
932−-}
933−newtype ShardCount = ShardCount Int deriving (Eq, Read, Show, Generic, ToJSON, Typeable)
934−
935−{-| 'ReplicaCount' is part of 'IndexSettings'
936−-}
937−newtype ReplicaCount = ReplicaCount Int deriving (Eq, Read, Show, Generic, ToJSON, Typeable)
938−
939−{-| 'IndexName' is used to describe which index to query/create/delete
940−-}
941−newtype IndexName = IndexName Text deriving (Eq, Generic, Read, Show, ToJSON, FromJSON, Typeable)
942−
943−{-| 'IndexSelection' is used for APIs which take a single index, a list of
944− indexes, or the special @_all@ index.
945−-}
946−--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.
947−data IndexSelection = IndexList (NonEmpty IndexName)
948− | AllIndexes deriving (Eq, Generic, Show, Typeable)
949−
950−{-| '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.
951−-}
952−data NodeSelection = LocalNode
953− -- ^ Whatever node receives this request
954− | NodeList (NonEmpty NodeSelector)
955− | AllNodes deriving (Eq, Generic, Show, Typeable)
956−
957−
958−-- | An exact match or pattern to identify a node. Note that All of
959−-- these options support wildcarding, so your node name, server, attr
960−-- name can all contain * characters to be a fuzzy match.
961−data NodeSelector = NodeByName NodeName
962− | NodeByFullNodeId FullNodeId
963− | NodeByHost Server
964− -- ^ e.g. 10.0.0.1 or even 10.0.0.*
965− | NodeByAttribute NodeAttrName Text
966− -- ^ NodeAttrName can be a pattern, e.g. rack*. The value can too.
967− deriving (Eq, Generic, Show, Typeable)
968−
969−{-| 'TemplateName' is used to describe which template to query/create/delete
970−-}
971−newtype TemplateName = TemplateName Text deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
972−
973−{-| 'TemplatePattern' represents a pattern which is matched against index names
974−-}
975−newtype TemplatePattern = TemplatePattern Text deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
976−
977−{-| 'MappingName' is part of mappings which are how ES describes and schematizes
978− the data in the indices.
979−-}
980−newtype MappingName = MappingName Text deriving (Eq, Generic, Read, Show, ToJSON, FromJSON, Typeable)
981−
982−{-| 'DocId' is a generic wrapper value for expressing unique Document IDs.
983− Can be set by the user or created by ES itself. Often used in client
984− functions for poking at specific documents.
985−-}
986−newtype DocId = DocId Text deriving (Eq, Generic, Read, Show, ToJSON, FromJSON, Typeable)
987−
988−{-| 'QueryString' is used to wrap query text bodies, be they human written or not.
989−-}
990−newtype QueryString = QueryString Text deriving (Eq, Generic, Read, Show, ToJSON, FromJSON, Typeable)
991−
992−{-| 'FieldName' is used all over the place wherever a specific field within
993− a document needs to be specified, usually in 'Query's or 'Filter's.
994−-}
995−newtype FieldName = FieldName Text deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
996−
997−
998−{-| 'Script' is often used in place of 'FieldName' to specify more
999−complex ways of extracting a value from a document.
1000−-}
1001−newtype Script = Script { scriptText :: Text } deriving (Eq, Read, Show, Generic, Typeable)
1002−
1003−{-| 'CacheName' is used in 'RegexpFilter' for describing the
1004− 'CacheKey' keyed caching behavior.
1005−-}
1006−newtype CacheName = CacheName Text deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1007−
1008−{-| 'CacheKey' is used in 'RegexpFilter' to key regex caching.
1009−-}
1010−newtype CacheKey =
1011− CacheKey Text deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1012−newtype Existence =
1013− Existence Bool deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1014−newtype NullValue =
1015− NullValue Bool deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1016−newtype CutoffFrequency =
1017− CutoffFrequency Double deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1018−newtype Analyzer =
1019− Analyzer Text deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1020−newtype MaxExpansions =
1021− MaxExpansions Int deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1022−
1023−{-| 'Lenient', if set to true, will cause format based failures to be
1024− ignored. I don't know what the bloody default is, Elasticsearch
1025− documentation didn't say what it was. Let me know if you figure it out.
1026−-}
1027−newtype Lenient =
1028− Lenient Bool deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1029−newtype Tiebreaker =
1030− Tiebreaker Double deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1031−newtype Boost =
1032− Boost Double deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1033−newtype BoostTerms =
1034− BoostTerms Double deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1035−
1036−{-| 'MinimumMatch' controls how many should clauses in the bool query should
1037− match. Can be an absolute value (2) or a percentage (30%) or a
1038− combination of both.
1039−-}
1040−newtype MinimumMatch =
1041− MinimumMatch Int deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1042−newtype DisableCoord =
1043− DisableCoord Bool deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1044−newtype IgnoreTermFrequency =
1045− IgnoreTermFrequency Bool deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1046−newtype MinimumTermFrequency =
1047− MinimumTermFrequency Int deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1048−newtype MaxQueryTerms =
1049− MaxQueryTerms Int deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1050−newtype Fuzziness =
1051− Fuzziness Double deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1052−
1053−{-| 'PrefixLength' is the prefix length used in queries, defaults to 0. -}
1054−newtype PrefixLength =
1055− PrefixLength Int deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1056−newtype TypeName =
1057− TypeName Text deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1058−newtype PercentMatch =
1059− PercentMatch Double deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1060−newtype StopWord =
1061− StopWord Text deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1062−newtype QueryPath =
1063− QueryPath Text deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1064−
1065−{-| Allowing a wildcard at the beginning of a word (eg "*ing") is particularly
1066− heavy, because all terms in the index need to be examined, just in case
1067− they match. Leading wildcards can be disabled by setting
1068− 'AllowLeadingWildcard' to false. -}
1069−newtype AllowLeadingWildcard =
1070− AllowLeadingWildcard Bool deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1071−newtype LowercaseExpanded =
1072− LowercaseExpanded Bool deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1073−newtype EnablePositionIncrements =
1074− EnablePositionIncrements Bool deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1075−
1076−{-| By default, wildcard terms in a query are not analyzed.
1077− Setting 'AnalyzeWildcard' to true enables best-effort analysis.
1078−-}
1079−newtype AnalyzeWildcard = AnalyzeWildcard Bool deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1080−
1081−{-| 'GeneratePhraseQueries' defaults to false.
1082−-}
1083−newtype GeneratePhraseQueries =
1084− GeneratePhraseQueries Bool deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1085−
1086−{-| 'Locale' is used for string conversions - defaults to ROOT.
1087−-}
1088−newtype Locale = Locale Text deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1089−newtype MaxWordLength = MaxWordLength Int deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1090−newtype MinWordLength = MinWordLength Int deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1091−
1092−{-| 'PhraseSlop' sets the default slop for phrases, 0 means exact
1093− phrase matches. Default is 0.
1094−-}
1095−newtype PhraseSlop = PhraseSlop Int deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1096−newtype MinDocFrequency = MinDocFrequency Int deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1097−newtype MaxDocFrequency = MaxDocFrequency Int deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1098−
1099−-- | Newtype wrapper to parse ES's concerning tendency to in some APIs return a floating point number of milliseconds since epoch ಠ_ಠ
1100−newtype POSIXMS = POSIXMS { posixMS :: UTCTime }
1101−
1102−{-| 'unpackId' is a silly convenience function that gets used once.
1103−-}
1104−unpackId :: DocId -> Text
1105−unpackId (DocId docId) = docId
1106−
1107−type TrackSortScores = Bool
1108−newtype From = From Int deriving (Eq, Read, Show, Generic, ToJSON)
1109−newtype Size = Size Int deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1110−
1111−data Search = Search { queryBody :: Maybe Query
1112− , filterBody :: Maybe Filter
1113− , sortBody :: Maybe Sort
1114− , aggBody :: Maybe Aggregations
1115− , highlight :: Maybe Highlights
1116− -- default False
1117− , trackSortScores :: TrackSortScores
1118− , from :: From
1119− , size :: Size
1120− , searchType :: SearchType
1121− , fields :: Maybe [FieldName]
1122− , source :: Maybe Source
1123− , suggestBody :: Maybe Suggest -- ^ Only one Suggestion request / response per Search is supported.
1124− } deriving (Eq, Read, Show, Generic, Typeable)
1125−
1126−data SearchType = SearchTypeQueryThenFetch
1127− | SearchTypeDfsQueryThenFetch
1128− | SearchTypeCount
1129− | SearchTypeScan
1130− | SearchTypeQueryAndFetch
1131− | SearchTypeDfsQueryAndFetch
1132− deriving (Eq, Read, Show, Generic, Typeable)
1133−
1134−data Source =
1135− NoSource
1136− | SourcePatterns PatternOrPatterns
1137− | SourceIncludeExclude Include Exclude
1138− deriving (Read, Show, Eq, Generic, Typeable)
1139−
1140−data PatternOrPatterns = PopPattern Pattern
1141− | PopPatterns [Pattern] deriving (Eq, Read, Show, Generic, Typeable)
1142−
1143−data Include = Include [Pattern] deriving (Eq, Read, Show, Generic, Typeable)
1144−data Exclude = Exclude [Pattern] deriving (Eq, Read, Show, Generic, Typeable)
1145−
1146−newtype Pattern = Pattern Text deriving (Eq, Read, Show, Generic, Typeable)
1147−
1148−data Highlights = Highlights { globalsettings :: Maybe HighlightSettings
1149− , highlightFields :: [FieldHighlight]
1150− } deriving (Read, Show, Eq, Generic, Typeable)
1151−
1152−data FieldHighlight = FieldHighlight FieldName (Maybe HighlightSettings)
1153− deriving (Read, Show, Eq, Generic, Typeable)
1154−
1155−
1156−data HighlightSettings = Plain PlainHighlight
1157− | Postings PostingsHighlight
1158− | FastVector FastVectorHighlight
1159− deriving (Read, Show, Eq, Generic, Typeable)
1160−data PlainHighlight =
1161− PlainHighlight { plainCommon :: Maybe CommonHighlight
1162− , plainNonPost :: Maybe NonPostings } deriving (Read, Show, Eq, Generic, Typeable)
1163−
1164− -- This requires that index_options are set to 'offset' in the mapping.
1165−data PostingsHighlight = PostingsHighlight (Maybe CommonHighlight) deriving (Read, Show, Eq, Generic, Typeable)
1166−
1167−-- This requires that term_vector is set to 'with_positions_offsets' in the mapping.
1168−data FastVectorHighlight =
1169− FastVectorHighlight { fvCommon :: Maybe CommonHighlight
1170− , fvNonPostSettings :: Maybe NonPostings
1171− , boundaryChars :: Maybe Text
1172− , boundaryMaxScan :: Maybe Int
1173− , fragmentOffset :: Maybe Int
1174− , matchedFields :: [Text]
1175− , phraseLimit :: Maybe Int
1176− } deriving (Read, Show, Eq, Generic, Typeable)
1177−
1178−data CommonHighlight =
1179− CommonHighlight { order :: Maybe Text
1180− , forceSource :: Maybe Bool
1181− , tag :: Maybe HighlightTag
1182− , encoder :: Maybe HighlightEncoder
1183− , noMatchSize :: Maybe Int
1184− , highlightQuery :: Maybe Query
1185− , requireFieldMatch :: Maybe Bool
1186− } deriving (Read, Show, Eq, Generic, Typeable)
1187−
1188−-- Settings that are only applicable to FastVector and Plain highlighters.
1189−data NonPostings =
1190− NonPostings { fragmentSize :: Maybe Int
1191− , numberOfFragments :: Maybe Int} deriving (Read, Show, Eq, Generic, Typeable)
1192−
1193−data HighlightEncoder = DefaultEncoder
1194− | HTMLEncoder
1195− deriving (Read, Show, Eq, Generic, Typeable)
1196−
1197−-- NOTE: Should the tags use some kind of HTML type, rather than Text?
1198−data HighlightTag = TagSchema Text
1199− | CustomTags ([Text], [Text]) -- Only uses more than the first value in the lists if fvh
1200− deriving (Read, Show, Eq, Generic, Typeable)
1201−
1202−
1203−data Query =
1204− TermQuery Term (Maybe Boost)
1205− | TermsQuery Text (NonEmpty Text)
1206− | QueryMatchQuery MatchQuery
1207− | QueryMultiMatchQuery MultiMatchQuery
1208− | QueryBoolQuery BoolQuery
1209− | QueryBoostingQuery BoostingQuery
1210− | QueryCommonTermsQuery CommonTermsQuery
1211− | ConstantScoreFilter Filter Boost
1212− | ConstantScoreQuery Query Boost
1213− | QueryDisMaxQuery DisMaxQuery
1214− | QueryFilteredQuery FilteredQuery
1215− | QueryFuzzyLikeThisQuery FuzzyLikeThisQuery
1216− | QueryFuzzyLikeFieldQuery FuzzyLikeFieldQuery
1217− | QueryFuzzyQuery FuzzyQuery
1218− | QueryHasChildQuery HasChildQuery
1219− | QueryHasParentQuery HasParentQuery
1220− | IdsQuery MappingName [DocId]
1221− | QueryIndicesQuery IndicesQuery
1222− | MatchAllQuery (Maybe Boost)
1223− | QueryMoreLikeThisQuery MoreLikeThisQuery
1224− | QueryMoreLikeThisFieldQuery MoreLikeThisFieldQuery
1225− | QueryNestedQuery NestedQuery
1226− | QueryPrefixQuery PrefixQuery
1227− | QueryQueryStringQuery QueryStringQuery
1228− | QuerySimpleQueryStringQuery SimpleQueryStringQuery
1229− | QueryRangeQuery RangeQuery
1230− | QueryRegexpQuery RegexpQuery
1231− | QueryTemplateQueryInline TemplateQueryInline
1232− deriving (Eq, Read, Show, Generic, Typeable)
1233−
1234−data RegexpQuery =
1235− RegexpQuery { regexpQueryField :: FieldName
1236− , regexpQuery :: Regexp
1237− , regexpQueryFlags :: RegexpFlags
1238− , regexpQueryBoost :: Maybe Boost
1239− } deriving (Eq, Read, Show, Generic, Typeable)
1240−
1241−data RangeQuery =
1242− RangeQuery { rangeQueryField :: FieldName
1243− , rangeQueryRange :: RangeValue
1244− , rangeQueryBoost :: Boost } deriving (Eq, Read, Show, Generic, Typeable)
1245−
1246−mkRangeQuery :: FieldName -> RangeValue -> RangeQuery
1247−mkRangeQuery f r = RangeQuery f r (Boost 1.0)
1248−
1249−data SimpleQueryStringQuery =
1250− SimpleQueryStringQuery
1251− { simpleQueryStringQuery :: QueryString
1252− , simpleQueryStringField :: Maybe FieldOrFields
1253− , simpleQueryStringOperator :: Maybe BooleanOperator
1254− , simpleQueryStringAnalyzer :: Maybe Analyzer
1255− , simpleQueryStringFlags :: Maybe (NonEmpty SimpleQueryFlag)
1256− , simpleQueryStringLowercaseExpanded :: Maybe LowercaseExpanded
1257− , simpleQueryStringLocale :: Maybe Locale
1258− } deriving (Eq, Read, Show, Generic, Typeable)
1259−
1260−data SimpleQueryFlag =
1261− SimpleQueryAll
1262− | SimpleQueryNone
1263− | SimpleQueryAnd
1264− | SimpleQueryOr
1265− | SimpleQueryPrefix
1266− | SimpleQueryPhrase
1267− | SimpleQueryPrecedence
1268− | SimpleQueryEscape
1269− | SimpleQueryWhitespace
1270− | SimpleQueryFuzzy
1271− | SimpleQueryNear
1272− | SimpleQuerySlop deriving (Eq, Read, Show, Generic, Typeable)
1273−
1274−-- use_dis_max and tie_breaker when fields are plural?
1275−data QueryStringQuery =
1276− QueryStringQuery
1277− { queryStringQuery :: QueryString
1278− , queryStringDefaultField :: Maybe FieldName
1279− , queryStringOperator :: Maybe BooleanOperator
1280− , queryStringAnalyzer :: Maybe Analyzer
1281− , queryStringAllowLeadingWildcard :: Maybe AllowLeadingWildcard
1282− , queryStringLowercaseExpanded :: Maybe LowercaseExpanded
1283− , queryStringEnablePositionIncrements :: Maybe EnablePositionIncrements
1284− , queryStringFuzzyMaxExpansions :: Maybe MaxExpansions
1285− , queryStringFuzziness :: Maybe Fuzziness
1286− , queryStringFuzzyPrefixLength :: Maybe PrefixLength
1287− , queryStringPhraseSlop :: Maybe PhraseSlop
1288− , queryStringBoost :: Maybe Boost
1289− , queryStringAnalyzeWildcard :: Maybe AnalyzeWildcard
1290− , queryStringGeneratePhraseQueries :: Maybe GeneratePhraseQueries
1291− , queryStringMinimumShouldMatch :: Maybe MinimumMatch
1292− , queryStringLenient :: Maybe Lenient
1293− , queryStringLocale :: Maybe Locale
1294− } deriving (Eq, Read, Show, Generic, Typeable)
1295−
1296−mkQueryStringQuery :: QueryString -> QueryStringQuery
1297−mkQueryStringQuery qs =
1298− QueryStringQuery qs Nothing Nothing
1299− Nothing Nothing Nothing Nothing
1300− Nothing Nothing Nothing Nothing
1301− Nothing Nothing Nothing Nothing
1302− Nothing Nothing
1303−
1304−data FieldOrFields = FofField FieldName
1305− | FofFields (NonEmpty FieldName) deriving (Eq, Read, Show, Generic, Typeable)
1306−
1307−data PrefixQuery =
1308− PrefixQuery
1309− { prefixQueryField :: FieldName
1310− , prefixQueryPrefixValue :: Text
1311− , prefixQueryBoost :: Maybe Boost } deriving (Eq, Read, Show, Generic, Typeable)
1312−
1313−data NestedQuery =
1314− NestedQuery
1315− { nestedQueryPath :: QueryPath
1316− , nestedQueryScoreType :: ScoreType
1317− , nestedQuery :: Query } deriving (Eq, Read, Show, Generic, Typeable)
1318−
1319−data MoreLikeThisFieldQuery =
1320− MoreLikeThisFieldQuery
1321− { moreLikeThisFieldText :: Text
1322− , moreLikeThisFieldFields :: FieldName
1323− -- default 0.3 (30%)
1324− , moreLikeThisFieldPercentMatch :: Maybe PercentMatch
1325− , moreLikeThisFieldMinimumTermFreq :: Maybe MinimumTermFrequency
1326− , moreLikeThisFieldMaxQueryTerms :: Maybe MaxQueryTerms
1327− , moreLikeThisFieldStopWords :: Maybe (NonEmpty StopWord)
1328− , moreLikeThisFieldMinDocFrequency :: Maybe MinDocFrequency
1329− , moreLikeThisFieldMaxDocFrequency :: Maybe MaxDocFrequency
1330− , moreLikeThisFieldMinWordLength :: Maybe MinWordLength
1331− , moreLikeThisFieldMaxWordLength :: Maybe MaxWordLength
1332− , moreLikeThisFieldBoostTerms :: Maybe BoostTerms
1333− , moreLikeThisFieldBoost :: Maybe Boost
1334− , moreLikeThisFieldAnalyzer :: Maybe Analyzer
1335− } deriving (Eq, Read, Show, Generic, Typeable)
1336−
1337−data MoreLikeThisQuery =
1338− MoreLikeThisQuery
1339− { moreLikeThisText :: Text
1340− , moreLikeThisFields :: Maybe (NonEmpty FieldName)
1341− -- default 0.3 (30%)
1342− , moreLikeThisPercentMatch :: Maybe PercentMatch
1343− , moreLikeThisMinimumTermFreq :: Maybe MinimumTermFrequency
1344− , moreLikeThisMaxQueryTerms :: Maybe MaxQueryTerms
1345− , moreLikeThisStopWords :: Maybe (NonEmpty StopWord)
1346− , moreLikeThisMinDocFrequency :: Maybe MinDocFrequency
1347− , moreLikeThisMaxDocFrequency :: Maybe MaxDocFrequency
1348− , moreLikeThisMinWordLength :: Maybe MinWordLength
1349− , moreLikeThisMaxWordLength :: Maybe MaxWordLength
1350− , moreLikeThisBoostTerms :: Maybe BoostTerms
1351− , moreLikeThisBoost :: Maybe Boost
1352− , moreLikeThisAnalyzer :: Maybe Analyzer
1353− } deriving (Eq, Read, Show, Generic, Typeable)
1354−
1355−data IndicesQuery =
1356− IndicesQuery
1357− { indicesQueryIndices :: [IndexName]
1358− , indicesQuery :: Query
1359− -- default "all"
1360− , indicesQueryNoMatch :: Maybe Query } deriving (Eq, Read, Show, Generic, Typeable)
1361−
1362−data HasParentQuery =
1363− HasParentQuery
1364− { hasParentQueryType :: TypeName
1365− , hasParentQuery :: Query
1366− , hasParentQueryScoreType :: Maybe ScoreType } deriving (Eq, Read, Show, Generic, Typeable)
1367−
1368−data HasChildQuery =
1369− HasChildQuery
1370− { hasChildQueryType :: TypeName
1371− , hasChildQuery :: Query
1372− , hasChildQueryScoreType :: Maybe ScoreType } deriving (Eq, Read, Show, Generic, Typeable)
1373−
1374−data ScoreType =
1375− ScoreTypeMax
1376− | ScoreTypeSum
1377− | ScoreTypeAvg
1378− | ScoreTypeNone deriving (Eq, Read, Show, Generic, Typeable)
1379−
1380−data FuzzyQuery =
1381− FuzzyQuery { fuzzyQueryField :: FieldName
1382− , fuzzyQueryValue :: Text
1383− , fuzzyQueryPrefixLength :: PrefixLength
1384− , fuzzyQueryMaxExpansions :: MaxExpansions
1385− , fuzzyQueryFuzziness :: Fuzziness
1386− , fuzzyQueryBoost :: Maybe Boost
1387− } deriving (Eq, Read, Show, Generic, Typeable)
1388−
1389−data FuzzyLikeFieldQuery =
1390− FuzzyLikeFieldQuery
1391− { fuzzyLikeField :: FieldName
1392− -- anaphora is good for the soul.
1393− , fuzzyLikeFieldText :: Text
1394− , fuzzyLikeFieldMaxQueryTerms :: MaxQueryTerms
1395− , fuzzyLikeFieldIgnoreTermFrequency :: IgnoreTermFrequency
1396− , fuzzyLikeFieldFuzziness :: Fuzziness
1397− , fuzzyLikeFieldPrefixLength :: PrefixLength
1398− , fuzzyLikeFieldBoost :: Boost
1399− , fuzzyLikeFieldAnalyzer :: Maybe Analyzer
1400− } deriving (Eq, Read, Show, Generic, Typeable)
1401−
1402−data FuzzyLikeThisQuery =
1403− FuzzyLikeThisQuery
1404− { fuzzyLikeFields :: [FieldName]
1405− , fuzzyLikeText :: Text
1406− , fuzzyLikeMaxQueryTerms :: MaxQueryTerms
1407− , fuzzyLikeIgnoreTermFrequency :: IgnoreTermFrequency
1408− , fuzzyLikeFuzziness :: Fuzziness
1409− , fuzzyLikePrefixLength :: PrefixLength
1410− , fuzzyLikeBoost :: Boost
1411− , fuzzyLikeAnalyzer :: Maybe Analyzer
1412− } deriving (Eq, Read, Show, Generic, Typeable)
1413−
1414−data FilteredQuery =
1415− FilteredQuery
1416− { filteredQuery :: Query
1417− , filteredFilter :: Filter } deriving (Eq, Read, Show, Generic, Typeable)
1418−
1419−data DisMaxQuery =
1420− DisMaxQuery { disMaxQueries :: [Query]
1421− -- default 0.0
1422− , disMaxTiebreaker :: Tiebreaker
1423− , disMaxBoost :: Maybe Boost
1424− } deriving (Eq, Read, Show, Generic, Typeable)
1425−
1426−data MatchQuery =
1427− MatchQuery { matchQueryField :: FieldName
1428− , matchQueryQueryString :: QueryString
1429− , matchQueryOperator :: BooleanOperator
1430− , matchQueryZeroTerms :: ZeroTermsQuery
1431− , matchQueryCutoffFrequency :: Maybe CutoffFrequency
1432− , matchQueryMatchType :: Maybe MatchQueryType
1433− , matchQueryAnalyzer :: Maybe Analyzer
1434− , matchQueryMaxExpansions :: Maybe MaxExpansions
1435− , matchQueryLenient :: Maybe Lenient
1436− , matchQueryBoost :: Maybe Boost } deriving (Eq, Read, Show, Generic, Typeable)
1437−
1438−{-| 'mkMatchQuery' is a convenience function that defaults the less common parameters,
1439− enabling you to provide only the 'FieldName' and 'QueryString' to make a 'MatchQuery'
1440−-}
1441−mkMatchQuery :: FieldName -> QueryString -> MatchQuery
1442−mkMatchQuery field query = MatchQuery field query Or ZeroTermsNone Nothing Nothing Nothing Nothing Nothing Nothing
1443−
1444−data MatchQueryType =
1445− MatchPhrase
1446− | MatchPhrasePrefix deriving (Eq, Read, Show, Generic, Typeable)
1447−
1448−data MultiMatchQuery =
1449− MultiMatchQuery { multiMatchQueryFields :: [FieldName]
1450− , multiMatchQueryString :: QueryString
1451− , multiMatchQueryOperator :: BooleanOperator
1452− , multiMatchQueryZeroTerms :: ZeroTermsQuery
1453− , multiMatchQueryTiebreaker :: Maybe Tiebreaker
1454− , multiMatchQueryType :: Maybe MultiMatchQueryType
1455− , multiMatchQueryCutoffFrequency :: Maybe CutoffFrequency
1456− , multiMatchQueryAnalyzer :: Maybe Analyzer
1457− , multiMatchQueryMaxExpansions :: Maybe MaxExpansions
1458− , multiMatchQueryLenient :: Maybe Lenient } deriving (Eq, Read, Show, Generic, Typeable)
1459−
1460−{-| 'mkMultiMatchQuery' is a convenience function that defaults the less common parameters,
1461− enabling you to provide only the list of 'FieldName's and 'QueryString' to
1462− make a 'MultiMatchQuery'.
1463−-}
1464−
1465−mkMultiMatchQuery :: [FieldName] -> QueryString -> MultiMatchQuery
1466−mkMultiMatchQuery matchFields query =
1467− MultiMatchQuery matchFields query
1468− Or ZeroTermsNone Nothing Nothing Nothing Nothing Nothing Nothing
1469−
1470−data MultiMatchQueryType =
1471− MultiMatchBestFields
1472− | MultiMatchMostFields
1473− | MultiMatchCrossFields
1474− | MultiMatchPhrase
1475− | MultiMatchPhrasePrefix deriving (Eq, Read, Show, Generic, Typeable)
1476−
1477−data BoolQuery =
1478− BoolQuery { boolQueryMustMatch :: [Query]
1479− , boolQueryMustNotMatch :: [Query]
1480− , boolQueryShouldMatch :: [Query]
1481− , boolQueryMinimumShouldMatch :: Maybe MinimumMatch
1482− , boolQueryBoost :: Maybe Boost
1483− , boolQueryDisableCoord :: Maybe DisableCoord
1484− } deriving (Eq, Read, Show, Generic, Typeable)
1485−
1486−mkBoolQuery :: [Query] -> [Query] -> [Query] -> BoolQuery
1487−mkBoolQuery must mustNot should =
1488− BoolQuery must mustNot should Nothing Nothing Nothing
1489−
1490−data BoostingQuery =
1491− BoostingQuery { positiveQuery :: Query
1492− , negativeQuery :: Query
1493− , negativeBoost :: Boost } deriving (Eq, Read, Show, Generic, Typeable)
1494−
1495−data CommonTermsQuery =
1496− CommonTermsQuery { commonField :: FieldName
1497− , commonQuery :: QueryString
1498− , commonCutoffFrequency :: CutoffFrequency
1499− , commonLowFreqOperator :: BooleanOperator
1500− , commonHighFreqOperator :: BooleanOperator
1501− , commonMinimumShouldMatch :: Maybe CommonMinimumMatch
1502− , commonBoost :: Maybe Boost
1503− , commonAnalyzer :: Maybe Analyzer
1504− , commonDisableCoord :: Maybe DisableCoord
1505− } deriving (Eq, Read, Show, Generic, Typeable)
1506−
1507−data CommonMinimumMatch =
1508− CommonMinimumMatchHighLow MinimumMatchHighLow
1509− | CommonMinimumMatch MinimumMatch
1510− deriving (Eq, Read, Show, Generic, Typeable)
1511−
1512−data MinimumMatchHighLow =
1513− MinimumMatchHighLow { lowFreq :: MinimumMatch
1514− , highFreq :: MinimumMatch } deriving (Eq, Read, Show, Generic, Typeable)
1515−
1516−data Filter = AndFilter [Filter] Cache
1517− | OrFilter [Filter] Cache
1518− | NotFilter Filter Cache
1519− | IdentityFilter
1520− | BoolFilter BoolMatch
1521− | ExistsFilter FieldName -- always cached
1522− | GeoBoundingBoxFilter GeoBoundingBoxConstraint
1523− | GeoDistanceFilter GeoPoint Distance DistanceType OptimizeBbox Cache
1524− | GeoDistanceRangeFilter GeoPoint DistanceRange
1525− | GeoPolygonFilter FieldName [LatLon]
1526− | IdsFilter MappingName [DocId]
1527− | LimitFilter Int
1528− | MissingFilter FieldName Existence NullValue
1529− | PrefixFilter FieldName PrefixValue Cache
1530− | QueryFilter Query Cache
1531− | RangeFilter FieldName RangeValue RangeExecution Cache
1532− | RegexpFilter FieldName Regexp RegexpFlags CacheName Cache CacheKey
1533− | TermFilter Term Cache
1534− deriving (Eq, Read, Show, Generic, Typeable)
1535−
1536−data ZeroTermsQuery = ZeroTermsNone
1537− | ZeroTermsAll deriving (Eq, Read, Show, Generic, Typeable)
1538−
1539−data RangeExecution = RangeExecutionIndex
1540− | RangeExecutionFielddata deriving (Eq, Read, Show, Generic, Typeable)
1541−
1542−newtype Regexp = Regexp Text deriving (Eq, Read, Show, Generic, Typeable, FromJSON)
1543−
1544−data RegexpFlags = AllRegexpFlags
1545− | NoRegexpFlags
1546− | SomeRegexpFlags (NonEmpty RegexpFlag) deriving (Eq, Read, Show, Generic, Typeable)
1547−
1548−data RegexpFlag = AnyString
1549− | Automaton
1550− | Complement
1551− | Empty
1552− | Intersection
1553− | Interval deriving (Eq, Read, Show, Generic, Typeable)
1554−
1555−newtype LessThan = LessThan Double deriving (Eq, Read, Show, Generic, Typeable)
1556−newtype LessThanEq = LessThanEq Double deriving (Eq, Read, Show, Generic, Typeable)
1557−newtype GreaterThan = GreaterThan Double deriving (Eq, Read, Show, Generic, Typeable)
1558−newtype GreaterThanEq = GreaterThanEq Double deriving (Eq, Read, Show, Generic, Typeable)
1559−
1560−newtype LessThanD = LessThanD UTCTime deriving (Eq, Read, Show, Generic, Typeable)
1561−newtype LessThanEqD = LessThanEqD UTCTime deriving (Eq, Read, Show, Generic, Typeable)
1562−newtype GreaterThanD = GreaterThanD UTCTime deriving (Eq, Read, Show, Generic, Typeable)
1563−newtype GreaterThanEqD = GreaterThanEqD UTCTime deriving (Eq, Read, Show, Generic, Typeable)
1564−
1565−data RangeValue = RangeDateLte LessThanEqD
1566− | RangeDateLt LessThanD
1567− | RangeDateGte GreaterThanEqD
1568− | RangeDateGt GreaterThanD
1569− | RangeDateGtLt GreaterThanD LessThanD
1570− | RangeDateGteLte GreaterThanEqD LessThanEqD
1571− | RangeDateGteLt GreaterThanEqD LessThanD
1572− | RangeDateGtLte GreaterThanD LessThanEqD
1573− | RangeDoubleLte LessThanEq
1574− | RangeDoubleLt LessThan
1575− | RangeDoubleGte GreaterThanEq
1576− | RangeDoubleGt GreaterThan
1577− | RangeDoubleGtLt GreaterThan LessThan
1578− | RangeDoubleGteLte GreaterThanEq LessThanEq
1579− | RangeDoubleGteLt GreaterThanEq LessThan
1580− | RangeDoubleGtLte GreaterThan LessThanEq
1581− deriving (Eq, Read, Show, Generic, Typeable)
1582−
1583−rangeValueToPair :: RangeValue -> [Pair]
1584−rangeValueToPair rv = case rv of
1585− RangeDateLte (LessThanEqD t) -> ["lte" .= t]
1586− RangeDateGte (GreaterThanEqD t) -> ["gte" .= t]
1587− RangeDateLt (LessThanD t) -> ["lt" .= t]
1588− RangeDateGt (GreaterThanD t) -> ["gt" .= t]
1589− RangeDateGteLte (GreaterThanEqD l) (LessThanEqD g) -> ["gte" .= l, "lte" .= g]
1590− RangeDateGtLte (GreaterThanD l) (LessThanEqD g) -> ["gt" .= l, "lte" .= g]
1591− RangeDateGteLt (GreaterThanEqD l) (LessThanD g) -> ["gte" .= l, "lt" .= g]
1592− RangeDateGtLt (GreaterThanD l) (LessThanD g) -> ["gt" .= l, "lt" .= g]
1593− RangeDoubleLte (LessThanEq t) -> ["lte" .= t]
1594− RangeDoubleGte (GreaterThanEq t) -> ["gte" .= t]
1595− RangeDoubleLt (LessThan t) -> ["lt" .= t]
1596− RangeDoubleGt (GreaterThan t) -> ["gt" .= t]
1597− RangeDoubleGteLte (GreaterThanEq l) (LessThanEq g) -> ["gte" .= l, "lte" .= g]
1598− RangeDoubleGtLte (GreaterThan l) (LessThanEq g) -> ["gt" .= l, "lte" .= g]
1599− RangeDoubleGteLt (GreaterThanEq l) (LessThan g) -> ["gte" .= l, "lt" .= g]
1600− RangeDoubleGtLt (GreaterThan l) (LessThan g) -> ["gt" .= l, "lt" .= g]
1601−
1602−data Term = Term { termField :: Text
1603− , termValue :: Text } deriving (Eq, Read, Show, Generic, Typeable)
1604−
1605−data BoolMatch = MustMatch Term Cache
1606− | MustNotMatch Term Cache
1607− | ShouldMatch [Term] Cache deriving (Eq, Read, Show, Generic, Typeable)
1608−
1609−-- "memory" or "indexed"
1610−data GeoFilterType = GeoFilterMemory
1611− | GeoFilterIndexed deriving (Eq, Read, Show, Generic, Typeable)
1612−
1613−data LatLon = LatLon { lat :: Double
1614− , lon :: Double } deriving (Eq, Read, Show, Generic, Typeable)
1615−
1616−data GeoBoundingBox =
1617− GeoBoundingBox { topLeft :: LatLon
1618− , bottomRight :: LatLon } deriving (Eq, Read, Show, Generic, Typeable)
1619−
1620−data GeoBoundingBoxConstraint =
1621− GeoBoundingBoxConstraint { geoBBField :: FieldName
1622− , constraintBox :: GeoBoundingBox
1623− , bbConstraintcache :: Cache
1624− , geoType :: GeoFilterType
1625− } deriving (Eq, Read, Show, Generic, Typeable)
1626−
1627−data GeoPoint =
1628− GeoPoint { geoField :: FieldName
1629− , latLon :: LatLon} deriving (Eq, Read, Show, Generic, Typeable)
1630−
1631−data DistanceUnit = Miles
1632− | Yards
1633− | Feet
1634− | Inches
1635− | Kilometers
1636− | Meters
1637− | Centimeters
1638− | Millimeters
1639− | NauticalMiles deriving (Eq, Read, Show, Generic, Typeable)
1640−
1641−data DistanceType = Arc
1642− | SloppyArc -- doesn't exist <1.0
1643− | Plane deriving (Eq, Read, Show, Generic, Typeable)
1644−
1645−data OptimizeBbox = OptimizeGeoFilterType GeoFilterType
1646− | NoOptimizeBbox deriving (Eq, Read, Show, Generic, Typeable)
1647−
1648−data Distance =
1649− Distance { coefficient :: Double
1650− , unit :: DistanceUnit } deriving (Eq, Read, Show, Generic, Typeable)
1651−
1652−data DistanceRange =
1653− DistanceRange { distanceFrom :: Distance
1654− , distanceTo :: Distance } deriving (Eq, Read, Show, Generic, Typeable)
1655−
1656−type TemplateQueryKey = Text
1657−type TemplateQueryValue = Text
1658−
1659−newtype TemplateQueryKeyValuePairs = TemplateQueryKeyValuePairs (HM.HashMap TemplateQueryKey TemplateQueryValue)
1660− deriving (Eq, Read, Show, Generic, Typeable)
1661−
1662−instance ToJSON TemplateQueryKeyValuePairs where
1663− toJSON (TemplateQueryKeyValuePairs x) = Object $ HM.map toJSON x
1664−
1665−instance FromJSON TemplateQueryKeyValuePairs where
1666− parseJSON (Object o) = pure . TemplateQueryKeyValuePairs $ HM.mapMaybe getValue o
1667− where getValue (String x) = Just x
1668− getValue _ = Nothing
1669− parseJSON _ = fail "error parsing TemplateQueryKeyValuePairs"
1670−
1671−data TemplateQueryInline =
1672− TemplateQueryInline { inline :: Query
1673− , params :: TemplateQueryKeyValuePairs
1674− }
1675− deriving (Eq, Read, Show, Generic, Typeable)
1676−
1677−instance ToJSON TemplateQueryInline where
1678− toJSON TemplateQueryInline{..} = object [ "query" .= inline
1679− , "params" .= params
1680− ]
1681−
1682−instance FromJSON TemplateQueryInline where
1683− parseJSON = withObject "TemplateQueryInline" parse
1684− where parse o = TemplateQueryInline
1685− <$> o .: "query"
1686− <*> o .: "params"
1687−
1688−data SearchResult a =
1689− SearchResult { took :: Int
1690− , timedOut :: Bool
1691− , shards :: ShardResult
1692− , searchHits :: SearchHits a
1693− , aggregations :: Maybe AggregationResults
1694− , scrollId :: Maybe ScrollId
1695− , suggest :: Maybe NamedSuggestionResponse -- ^ Only one Suggestion request / response per Search is supported.
1696− }
1697− deriving (Eq, Read, Show, Generic, Typeable)
1698−
1699−newtype ScrollId = ScrollId Text deriving (Eq, Read, Show, Generic, Ord, ToJSON, FromJSON)
1700−
1701−type Score = Maybe Double
1702−
1703−data SearchHits a =
1704− SearchHits { hitsTotal :: Int
1705− , maxScore :: Score
1706− , hits :: [Hit a] } deriving (Eq, Read, Show, Generic, Typeable)
1707−
1708−instance Semigroup (SearchHits a) where
1709− (SearchHits ta ma ha) <> (SearchHits tb mb hb) = SearchHits (ta + tb) (max ma mb) (ha <> hb)
1710−
1711−instance Monoid (SearchHits a) where
1712− mempty = SearchHits 0 Nothing mempty
1713− mappend = (<>)
1714−
1715−data Hit a =
1716− Hit { hitIndex :: IndexName
1717− , hitType :: MappingName
1718− , hitDocId :: DocId
1719− , hitScore :: Score
1720− , hitSource :: Maybe a
1721− , hitHighlight :: Maybe HitHighlight } deriving (Eq, Read, Show, Generic, Typeable)
1722−
1723−data ShardResult =
1724− ShardResult { shardTotal :: Int
1725− , shardsSuccessful :: Int
1726− , shardsFailed :: Int } deriving (Eq, Read, Show, Generic, Typeable)
1727−
1728−type HitHighlight = M.Map Text [Text]
1729−
1730−showText :: Show a => a -> Text
1731−showText = T.pack . show
1732−
1733−readMay :: Read a => String -> Maybe a
1734−readMay s = case reads s of
1735− (a, ""):_ -> Just a
1736− _ -> Nothing
1737−
1738−parseReadText :: Read a => Text -> Parser a
1739−parseReadText = maybe mzero return . readMay . T.unpack
1740−
1741−type Aggregations = M.Map Text Aggregation
1742−
1743−emptyAggregations :: Aggregations
1744−emptyAggregations = M.empty
1745−
1746−mkAggregations :: Text -> Aggregation -> Aggregations
1747−mkAggregations name aggregation = M.insert name aggregation emptyAggregations
1748−
1749−data TermOrder = TermOrder{ termSortField :: Text
1750− , termSortOrder :: SortOrder } deriving (Eq, Read, Show, Generic, Typeable)
1751−
1752−data TermInclusion = TermInclusion Text
1753− | TermPattern Text Text deriving (Eq, Read, Show, Generic, Typeable)
1754−
1755−data CollectionMode = BreadthFirst
1756− | DepthFirst deriving (Eq, Read, Show, Generic, Typeable)
1757−
1758−data ExecutionHint = Ordinals
1759− | GlobalOrdinals
1760− | GlobalOrdinalsHash
1761− | GlobalOrdinalsLowCardinality
1762− | Map deriving (Eq, Read, Show, Generic, Typeable)
1763−
1764−data TimeInterval = Weeks
1765− | Days
1766− | Hours
1767− | Minutes
1768− | Seconds deriving Eq
1769−
1770−data Interval = Year
1771− | Quarter
1772− | Month
1773− | Week
1774− | Day
1775− | Hour
1776− | Minute
1777− | Second
1778− | FractionalInterval Float TimeInterval deriving (Eq, Read, Show, Generic, Typeable)
1779−
1780−data Aggregation = TermsAgg TermsAggregation
1781− | CardinalityAgg CardinalityAggregation
1782− | DateHistogramAgg DateHistogramAggregation
1783− | ValueCountAgg ValueCountAggregation
1784− | FilterAgg FilterAggregation
1785− | DateRangeAgg DateRangeAggregation
1786− | MissingAgg MissingAggregation
1787− | TopHitsAgg TopHitsAggregation
1788− deriving (Eq, Read, Show, Generic, Typeable)
1789−
1790−data TopHitsAggregation = TopHitsAggregation
1791− { taFrom :: Maybe From
1792− , taSize :: Maybe Size
1793− , taSort :: Maybe Sort
1794− } deriving (Eq, Read, Show)
1795−
1796−data MissingAggregation = MissingAggregation
1797− { maField :: Text
1798− } deriving (Eq, Read, Show, Generic, Typeable)
1799−
1800−data TermsAggregation = TermsAggregation { term :: Either Text Text
1801− , termInclude :: Maybe TermInclusion
1802− , termExclude :: Maybe TermInclusion
1803− , termOrder :: Maybe TermOrder
1804− , termMinDocCount :: Maybe Int
1805− , termSize :: Maybe Int
1806− , termShardSize :: Maybe Int
1807− , termCollectMode :: Maybe CollectionMode
1808− , termExecutionHint :: Maybe ExecutionHint
1809− , termAggs :: Maybe Aggregations
1810− } deriving (Eq, Read, Show, Generic, Typeable)
1811−
1812−data CardinalityAggregation = CardinalityAggregation { cardinalityField :: FieldName,
1813− precisionThreshold :: Maybe Int
1814− } deriving (Eq, Read, Show, Generic, Typeable)
1815−
1816−data DateHistogramAggregation = DateHistogramAggregation { dateField :: FieldName
1817− , dateInterval :: Interval
1818− , dateFormat :: Maybe Text
1819− -- pre and post deprecated in 1.5
1820− , datePreZone :: Maybe Text
1821− , datePostZone :: Maybe Text
1822− , datePreOffset :: Maybe Text
1823− , datePostOffset :: Maybe Text
1824− , dateAggs :: Maybe Aggregations
1825− } deriving (Eq, Read, Show, Generic, Typeable)
1826−
1827−
1828−data DateRangeAggregation = DateRangeAggregation { draField :: FieldName
1829− , draFormat :: Maybe Text
1830− , draRanges :: NonEmpty DateRangeAggRange
1831− } deriving (Eq, Read, Show, Generic, Typeable)
1832−
1833−data DateRangeAggRange = DateRangeFrom DateMathExpr
1834− | DateRangeTo DateMathExpr
1835− | DateRangeFromAndTo DateMathExpr DateMathExpr deriving (Eq, Read, Show, Generic, Typeable)
1836−
1837−-- | See <https://www.elastic.co/guide/en/elasticsearch/reference/current/common-options.html#date-math> for more information.
1838−data DateMathExpr = DateMathExpr DateMathAnchor [DateMathModifier] deriving (Eq, Read, Show, Generic, Typeable)
1839−
1840−
1841−-- | Starting point for a date range. This along with the 'DateMathModifiers' gets you the date ES will start from.
1842−data DateMathAnchor = DMNow
1843− | DMDate Day deriving (Eq, Read, Show, Generic, Typeable)
1844−
1845−data DateMathModifier = AddTime Int DateMathUnit
1846− | SubtractTime Int DateMathUnit
1847− | RoundDownTo DateMathUnit deriving (Eq, Read, Show, Generic, Typeable)
1848−
1849−data DateMathUnit = DMYear
1850− | DMMonth
1851− | DMWeek
1852− | DMDay
1853− | DMHour
1854− | DMMinute
1855− | DMSecond deriving (Eq, Read, Show, Generic, Typeable)
1856−
1857−-- | See <https://www.elastic.co/guide/en/elasticsearch/reference/current/search-aggregations-metrics-valuecount-aggregation.html> for more information.
1858−data ValueCountAggregation = FieldValueCount FieldName
1859− | ScriptValueCount Script deriving (Eq, Read, Show, Generic, Typeable)
1860−
1861−-- | 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.
1862−data FilterAggregation = FilterAggregation { faFilter :: Filter
1863− , faAggs :: Maybe Aggregations} deriving (Eq, Read, Show, Generic, Typeable)
1864−
1865−mkTermsAggregation :: Text -> TermsAggregation
1866−mkTermsAggregation t = TermsAggregation (Left t) Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing
1867−
1868−mkTermsScriptAggregation :: Text -> TermsAggregation
1869−mkTermsScriptAggregation t = TermsAggregation (Right t) Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing
1870−
1871−mkDateHistogram :: FieldName -> Interval -> DateHistogramAggregation
1872−mkDateHistogram t i = DateHistogramAggregation t i Nothing Nothing Nothing Nothing Nothing Nothing
1873−
1874−mkCardinalityAggregation :: FieldName -> CardinalityAggregation
1875−mkCardinalityAggregation t = CardinalityAggregation t Nothing
1876−
1877−instance ToJSON Version where
1878− toJSON Version {..} = object ["number" .= number
1879− ,"build_hash" .= build_hash
1880− ,"build_timestamp" .= build_timestamp
1881− ,"build_snapshot" .= build_snapshot
1882− ,"lucene_version" .= lucene_version]
1883−
1884−instance FromJSON Version where
1885− parseJSON = withObject "Version" parse
1886− where parse o = Version
1887− <$> o .: "number"
1888− <*> o .: "build_hash"
1889− <*> o .: "build_timestamp"
1890− <*> o .: "build_snapshot"
1891− <*> o .: "lucene_version"
1892−
1893−instance ToJSON VersionNumber where
1894− toJSON = toJSON . Vers.showVersion . versionNumber
1895−
1896−instance FromJSON VersionNumber where
1897− parseJSON = withText "VersionNumber" (parse . T.unpack)
1898− where
1899− parse s = case filter (null . snd)(RP.readP_to_S Vers.parseVersion s) of
1900− [(v, _)] -> pure (VersionNumber v)
1901− [] -> fail ("Invalid version string " ++ s)
1902− xs -> fail ("Ambiguous version string " ++ s ++ " (" ++ intercalate ", " (Vers.showVersion . fst <$> xs) ++ ")")
1903−
1904−instance ToJSON TermOrder where
1905− toJSON (TermOrder termSortField termSortOrder) = object [termSortField .= termSortOrder]
1906−
1907−instance ToJSON TermInclusion where
1908− toJSON (TermInclusion x) = toJSON x
1909− toJSON (TermPattern pattern flags) = omitNulls [ "pattern" .= pattern,
1910− "flags" .= flags]
1911−
1912−instance ToJSON CollectionMode where
1913− toJSON BreadthFirst = "breadth_first"
1914− toJSON DepthFirst = "depth_first"
1915−
1916−instance ToJSON ExecutionHint where
1917− toJSON Ordinals = "ordinals"
1918− toJSON GlobalOrdinals = "global_ordinals"
1919− toJSON GlobalOrdinalsHash = "global_ordinals_hash"
1920− toJSON GlobalOrdinalsLowCardinality = "global_ordinals_low_cardinality"
1921− toJSON Map = "map"
1922−
1923−instance ToJSON Interval where
1924− toJSON Year = "year"
1925− toJSON Quarter = "quarter"
1926− toJSON Month = "month"
1927− toJSON Week = "week"
1928− toJSON Day = "day"
1929− toJSON Hour = "hour"
1930− toJSON Minute = "minute"
1931− toJSON Second = "second"
1932− toJSON (FractionalInterval fraction interval) = toJSON $ show fraction ++ show interval
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−instance ToJSON DateRangeAggregation where
2003− toJSON DateRangeAggregation {..} =
2004− omitNulls [ "field" .= draField
2005− , "format" .= draFormat
2006− , "ranges" .= toList draRanges
2007− ]
2008−
2009−instance ToJSON DateRangeAggRange where
2010− toJSON (DateRangeFrom e) = object [ "from" .= e ]
2011− toJSON (DateRangeTo e) = object [ "to" .= e ]
2012− toJSON (DateRangeFromAndTo f t) = object [ "from" .= f, "to" .= t ]
2013−
2014−instance ToJSON DateMathExpr where
2015− toJSON (DateMathExpr a mods) = String (fmtA a <> mconcat (fmtMod <$> mods))
2016− where fmtA DMNow = "now"
2017− fmtA (DMDate date) = (T.pack $ showGregorian date) <> "||"
2018− fmtMod (AddTime n u) = "+" <> showText n <> fmtU u
2019− fmtMod (SubtractTime n u) = "-" <> showText n <> fmtU u
2020− fmtMod (RoundDownTo u) = "/" <> fmtU u
2021− fmtU DMYear = "y"
2022− fmtU DMMonth = "M"
2023− fmtU DMWeek = "w"
2024− fmtU DMDay = "d"
2025− fmtU DMHour = "h"
2026− fmtU DMMinute = "m"
2027− fmtU DMSecond = "s"
2028−
2029−
2030−type AggregationResults = M.Map Text Value
2031−
2032−class BucketAggregation a where
2033− key :: a -> BucketValue
2034− docCount :: a -> Int
2035− aggs :: a -> Maybe AggregationResults
2036−
2037−
2038−data Bucket a = Bucket { buckets :: [a]} deriving (Read, Show)
2039−
2040−data BucketValue = TextValue Text
2041− | ScientificValue Scientific
2042− | BoolValue Bool deriving (Read, Show)
2043−
2044−data MissingResult = MissingResult { missingDocCount :: Int } deriving (Show)
2045−
2046−data TopHitResult a = TopHitResult { tarHits :: (SearchHits a)
2047− } deriving Show
2048−
2049−data TermsResult = TermsResult { termKey :: BucketValue
2050− , termsDocCount :: Int
2051− , termsAggs :: Maybe AggregationResults } deriving (Read, Show)
2052−
2053−data DateHistogramResult = DateHistogramResult { dateKey :: Int
2054− , dateKeyStr :: Maybe Text
2055− , dateDocCount :: Int
2056− , dateHistogramAggs :: Maybe AggregationResults } deriving (Read, Show)
2057−
2058−data DateRangeResult = DateRangeResult { dateRangeKey :: Text
2059− , dateRangeFrom :: Maybe UTCTime
2060− , dateRangeFromAsString :: Maybe Text
2061− , dateRangeTo :: Maybe UTCTime
2062− , dateRangeToAsString :: Maybe Text
2063− , dateRangeDocCount :: Int
2064− , dateRangeAggs :: Maybe AggregationResults } deriving (Read, Show, Eq, Generic, Typeable)
2065−
2066−toTerms :: Text -> AggregationResults -> Maybe (Bucket TermsResult)
2067−toTerms = toAggResult
2068−
2069−toDateHistogram :: Text -> AggregationResults -> Maybe (Bucket DateHistogramResult)
2070−toDateHistogram = toAggResult
2071−
2072−toMissing :: Text -> AggregationResults -> Maybe MissingResult
2073−toMissing = toAggResult
2074−
2075−toTopHits :: (FromJSON a) => Text -> AggregationResults -> Maybe (TopHitResult a)
2076−toTopHits = toAggResult
2077−
2078−toAggResult :: (FromJSON a) => Text -> AggregationResults -> Maybe a
2079−toAggResult t a = M.lookup t a >>= deserialize
2080− where deserialize = parseMaybe parseJSON
2081−
2082−instance BucketAggregation TermsResult where
2083− key = termKey
2084− docCount = termsDocCount
2085− aggs = termsAggs
2086−
2087−instance BucketAggregation DateHistogramResult where
2088− key = TextValue . showText . dateKey
2089− docCount = dateDocCount
2090− aggs = dateHistogramAggs
2091−
2092−instance BucketAggregation DateRangeResult where
2093− key = TextValue . dateRangeKey
2094− docCount = dateRangeDocCount
2095− aggs = dateRangeAggs
2096−
2097−instance (FromJSON a) => FromJSON (Bucket a) where
2098− parseJSON (Object v) = Bucket <$>
2099− v .: "buckets"
2100− parseJSON _ = mempty
2101−
2102−instance FromJSON BucketValue where
2103− parseJSON (String t) = return $ TextValue t
2104− parseJSON (Number s) = return $ ScientificValue s
2105− parseJSON (Bool b) = return $ BoolValue b
2106− parseJSON _ = mempty
2107−
2108−instance FromJSON MissingResult where
2109− parseJSON = withObject "MissingResult" parse
2110− where parse v = MissingResult <$> v .: "doc_count"
2111−
2112−instance FromJSON TermsResult where
2113− parseJSON (Object v) = TermsResult <$>
2114− v .: "key" <*>
2115− v .: "doc_count" <*>
2116− (pure $ getNamedSubAgg v ["key", "doc_count"])
2117− parseJSON _ = mempty
2118−
2119−instance FromJSON DateHistogramResult where
2120− parseJSON (Object v) = DateHistogramResult <$>
2121− v .: "key" <*>
2122− v .:? "key_as_string" <*>
2123− v .: "doc_count" <*>
2124− (pure $ getNamedSubAgg v [ "key"
2125− , "doc_count"
2126− , "key_as_string"
2127− ]
2128− )
2129− parseJSON _ = mempty
2130−
2131−instance FromJSON DateRangeResult where
2132− parseJSON = withObject "DateRangeResult" parse
2133− where parse v = DateRangeResult <$>
2134− v .: "key" <*>
2135− (fmap posixMS <$> v .:? "from") <*>
2136− v .:? "from_as_string" <*>
2137− (fmap posixMS <$> v .:? "to") <*>
2138− v .:? "to_as_string" <*>
2139− v .: "doc_count" <*>
2140− (pure $ getNamedSubAgg v [ "key"
2141− , "from"
2142− , "from_as_string"
2143− , "to"
2144− , "to_as_string"
2145− , "doc_count"
2146− ]
2147− )
2148−
2149−instance FromJSON POSIXMS where
2150− parseJSON = withScientific "POSIXMS" (return . parse)
2151− where parse n = let n' = truncate n :: Integer
2152− in POSIXMS (posixSecondsToUTCTime (fromInteger (n' `div` 1000)))
2153−
2154−instance (FromJSON a) => FromJSON (TopHitResult a) where
2155− parseJSON (Object v) = TopHitResult <$>
2156− v .: "hits"
2157− parseJSON _ = fail "Failure in FromJSON (TopHitResult a)"
2158−
2159−instance Semigroup Filter where
2160− a <> b = AndFilter [a, b] defaultCache
2161−
2162−instance Monoid Filter where
2163− mempty = IdentityFilter
2164− mappend = (<>)
2165−
2166−instance Seminearring Filter where
2167− a <||> b = OrFilter [a, b] defaultCache
2168−
2169−instance ToJSON Filter where
2170− toJSON (AndFilter filters cache) =
2171− object ["and" .=
2172− object [ "filters" .= fmap toJSON filters
2173− , "_cache" .= cache]]
2174−
2175− toJSON (OrFilter filters cache) =
2176− object ["or" .=
2177− object [ "filters" .= fmap toJSON filters
2178− , "_cache" .= cache]]
2179−
2180− toJSON (NotFilter notFilter cache) =
2181− object ["not" .=
2182− object ["filter" .= notFilter
2183− , "_cache" .= cache]]
2184−
2185− toJSON (IdentityFilter) =
2186− object ["match_all" .= object []]
2187−
2188− toJSON (TermFilter (Term termFilterField termFilterValue) cache) =
2189− object ["term" .= object base]
2190− where base = [termFilterField .= termFilterValue,
2191− "_cache" .= cache]
2192−
2193− toJSON (ExistsFilter (FieldName fieldName)) =
2194− object ["exists" .= object
2195− ["field" .= fieldName]]
2196−
2197− toJSON (BoolFilter boolMatch) =
2198− object ["bool" .= boolMatch]
2199−
2200− toJSON (GeoBoundingBoxFilter bbConstraint) =
2201− object ["geo_bounding_box" .= bbConstraint]
2202−
2203− toJSON (GeoDistanceFilter (GeoPoint (FieldName distanceGeoField) geoDistLatLon)
2204− distance distanceType optimizeBbox cache) =
2205− object ["geo_distance" .=
2206− object ["distance" .= distance
2207− , "distance_type" .= distanceType
2208− , "optimize_bbox" .= optimizeBbox
2209− , distanceGeoField .= geoDistLatLon
2210− , "_cache" .= cache]]
2211−
2212− toJSON (GeoDistanceRangeFilter (GeoPoint (FieldName gddrField) drLatLon)
2213− (DistanceRange geoDistRangeDistFrom drDistanceTo)) =
2214− object ["geo_distance_range" .=
2215− object ["from" .= geoDistRangeDistFrom
2216− , "to" .= drDistanceTo
2217− , gddrField .= drLatLon]]
2218−
2219− toJSON (GeoPolygonFilter (FieldName geoPolygonFilterField) latLons) =
2220− object ["geo_polygon" .=
2221− object [geoPolygonFilterField .=
2222− object ["points" .= fmap toJSON latLons]]]
2223−
2224− toJSON (IdsFilter (MappingName mappingName) values) =
2225− object ["ids" .=
2226− object ["type" .= mappingName
2227− , "values" .= fmap unpackId values]]
2228−
2229− toJSON (LimitFilter limit) =
2230− object ["limit" .= object ["value" .= limit]]
2231−
2232− toJSON (MissingFilter (FieldName fieldName) (Existence existence) (NullValue nullValue)) =
2233− object ["missing" .=
2234− object [ "field" .= fieldName
2235− , "existence" .= existence
2236− , "null_value" .= nullValue]]
2237−
2238− toJSON (PrefixFilter (FieldName fieldName) fieldValue cache) =
2239− object ["prefix" .=
2240− object [fieldName .= fieldValue
2241− , "_cache" .= cache]]
2242−
2243− toJSON (QueryFilter query False) =
2244− object ["query" .= toJSON query ]
2245− toJSON (QueryFilter query True) =
2246− object ["fquery" .=
2247− object [ "query" .= toJSON query
2248− , "_cache" .= True ]]
2249−
2250− toJSON (RangeFilter (FieldName fieldName) rangeValue rangeExecution cache) =
2251− object ["range" .=
2252− object [ fieldName .= object (rangeValueToPair rangeValue)
2253− , "execution" .= rangeExecution
2254− , "_cache" .= cache]]
2255−
2256− toJSON (RegexpFilter (FieldName fieldName)
2257− (Regexp regexText) flags (CacheName cacheName) cache (CacheKey cacheKey)) =
2258− object ["regexp" .=
2259− object [fieldName .=
2260− object ["value" .= regexText
2261− , "flags" .= flags]
2262− , "_name" .= cacheName
2263− , "_cache" .= cache
2264− , "_cache_key" .= cacheKey]]
2265−
2266−instance FromJSON Filter where
2267− parseJSON = withObject "Filter" parse
2268− where parse o = andFilter `taggedWith` "and"
2269− <|> orFilter `taggedWith` "or"
2270− <|> notFilter `taggedWith` "not"
2271− <|> identityFilter `taggedWith` "match_all"
2272− <|> boolFilter `taggedWith` "bool"
2273− <|> existsFilter `taggedWith` "exists"
2274− <|> geoBoundingBoxFilter `taggedWith` "geo_bounding_box"
2275− <|> geoDistanceFilter `taggedWith` "geo_distance"
2276− <|> geoDistanceRangeFilter `taggedWith` "geo_distance_range"
2277− <|> geoPolygonFilter `taggedWith` "geo_polygon"
2278− <|> idsFilter `taggedWith` "ids"
2279− <|> limitFilter `taggedWith` "limit"
2280− <|> missingFilter `taggedWith` "missing"
2281− <|> prefixFilter `taggedWith` "prefix"
2282− <|> queryFilter `taggedWith` "query"
2283− <|> fqueryFilter `taggedWith` "fquery"
2284− <|> rangeFilter `taggedWith` "range"
2285− <|> regexpFilter `taggedWith` "regexp"
2286− <|> termFilter `taggedWith` "term"
2287− where taggedWith parser k = parser =<< o .: k
2288− andFilter o = AndFilter <$> o .: "filters"
2289− <*> o .:? "_cache" .!= defaultCache
2290− orFilter o = OrFilter <$> o .: "filters"
2291− <*> o .:? "_cache" .!= defaultCache
2292− notFilter o = NotFilter <$> o .: "filter"
2293− <*> o .: "_cache" .!= defaultCache
2294− identityFilter :: Object -> Parser Filter
2295− identityFilter m
2296− | HM.null m = pure IdentityFilter
2297− | otherwise = fail ("Identityfilter expected empty object but got " <> show m)
2298− boolFilter = pure . BoolFilter
2299− existsFilter o = ExistsFilter <$> o .: "field"
2300− geoBoundingBoxFilter = pure . GeoBoundingBoxFilter
2301− geoDistanceFilter o = do
2302− case HM.toList (deleteSeveral ["distance", "distance_type", "optimize_bbox", "_cache"] o) of
2303− [(fn, v)] -> do
2304− gp <- GeoPoint (FieldName fn) <$> parseJSON v
2305− GeoDistanceFilter gp <$> o .: "distance"
2306− <*> o .: "distance_type"
2307− <*> o .: "optimize_bbox"
2308− <*> o .:? "_cache" .!= defaultCache
2309− _ -> fail "Could not find GeoDistanceFilter field name"
2310− geoDistanceRangeFilter o = do
2311− case HM.toList (deleteSeveral ["from", "to"] o) of
2312− [(fn, v)] -> do
2313− gp <- GeoPoint (FieldName fn) <$> parseJSON v
2314− rng <- DistanceRange <$> o .: "from" <*> o .: "to"
2315− return (GeoDistanceRangeFilter gp rng)
2316− _ -> fail "Could not find GeoDistanceRangeFilter field name"
2317− geoPolygonFilter = fieldTagged $ \fn o -> GeoPolygonFilter fn <$> o .: "points"
2318− idsFilter o = IdsFilter <$> o .: "type"
2319− <*> o .: "values"
2320− limitFilter o = LimitFilter <$> o .: "value"
2321− missingFilter o = MissingFilter <$> o .: "field"
2322− <*> o .: "existence"
2323− <*> o .: "null_value"
2324− prefixFilter o = case HM.toList (HM.delete "_cache" o) of
2325− [(fn, String v)] -> PrefixFilter (FieldName fn) v <$> o .:? "_cache" .!= defaultCache
2326− _ -> fail "Could not parse PrefixFilter"
2327−
2328− queryFilter q = pure (QueryFilter q False)
2329− fqueryFilter o = QueryFilter <$> o .: "query" <*> pure True
2330− rangeFilter o = case HM.toList (deleteSeveral ["execution", "_cache"] o) of
2331− [(fn, v)] -> RangeFilter (FieldName fn)
2332− <$> parseJSON v
2333− <*> o .: "execution"
2334− <*> o .:? "_cache" .!= defaultCache
2335− _ -> fail "Could not find field name for RangeFilter"
2336− regexpFilter o = case HM.toList (deleteSeveral ["_name", "_cache", "_cache_key"] o) of
2337− [(fn, Object o')] -> RegexpFilter (FieldName fn)
2338− <$> o' .: "value"
2339− <*> o' .: "flags"
2340− <*> o .: "_name"
2341− <*> o .:? "_cache" .!= defaultCache
2342− <*> o .: "_cache_key"
2343− _ -> fail "Could not find field name for RegexpFilter"
2344− termFilter o = case HM.toList (HM.delete "_cache" o) of
2345− [(termField, String termVal)] -> TermFilter (Term termField termVal)
2346− <$> o .:? "_cache" .!= defaultCache
2347− _ -> fail "Could not find term field for TermFilter"
2348−
2349−fieldTagged :: Monad m => (FieldName -> Object -> m a) -> Object -> m a
2350−fieldTagged f o = case HM.toList o of
2351− [(k, Object o')] -> f (FieldName k) o'
2352− _ -> fail "Expected object with 1 field-named key"
2353−
2354−-- Try to get an AggregationResults when we don't know the
2355−-- field name. We filter out the known keys to try to minimize the noise.
2356−getNamedSubAgg :: Object -> [Text] -> Maybe AggregationResults
2357−getNamedSubAgg o knownKeys = maggRes
2358− where unknownKeys = HM.filterWithKey (\k _ -> k `notElem` knownKeys) o
2359− maggRes
2360− | HM.null unknownKeys = Nothing
2361− | otherwise = Just . M.fromList $ HM.toList unknownKeys
2362−
2363−instance ToJSON GeoPoint where
2364− toJSON (GeoPoint (FieldName geoPointField) geoPointLatLon) =
2365− object [ geoPointField .= geoPointLatLon ]
2366−
2367−
2368−instance ToJSON Query where
2369− toJSON (TermQuery (Term termQueryField termQueryValue) boost) =
2370− object [ "term" .=
2371− object [termQueryField .= object merged]]
2372− where
2373− base = [ "value" .= termQueryValue ]
2374− boosted = maybe [] (return . ("boost" .=)) boost
2375− merged = mappend base boosted
2376−
2377− toJSON (TermsQuery fieldName terms) =
2378− object [ "terms" .= object conjoined ]
2379− where conjoined = [fieldName .= terms]
2380−
2381− toJSON (IdsQuery idsQueryMappingName docIds) =
2382− object [ "ids" .= object conjoined ]
2383− where conjoined = [ "type" .= idsQueryMappingName
2384− , "values" .= fmap toJSON docIds ]
2385−
2386− toJSON (QueryQueryStringQuery qQueryStringQuery) =
2387− object [ "query_string" .= qQueryStringQuery ]
2388−
2389− toJSON (QueryMatchQuery matchQuery) =
2390− object [ "match" .= matchQuery ]
2391−
2392− toJSON (QueryMultiMatchQuery multiMatchQuery) =
2393− toJSON multiMatchQuery
2394−
2395− toJSON (QueryBoolQuery boolQuery) =
2396− object [ "bool" .= boolQuery ]
2397−
2398− toJSON (QueryBoostingQuery boostingQuery) =
2399− object [ "boosting" .= boostingQuery ]
2400−
2401− toJSON (QueryCommonTermsQuery commonTermsQuery) =
2402− object [ "common" .= commonTermsQuery ]
2403−
2404− toJSON (ConstantScoreFilter csFilter boost) =
2405− object ["constant_score" .= object ["filter" .= csFilter
2406− , "boost" .= boost]]
2407−
2408− toJSON (ConstantScoreQuery query boost) =
2409− object ["constant_score" .= object ["query" .= query
2410− , "boost" .= boost]]
2411−
2412− toJSON (QueryDisMaxQuery disMaxQuery) =
2413− object [ "dis_max" .= disMaxQuery ]
2414−
2415− toJSON (QueryFilteredQuery qFilteredQuery) =
2416− object [ "filtered" .= qFilteredQuery ]
2417−
2418− toJSON (QueryFuzzyLikeThisQuery fuzzyQuery) =
2419− object [ "fuzzy_like_this" .= fuzzyQuery ]
2420−
2421− toJSON (QueryFuzzyLikeFieldQuery fuzzyFieldQuery) =
2422− object [ "fuzzy_like_this_field" .= fuzzyFieldQuery ]
2423−
2424− toJSON (QueryFuzzyQuery fuzzyQuery) =
2425− object [ "fuzzy" .= fuzzyQuery ]
2426−
2427− toJSON (QueryHasChildQuery childQuery) =
2428− object [ "has_child" .= childQuery ]
2429−
2430− toJSON (QueryHasParentQuery parentQuery) =
2431− object [ "has_parent" .= parentQuery ]
2432−
2433− toJSON (QueryIndicesQuery qIndicesQuery) =
2434− object [ "indices" .= qIndicesQuery ]
2435−
2436− toJSON (MatchAllQuery boost) =
2437− object [ "match_all" .= omitNulls [ "boost" .= boost ] ]
2438−
2439− toJSON (QueryMoreLikeThisQuery query) =
2440− object [ "more_like_this" .= query ]
2441−
2442− toJSON (QueryMoreLikeThisFieldQuery query) =
2443− object [ "more_like_this_field" .= query ]
2444−
2445− toJSON (QueryNestedQuery query) =
2446− object [ "nested" .= query ]
2447−
2448− toJSON (QueryPrefixQuery query) =
2449− object [ "prefix" .= query ]
2450−
2451− toJSON (QueryRangeQuery query) =
2452− object [ "range" .= query ]
2453−
2454− toJSON (QueryRegexpQuery query) =
2455− object [ "regexp" .= query ]
2456−
2457− toJSON (QuerySimpleQueryStringQuery query) =
2458− object [ "simple_query_string" .= query ]
2459−
2460− toJSON (QueryTemplateQueryInline templateQuery) =
2461− object [ "template" .= templateQuery ]
2462−
2463−instance FromJSON Query where
2464− parseJSON v = withObject "Query" parse v
2465− where parse o = termQuery `taggedWith` "term"
2466− <|> termsQuery `taggedWith` "terms"
2467− <|> idsQuery `taggedWith` "ids"
2468− <|> queryQueryStringQuery `taggedWith` "query_string"
2469− <|> queryMatchQuery `taggedWith` "match"
2470− <|> queryMultiMatchQuery
2471− <|> queryBoolQuery `taggedWith` "bool"
2472− <|> queryBoostingQuery `taggedWith` "boosting"
2473− <|> queryCommonTermsQuery `taggedWith` "common"
2474− <|> constantScoreFilter `taggedWith` "constant_score"
2475− <|> constantScoreQuery `taggedWith` "constant_score"
2476− <|> queryDisMaxQuery `taggedWith` "dis_max"
2477− <|> queryFilteredQuery `taggedWith` "filtered"
2478− <|> queryFuzzyLikeThisQuery `taggedWith` "fuzzy_like_this"
2479− <|> queryFuzzyLikeFieldQuery `taggedWith` "fuzzy_like_this_field"
2480− <|> queryFuzzyQuery `taggedWith` "fuzzy"
2481− <|> queryHasChildQuery `taggedWith` "has_child"
2482− <|> queryHasParentQuery `taggedWith` "has_parent"
2483− <|> queryIndicesQuery `taggedWith` "indices"
2484− <|> matchAllQuery `taggedWith` "match_all"
2485− <|> queryMoreLikeThisQuery `taggedWith` "more_like_this"
2486− <|> queryMoreLikeThisFieldQuery `taggedWith` "more_like_this_field"
2487− <|> queryNestedQuery `taggedWith` "nested"
2488− <|> queryPrefixQuery `taggedWith` "prefix"
2489− <|> queryRangeQuery `taggedWith` "range"
2490− <|> queryRegexpQuery `taggedWith` "regexp"
2491− <|> querySimpleQueryStringQuery `taggedWith` "simple_query_string"
2492− <|> queryTemplateQueryInline `taggedWith` "template"
2493− where taggedWith parser k = parser =<< o .: k
2494− termQuery = fieldTagged $ \(FieldName fn) o ->
2495− TermQuery <$> (Term fn <$> o .: "value") <*> o .:? "boost"
2496− termsQuery o = case HM.toList o of
2497− [(fn, vs)] -> do vals <- parseJSON vs
2498− case vals of
2499− x:xs -> return (TermsQuery fn (x :| xs))
2500− _ -> fail "Expected non empty list of values"
2501− _ -> fail "Expected object with 1 field-named key"
2502− idsQuery o = IdsQuery <$> o .: "type"
2503− <*> o .: "values"
2504− queryQueryStringQuery = pure . QueryQueryStringQuery
2505− queryMatchQuery = pure . QueryMatchQuery
2506− queryMultiMatchQuery = QueryMultiMatchQuery <$> parseJSON v
2507− queryBoolQuery = pure . QueryBoolQuery
2508− queryBoostingQuery = pure . QueryBoostingQuery
2509− queryCommonTermsQuery = pure . QueryCommonTermsQuery
2510− constantScoreFilter o = case HM.lookup "filter" o of
2511− Just x -> ConstantScoreFilter <$> parseJSON x
2512− <*> o .: "boost"
2513− _ -> fail "Does not appear to be a ConstantScoreFilter"
2514− constantScoreQuery o = case HM.lookup "query" o of
2515− Just x -> ConstantScoreQuery <$> parseJSON x
2516− <*> o .: "boost"
2517− _ -> fail "Does not appear to be a ConstantScoreQuery"
2518− queryDisMaxQuery = pure . QueryDisMaxQuery
2519− queryFilteredQuery = pure . QueryFilteredQuery
2520− queryFuzzyLikeThisQuery = pure . QueryFuzzyLikeThisQuery
2521− queryFuzzyLikeFieldQuery = pure . QueryFuzzyLikeFieldQuery
2522− queryFuzzyQuery = pure . QueryFuzzyQuery
2523− queryHasChildQuery = pure . QueryHasChildQuery
2524− queryHasParentQuery = pure . QueryHasParentQuery
2525− queryIndicesQuery = pure . QueryIndicesQuery
2526− matchAllQuery o = MatchAllQuery <$> o .:? "boost"
2527− queryMoreLikeThisQuery = pure . QueryMoreLikeThisQuery
2528− queryMoreLikeThisFieldQuery = pure . QueryMoreLikeThisFieldQuery
2529− queryNestedQuery = pure . QueryNestedQuery
2530− queryPrefixQuery = pure . QueryPrefixQuery
2531− queryRangeQuery = pure . QueryRangeQuery
2532− queryRegexpQuery = pure . QueryRegexpQuery
2533− querySimpleQueryStringQuery = pure . QuerySimpleQueryStringQuery
2534− queryTemplateQueryInline = pure . QueryTemplateQueryInline
2535−
2536−
2537−omitNulls :: [(Text, Value)] -> Value
2538−omitNulls = object . filter notNull where
2539− notNull (_, Null) = False
2540− notNull (_, Array a) = (not . V.null) a
2541− notNull _ = True
2542−
2543−
2544−instance ToJSON SimpleQueryStringQuery where
2545− toJSON SimpleQueryStringQuery {..} =
2546− omitNulls (base ++ maybeAdd)
2547− where base = [ "query" .= simpleQueryStringQuery ]
2548− maybeAdd = [ "fields" .= simpleQueryStringField
2549− , "default_operator" .= simpleQueryStringOperator
2550− , "analyzer" .= simpleQueryStringAnalyzer
2551− , "flags" .= simpleQueryStringFlags
2552− , "lowercase_expanded_terms" .= simpleQueryStringLowercaseExpanded
2553− , "locale" .= simpleQueryStringLocale ]
2554−
2555−instance FromJSON SimpleQueryStringQuery where
2556− parseJSON = withObject "SimpleQueryStringQuery" parse
2557− where parse o = SimpleQueryStringQuery <$> o .: "query"
2558− <*> o .:? "fields"
2559− <*> o .:? "default_operator"
2560− <*> o .:? "analyzer"
2561− <*> (parseFlags <$> o .:? "flags")
2562− <*> o .:? "lowercase_expanded_terms"
2563− <*> o .:? "locale"
2564− parseFlags (Just (x:xs)) = Just (x :| xs)
2565− parseFlags _ = Nothing
2566−
2567−instance ToJSON FieldOrFields where
2568− toJSON (FofField fieldName) =
2569− toJSON fieldName
2570− toJSON (FofFields fieldNames) =
2571− toJSON fieldNames
2572−
2573−instance FromJSON FieldOrFields where
2574− parseJSON v = FofField <$> parseJSON v
2575− <|> FofFields <$> (parseNEJSON =<< parseJSON v)
2576−
2577−instance ToJSON SimpleQueryFlag where
2578− toJSON SimpleQueryAll = "ALL"
2579− toJSON SimpleQueryNone = "NONE"
2580− toJSON SimpleQueryAnd = "AND"
2581− toJSON SimpleQueryOr = "OR"
2582− toJSON SimpleQueryPrefix = "PREFIX"
2583− toJSON SimpleQueryPhrase = "PHRASE"
2584− toJSON SimpleQueryPrecedence = "PRECEDENCE"
2585− toJSON SimpleQueryEscape = "ESCAPE"
2586− toJSON SimpleQueryWhitespace = "WHITESPACE"
2587− toJSON SimpleQueryFuzzy = "FUZZY"
2588− toJSON SimpleQueryNear = "NEAR"
2589− toJSON SimpleQuerySlop = "SLOP"
2590−
2591−instance FromJSON SimpleQueryFlag where
2592− parseJSON = withText "SimpleQueryFlag" parse
2593− where parse "ALL" = pure SimpleQueryAll
2594− parse "NONE" = pure SimpleQueryNone
2595− parse "AND" = pure SimpleQueryAnd
2596− parse "OR" = pure SimpleQueryOr
2597− parse "PREFIX" = pure SimpleQueryPrefix
2598− parse "PHRASE" = pure SimpleQueryPhrase
2599− parse "PRECEDENCE" = pure SimpleQueryPrecedence
2600− parse "ESCAPE" = pure SimpleQueryEscape
2601− parse "WHITESPACE" = pure SimpleQueryWhitespace
2602− parse "FUZZY" = pure SimpleQueryFuzzy
2603− parse "NEAR" = pure SimpleQueryNear
2604− parse "SLOP" = pure SimpleQuerySlop
2605− parse f = fail ("Unexpected SimpleQueryFlag: " <> show f)
2606−
2607−instance ToJSON RegexpQuery where
2608− toJSON (RegexpQuery (FieldName rqQueryField)
2609− (Regexp regexpQueryQuery) rqQueryFlags
2610− rqQueryBoost) =
2611− object [ rqQueryField .= omitNulls base ]
2612− where base = [ "value" .= regexpQueryQuery
2613− , "flags" .= rqQueryFlags
2614− , "boost" .= rqQueryBoost ]
2615−
2616−instance FromJSON RegexpQuery where
2617− parseJSON = withObject "RegexpQuery" parse
2618− where parse = fieldTagged $ \fn o ->
2619− RegexpQuery fn
2620− <$> o .: "value"
2621− <*> o .: "flags"
2622− <*> o .:? "boost"
2623−
2624−instance ToJSON QueryStringQuery where
2625− toJSON (QueryStringQuery qsQueryString
2626− qsDefaultField qsOperator
2627− qsAnalyzer qsAllowWildcard
2628− qsLowercaseExpanded qsEnablePositionIncrements
2629− qsFuzzyMaxExpansions qsFuzziness
2630− qsFuzzyPrefixLength qsPhraseSlop
2631− qsBoost qsAnalyzeWildcard
2632− qsGeneratePhraseQueries qsMinimumShouldMatch
2633− qsLenient qsLocale) =
2634− omitNulls base
2635− where
2636− base = [ "query" .= qsQueryString
2637− , "default_field" .= qsDefaultField
2638− , "default_operator" .= qsOperator
2639− , "analyzer" .= qsAnalyzer
2640− , "allow_leading_wildcard" .= qsAllowWildcard
2641− , "lowercase_expanded_terms" .= qsLowercaseExpanded
2642− , "enable_position_increments" .= qsEnablePositionIncrements
2643− , "fuzzy_max_expansions" .= qsFuzzyMaxExpansions
2644− , "fuzziness" .= qsFuzziness
2645− , "fuzzy_prefix_length" .= qsFuzzyPrefixLength
2646− , "phrase_slop" .= qsPhraseSlop
2647− , "boost" .= qsBoost
2648− , "analyze_wildcard" .= qsAnalyzeWildcard
2649− , "auto_generate_phrase_queries" .= qsGeneratePhraseQueries
2650− , "minimum_should_match" .= qsMinimumShouldMatch
2651− , "lenient" .= qsLenient
2652− , "locale" .= qsLocale ]
2653−
2654−instance FromJSON QueryStringQuery where
2655− parseJSON = withObject "QueryStringQuery" parse
2656− where parse o = QueryStringQuery
2657− <$> o .: "query"
2658− <*> o .:? "default_field"
2659− <*> o .:? "default_operator"
2660− <*> o .:? "analyzer"
2661− <*> o .:? "allow_leading_wildcard"
2662− <*> o .:? "lowercase_expanded_terms"
2663− <*> o .:? "enable_position_increments"
2664− <*> o .:? "fuzzy_max_expansions"
2665− <*> o .:? "fuzziness"
2666− <*> o .:? "fuzzy_prefix_length"
2667− <*> o .:? "phrase_slop"
2668− <*> o .:? "boost"
2669− <*> o .:? "analyze_wildcard"
2670− <*> o .:? "auto_generate_phrase_queries"
2671− <*> o .:? "minimum_should_match"
2672− <*> o .:? "lenient"
2673− <*> o .:? "locale"
2674−
2675−instance ToJSON RangeQuery where
2676− toJSON (RangeQuery (FieldName fieldName) range boost) =
2677− object [ fieldName .= object conjoined ]
2678− where conjoined = [ "boost" .= boost ] ++ (rangeValueToPair range)
2679−
2680−instance FromJSON RangeQuery where
2681− parseJSON = withObject "RangeQuery" parse
2682− where parse = fieldTagged $ \fn o ->
2683− RangeQuery fn
2684− <$> parseJSON (Object o)
2685− <*> o .: "boost"
2686−
2687−instance FromJSON RangeValue where
2688− parseJSON = withObject "RangeValue" parse
2689− where parse o = parseDate o
2690− <|> parseDouble o
2691− parseDate o = do lt <- o .:? "lt"
2692− lte <- o .:? "lte"
2693− gt <- o .:? "gt"
2694− gte <- o .:? "gte"
2695− case (lt, lte, gt, gte) of
2696− (Just a, _, Just b, _) -> return (RangeDateGtLt (GreaterThanD b) (LessThanD a))
2697− (Just a, _, _, Just b)-> return (RangeDateGteLt (GreaterThanEqD b) (LessThanD a))
2698− (_, Just a, Just b, _)-> return (RangeDateGtLte (GreaterThanD b) (LessThanEqD a))
2699− (_, Just a, _, Just b)-> return (RangeDateGteLte (GreaterThanEqD b) (LessThanEqD a))
2700− (_, _, Just a, _)-> return (RangeDateGt (GreaterThanD a))
2701− (Just a, _, _, _)-> return (RangeDateLt (LessThanD a))
2702− (_, _, _, Just a)-> return (RangeDateGte (GreaterThanEqD a))
2703− (_, Just a, _, _)-> return (RangeDateLte (LessThanEqD a))
2704− (Nothing, Nothing, Nothing, Nothing) -> mzero
2705− parseDouble o = do lt <- o .:? "lt"
2706− lte <- o .:? "lte"
2707− gt <- o .:? "gt"
2708− gte <- o .:? "gte"
2709− case (lt, lte, gt, gte) of
2710− (Just a, _, Just b, _) -> return (RangeDoubleGtLt (GreaterThan b) (LessThan a))
2711− (Just a, _, _, Just b)-> return (RangeDoubleGteLt (GreaterThanEq b) (LessThan a))
2712− (_, Just a, Just b, _)-> return (RangeDoubleGtLte (GreaterThan b) (LessThanEq a))
2713− (_, Just a, _, Just b)-> return (RangeDoubleGteLte (GreaterThanEq b) (LessThanEq a))
2714− (_, _, Just a, _)-> return (RangeDoubleGt (GreaterThan a))
2715− (Just a, _, _, _)-> return (RangeDoubleLt (LessThan a))
2716− (_, _, _, Just a)-> return (RangeDoubleGte (GreaterThanEq a))
2717− (_, Just a, _, _)-> return (RangeDoubleLte (LessThanEq a))
2718− (Nothing, Nothing, Nothing, Nothing) -> mzero
2719−
2720−instance ToJSON PrefixQuery where
2721− toJSON (PrefixQuery (FieldName fieldName) queryValue boost) =
2722− object [ fieldName .= omitNulls base ]
2723− where base = [ "value" .= queryValue
2724− , "boost" .= boost ]
2725−
2726−instance FromJSON PrefixQuery where
2727− parseJSON = withObject "PrefixQuery" parse
2728− where parse = fieldTagged $ \fn o ->
2729− PrefixQuery fn
2730− <$> o .: "value"
2731− <*> o .:? "boost"
2732−
2733−instance ToJSON NestedQuery where
2734− toJSON (NestedQuery nqPath nqScoreType nqQuery) =
2735− object [ "path" .= nqPath
2736− , "score_mode" .= nqScoreType
2737− , "query" .= nqQuery ]
2738−
2739−instance FromJSON NestedQuery where
2740− parseJSON = withObject "NestedQuery" parse
2741− where parse o = NestedQuery
2742− <$> o .: "path"
2743− <*> o .: "score_mode"
2744− <*> o .: "query"
2745−
2746−instance ToJSON MoreLikeThisFieldQuery where
2747− toJSON (MoreLikeThisFieldQuery text (FieldName fieldName)
2748− percent mtf mqt stopwords mindf maxdf
2749− minwl maxwl boostTerms boost analyzer) =
2750− object [ fieldName .= omitNulls base ]
2751− where base = [ "like_text" .= text
2752− , "percent_terms_to_match" .= percent
2753− , "min_term_freq" .= mtf
2754− , "max_query_terms" .= mqt
2755− , "stop_words" .= stopwords
2756− , "min_doc_freq" .= mindf
2757− , "max_doc_freq" .= maxdf
2758− , "min_word_length" .= minwl
2759− , "max_word_length" .= maxwl
2760− , "boost_terms" .= boostTerms
2761− , "boost" .= boost
2762− , "analyzer" .= analyzer ]
2763−
2764−instance FromJSON MoreLikeThisFieldQuery where
2765− parseJSON = withObject "MoreLikeThisFieldQuery" parse
2766− where parse = fieldTagged $ \fn o ->
2767− MoreLikeThisFieldQuery
2768− <$> o .: "like_text"
2769− <*> pure fn
2770− <*> o .:? "percent_terms_to_match"
2771− <*> o .:? "min_term_freq"
2772− <*> o .:? "max_query_terms"
2773− -- <*> (optionalNE =<< o .:? "stop_words")
2774− <*> o .:? "stop_words"
2775− <*> o .:? "min_doc_freq"
2776− <*> o .:? "max_doc_freq"
2777− <*> o .:? "min_word_length"
2778− <*> o .:? "max_word_length"
2779− <*> o .:? "boost_terms"
2780− <*> o .:? "boost"
2781− <*> o .:? "analyzer"
2782− -- optionalNE = maybe (pure Nothing) (fmap Just . parseNEJSON)
2783−
2784−instance ToJSON MoreLikeThisQuery where
2785− toJSON (MoreLikeThisQuery text fields percent
2786− mtf mqt stopwords mindf maxdf
2787− minwl maxwl boostTerms boost analyzer) =
2788− omitNulls base
2789− where base = [ "like_text" .= text
2790− , "fields" .= fields
2791− , "percent_terms_to_match" .= percent
2792− , "min_term_freq" .= mtf
2793− , "max_query_terms" .= mqt
2794− , "stop_words" .= stopwords
2795− , "min_doc_freq" .= mindf
2796− , "max_doc_freq" .= maxdf
2797− , "min_word_length" .= minwl
2798− , "max_word_length" .= maxwl
2799− , "boost_terms" .= boostTerms
2800− , "boost" .= boost
2801− , "analyzer" .= analyzer ]
2802−
2803−instance FromJSON MoreLikeThisQuery where
2804− parseJSON = withObject "MoreLikeThisQuery" parse
2805− where parse o = MoreLikeThisQuery
2806− <$> o .: "like_text"
2807− -- <*> (optionalNE =<< o .:? "fields")
2808− <*> o .:? "fields"
2809− <*> o .:? "percent_terms_to_match"
2810− <*> o .:? "min_term_freq"
2811− <*> o .:? "max_query_terms"
2812− -- <*> (optionalNE =<< o .:? "stop_words")
2813− <*> o .:? "stop_words"
2814− <*> o .:? "min_doc_freq"
2815− <*> o .:? "max_doc_freq"
2816− <*> o .:? "min_word_length"
2817− <*> o .:? "max_word_length"
2818− <*> o .:? "boost_terms"
2819− <*> o .:? "boost"
2820− <*> o .:? "analyzer"
2821− -- optionalNE = maybe (pure Nothing) (fmap Just . parseNEJSON)
2822−
2823−instance ToJSON IndicesQuery where
2824− toJSON (IndicesQuery indices query noMatch) =
2825− omitNulls [ "indices" .= indices
2826− , "no_match_query" .= noMatch
2827− , "query" .= query ]
2828−
2829−instance FromJSON IndicesQuery where
2830− parseJSON = withObject "IndicesQuery" parse
2831− where parse o = IndicesQuery
2832− <$> o .:? "indices" .!= []
2833− <*> o .: "query"
2834− <*> o .:? "no_match_query"
2835−
2836−instance ToJSON HasParentQuery where
2837− toJSON (HasParentQuery queryType query scoreType) =
2838− omitNulls [ "parent_type" .= queryType
2839− , "score_type" .= scoreType
2840− , "query" .= query ]
2841−
2842−instance FromJSON HasParentQuery where
2843− parseJSON = withObject "HasParentQuery" parse
2844− where parse o = HasParentQuery
2845− <$> o .: "parent_type"
2846− <*> o .: "query"
2847− <*> o .:? "score_type"
2848−
2849−instance ToJSON HasChildQuery where
2850− toJSON (HasChildQuery queryType query scoreType) =
2851− omitNulls [ "query" .= query
2852− , "score_type" .= scoreType
2853− , "type" .= queryType ]
2854−
2855−instance FromJSON HasChildQuery where
2856− parseJSON = withObject "HasChildQuery" parse
2857− where parse o = HasChildQuery
2858− <$> o .: "type"
2859− <*> o .: "query"
2860− <*> o .:? "score_type"
2861−
2862−instance ToJSON FuzzyQuery where
2863− toJSON (FuzzyQuery (FieldName fieldName) queryText
2864− prefixLength maxEx fuzziness boost) =
2865− object [ fieldName .= omitNulls base ]
2866− where base = [ "value" .= queryText
2867− , "fuzziness" .= fuzziness
2868− , "prefix_length" .= prefixLength
2869− , "boost" .= boost
2870− , "max_expansions" .= maxEx ]
2871−
2872−instance FromJSON FuzzyQuery where
2873− parseJSON = withObject "FuzzyQuery" parse
2874− where parse = fieldTagged $ \fn o ->
2875− FuzzyQuery fn
2876− <$> o .: "value"
2877− <*> o .: "prefix_length"
2878− <*> o .: "max_expansions"
2879− <*> o .: "fuzziness"
2880− <*> o .:? "boost"
2881−
2882−instance ToJSON FuzzyLikeFieldQuery where
2883− toJSON (FuzzyLikeFieldQuery (FieldName fieldName)
2884− fieldText maxTerms ignoreFreq fuzziness prefixLength
2885− boost analyzer) =
2886− object [ fieldName .=
2887− omitNulls [ "like_text" .= fieldText
2888− , "max_query_terms" .= maxTerms
2889− , "ignore_tf" .= ignoreFreq
2890− , "fuzziness" .= fuzziness
2891− , "prefix_length" .= prefixLength
2892− , "analyzer" .= analyzer
2893− , "boost" .= boost ]]
2894−
2895−instance FromJSON FuzzyLikeFieldQuery where
2896− parseJSON = withObject "FuzzyLikeFieldQuery" parse
2897− where parse = fieldTagged $ \fn o ->
2898− FuzzyLikeFieldQuery fn
2899− <$> o .: "like_text"
2900− <*> o .: "max_query_terms"
2901− <*> o .: "ignore_tf"
2902− <*> o .: "fuzziness"
2903− <*> o .: "prefix_length"
2904− <*> o .: "boost"
2905− <*> o .:? "analyzer"
2906−
2907−instance ToJSON FuzzyLikeThisQuery where
2908− toJSON (FuzzyLikeThisQuery fields text maxTerms
2909− ignoreFreq fuzziness prefixLength boost analyzer) =
2910− omitNulls base
2911− where base = [ "fields" .= fields
2912− , "like_text" .= text
2913− , "max_query_terms" .= maxTerms
2914− , "ignore_tf" .= ignoreFreq
2915− , "fuzziness" .= fuzziness
2916− , "prefix_length" .= prefixLength
2917− , "analyzer" .= analyzer
2918− , "boost" .= boost ]
2919−
2920−instance FromJSON FuzzyLikeThisQuery where
2921− parseJSON = withObject "FuzzyLikeThisQuery" parse
2922− where parse o = FuzzyLikeThisQuery
2923− <$> o .:? "fields" .!= []
2924− <*> o .: "like_text"
2925− <*> o .: "max_query_terms"
2926− <*> o .: "ignore_tf"
2927− <*> o .: "fuzziness"
2928− <*> o .: "prefix_length"
2929− <*> o .: "boost"
2930− <*> o .:? "analyzer"
2931−
2932−instance ToJSON FilteredQuery where
2933− toJSON (FilteredQuery query fFilter) =
2934− object [ "query" .= query
2935− , "filter" .= fFilter ]
2936−
2937−instance FromJSON FilteredQuery where
2938− parseJSON = withObject "FilteredQuery" parse
2939− where parse o = FilteredQuery
2940− <$> o .: "query"
2941− <*> o .: "filter"
2942−
2943−instance ToJSON DisMaxQuery where
2944− toJSON (DisMaxQuery queries tiebreaker boost) =
2945− omitNulls base
2946− where base = [ "queries" .= queries
2947− , "boost" .= boost
2948− , "tie_breaker" .= tiebreaker ]
2949−
2950−instance FromJSON DisMaxQuery where
2951− parseJSON = withObject "DisMaxQuery" parse
2952− where parse o = DisMaxQuery
2953− <$> o .:? "queries" .!= []
2954− <*> o .: "tie_breaker"
2955− <*> o .:? "boost"
2956−
2957−instance ToJSON CommonTermsQuery where
2958− toJSON (CommonTermsQuery (FieldName fieldName)
2959− (QueryString query) cf lfo hfo msm
2960− boost analyzer disableCoord) =
2961− object [fieldName .= omitNulls base ]
2962− where base = [ "query" .= query
2963− , "cutoff_frequency" .= cf
2964− , "low_freq_operator" .= lfo
2965− , "minimum_should_match" .= msm
2966− , "boost" .= boost
2967− , "analyzer" .= analyzer
2968− , "disable_coord" .= disableCoord
2969− , "high_freq_operator" .= hfo ]
2970−
2971−instance FromJSON CommonTermsQuery where
2972− parseJSON = withObject "CommonTermsQuery" parse
2973− where parse = fieldTagged $ \fn o ->
2974− CommonTermsQuery fn
2975− <$> o .: "query"
2976− <*> o .: "cutoff_frequency"
2977− <*> o .: "low_freq_operator"
2978− <*> o .: "high_freq_operator"
2979− <*> o .:? "minimum_should_match"
2980− <*> o .:? "boost"
2981− <*> o .:? "analyzer"
2982− <*> o .:? "disable_coord"
2983−
2984−instance ToJSON CommonMinimumMatch where
2985− toJSON (CommonMinimumMatch mm) = toJSON mm
2986− toJSON (CommonMinimumMatchHighLow (MinimumMatchHighLow lowF highF)) =
2987− object [ "low_freq" .= lowF
2988− , "high_freq" .= highF ]
2989−
2990−instance FromJSON CommonMinimumMatch where
2991− parseJSON v = parseMinimum v
2992− <|> parseMinimumHighLow v
2993− where parseMinimum = fmap CommonMinimumMatch . parseJSON
2994− parseMinimumHighLow = fmap CommonMinimumMatchHighLow . withObject "CommonMinimumMatchHighLow" (\o ->
2995− MinimumMatchHighLow
2996− <$> o .: "low_freq"
2997− <*> o .: "high_freq")
2998−
2999−
3000−instance ToJSON BoostingQuery where
3001− toJSON (BoostingQuery bqPositiveQuery bqNegativeQuery bqNegativeBoost) =
3002− object [ "positive" .= bqPositiveQuery
3003− , "negative" .= bqNegativeQuery
3004− , "negative_boost" .= bqNegativeBoost ]
3005−
3006−instance FromJSON BoostingQuery where
3007− parseJSON = withObject "BoostingQuery" parse
3008− where parse o = BoostingQuery
3009− <$> o .: "positive"
3010− <*> o .: "negative"
3011− <*> o .: "negative_boost"
3012−
3013−instance ToJSON BoolQuery where
3014− toJSON (BoolQuery mustM notM shouldM bqMin boost disableCoord) =
3015− omitNulls base
3016− where base = [ "must" .= mustM
3017− , "must_not" .= notM
3018− , "should" .= shouldM
3019− , "minimum_should_match" .= bqMin
3020− , "boost" .= boost
3021− , "disable_coord" .= disableCoord ]
3022−
3023−instance FromJSON BoolQuery where
3024− parseJSON = withObject "BoolQuery" parse
3025− where parse o = BoolQuery
3026− <$> o .:? "must" .!= []
3027− <*> o .:? "must_not" .!= []
3028− <*> o .:? "should" .!= []
3029− <*> o .:? "minimum_should_match"
3030− <*> o .:? "boost"
3031− <*> o .:? "disable_coord"
3032−
3033−instance ToJSON MatchQuery where
3034− toJSON (MatchQuery (FieldName fieldName)
3035− (QueryString mqQueryString) booleanOperator
3036− zeroTermsQuery cutoffFrequency matchQueryType
3037− analyzer maxExpansions lenient boost) =
3038− object [ fieldName .= omitNulls base ]
3039− where base = [ "query" .= mqQueryString
3040− , "operator" .= booleanOperator
3041− , "zero_terms_query" .= zeroTermsQuery
3042− , "cutoff_frequency" .= cutoffFrequency
3043− , "type" .= matchQueryType
3044− , "analyzer" .= analyzer
3045− , "max_expansions" .= maxExpansions
3046− , "lenient" .= lenient
3047− , "boost" .= boost ]
3048−
3049−instance FromJSON MatchQuery where
3050− parseJSON = withObject "MatchQuery" parse
3051− where parse = fieldTagged $ \fn o ->
3052− MatchQuery fn
3053− <$> o .: "query"
3054− <*> o .: "operator"
3055− <*> o .: "zero_terms_query"
3056− <*> o .:? "cutoff_frequency"
3057− <*> o .:? "type"
3058− <*> o .:? "analyzer"
3059− <*> o .:? "max_expansions"
3060− <*> o .:? "lenient"
3061− <*> o .:? "boost"
3062−
3063−instance ToJSON MultiMatchQuery where
3064− toJSON (MultiMatchQuery fields (QueryString query) boolOp
3065− ztQ tb mmqt cf analyzer maxEx lenient) =
3066− object ["multi_match" .= omitNulls base]
3067− where base = [ "fields" .= fmap toJSON fields
3068− , "query" .= query
3069− , "operator" .= boolOp
3070− , "zero_terms_query" .= ztQ
3071− , "tie_breaker" .= tb
3072− , "type" .= mmqt
3073− , "cutoff_frequency" .= cf
3074− , "analyzer" .= analyzer
3075− , "max_expansions" .= maxEx
3076− , "lenient" .= lenient ]
3077−
3078−instance FromJSON MultiMatchQuery where
3079− parseJSON = withObject "MultiMatchQuery" parse
3080− where parse raw = do o <- raw .: "multi_match"
3081− MultiMatchQuery
3082− <$> o .:? "fields" .!= []
3083− <*> o .: "query"
3084− <*> o .: "operator"
3085− <*> o .: "zero_terms_query"
3086− <*> o .:? "tie_breaker"
3087− <*> o .:? "type"
3088− <*> o .:? "cutoff_frequency"
3089− <*> o .:? "analyzer"
3090− <*> o .:? "max_expansions"
3091− <*> o .:? "lenient"
3092−
3093−instance ToJSON MultiMatchQueryType where
3094− toJSON MultiMatchBestFields = "best_fields"
3095− toJSON MultiMatchMostFields = "most_fields"
3096− toJSON MultiMatchCrossFields = "cross_fields"
3097− toJSON MultiMatchPhrase = "phrase"
3098− toJSON MultiMatchPhrasePrefix = "phrase_prefix"
3099−
3100−instance FromJSON MultiMatchQueryType where
3101− parseJSON = withText "MultiMatchPhrasePrefix" parse
3102− where parse "best_fields" = pure MultiMatchBestFields
3103− parse "most_fields" = pure MultiMatchMostFields
3104− parse "cross_fields" = pure MultiMatchCrossFields
3105− parse "phrase" = pure MultiMatchPhrase
3106− parse "phrase_prefix" = pure MultiMatchPhrasePrefix
3107− parse t = fail ("Unexpected MultiMatchPhrasePrefix: " <> show t)
3108−
3109−instance ToJSON BooleanOperator where
3110− toJSON And = String "and"
3111− toJSON Or = String "or"
3112−
3113−instance FromJSON BooleanOperator where
3114− parseJSON = withText "BooleanOperator" parse
3115− where parse "and" = pure And
3116− parse "or" = pure Or
3117− parse o = fail ("Unexpected BooleanOperator: " <> show o)
3118−
3119−instance ToJSON ZeroTermsQuery where
3120− toJSON ZeroTermsNone = String "none"
3121− toJSON ZeroTermsAll = String "all"
3122−
3123−instance FromJSON ZeroTermsQuery where
3124− parseJSON = withText "ZeroTermsQuery" parse
3125− where parse "none" = pure ZeroTermsNone
3126− parse "all" = pure ZeroTermsAll
3127− parse q = fail ("Unexpected ZeroTermsQuery: " <> show q)
3128−
3129−instance ToJSON MatchQueryType where
3130− toJSON MatchPhrase = "phrase"
3131− toJSON MatchPhrasePrefix = "phrase_prefix"
3132−
3133−instance FromJSON MatchQueryType where
3134− parseJSON = withText "MatchQueryType" parse
3135− where parse "phrase" = pure MatchPhrase
3136− parse "phrase_prefix" = pure MatchPhrasePrefix
3137− parse t = fail ("Unexpected MatchQueryType: " <> show t)
3138−
3139−instance FromJSON Status where
3140− parseJSON (Object v) = Status <$>
3141− v .:? "ok" <*>
3142− (v .:? "status" .!= 200) <*>
3143− v .: "name" <*>
3144− v .: "version" <*>
3145− v .: "tagline"
3146− parseJSON _ = empty
3147−
3148−
3149−instance ToJSON IndexSettings where
3150− toJSON (IndexSettings s r) = object ["settings" .=
3151− object ["index" .=
3152− object ["number_of_shards" .= s, "number_of_replicas" .= r]
3153− ]
3154− ]
3155−
3156−instance FromJSON IndexSettings where
3157− parseJSON = withObject "IndexSettings" parse
3158− where parse o = do s <- o .: "settings"
3159− i <- s .: "index"
3160− IndexSettings <$> i .: "number_of_shards"
3161− <*> i .: "number_of_replicas"
3162−
3163−instance ToJSON UpdatableIndexSetting where
3164− toJSON (NumberOfReplicas x) = oPath ("index" :| ["number_of_replicas"]) x
3165− toJSON (AutoExpandReplicas x) = oPath ("index" :| ["auto_expand_replicas"]) x
3166− toJSON (RefreshInterval x) = oPath ("index" :| ["refresh_interval"]) (NominalDiffTimeJSON x)
3167− toJSON (IndexConcurrency x) = oPath ("index" :| ["concurrency"]) x
3168− toJSON (FailOnMergeFailure x) = oPath ("index" :| ["fail_on_merge_failure"]) x
3169− toJSON (TranslogFlushThresholdOps x) = oPath ("index" :| ["translog", "flush_threshold_ops"]) x
3170− toJSON (TranslogFlushThresholdSize x) = oPath ("index" :| ["translog", "flush_threshold_size"]) x
3171− toJSON (TranslogFlushThresholdPeriod x) = oPath ("index" :| ["translog", "flush_threshold_period"]) (NominalDiffTimeJSON x)
3172− toJSON (TranslogDisableFlush x) = oPath ("index" :| ["translog", "disable_flush"]) x
3173− toJSON (CacheFilterMaxSize x) = oPath ("index" :| ["cache", "filter", "max_size"]) x
3174− toJSON (CacheFilterExpire x) = oPath ("index" :| ["cache", "filter", "expire"]) (NominalDiffTimeJSON <$> x)
3175− toJSON (GatewaySnapshotInterval x) = oPath ("index" :| ["gateway", "snapshot_interval"]) (NominalDiffTimeJSON x)
3176− toJSON (RoutingAllocationInclude fs) = oPath ("index" :| ["routing", "allocation", "include"]) (attrFilterJSON fs)
3177− toJSON (RoutingAllocationExclude fs) = oPath ("index" :| ["routing", "allocation", "exclude"]) (attrFilterJSON fs)
3178− toJSON (RoutingAllocationRequire fs) = oPath ("index" :| ["routing", "allocation", "require"]) (attrFilterJSON fs)
3179− toJSON (RoutingAllocationEnable x) = oPath ("index" :| ["routing", "allocation", "enable"]) x
3180− toJSON (RoutingAllocationShardsPerNode x) = oPath ("index" :| ["routing", "allocation", "total_shards_per_node"]) x
3181− toJSON (RecoveryInitialShards x) = oPath ("index" :| ["recovery", "initial_shards"]) x
3182− toJSON (GCDeletes x) = oPath ("index" :| ["gc_deletes"]) (NominalDiffTimeJSON x)
3183− toJSON (TTLDisablePurge x) = oPath ("index" :| ["ttl", "disable_purge"]) x
3184− toJSON (TranslogFSType x) = oPath ("index" :| ["translog", "fs", "type"]) x
3185− toJSON (IndexCompoundFormat x) = oPath ("index" :| ["compound_format"]) x
3186− toJSON (IndexCompoundOnFlush x) = oPath ("index" :| ["compound_on_flush"]) x
3187− toJSON (WarmerEnabled x) = oPath ("index" :| ["warmer", "enabled"]) x
3188− toJSON (BlocksReadOnly x) = oPath ("blocks" :| ["read_only"]) x
3189− toJSON (BlocksRead x) = oPath ("blocks" :| ["read"]) x
3190− toJSON (BlocksWrite x) = oPath ("blocks" :| ["write"]) x
3191− toJSON (BlocksMetaData x) = oPath ("blocks" :| ["metadata"]) x
3192−
3193−instance FromJSON UpdatableIndexSetting where
3194− parseJSON = withObject "UpdatableIndexSetting" parse
3195− where parse o = numberOfReplicas `taggedAt` ["index", "number_of_replicas"]
3196− <|> autoExpandReplicas `taggedAt` ["index", "auto_expand_replicas"]
3197− <|> refreshInterval `taggedAt` ["index", "refresh_interval"]
3198− <|> indexConcurrency `taggedAt` ["index", "concurrency"]
3199− <|> failOnMergeFailure `taggedAt` ["index", "fail_on_merge_failure"]
3200− <|> translogFlushThresholdOps `taggedAt` ["index", "translog", "flush_threshold_ops"]
3201− <|> translogFlushThresholdSize `taggedAt` ["index", "translog", "flush_threshold_size"]
3202− <|> translogFlushThresholdPeriod `taggedAt` ["index", "translog", "flush_threshold_period"]
3203− <|> translogDisableFlush `taggedAt` ["index", "translog", "disable_flush"]
3204− <|> cacheFilterMaxSize `taggedAt` ["index", "cache", "filter", "max_size"]
3205− <|> cacheFilterExpire `taggedAt` ["index", "cache", "filter", "expire"]
3206− <|> gatewaySnapshotInterval `taggedAt` ["index", "gateway", "snapshot_interval"]
3207− <|> routingAllocationInclude `taggedAt` ["index", "routing", "allocation", "include"]
3208− <|> routingAllocationExclude `taggedAt` ["index", "routing", "allocation", "exclude"]
3209− <|> routingAllocationRequire `taggedAt` ["index", "routing", "allocation", "require"]
3210− <|> routingAllocationEnable `taggedAt` ["index", "routing", "allocation", "enable"]
3211− <|> routingAllocationShardsPerNode `taggedAt` ["index", "routing", "allocation", "total_shards_per_node"]
3212− <|> recoveryInitialShards `taggedAt` ["index", "recovery", "initial_shards"]
3213− <|> gcDeletes `taggedAt` ["index", "gc_deletes"]
3214− <|> ttlDisablePurge `taggedAt` ["index", "ttl", "disable_purge"]
3215− <|> translogFSType `taggedAt` ["index", "translog", "fs", "type"]
3216− <|> compoundFormat `taggedAt` ["index", "compound_format"]
3217− <|> compoundOnFlush `taggedAt` ["index", "compound_on_flush"]
3218− <|> warmerEnabled `taggedAt` ["index", "warmer", "enabled"]
3219− <|> blocksReadOnly `taggedAt` ["blocks", "read_only"]
3220− <|> blocksRead `taggedAt` ["blocks", "read"]
3221− <|> blocksWrite `taggedAt` ["blocks", "write"]
3222− <|> blocksMetaData `taggedAt` ["blocks", "metadata"]
3223− where taggedAt f ks = taggedAt' f (Object o) ks
3224− taggedAt' f v [] = f =<< (parseJSON v <|> (parseJSON (unStringlyTypeJSON v)))
3225− taggedAt' f v (k:ks) = withObject "Object" (\o -> do v' <- o .: k
3226− taggedAt' f v' ks) v
3227− numberOfReplicas = pure . NumberOfReplicas
3228− autoExpandReplicas = pure . AutoExpandReplicas
3229− refreshInterval = pure . RefreshInterval . ndtJSON
3230− indexConcurrency = pure . IndexConcurrency
3231− failOnMergeFailure = pure . FailOnMergeFailure
3232− translogFlushThresholdOps = pure . TranslogFlushThresholdOps
3233− translogFlushThresholdSize = pure . TranslogFlushThresholdSize
3234− translogFlushThresholdPeriod = pure . TranslogFlushThresholdPeriod . ndtJSON
3235− translogDisableFlush = pure . TranslogDisableFlush
3236− cacheFilterMaxSize = pure . CacheFilterMaxSize
3237− cacheFilterExpire = pure . CacheFilterExpire . fmap ndtJSON
3238− gatewaySnapshotInterval = pure . GatewaySnapshotInterval . ndtJSON
3239− routingAllocationInclude = fmap RoutingAllocationInclude . parseAttrFilter
3240− routingAllocationExclude = fmap RoutingAllocationExclude . parseAttrFilter
3241− routingAllocationRequire = fmap RoutingAllocationRequire . parseAttrFilter
3242− routingAllocationEnable = pure . RoutingAllocationEnable
3243− routingAllocationShardsPerNode = pure . RoutingAllocationShardsPerNode
3244− recoveryInitialShards = pure . RecoveryInitialShards
3245− gcDeletes = pure . GCDeletes . ndtJSON
3246− ttlDisablePurge = pure . TTLDisablePurge
3247− translogFSType = pure . TranslogFSType
3248− compoundFormat = pure . IndexCompoundFormat
3249− compoundOnFlush = pure . IndexCompoundOnFlush
3250− warmerEnabled = pure . WarmerEnabled
3251− blocksReadOnly = pure . BlocksReadOnly
3252− blocksRead = pure . BlocksRead
3253− blocksWrite = pure . BlocksWrite
3254− blocksMetaData = pure . BlocksMetaData
3255−
3256−instance FromJSON IndexSettingsSummary where
3257− parseJSON = withObject "IndexSettingsSummary" parse
3258− where parse o = case HM.toList o of
3259− [(ixn, v@(Object o'))] -> IndexSettingsSummary (IndexName ixn)
3260− <$> parseJSON v
3261− <*> (fmap (filter (not . redundant)) . parseSettings =<< o' .: "settings")
3262− _ -> fail "Expected single-key object with index name"
3263− redundant (NumberOfReplicas _) = True
3264− redundant _ = False
3265−
3266−-- | For some reason in several settings APIs, all leaf values get returned
3267−-- as strings. This function attepmts to recover from this for all
3268−-- non-recursive JSON types. If nothing can be done, the value is left alone.
3269−unStringlyTypeJSON :: Value -> Value
3270−unStringlyTypeJSON (String "true") = Bool True
3271−unStringlyTypeJSON (String "false") = Bool False
3272−unStringlyTypeJSON (String "null") = Null
3273−unStringlyTypeJSON v@(String t) = case readMay (T.unpack t) of
3274− Just n -> Number n
3275− Nothing -> v
3276−unStringlyTypeJSON v = v
3277−
3278−
3279−parseSettings :: Object -> Parser [UpdatableIndexSetting]
3280−parseSettings o = do
3281− o' <- o .: "index"
3282− -- slice the index object into singleton hashmaps and try to parse each
3283− parses <- forM (HM.toList o') $ \(k, v) -> do
3284− -- blocks are now nested into the "index" key, which is not how they're serialized
3285− let atRoot = Object (HM.singleton k v)
3286− let atIndex = Object (HM.singleton "index" atRoot)
3287− optional (parseJSON atRoot <|> parseJSON atIndex)
3288− return (catMaybes parses)
3289−
3290−oPath :: ToJSON a => NonEmpty Text -> a -> Value
3291−oPath (k :| []) v = object [k .= v]
3292−oPath (k:| (h:t)) v = object [k .= oPath (h :| t) v]
3293−
3294−attrFilterJSON :: NonEmpty NodeAttrFilter -> Value
3295−attrFilterJSON fs = object [ n .= T.intercalate "," (toList vs)
3296− | NodeAttrFilter (NodeAttrName n) vs <- toList fs]
3297−
3298−parseAttrFilter :: Value -> Parser (NonEmpty NodeAttrFilter)
3299−parseAttrFilter = withObject "NonEmpty NodeAttrFilter" parse
3300− where parse o = case HM.toList o of
3301− [] -> fail "Expected non-empty list of NodeAttrFilters"
3302− x:xs -> DT.mapM (uncurry parse') (x :| xs)
3303− parse' n = withText "Text" $ \t ->
3304− case T.splitOn "," t of
3305− fv:fvs -> return (NodeAttrFilter (NodeAttrName n) (fv :| fvs))
3306− [] -> fail "Expected non-empty list of filter values"
3307−
3308−instance ToJSON ReplicaBounds where
3309− toJSON (ReplicasBounded a b) = String (showText a <> "-" <> showText b)
3310− toJSON (ReplicasLowerBounded a) = String (showText a <> "-all")
3311− toJSON ReplicasUnbounded = Bool False
3312−
3313−instance FromJSON ReplicaBounds where
3314− parseJSON v = withText "ReplicaBounds" parseText v
3315− <|> withBool "ReplicaBounds" parseBool v
3316− where parseText t = case T.splitOn "-" t of
3317− [a, "all"] -> ReplicasLowerBounded <$> parseReadText a
3318− [a, b] -> ReplicasBounded <$> parseReadText a
3319− <*> parseReadText b
3320− _ -> fail ("Could not parse ReplicaBounds: " <> show t)
3321− parseBool False = pure ReplicasUnbounded
3322− parseBool _ = fail "ReplicasUnbounded cannot be represented with True"
3323−
3324−instance ToJSON AllocationPolicy where
3325− toJSON AllocAll = String "all"
3326− toJSON AllocPrimaries = String "primaries"
3327− toJSON AllocNewPrimaries = String "new_primaries"
3328− toJSON AllocNone = String "none"
3329−
3330−instance FromJSON AllocationPolicy where
3331− parseJSON = withText "AllocationPolicy" parse
3332− where parse "all" = pure AllocAll
3333− parse "primaries" = pure AllocPrimaries
3334− parse "new_primaries" = pure AllocNewPrimaries
3335− parse "none" = pure AllocNone
3336− parse t = fail ("Invlaid AllocationPolicy: " <> show t)
3337−
3338−instance ToJSON InitialShardCount where
3339− toJSON QuorumShards = String "quorum"
3340− toJSON QuorumMinus1Shards = String "quorum-1"
3341− toJSON FullShards = String "full"
3342− toJSON FullMinus1Shards = String "full-1"
3343− toJSON (ExplicitShards x) = toJSON x
3344−
3345−instance FromJSON InitialShardCount where
3346− parseJSON v = withText "InitialShardCount" parseText v
3347− <|> ExplicitShards <$> parseJSON v
3348− where parseText "quorum" = pure QuorumShards
3349− parseText "quorum-1" = pure QuorumMinus1Shards
3350− parseText "full" = pure FullShards
3351− parseText "full-1" = pure FullMinus1Shards
3352− parseText _ = mzero
3353−
3354−instance ToJSON FSType where
3355− toJSON FSSimple = "simple"
3356− toJSON FSBuffered = "buffered"
3357−
3358−instance FromJSON FSType where
3359− parseJSON = withText "FSType" parse
3360− where parse "simple" = pure FSSimple
3361− parse "buffered" = pure FSBuffered
3362− parse t = fail ("Invalid FSType: " <> show t)
3363−
3364−instance ToJSON CompoundFormat where
3365− toJSON (CompoundFileFormat x) = Bool x
3366− toJSON (MergeSegmentVsTotalIndex x) = toJSON x
3367−
3368−instance FromJSON CompoundFormat where
3369− parseJSON v = CompoundFileFormat <$> parseJSON v
3370− <|> MergeSegmentVsTotalIndex <$> parseJSON v
3371−
3372−instance ToJSON NominalDiffTimeJSON where
3373− toJSON (NominalDiffTimeJSON t) = String (showText (round t :: Integer) <> "s")
3374−
3375−instance FromJSON NominalDiffTimeJSON where
3376− parseJSON = withText "NominalDiffTime" parse
3377− where parse t = case T.takeEnd 1 t of
3378− "s" -> NominalDiffTimeJSON . fromInteger <$> parseReadText (T.dropEnd 1 t)
3379− _ -> fail "Invalid or missing NominalDiffTime unit (expected s)"
3380−
3381−instance ToJSON IndexTemplate where
3382− toJSON (IndexTemplate p s m) = merge
3383− (object [ "template" .= p
3384− , "mappings" .= foldl' merge (object []) m
3385− ])
3386− (toJSON s)
3387− where
3388− merge (Object o1) (Object o2) = toJSON $ HM.union o1 o2
3389− merge o Null = o
3390− merge _ _ = undefined
3391−
3392−instance (FromJSON a) => FromJSON (EsResult a) where
3393− parseJSON jsonVal@(Object v) = do
3394− found <- v .:? "found" .!= False
3395− fr <- if found
3396− then parseJSON jsonVal
3397− else return Nothing
3398− EsResult <$> v .: "_index" <*>
3399− v .: "_type" <*>
3400− v .: "_id" <*>
3401− pure fr
3402− parseJSON _ = empty
3403−
3404−instance (FromJSON a) => FromJSON (EsResultFound a) where
3405− parseJSON (Object v) = EsResultFound <$>
3406− v .: "_version" <*>
3407− v .: "_source"
3408− parseJSON _ = empty
3409−
3410−instance FromJSON EsError where
3411− parseJSON (Object v) = EsError <$>
3412− v .: "status" <*>
3413− (v .: "error" <|> (v .: "error" >>= (.: "reason")))
3414− parseJSON _ = empty
3415−
3416−instance FromJSON IndexAliasesSummary where
3417− parseJSON = withObject "IndexAliasesSummary" parse
3418− where parse o = IndexAliasesSummary . mconcat <$> mapM (uncurry go) (HM.toList o)
3419− go ixn = withObject "index aliases" $ \ia -> do
3420− aliases <- ia .:? "aliases" .!= mempty
3421− forM (HM.toList aliases) $ \(aName, v) -> do
3422− let indexAlias = IndexAlias (IndexName ixn) (IndexAliasName (IndexName aName))
3423− IndexAliasSummary indexAlias <$> parseJSON v
3424−
3425−
3426−instance ToJSON IndexAliasAction where
3427− toJSON (AddAlias ia opts) = object ["add" .= (iaObj <> optsObj)]
3428− where Object iaObj = toJSON ia
3429− Object optsObj = toJSON opts
3430− toJSON (RemoveAlias ia) = object ["remove" .= iaObj]
3431− where Object iaObj = toJSON ia
3432−
3433−instance ToJSON IndexAlias where
3434− toJSON IndexAlias {..} = object ["index" .= srcIndex
3435− , "alias" .= indexAlias
3436− ]
3437−
3438−instance ToJSON IndexAliasCreate where
3439− toJSON IndexAliasCreate {..} = Object (filterObj <> routingObj)
3440− where filterObj = maybe mempty (HM.singleton "filter" . toJSON) aliasCreateFilter
3441− Object routingObj = maybe (Object mempty) toJSON aliasCreateRouting
3442−
3443−instance ToJSON AliasRouting where
3444− toJSON (AllAliasRouting v) = object ["routing" .= v]
3445− toJSON (GranularAliasRouting srch idx) = object (catMaybes prs)
3446− where prs = [("search_routing" .=) <$> srch
3447− ,("index_routing" .=) <$> idx]
3448−
3449−instance FromJSON AliasRouting where
3450− parseJSON = withObject "AliasRouting" parse
3451− where parse o = parseAll o <|> parseGranular o
3452− parseAll o = AllAliasRouting <$> o .: "routing"
3453− parseGranular o = do
3454− sr <- o .:? "search_routing"
3455− ir <- o .:? "index_routing"
3456− if isNothing sr && isNothing ir
3457− then fail "Both search_routing and index_routing can't be blank"
3458− else return (GranularAliasRouting sr ir)
3459−
3460−instance FromJSON IndexAliasCreate where
3461− parseJSON v = withObject "IndexAliasCreate" parse v
3462− where parse o = IndexAliasCreate <$> optional (parseJSON v)
3463− <*> o .:? "filter"
3464−
3465−instance ToJSON SearchAliasRouting where
3466− toJSON (SearchAliasRouting rvs) = toJSON (T.intercalate "," (routingValue <$> toList rvs))
3467−
3468−instance FromJSON SearchAliasRouting where
3469− parseJSON = withText "SearchAliasRouting" parse
3470− where parse t = SearchAliasRouting <$> parseNEJSON (String <$> T.splitOn "," t)
3471−
3472−instance ToJSON Search where
3473− toJSON (Search query sFilter sort searchAggs highlight sTrackSortScores sFrom sSize _ sFields sSource sSuggest) =
3474− omitNulls [ "query" .= query
3475− , "filter" .= sFilter
3476− , "sort" .= sort
3477− , "aggregations" .= searchAggs
3478− , "highlight" .= highlight
3479− , "from" .= sFrom
3480− , "size" .= sSize
3481− , "track_scores" .= sTrackSortScores
3482− , "fields" .= sFields
3483− , "_source" .= sSource
3484− , "suggest" .= sSuggest]
3485−
3486−
3487−instance ToJSON Source where
3488− toJSON NoSource = toJSON False
3489− toJSON (SourcePatterns patterns) = toJSON patterns
3490− toJSON (SourceIncludeExclude incl excl) = object [ "include" .= incl, "exclude" .= excl ]
3491−
3492−instance ToJSON PatternOrPatterns where
3493− toJSON (PopPattern pattern) = toJSON pattern
3494− toJSON (PopPatterns patterns) = toJSON patterns
3495−
3496−instance ToJSON Include where
3497− toJSON (Include patterns) = toJSON patterns
3498−
3499−instance ToJSON Exclude where
3500− toJSON (Exclude patterns) = toJSON patterns
3501−
3502−instance ToJSON Pattern where
3503− toJSON (Pattern pattern) = toJSON pattern
3504−
3505−
3506−instance ToJSON FieldHighlight where
3507− toJSON (FieldHighlight (FieldName fName) (Just fSettings)) =
3508− object [ fName .= fSettings ]
3509− toJSON (FieldHighlight (FieldName fName) Nothing) =
3510− object [ fName .= emptyObject ]
3511−
3512−instance ToJSON Highlights where
3513− toJSON (Highlights global fields) =
3514− omitNulls (("fields" .= fields)
3515− : highlightSettingsPairs global)
3516−
3517−instance ToJSON HighlightSettings where
3518− toJSON hs = omitNulls (highlightSettingsPairs (Just hs))
3519−
3520−highlightSettingsPairs :: Maybe HighlightSettings -> [Pair]
3521−highlightSettingsPairs Nothing = []
3522−highlightSettingsPairs (Just (Plain plh)) = plainHighPairs (Just plh)
3523−highlightSettingsPairs (Just (Postings ph)) = postHighPairs (Just ph)
3524−highlightSettingsPairs (Just (FastVector fvh)) = fastVectorHighPairs (Just fvh)
3525−
3526−
3527−plainHighPairs :: Maybe PlainHighlight -> [Pair]
3528−plainHighPairs Nothing = []
3529−plainHighPairs (Just (PlainHighlight plCom plNonPost)) =
3530− [ "type" .= String "plain"]
3531− ++ commonHighlightPairs plCom
3532− ++ nonPostingsToPairs plNonPost
3533−
3534−postHighPairs :: Maybe PostingsHighlight -> [Pair]
3535−postHighPairs Nothing = []
3536−postHighPairs (Just (PostingsHighlight pCom)) =
3537− ("type" .= String "postings")
3538− : commonHighlightPairs pCom
3539−
3540−fastVectorHighPairs :: Maybe FastVectorHighlight -> [Pair]
3541−fastVectorHighPairs Nothing = []
3542−fastVectorHighPairs (Just
3543− (FastVectorHighlight fvCom fvNonPostSettings fvBoundChars
3544− fvBoundMaxScan fvFragOff fvMatchedFields
3545− fvPhraseLim)) =
3546− [ "type" .= String "fvh"
3547− , "boundary_chars" .= fvBoundChars
3548− , "boundary_max_scan" .= fvBoundMaxScan
3549− , "fragment_offset" .= fvFragOff
3550− , "matched_fields" .= fvMatchedFields
3551− , "phraseLimit" .= fvPhraseLim]
3552− ++ commonHighlightPairs fvCom
3553− ++ nonPostingsToPairs fvNonPostSettings
3554−
3555−deleteSeveral :: (Eq k, Hashable k) => [k] -> HM.HashMap k v -> HM.HashMap k v
3556−deleteSeveral ks hm = foldr HM.delete hm ks
3557−
3558−commonHighlightPairs :: Maybe CommonHighlight -> [Pair]
3559−commonHighlightPairs Nothing = []
3560−commonHighlightPairs (Just (CommonHighlight chScore chForceSource chTag chEncoder
3561− chNoMatchSize chHighlightQuery
3562− chRequireFieldMatch)) =
3563− [ "order" .= chScore
3564− , "force_source" .= chForceSource
3565− , "encoder" .= chEncoder
3566− , "no_match_size" .= chNoMatchSize
3567− , "highlight_query" .= chHighlightQuery
3568− , "require_fieldMatch" .= chRequireFieldMatch]
3569− ++ highlightTagToPairs chTag
3570−
3571−
3572−nonPostingsToPairs :: Maybe NonPostings -> [Pair]
3573−nonPostingsToPairs Nothing = []
3574−nonPostingsToPairs (Just (NonPostings npFragSize npNumOfFrags)) =
3575− [ "fragment_size" .= npFragSize
3576− , "number_of_fragments" .= npNumOfFrags]
3577−
3578−parseNEJSON :: (FromJSON a) => [Value] -> Parser (NonEmpty a)
3579−parseNEJSON [] = fail "Expected non-empty list"
3580−parseNEJSON (x:xs) = DT.mapM parseJSON (x :| xs)
3581−
3582−
3583−instance ToJSON HighlightEncoder where
3584− toJSON DefaultEncoder = String "default"
3585− toJSON HTMLEncoder = String "html"
3586−
3587−highlightTagToPairs :: Maybe HighlightTag -> [Pair]
3588−highlightTagToPairs (Just (TagSchema _)) = [ "scheme" .= String "default"]
3589−highlightTagToPairs (Just (CustomTags (pre, post))) = [ "pre_tags" .= pre
3590− , "post_tags" .= post]
3591−highlightTagToPairs Nothing = []
3592−
3593−instance ToJSON SortSpec where
3594− toJSON (DefaultSortSpec
3595− (DefaultSort (FieldName dsSortFieldName) dsSortOrder dsIgnoreUnmapped
3596− dsSortMode dsMissingSort dsNestedFilter)) =
3597− object [dsSortFieldName .= omitNulls base] where
3598− base = [ "order" .= dsSortOrder
3599− , "ignore_unmapped" .= dsIgnoreUnmapped
3600− , "mode" .= dsSortMode
3601− , "missing" .= dsMissingSort
3602− , "nested_filter" .= dsNestedFilter ]
3603−
3604− toJSON (GeoDistanceSortSpec gdsSortOrder (GeoPoint (FieldName field) gdsLatLon) units) =
3605− object [ "unit" .= units
3606− , field .= gdsLatLon
3607− , "order" .= gdsSortOrder ]
3608−
3609−
3610−instance ToJSON SortOrder where
3611− toJSON Ascending = String "asc"
3612− toJSON Descending = String "desc"
3613−
3614−
3615−instance ToJSON SortMode where
3616− toJSON SortMin = String "min"
3617− toJSON SortMax = String "max"
3618− toJSON SortSum = String "sum"
3619− toJSON SortAvg = String "avg"
3620−
3621−
3622−instance ToJSON Missing where
3623− toJSON LastMissing = String "_last"
3624− toJSON FirstMissing = String "_first"
3625− toJSON (CustomMissing txt) = String txt
3626−
3627−
3628−instance ToJSON ScoreType where
3629− toJSON ScoreTypeMax = "max"
3630− toJSON ScoreTypeAvg = "avg"
3631− toJSON ScoreTypeSum = "sum"
3632− toJSON ScoreTypeNone = "none"
3633−
3634−instance FromJSON ScoreType where
3635− parseJSON = withText "ScoreType" parse
3636− where parse "max" = pure ScoreTypeMax
3637− parse "avg" = pure ScoreTypeAvg
3638− parse "sum" = pure ScoreTypeSum
3639− parse "none" = pure ScoreTypeNone
3640− parse t = fail ("Unexpected ScoreType: " <> show t)
3641−
3642−instance ToJSON Distance where
3643− toJSON (Distance dCoefficient dUnit) =
3644− String boltedTogether where
3645− coefText = showText dCoefficient
3646− (String unitText) = toJSON dUnit
3647− boltedTogether = mappend coefText unitText
3648−
3649−instance FromJSON Distance where
3650− parseJSON = withText "Distance" parse
3651− where parse t = Distance <$> parseCoeff nT
3652− <*> parseJSON (String unitT)
3653− where (nT, unitT) = T.span validForNumber t
3654− -- may be a better way to do this
3655− validForNumber '-' = True
3656− validForNumber '.' = True
3657− validForNumber 'e' = True
3658− validForNumber c = isNumber c
3659− parseCoeff "" = fail "Empty string cannot be parsed as number"
3660− parseCoeff s = return (read (T.unpack s))
3661−
3662−instance ToJSON DistanceUnit where
3663− toJSON Miles = String "mi"
3664− toJSON Yards = String "yd"
3665− toJSON Feet = String "ft"
3666− toJSON Inches = String "in"
3667− toJSON Kilometers = String "km"
3668− toJSON Meters = String "m"
3669− toJSON Centimeters = String "cm"
3670− toJSON Millimeters = String "mm"
3671− toJSON NauticalMiles = String "nmi"
3672−
3673−
3674−instance FromJSON DistanceUnit where
3675− parseJSON = withText "DistanceUnit" parse
3676− where parse "mi" = pure Miles
3677− parse "yd" = pure Yards
3678− parse "ft" = pure Feet
3679− parse "in" = pure Inches
3680− parse "km" = pure Kilometers
3681− parse "m" = pure Meters
3682− parse "cm" = pure Centimeters
3683− parse "mm" = pure Millimeters
3684− parse "nmi" = pure NauticalMiles
3685− parse u = fail ("Unrecognized DistanceUnit: " <> show u)
3686−
3687−instance ToJSON DistanceType where
3688− toJSON Arc = String "arc"
3689− toJSON SloppyArc = String "sloppy_arc"
3690− toJSON Plane = String "plane"
3691−
3692−instance FromJSON DistanceType where
3693− parseJSON = withText "DistanceType" parse
3694− where parse "arc" = pure Arc
3695− parse "sloppy_arc" = pure SloppyArc
3696− parse "plane" = pure Plane
3697− parse t = fail ("Unrecognized DistanceType: " <> show t)
3698−
3699−
3700−instance ToJSON OptimizeBbox where
3701− toJSON NoOptimizeBbox = String "none"
3702− toJSON (OptimizeGeoFilterType gft) = toJSON gft
3703−
3704−instance FromJSON OptimizeBbox where
3705− parseJSON v = withText "NoOptimizeBbox" parseNoOptimize v
3706− <|> parseOptimize v
3707− where parseNoOptimize "none" = pure NoOptimizeBbox
3708− parseNoOptimize _ = mzero
3709− parseOptimize = fmap OptimizeGeoFilterType . parseJSON
3710−
3711−instance ToJSON GeoBoundingBoxConstraint where
3712− toJSON (GeoBoundingBoxConstraint
3713− (FieldName gbbcGeoBBField) gbbcConstraintBox cache type') =
3714− object [gbbcGeoBBField .= gbbcConstraintBox
3715− , "_cache" .= cache
3716− , "type" .= type']
3717−
3718−instance FromJSON GeoBoundingBoxConstraint where
3719− parseJSON = withObject "GeoBoundingBoxConstraint" parse
3720− where parse o = case HM.toList (deleteSeveral ["type", "_cache"] o) of
3721− [(fn, v)] -> GeoBoundingBoxConstraint (FieldName fn)
3722− <$> parseJSON v
3723− <*> o .:? "_cache" .!= defaultCache
3724− <*> o .: "type"
3725− _ -> fail "Could not find field name for GeoBoundingBoxConstraint"
3726−
3727−instance ToJSON GeoFilterType where
3728− toJSON GeoFilterMemory = String "memory"
3729− toJSON GeoFilterIndexed = String "indexed"
3730−
3731−instance FromJSON GeoFilterType where
3732− parseJSON = withText "GeoFilterType" parse
3733− where parse "memory" = pure GeoFilterMemory
3734− parse "indexed" = pure GeoFilterIndexed
3735− parse t = fail ("Unrecognized GeoFilterType: " <> show t)
3736−
3737−instance ToJSON GeoBoundingBox where
3738− toJSON (GeoBoundingBox gbbTopLeft gbbBottomRight) =
3739− object ["top_left" .= gbbTopLeft
3740− , "bottom_right" .= gbbBottomRight]
3741−
3742−instance FromJSON GeoBoundingBox where
3743− parseJSON = withObject "GeoBoundingBox" parse
3744− where parse o = GeoBoundingBox
3745− <$> o .: "top_left"
3746− <*> o .: "bottom_right"
3747−
3748−instance ToJSON LatLon where
3749− toJSON (LatLon lLat lLon) =
3750− object ["lat" .= lLat
3751− , "lon" .= lLon]
3752−
3753−instance FromJSON LatLon where
3754− parseJSON = withObject "LatLon" parse
3755− where parse o = LatLon <$> o .: "lat"
3756− <*> o .: "lon"
3757−
3758−-- index for smaller ranges, fielddata for longer ranges
3759−instance ToJSON RangeExecution where
3760− toJSON RangeExecutionIndex = "index"
3761− toJSON RangeExecutionFielddata = "fielddata"
3762−
3763−
3764−instance FromJSON RangeExecution where
3765− parseJSON = withText "RangeExecution" parse
3766− where parse "index" = pure RangeExecutionIndex
3767− parse "fielddata" = pure RangeExecutionFielddata
3768− parse t = error ("Unrecognized RangeExecution " <> show t)
3769−
3770−instance ToJSON RegexpFlags where
3771− toJSON AllRegexpFlags = String "ALL"
3772− toJSON NoRegexpFlags = String "NONE"
3773− toJSON (SomeRegexpFlags (h :| fs)) = String $ T.intercalate "|" flagStrs
3774− where flagStrs = map flagStr . nub $ h:fs
3775− flagStr AnyString = "ANYSTRING"
3776− flagStr Automaton = "AUTOMATON"
3777− flagStr Complement = "COMPLEMENT"
3778− flagStr Empty = "EMPTY"
3779− flagStr Intersection = "INTERSECTION"
3780− flagStr Interval = "INTERVAL"
3781−
3782−instance FromJSON RegexpFlags where
3783− parseJSON = withText "RegexpFlags" parse
3784− where parse "ALL" = pure AllRegexpFlags
3785− parse "NONE" = pure NoRegexpFlags
3786− parse t = SomeRegexpFlags <$> parseNEJSON (String <$> T.splitOn "|" t)
3787−
3788−instance FromJSON RegexpFlag where
3789− parseJSON = withText "RegexpFlag" parse
3790− where parse "ANYSTRING" = pure AnyString
3791− parse "AUTOMATON" = pure Automaton
3792− parse "COMPLEMENT" = pure Complement
3793− parse "EMPTY" = pure Empty
3794− parse "INTERSECTION" = pure Intersection
3795− parse "INTERVAL" = pure Interval
3796− parse f = fail ("Unknown RegexpFlag: " <> show f)
3797−
3798−instance ToJSON Term where
3799− toJSON (Term field value) = object ["term" .= object
3800− [field .= value]]
3801−
3802−instance FromJSON Term where
3803− parseJSON = withObject "Term" parse
3804− where parse o = do termObj <- o .: "term"
3805− case HM.toList termObj of
3806− [(fn, v)] -> Term fn <$> parseJSON v
3807− _ -> fail "Expected object with 1 field-named key"
3808−
3809−instance ToJSON BoolMatch where
3810− toJSON (MustMatch term cache) = object ["must" .= term,
3811− "_cache" .= cache]
3812− toJSON (MustNotMatch term cache) = object ["must_not" .= term,
3813− "_cache" .= cache]
3814− toJSON (ShouldMatch terms cache) = object ["should" .= fmap toJSON terms,
3815− "_cache" .= cache]
3816−
3817−instance FromJSON BoolMatch where
3818− parseJSON = withObject "BoolMatch" parse
3819− where parse o = mustMatch `taggedWith` "must"
3820− <|> mustNotMatch `taggedWith` "must_not"
3821− <|> shouldMatch `taggedWith` "should"
3822− where taggedWith parser k = parser =<< o .: k
3823− mustMatch t = MustMatch t <$> o .:? "_cache" .!= defaultCache
3824− mustNotMatch t = MustNotMatch t <$> o .:? "_cache" .!= defaultCache
3825− shouldMatch t = ShouldMatch t <$> o .:? "_cache" .!= defaultCache
3826−
3827−instance (FromJSON a) => FromJSON (SearchResult a) where
3828− parseJSON (Object v) = SearchResult <$>
3829− v .: "took" <*>
3830− v .: "timed_out" <*>
3831− v .: "_shards" <*>
3832− v .: "hits" <*>
3833− v .:? "aggregations" <*>
3834− v .:? "_scroll_id" <*>
3835− v .:? "suggest"
3836− parseJSON _ = empty
3837−
3838−instance (FromJSON a) => FromJSON (SearchHits a) where
3839− parseJSON (Object v) = SearchHits <$>
3840− v .: "total" <*>
3841− v .: "max_score" <*>
3842− v .: "hits"
3843− parseJSON _ = empty
3844−
3845−instance (FromJSON a) => FromJSON (Hit a) where
3846− parseJSON (Object v) = Hit <$>
3847− v .: "_index" <*>
3848− v .: "_type" <*>
3849− v .: "_id" <*>
3850− v .: "_score" <*>
3851− v .:? "_source" <*>
3852− v .:? "highlight"
3853− parseJSON _ = empty
3854−
3855−instance FromJSON ShardResult where
3856− parseJSON (Object v) = ShardResult <$>
3857− v .: "total" <*>
3858− v .: "successful" <*>
3859− v .: "failed"
3860− parseJSON _ = empty
3861−
3862−
3863−instance FromJSON DocVersion where
3864− parseJSON v = do
3865− i <- parseJSON v
3866− maybe (fail "DocVersion out of range") return $ mkDocVersion i
3867−
3868−-- This insanity is because ES *sometimes* returns Replica/Shard counts as strings
3869−instance FromJSON ReplicaCount where
3870− parseJSON v = parseAsInt v
3871− <|> parseAsString v
3872− where parseAsInt = fmap ReplicaCount . parseJSON
3873− parseAsString = withText "ReplicaCount" (fmap ReplicaCount . parseReadText)
3874−
3875−instance FromJSON ShardCount where
3876− parseJSON v = parseAsInt v
3877− <|> parseAsString v
3878− where parseAsInt = fmap ShardCount . parseJSON
3879− parseAsString = withText "ShardCount" (fmap ShardCount . parseReadText)
3880−
3881−instance Bounded DocVersion where
3882− minBound = DocVersion 1
3883− maxBound = DocVersion 9200000000000000000 -- 9.2e+18
3884−
3885−instance Enum DocVersion where
3886− succ x
3887− | x /= maxBound = DocVersion (succ $ docVersionNumber x)
3888− | otherwise = succError "DocVersion"
3889− pred x
3890− | x /= minBound = DocVersion (pred $ docVersionNumber x)
3891− | otherwise = predError "DocVersion"
3892− toEnum i =
3893− fromMaybe (error $ show i ++ " out of DocVersion range") $ mkDocVersion i
3894− fromEnum = docVersionNumber
3895− enumFrom = boundedEnumFrom
3896− enumFromThen = boundedEnumFromThen
3897−
3898−-- | Username type used for HTTP Basic authentication. See 'basicAuthHook'.
3899−newtype EsUsername = EsUsername { esUsername :: Text } deriving (Read, Show, Eq)
3900−
3901−-- | Password type used for HTTP Basic authentication. See 'basicAuthHook'.
3902−newtype EsPassword = EsPassword { esPassword :: Text } deriving (Read, Show, Eq)
3903−
3904−
3905−data SnapshotRepoSelection = SnapshotRepoList (NonEmpty SnapshotRepoPattern)
3906− | AllSnapshotRepos deriving (Eq, Generic, Show, Typeable)
3907−
3908−
3909−-- | Either specifies an exact repo name or one with globs in it,
3910−-- e.g. @RepoPattern "foo*"@ __NOTE__: Patterns are not supported on ES < 1.7
3911−data SnapshotRepoPattern = ExactRepo SnapshotRepoName
3912− | RepoPattern Text
3913− deriving (Eq, Generic, Show, Typeable)
3914−
3915−-- | The unique name of a snapshot repository.
3916−newtype SnapshotRepoName = SnapshotRepoName { snapshotRepoName :: Text }
3917− deriving (Eq, Ord, Generic, Show, Typeable, ToJSON, FromJSON)
3918−
3919−
3920−-- | A generic representation of a snapshot repo. This is what gets
3921−-- sent to and parsed from the server. For repo types enabled by
3922−-- plugins that aren't exported by this library, consider making a
3923−-- custom type which implements 'SnapshotRepo'. If it is a common repo
3924−-- type, consider submitting a pull request to have it included in the
3925−-- library proper
3926−data GenericSnapshotRepo = GenericSnapshotRepo {
3927− gSnapshotRepoName :: SnapshotRepoName
3928− , gSnapshotRepoType :: SnapshotRepoType
3929− , gSnapshotRepoSettings :: GenericSnapshotRepoSettings
3930− } deriving (Eq, Generic, Show, Typeable)
3931−
3932−
3933−instance SnapshotRepo GenericSnapshotRepo where
3934− toGSnapshotRepo = id
3935− fromGSnapshotRepo = Right
3936−
3937−
3938−newtype SnapshotRepoType = SnapshotRepoType { snapshotRepoType :: Text }
3939− deriving (Eq, Ord, Generic, Show, Typeable, ToJSON, FromJSON)
3940−
3941−
3942−-- | Opaque representation of snapshot repo settings. Instances of
3943−-- 'SnapshotRepo' will produce this.
3944−newtype GenericSnapshotRepoSettings = GenericSnapshotRepoSettings { gSnapshotRepoSettingsObject :: Object }
3945− deriving (Eq, Generic, Show, Typeable, ToJSON)
3946−
3947−
3948− -- Regardless of whether you send strongly typed json, my version of
3949− -- ES sends back stringly typed json in the settings, e.g. booleans
3950− -- as strings, so we'll try to convert them.
3951−instance FromJSON GenericSnapshotRepoSettings where
3952− parseJSON = fmap (GenericSnapshotRepoSettings . fmap unStringlyTypeJSON). parseJSON
3953−
3954−-- | The result of running 'verifySnapshotRepo'.
3955−newtype SnapshotVerification = SnapshotVerification { snapshotNodeVerifications :: [SnapshotNodeVerification] }
3956− deriving (Eq, Generic, Show, Typeable)
3957−
3958−
3959−instance FromJSON SnapshotVerification where
3960− parseJSON = withObject "SnapshotVerification" parse
3961− where
3962− parse o = do
3963− o2 <- o .: "nodes"
3964− SnapshotVerification <$> mapM (uncurry parse') (HM.toList o2)
3965− parse' rawFullId = withObject "SnapshotNodeVerification" $ \o ->
3966− SnapshotNodeVerification (FullNodeId rawFullId) <$> o .: "name"
3967−
3968−
3969−-- | A node that has verified a snapshot
3970−data SnapshotNodeVerification = SnapshotNodeVerification {
3971− snvFullId :: FullNodeId
3972− , snvNodeName :: NodeName
3973− } deriving (Eq, Generic, Show, Typeable)
3974−
3975−
3976−-- | Unique, automatically-generated name assigned to nodes that are
3977−-- usually returned in node-oriented APIs.
3978−newtype FullNodeId = FullNodeId { fullNodeId :: Text }
3979− deriving (Eq, Ord, Generic, Show, Typeable, FromJSON)
3980−
3981−
3982−-- | A human-readable node name that is supplied by the user in the
3983−-- node config or automatically generated by ElasticSearch.
3984−newtype NodeName = NodeName { nodeName :: Text }
3985− deriving (Eq, Ord, Generic, Show, Typeable, FromJSON)
3986−
3987−newtype ClusterName = ClusterName { clusterName :: Text }
3988− deriving (Eq, Ord, Generic, Show, Typeable, FromJSON)
3989−
3990−data NodesInfo = NodesInfo {
3991− nodesInfo :: [NodeInfo]
3992− , nodesClusterName :: ClusterName
3993− } deriving (Eq, Show, Generic, Typeable)
3994−
3995−data NodesStats = NodesStats {
3996− nodesStats :: [NodeStats]
3997− , nodesStatsClusterName :: ClusterName
3998− } deriving (Eq, Show, Generic, Typeable)
3999−
4000−data NodeStats = NodeStats {
4001− nodeStatsName :: NodeName
4002− , nodeStatsFullId :: FullNodeId
4003− , nodeStatsBreakersStats :: Maybe NodeBreakersStats
4004− , nodeStatsHTTP :: NodeHTTPStats
4005− , nodeStatsTransport :: NodeTransportStats
4006− , nodeStatsFS :: NodeFSStats
4007− , nodeStatsNetwork :: NodeNetworkStats
4008− , nodeStatsThreadPool :: NodeThreadPoolsStats
4009− , nodeStatsJVM :: NodeJVMStats
4010− , nodeStatsProcess :: NodeProcessStats
4011− , nodeStatsOS :: NodeOSStats
4012− , nodeStatsIndices :: NodeIndicesStats
4013− } deriving (Eq, Show, Generic, Typeable)
4014−
4015−data NodeBreakersStats = NodeBreakersStats {
4016− nodeStatsParentBreaker :: NodeBreakerStats
4017− , nodeStatsRequestBreaker :: NodeBreakerStats
4018− , nodeStatsFieldDataBreaker :: NodeBreakerStats
4019− } deriving (Eq, Show, Generic, Typeable)
4020−
4021−data NodeBreakerStats = NodeBreakerStats {
4022− nodeBreakersTripped :: Int
4023− , nodeBreakersOverhead :: Double
4024− , nodeBreakersEstSize :: Bytes
4025− , nodeBreakersLimitSize :: Bytes
4026− } deriving (Eq, Show, Generic, Typeable)
4027−
4028−data NodeHTTPStats = NodeHTTPStats {
4029− nodeHTTPTotalOpened :: Int
4030− , nodeHTTPCurrentOpen :: Int
4031− } deriving (Eq, Show, Generic, Typeable)
4032−
4033−data NodeTransportStats = NodeTransportStats {
4034− nodeTransportTXSize :: Bytes
4035− , nodeTransportCount :: Int
4036− , nodeTransportRXSize :: Bytes
4037− , nodeTransportRXCount :: Int
4038− , nodeTransportServerOpen :: Int
4039− } deriving (Eq, Show, Generic, Typeable)
4040−
4041−data NodeFSStats = NodeFSStats {
4042− nodeFSDataPaths :: [NodeDataPathStats]
4043− , nodeFSTotal :: NodeFSTotalStats
4044− , nodeFSTimestamp :: UTCTime
4045− } deriving (Eq, Show, Generic, Typeable)
4046−
4047−data NodeDataPathStats = NodeDataPathStats {
4048− nodeDataPathDiskServiceTime :: Maybe Double
4049− , nodeDataPathDiskQueue :: Maybe Double
4050− , nodeDataPathIOSize :: Maybe Bytes
4051− , nodeDataPathWriteSize :: Maybe Bytes
4052− , nodeDataPathReadSize :: Maybe Bytes
4053− , nodeDataPathIOOps :: Maybe Int
4054− , nodeDataPathWrites :: Maybe Int
4055− , nodeDataPathReads :: Maybe Int
4056− , nodeDataPathAvailable :: Bytes
4057− , nodeDataPathFree :: Bytes
4058− , nodeDataPathTotal :: Bytes
4059− , nodeDataPathType :: Maybe Text
4060− , nodeDataPathDevice :: Text
4061− , nodeDataPathMount :: Text
4062− , nodeDataPathPath :: Text
4063− } deriving (Eq, Show, Generic, Typeable)
4064−
4065−data NodeFSTotalStats = NodeFSTotalStats {
4066− nodeFSTotalDiskServiceTime :: Maybe Double
4067− , nodeFSTotalDiskQueue :: Maybe Double
4068− , nodeFSTotalIOSize :: Maybe Bytes
4069− , nodeFSTotalWriteSize :: Maybe Bytes
4070− , nodeFSTotalReadSize :: Maybe Bytes
4071− , nodeFSTotalIOOps :: Maybe Int
4072− , nodeFSTotalWrites :: Maybe Int
4073− , nodeFSTotalReads :: Maybe Int
4074− , nodeFSTotalAvailable :: Bytes
4075− , nodeFSTotalFree :: Bytes
4076− , nodeFSTotalTotal :: Bytes
4077− } deriving (Eq, Show, Generic, Typeable)
4078−
4079−data NodeNetworkStats = NodeNetworkStats {
4080− nodeNetTCPOutRSTs :: Int
4081− , nodeNetTCPInErrs :: Int
4082− , nodeNetTCPAttemptFails :: Int
4083− , nodeNetTCPEstabResets :: Int
4084− , nodeNetTCPRetransSegs :: Int
4085− , nodeNetTCPOutSegs :: Int
4086− , nodeNetTCPInSegs :: Int
4087− , nodeNetTCPCurrEstab :: Int
4088− , nodeNetTCPPassiveOpens :: Int
4089− , nodeNetTCPActiveOpens :: Int
4090− } deriving (Eq, Show, Generic, Typeable)
4091−
4092−data NodeThreadPoolsStats = NodeThreadPoolsStats {
4093− nodeThreadPoolsStatsSnapshot :: NodeThreadPoolStats
4094− , nodeThreadPoolsStatsBulk :: NodeThreadPoolStats
4095− , nodeThreadPoolsStatsMerge :: NodeThreadPoolStats
4096− , nodeThreadPoolsStatsGet :: NodeThreadPoolStats
4097− , nodeThreadPoolsStatsManagement :: NodeThreadPoolStats
4098− , nodeThreadPoolsStatsFetchShardStore :: Maybe NodeThreadPoolStats
4099− , nodeThreadPoolsStatsOptimize :: NodeThreadPoolStats
4100− , nodeThreadPoolsStatsFlush :: NodeThreadPoolStats
4101− , nodeThreadPoolsStatsSearch :: NodeThreadPoolStats
4102− , nodeThreadPoolsStatsWarmer :: NodeThreadPoolStats
4103− , nodeThreadPoolsStatsGeneric :: NodeThreadPoolStats
4104− , nodeThreadPoolsStatsSuggest :: NodeThreadPoolStats
4105− , nodeThreadPoolsStatsRefresh :: NodeThreadPoolStats
4106− , nodeThreadPoolsStatsIndex :: NodeThreadPoolStats
4107− , nodeThreadPoolsStatsListener :: Maybe NodeThreadPoolStats
4108− , nodeThreadPoolsStatsFetchShardStarted :: Maybe NodeThreadPoolStats
4109− , nodeThreadPoolsStatsPercolate :: NodeThreadPoolStats
4110− } deriving (Eq, Show, Generic, Typeable)
4111−
4112−data NodeThreadPoolStats = NodeThreadPoolStats {
4113− nodeThreadPoolCompleted :: Int
4114− , nodeThreadPoolLargest :: Int
4115− , nodeThreadPoolRejected :: Int
4116− , nodeThreadPoolActive :: Int
4117− , nodeThreadPoolQueue :: Int
4118− , nodeThreadPoolThreads :: Int
4119− } deriving (Eq, Show, Generic, Typeable)
4120−
4121−data NodeJVMStats = NodeJVMStats {
4122− nodeJVMStatsMappedBufferPool :: JVMBufferPoolStats
4123− , nodeJVMStatsDirectBufferPool :: JVMBufferPoolStats
4124− , nodeJVMStatsGCOldCollector :: JVMGCStats
4125− , nodeJVMStatsGCYoungCollector :: JVMGCStats
4126− , nodeJVMStatsPeakThreadsCount :: Int
4127− , nodeJVMStatsThreadsCount :: Int
4128− , nodeJVMStatsOldPool :: JVMPoolStats
4129− , nodeJVMStatsSurvivorPool :: JVMPoolStats
4130− , nodeJVMStatsYoungPool :: JVMPoolStats
4131− , nodeJVMStatsNonHeapCommitted :: Bytes
4132− , nodeJVMStatsNonHeapUsed :: Bytes
4133− , nodeJVMStatsHeapMax :: Bytes
4134− , nodeJVMStatsHeapCommitted :: Bytes
4135− , nodeJVMStatsHeapUsedPercent :: Int
4136− , nodeJVMStatsHeapUsed :: Bytes
4137− , nodeJVMStatsUptime :: NominalDiffTime
4138− , nodeJVMStatsTimestamp :: UTCTime
4139− } deriving (Eq, Show, Generic, Typeable)
4140−
4141−data JVMBufferPoolStats = JVMBufferPoolStats {
4142− jvmBufferPoolStatsTotalCapacity :: Bytes
4143− , jvmBufferPoolStatsUsed :: Bytes
4144− , jvmBufferPoolStatsCount :: Int
4145− } deriving (Eq, Show, Generic, Typeable)
4146−
4147−data JVMGCStats = JVMGCStats {
4148− jvmGCStatsCollectionTime :: NominalDiffTime
4149− , jvmGCStatsCollectionCount :: Int
4150− } deriving (Eq, Show, Generic, Typeable)
4151−
4152−data JVMPoolStats = JVMPoolStats {
4153− jvmPoolStatsPeakMax :: Bytes
4154− , jvmPoolStatsPeakUsed :: Bytes
4155− , jvmPoolStatsMax :: Bytes
4156− , jvmPoolStatsUsed :: Bytes
4157− } deriving (Eq, Show, Generic, Typeable)
4158−
4159−data NodeProcessStats = NodeProcessStats {
4160− nodeProcessMemTotalVirtual :: Bytes
4161− , nodeProcessMemShare :: Bytes
4162− , nodeProcessMemResident :: Bytes
4163− , nodeProcessCPUTotal :: NominalDiffTime
4164− , nodeProcessCPUUser :: NominalDiffTime
4165− , nodeProcessCPUSys :: NominalDiffTime
4166− , nodeProcessCPUPercent :: Int
4167− , nodeProcessOpenFDs :: Int
4168− , nodeProcessTimestamp :: UTCTime
4169− } deriving (Eq, Show, Generic, Typeable)
4170−
4171−data NodeOSStats = NodeOSStats {
4172− nodeOSSwapFree :: Bytes
4173− , nodeOSSwapUsed :: Bytes
4174− , nodeOSMemActualUsed :: Bytes
4175− , nodeOSMemActualFree :: Bytes
4176− , nodeOSMemUsedPercent :: Int
4177− , nodeOSMemFreePercent :: Int
4178− , nodeOSMemUsed :: Bytes
4179− , nodeOSMemFree :: Bytes
4180− , nodeOSCPUStolen :: Int
4181− , nodeOSCPUUsage :: Int
4182− , nodeOSCPUIdle :: Int
4183− , nodeOSCPUUser :: Int
4184− , nodeOSCPUSys :: Int
4185− , nodeOSLoad :: Maybe LoadAvgs
4186− , nodeOSUptime :: NominalDiffTime
4187− , nodeOSTimestamp :: UTCTime
4188− } deriving (Eq, Show, Generic, Typeable)
4189−
4190−data LoadAvgs = LoadAvgs {
4191− loadAvg1Min :: Double
4192− , loadAvg5Min :: Double
4193− , loadAvg15Min :: Double
4194− } deriving (Eq, Show, Generic, Typeable)
4195−
4196−data NodeIndicesStats = NodeIndicesStats {
4197− nodeIndicesStatsRecoveryThrottleTime :: Maybe NominalDiffTime
4198− , nodeIndicesStatsRecoveryCurrentAsTarget :: Maybe Int
4199− , nodeIndicesStatsRecoveryCurrentAsSource :: Maybe Int
4200− , nodeIndicesStatsQueryCacheMisses :: Maybe Int
4201− , nodeIndicesStatsQueryCacheHits :: Maybe Int
4202− , nodeIndicesStatsQueryCacheEvictions :: Maybe Int
4203− , nodeIndicesStatsQueryCacheSize :: Maybe Bytes
4204− , nodeIndicesStatsSuggestCurrent :: Int
4205− , nodeIndicesStatsSuggestTime :: NominalDiffTime
4206− , nodeIndicesStatsSuggestTotal :: Int
4207− , nodeIndicesStatsTranslogSize :: Bytes
4208− , nodeIndicesStatsTranslogOps :: Int
4209− , nodeIndicesStatsSegFixedBitSetMemory :: Maybe Bytes
4210− , nodeIndicesStatsSegVersionMapMemory :: Bytes
4211− , nodeIndicesStatsSegIndexWriterMaxMemory :: Maybe Bytes
4212− , nodeIndicesStatsSegIndexWriterMemory :: Bytes
4213− , nodeIndicesStatsSegMemory :: Bytes
4214− , nodeIndicesStatsSegCount :: Int
4215− , nodeIndicesStatsCompletionSize :: Bytes
4216− , nodeIndicesStatsPercolateQueries :: Int
4217− , nodeIndicesStatsPercolateMemory :: Bytes
4218− , nodeIndicesStatsPercolateCurrent :: Int
4219− , nodeIndicesStatsPercolateTime :: NominalDiffTime
4220− , nodeIndicesStatsPercolateTotal :: Int
4221− , nodeIndicesStatsFieldDataEvictions :: Int
4222− , nodeIndicesStatsFieldDataMemory :: Bytes
4223− , nodeIndicesStatsIDCacheMemory :: Bytes
4224− , nodeIndicesStatsFilterCacheEvictions :: Int
4225− , nodeIndicesStatsFilterCacheMemory :: Bytes
4226− , nodeIndicesStatsWarmerTotalTime :: NominalDiffTime
4227− , nodeIndicesStatsWarmerTotal :: Int
4228− , nodeIndicesStatsWarmerCurrent :: Int
4229− , nodeIndicesStatsFlushTotalTime :: NominalDiffTime
4230− , nodeIndicesStatsFlushTotal :: Int
4231− , nodeIndicesStatsRefreshTotalTime :: NominalDiffTime
4232− , nodeIndicesStatsRefreshTotal :: Int
4233− , nodeIndicesStatsMergesTotalSize :: Bytes
4234− , nodeIndicesStatsMergesTotalDocs :: Int
4235− , nodeIndicesStatsMergesTotalTime :: NominalDiffTime
4236− , nodeIndicesStatsMergesTotal :: Int
4237− , nodeIndicesStatsMergesCurrentSize :: Bytes
4238− , nodeIndicesStatsMergesCurrentDocs :: Int
4239− , nodeIndicesStatsMergesCurrent :: Int
4240− , nodeIndicesStatsSearchFetchCurrent :: Int
4241− , nodeIndicesStatsSearchFetchTime :: NominalDiffTime
4242− , nodeIndicesStatsSearchFetchTotal :: Int
4243− , nodeIndicesStatsSearchQueryCurrent :: Int
4244− , nodeIndicesStatsSearchQueryTime :: NominalDiffTime
4245− , nodeIndicesStatsSearchQueryTotal :: Int
4246− , nodeIndicesStatsSearchOpenContexts :: Int
4247− , nodeIndicesStatsGetCurrent :: Int
4248− , nodeIndicesStatsGetMissingTime :: NominalDiffTime
4249− , nodeIndicesStatsGetMissingTotal :: Int
4250− , nodeIndicesStatsGetExistsTime :: NominalDiffTime
4251− , nodeIndicesStatsGetExistsTotal :: Int
4252− , nodeIndicesStatsGetTime :: NominalDiffTime
4253− , nodeIndicesStatsGetTotal :: Int
4254− , nodeIndicesStatsIndexingThrottleTime :: Maybe NominalDiffTime
4255− , nodeIndicesStatsIndexingIsThrottled :: Maybe Bool
4256− , nodeIndicesStatsIndexingNoopUpdateTotal :: Maybe Int
4257− , nodeIndicesStatsIndexingDeleteCurrent :: Int
4258− , nodeIndicesStatsIndexingDeleteTime :: NominalDiffTime
4259− , nodeIndicesStatsIndexingDeleteTotal :: Int
4260− , nodeIndicesStatsIndexingIndexCurrent :: Int
4261− , nodeIndicesStatsIndexingIndexTime :: NominalDiffTime
4262− , nodeIndicesStatsIndexingTotal :: Int
4263− , nodeIndicesStatsStoreThrottleTime :: NominalDiffTime
4264− , nodeIndicesStatsStoreSize :: Bytes
4265− , nodeIndicesStatsDocsDeleted :: Int
4266− , nodeIndicesStatsDocsCount :: Int
4267− } deriving (Eq, Show, Generic, Typeable)
4268−
4269−-- | A quirky address format used throughout ElasticSearch. An example
4270−-- would be inet[/1.1.1.1:9200]. inet may be a placeholder for a
4271−-- <https://en.wikipedia.org/wiki/Fully_qualified_domain_name FQDN>.
4272−newtype EsAddress = EsAddress { esAddress :: Text }
4273− deriving (Eq, Ord, Generic, Show, Typeable, FromJSON)
4274−
4275−-- | Typically a 7 character hex string.
4276−newtype BuildHash = BuildHash { buildHash :: Text }
4277− deriving (Eq, Ord, Generic, Read, Show, Typeable, FromJSON, ToJSON)
4278−
4279−newtype PluginName = PluginName { pluginName :: Text }
4280− deriving (Eq, Ord, Generic, Show, Typeable, FromJSON)
4281−
4282−data NodeInfo = NodeInfo {
4283− nodeInfoHTTPAddress :: EsAddress
4284− , nodeInfoBuild :: BuildHash
4285− , nodeInfoESVersion :: VersionNumber
4286− , nodeInfoIP :: Server
4287− , nodeInfoHost :: Server
4288− , nodeInfoTransportAddress :: EsAddress
4289− , nodeInfoName :: NodeName
4290− , nodeInfoFullId :: FullNodeId
4291− , nodeInfoPlugins :: [NodePluginInfo]
4292− , nodeInfoHTTP :: NodeHTTPInfo
4293− , nodeInfoTransport :: NodeTransportInfo
4294− , nodeInfoNetwork :: NodeNetworkInfo
4295− , nodeInfoThreadPool :: NodeThreadPoolsInfo
4296− , nodeInfoJVM :: NodeJVMInfo
4297− , nodeInfoProcess :: NodeProcessInfo
4298− , nodeInfoOS :: NodeOSInfo
4299− , nodeInfoSettings :: Object
4300− -- ^ The members of the settings objects are not consistent,
4301− -- dependent on plugins, etc.
4302− } deriving (Eq, Show, Generic, Typeable)
4303−
4304−data NodePluginInfo = NodePluginInfo {
4305− nodePluginSite :: Bool
4306− -- ^ Is this a site plugin?
4307− , nodePluginJVM :: Bool
4308− -- ^ Is this plugin running on the JVM
4309− , nodePluginDescription :: Text
4310− , nodePluginVersion :: MaybeNA VersionNumber
4311− , nodePluginName :: PluginName
4312− } deriving (Eq, Show, Generic, Typeable)
4313−
4314−data NodeHTTPInfo = NodeHTTPInfo {
4315− nodeHTTPMaxContentLength :: Bytes
4316− , nodeHTTPTransportAddress :: BoundTransportAddress
4317− } deriving (Eq, Show, Generic, Typeable)
4318−
4319−data NodeTransportInfo = NodeTransportInfo {
4320− nodeTransportProfiles :: [BoundTransportAddress]
4321− , nodeTransportAddress :: BoundTransportAddress
4322− } deriving (Eq, Show, Generic, Typeable)
4323−
4324−data BoundTransportAddress = BoundTransportAddress {
4325− publishAddress :: EsAddress
4326− , boundAddress :: EsAddress
4327− } deriving (Eq, Show, Generic, Typeable)
4328−
4329−data NodeNetworkInfo = NodeNetworkInfo {
4330− nodeNetworkPrimaryInterface :: NodeNetworkInterface
4331− , nodeNetworkRefreshInterval :: NominalDiffTime
4332− } deriving (Eq, Show, Generic, Typeable)
4333−
4334−newtype MacAddress = MacAddress { macAddress :: Text }
4335− deriving (Eq, Ord, Generic, Show, Typeable, FromJSON)
4336−
4337−newtype NetworkInterfaceName = NetworkInterfaceName { networkInterfaceName :: Text }
4338− deriving (Eq, Ord, Generic, Show, Typeable, FromJSON)
4339−
4340−data NodeNetworkInterface = NodeNetworkInterface {
4341− nodeNetIfaceMacAddress :: MacAddress
4342− , nodeNetIfaceName :: NetworkInterfaceName
4343− , nodeNetIfaceAddress :: Server
4344− } deriving (Eq, Show, Generic, Typeable)
4345−
4346−data NodeThreadPoolsInfo = NodeThreadPoolsInfo {
4347− nodeThreadPoolsRefresh :: NodeThreadPoolInfo
4348− , nodeThreadPoolsManagement :: NodeThreadPoolInfo
4349− , nodeThreadPoolsPercolate :: NodeThreadPoolInfo
4350− , nodeThreadPoolsListener :: Maybe NodeThreadPoolInfo
4351− , nodeThreadPoolsFetchShardStarted :: Maybe NodeThreadPoolInfo
4352− , nodeThreadPoolsSearch :: NodeThreadPoolInfo
4353− , nodeThreadPoolsFlush :: NodeThreadPoolInfo
4354− , nodeThreadPoolsWarmer :: NodeThreadPoolInfo
4355− , nodeThreadPoolsOptimize :: NodeThreadPoolInfo
4356− , nodeThreadPoolsBulk :: NodeThreadPoolInfo
4357− , nodeThreadPoolsSuggest :: NodeThreadPoolInfo
4358− , nodeThreadPoolsMerge :: NodeThreadPoolInfo
4359− , nodeThreadPoolsSnapshot :: NodeThreadPoolInfo
4360− , nodeThreadPoolsGet :: NodeThreadPoolInfo
4361− , nodeThreadPoolsFetchShardStore :: Maybe NodeThreadPoolInfo
4362− , nodeThreadPoolsIndex :: NodeThreadPoolInfo
4363− , nodeThreadPoolsGeneric :: NodeThreadPoolInfo
4364− } deriving (Eq, Show, Generic, Typeable)
4365−
4366−data NodeThreadPoolInfo = NodeThreadPoolInfo {
4367− nodeThreadPoolQueueSize :: ThreadPoolSize
4368− , nodeThreadPoolKeepalive :: Maybe NominalDiffTime
4369− , nodeThreadPoolMin :: Maybe Int
4370− , nodeThreadPoolMax :: Maybe Int
4371− , nodeThreadPoolType :: ThreadPoolType
4372− } deriving (Eq, Show, Generic, Typeable)
4373−
4374−data ThreadPoolSize = ThreadPoolBounded Int
4375− | ThreadPoolUnbounded
4376− deriving (Eq, Show, Generic, Typeable)
4377−
4378−data ThreadPoolType = ThreadPoolScaling
4379− | ThreadPoolFixed
4380− | ThreadPoolCached
4381− deriving (Eq, Show, Generic, Typeable)
4382−
4383−data NodeJVMInfo = NodeJVMInfo {
4384− nodeJVMInfoMemoryPools :: [JVMMemoryPool]
4385− , nodeJVMInfoMemoryPoolsGCCollectors :: [JVMGCCollector]
4386− , nodeJVMInfoMemoryInfo :: JVMMemoryInfo
4387− , nodeJVMInfoStartTime :: UTCTime
4388− , nodeJVMInfoVMVendor :: Text
4389− , nodeJVMVMVersion :: VersionNumber
4390− -- ^ JVM doesn't seme to follow normal version conventions
4391− , nodeJVMVMName :: Text
4392− , nodeJVMVersion :: VersionNumber
4393− , nodeJVMPID :: PID
4394− } deriving (Eq, Show, Generic, Typeable)
4395−
4396−-- | Handles quirks in the way JVM versions are rendered (1.7.0_101 -> 1.7.0.101)
4397−newtype JVMVersion = JVMVersion { unJVMVersion :: VersionNumber }
4398−
4399−data JVMMemoryInfo = JVMMemoryInfo {
4400− jvmMemoryInfoDirectMax :: Bytes
4401− , jvmMemoryInfoNonHeapMax :: Bytes
4402− , jvmMemoryInfoNonHeapInit :: Bytes
4403− , jvmMemoryInfoHeapMax :: Bytes
4404− , jvmMemoryInfoHeapInit :: Bytes
4405− } deriving (Eq, Show, Generic, Typeable)
4406−
4407−newtype JVMMemoryPool = JVMMemoryPool {
4408− jvmMemoryPool :: Text
4409− } deriving (Eq, Show, Generic, Typeable, FromJSON)
4410−
4411−newtype JVMGCCollector = JVMGCCollector {
4412− jvmGCCollector :: Text
4413− } deriving (Eq, Show, Generic, Typeable, FromJSON)
4414−
4415−newtype PID = PID {
4416− pid :: Int
4417− } deriving (Eq, Show, Generic, Typeable, FromJSON)
4418−
4419−data NodeOSInfo = NodeOSInfo {
4420− nodeOSSwap :: Bytes
4421− , nodeOSMem :: Bytes
4422− , nodeOSCPUInfo :: CPUInfo
4423− , nodeOSAvailableProcessors :: Int
4424− , nodeOSRefreshInterval :: NominalDiffTime
4425− } deriving (Eq, Show, Generic, Typeable)
4426−
4427−data CPUInfo = CPUInfo {
4428− cpuCacheSize :: Bytes
4429− , cpuCoresPerSocket :: Int
4430− , cpuTotalSockets :: Int
4431− , cpuTotalCores :: Int
4432− , cpuMHZ :: Int
4433− , cpuModel :: Text
4434− , cpuVendor :: Text
4435− } deriving (Eq, Show, Generic, Typeable)
4436−
4437−data NodeProcessInfo = NodeProcessInfo {
4438− nodeProcessMLockAll :: Bool
4439− -- ^ See <https://www.elastic.co/guide/en/elasticsearch/reference/current/setup-configuration.html>
4440− , nodeProcessMaxFileDescriptors :: Int
4441− , nodeProcessId :: PID
4442− , nodeProcessRefreshInterval :: NominalDiffTime
4443− } deriving (Eq, Show, Generic, Typeable)
4444−
4445−data SnapshotRepoUpdateSettings = SnapshotRepoUpdateSettings {
4446− repoUpdateVerify :: Bool
4447− -- ^ After creation/update, synchronously check that nodes can
4448− -- write to this repo. Defaults to True. You may use False if you
4449− -- need a faster response and plan on verifying manually later
4450− -- with 'verifySnapshotRepo'.
4451− } deriving (Eq, Show, Generic, Typeable)
4452−
4453−
4454−-- | Reasonable defaults for repo creation/update
4455−--
4456−-- * repoUpdateVerify True
4457−defaultSnapshotRepoUpdateSettings :: SnapshotRepoUpdateSettings
4458−defaultSnapshotRepoUpdateSettings = SnapshotRepoUpdateSettings True
4459−
4460−
4461−-- | A filesystem-based snapshot repo that ships with
4462−-- ElasticSearch. This is an instance of 'SnapshotRepo' so it can be
4463−-- used with 'updateSnapshotRepo'
4464−data FsSnapshotRepo = FsSnapshotRepo {
4465− fsrName :: SnapshotRepoName
4466− , fsrLocation :: FilePath
4467− , fsrCompressMetadata :: Bool
4468− , fsrChunkSize :: Maybe Bytes
4469− -- ^ Size by which to split large files during snapshotting.
4470− , fsrMaxRestoreBytesPerSec :: Maybe Bytes
4471− -- ^ Throttle node restore rate. If not supplied, defaults to 40mb/sec
4472− , fsrMaxSnapshotBytesPerSec :: Maybe Bytes
4473− -- ^ Throttle node snapshot rate. If not supplied, defaults to 40mb/sec
4474− } deriving (Eq, Generic, Show, Typeable)
4475−
4476−
4477−instance SnapshotRepo FsSnapshotRepo where
4478− toGSnapshotRepo FsSnapshotRepo {..} =
4479− GenericSnapshotRepo fsrName fsRepoType (GenericSnapshotRepoSettings settings)
4480− where
4481− Object settings = object $ [ "location" .= fsrLocation
4482− , "compress" .= fsrCompressMetadata
4483− ] ++ optionalPairs
4484− optionalPairs = catMaybes [ ("chunk_size" .=) <$> fsrChunkSize
4485− , ("max_restore_bytes_per_sec" .=) <$> fsrMaxRestoreBytesPerSec
4486− , ("max_snapshot_bytes_per_sec" .=) <$> fsrMaxSnapshotBytesPerSec
4487− ]
4488− fromGSnapshotRepo GenericSnapshotRepo {..}
4489− | gSnapshotRepoType == fsRepoType = do
4490− let o = gSnapshotRepoSettingsObject gSnapshotRepoSettings
4491− parseRepo $ do
4492− FsSnapshotRepo gSnapshotRepoName <$> o .: "location"
4493− <*> o .:? "compress" .!= False
4494− <*> o .:? "chunk_size"
4495− <*> o .:? "max_restore_bytes_per_sec"
4496− <*> o .:? "max_snapshot_bytes_per_sec"
4497− | otherwise = Left (RepoTypeMismatch fsRepoType gSnapshotRepoType)
4498−
4499−
4500−parseRepo :: Parser a -> Either SnapshotRepoConversionError a
4501−parseRepo parser = case parseEither (const parser) () of
4502− Left e -> Left (OtherRepoConversionError (T.pack e))
4503− Right a -> Right a
4504−
4505−
4506−fsRepoType :: SnapshotRepoType
4507−fsRepoType = SnapshotRepoType "fs"
4508−
4509−-- | Law: fromGSnapshotRepo (toGSnapshotRepo r) == Right r
4510−class SnapshotRepo r where
4511− toGSnapshotRepo :: r -> GenericSnapshotRepo
4512− fromGSnapshotRepo :: GenericSnapshotRepo -> Either SnapshotRepoConversionError r
4513−
4514−
4515−data SnapshotRepoConversionError = RepoTypeMismatch SnapshotRepoType SnapshotRepoType
4516− -- ^ Expected type and actual type
4517− | OtherRepoConversionError Text
4518− deriving (Show, Eq, Generic, Typeable)
4519−
4520−
4521−instance Exception SnapshotRepoConversionError
4522−
4523−
4524−data SnapshotCreateSettings = SnapshotCreateSettings {
4525− snapWaitForCompletion :: Bool
4526− -- ^ Should the API call return immediately after initializing
4527− -- the snapshot or wait until completed? Note that if this is
4528− -- enabled it could wait a long time, so you should adjust your
4529− -- 'ManagerSettings' accordingly to set long timeouts or
4530− -- explicitly handle timeouts.
4531− , snapIndices :: Maybe IndexSelection
4532− -- ^ Nothing will snapshot all indices. Just [] is permissable and
4533− -- will essentially be a no-op snapshot.
4534− , snapIgnoreUnavailable :: Bool
4535− -- ^ If set to True, any matched indices that don't exist will be
4536− -- ignored. Otherwise it will be an error and fail.
4537− , snapIncludeGlobalState :: Bool
4538− , snapPartial :: Bool
4539− -- ^ If some indices failed to snapshot (e.g. if not all primary
4540− -- shards are available), should the process proceed?
4541− } deriving (Eq, Generic, Show, Typeable)
4542−
4543−
4544−-- | Reasonable defaults for snapshot creation
4545−--
4546−-- * snapWaitForCompletion False
4547−-- * snapIndices Nothing
4548−-- * snapIgnoreUnavailable False
4549−-- * snapIncludeGlobalState True
4550−-- * snapPartial False
4551−defaultSnapshotCreateSettings :: SnapshotCreateSettings
4552−defaultSnapshotCreateSettings = SnapshotCreateSettings {
4553− snapWaitForCompletion = False
4554− , snapIndices = Nothing
4555− , snapIgnoreUnavailable = False
4556− , snapIncludeGlobalState = True
4557− , snapPartial = False
4558− }
4559−
4560−
4561−data SnapshotSelection = SnapshotList (NonEmpty SnapshotPattern)
4562− | AllSnapshots deriving (Eq, Generic, Show, Typeable)
4563−
4564−
4565−-- | Either specifies an exact snapshot name or one with globs in it,
4566−-- e.g. @SnapPattern "foo*"@ __NOTE__: Patterns are not supported on
4567−-- ES < 1.7
4568−data SnapshotPattern = ExactSnap SnapshotName
4569− | SnapPattern Text
4570− deriving (Eq, Generic, Show, Typeable)
4571−
4572−
4573−-- | General information about the state of a snapshot. Has some
4574−-- redundancies with 'SnapshotStatus'
4575−data SnapshotInfo = SnapshotInfo {
4576− snapInfoShards :: ShardResult
4577− , snapInfoFailures :: [SnapshotShardFailure]
4578− , snapInfoDuration :: NominalDiffTime
4579− , snapInfoEndTime :: UTCTime
4580− , snapInfoStartTime :: UTCTime
4581− , snapInfoState :: SnapshotState
4582− , snapInfoIndices :: [IndexName]
4583− , snapInfoName :: SnapshotName
4584− } deriving (Eq, Generic, Show, Typeable)
4585−
4586−
4587−instance FromJSON SnapshotInfo where
4588− parseJSON = withObject "SnapshotInfo" parse
4589− where
4590− parse o = SnapshotInfo <$> o .: "shards"
4591− <*> o .: "failures"
4592− <*> (unMS <$> o .: "duration_in_millis")
4593− <*> (posixMS <$> o .: "end_time_in_millis")
4594− <*> (posixMS <$> o .: "start_time_in_millis")
4595− <*> o .: "state"
4596− <*> o .: "indices"
4597− <*> o .: "snapshot"
4598−
4599−data SnapshotShardFailure = SnapshotShardFailure {
4600− snapShardFailureIndex :: IndexName
4601− , snapShardFailureNodeId :: Maybe NodeName -- I'm not 100% sure this isn't actually 'FullNodeId'
4602− , snapShardFailureReason :: Text
4603− , snapShardFailureShardId :: ShardId
4604− } deriving (Eq, Show, Generic, Typeable)
4605−
4606−
4607−instance FromJSON SnapshotShardFailure where
4608− parseJSON = withObject "SnapshotShardFailure" parse
4609− where
4610− parse o = SnapshotShardFailure <$> o .: "index"
4611− <*> o .:? "node_id"
4612− <*> o .: "reason"
4613− <*> o .: "shard_id"
4614−
4615−
4616−newtype ShardId = ShardId { shardId :: Int }
4617− deriving (Eq, Show, Generic, Typeable, FromJSON)
4618−
4619−-- | Milliseconds
4620−newtype MS = MS NominalDiffTime
4621−
4622−
4623−-- keeps the unexported constructor warnings at bay
4624−unMS :: MS -> NominalDiffTime
4625−unMS (MS t) = t
4626−
4627−
4628−instance FromJSON MS where
4629− parseJSON = withScientific "MS" (return . MS . parse)
4630− where
4631− parse n = fromInteger ((truncate n) * 1000)
4632−
4633−
4634−data SnapshotState = SnapshotInit
4635− | SnapshotStarted
4636− | SnapshotSuccess
4637− | SnapshotFailed
4638− | SnapshotAborted
4639− | SnapshotMissing
4640− | SnapshotWaiting
4641− deriving (Show, Eq, Generic, Typeable)
4642−
4643−instance FromJSON SnapshotState where
4644− parseJSON = withText "SnapshotState" parse
4645− where
4646− parse "INIT" = return SnapshotInit
4647− parse "STARTED" = return SnapshotStarted
4648− parse "SUCCESS" = return SnapshotSuccess
4649− parse "FAILED" = return SnapshotFailed
4650− parse "ABORTED" = return SnapshotAborted
4651− parse "MISSING" = return SnapshotMissing
4652− parse "WAITING" = return SnapshotWaiting
4653− parse t = fail ("Invalid snapshot state " <> T.unpack t)
4654−
4655−
4656−newtype SnapshotName = SnapshotName { snapshotName :: Text }
4657− deriving (Show, Eq, Ord, Generic, Typeable, ToJSON, FromJSON)
4658−
4659−
4660−data SnapshotRestoreSettings = SnapshotRestoreSettings {
4661− snapRestoreWaitForCompletion :: Bool
4662− -- ^ Should the API call return immediately after initializing
4663− -- the restore or wait until completed? Note that if this is
4664− -- enabled, it could wait a long time, so you should adjust your
4665− -- 'ManagerSettings' accordingly to set long timeouts or
4666− -- explicitly handle timeouts.
4667− , snapRestoreIndices :: Maybe IndexSelection
4668− -- ^ Nothing will restore all indices in the snapshot. Just [] is
4669− -- permissable and will essentially be a no-op restore.
4670− , snapRestoreIgnoreUnavailable :: Bool
4671− -- ^ If set to True, any indices that do not exist will be ignored
4672− -- during snapshot rather than failing the restore.
4673− , snapRestoreIncludeGlobalState :: Bool
4674− -- ^ If set to false, will ignore any global state in the snapshot
4675− -- and will not restore it.
4676− , snapRestoreRenamePattern :: Maybe RestoreRenamePattern
4677− -- ^ A regex pattern for matching indices. Used with
4678− -- 'snapRestoreRenameReplacement', the restore can reference the
4679− -- matched index and create a new index name upon restore.
4680− , snapRestoreRenameReplacement :: Maybe (NonEmpty RestoreRenameToken)
4681− -- ^ Expression of how index renames should be constructed.
4682− , snapRestorePartial :: Bool
4683− -- ^ If some indices fail to restore, should the process proceed?
4684− , snapRestoreIncludeAliases :: Bool
4685− -- ^ Should the restore also restore the aliases captured in the
4686− -- snapshot.
4687− , snapRestoreIndexSettingsOverrides :: Maybe RestoreIndexSettings
4688− -- ^ Settings to apply during the restore process. __NOTE:__ This
4689− -- option is not supported in ES < 1.5 and should be set to
4690− -- Nothing in that case.
4691− , snapRestoreIgnoreIndexSettings :: Maybe (NonEmpty Text)
4692− -- ^ This type could be more rich but it isn't clear which
4693− -- settings are allowed to be ignored during restore, so we're
4694− -- going with including this feature in a basic form rather than
4695− -- omitting it. One example here would be
4696− -- "index.refresh_interval". Any setting specified here will
4697− -- revert back to the server default during the restore process.
4698− } deriving (Eq, Generic, Show, Typeable)
4699−
4700−-- | Regex-stype pattern, e.g. "index_(.+)" to match index names
4701−newtype RestoreRenamePattern = RestoreRenamePattern { rrPattern :: Text }
4702− deriving (Show, Eq, Generic, Typeable, Ord, ToJSON)
4703−
4704−
4705−-- | A single token in a index renaming scheme for a restore. These
4706−-- are concatenated into a string before being sent to
4707−-- ElasticSearch. Check out these Java
4708−-- <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.
4709−data RestoreRenameToken = RRTLit Text
4710− -- ^ Just a literal string of characters
4711− | RRSubWholeMatch
4712− -- ^ Equivalent to $0. The entire matched pattern, not any subgroup
4713− | RRSubGroup RRGroupRefNum
4714− -- ^ A specific reference to a group number
4715− deriving (Show, Eq, Generic, Typeable)
4716−
4717−
4718−-- | A group number for regex matching. Only values from 1-9 are
4719−-- supported. Construct with 'mkRRGroupRefNum'
4720−newtype RRGroupRefNum = RRGroupRefNum { rrGroupRefNum :: Int }
4721− deriving (Show, Eq, Generic, Typeable, Ord)
4722−
4723−instance Bounded RRGroupRefNum where
4724− minBound = RRGroupRefNum 1
4725− maxBound = RRGroupRefNum 9
4726−
4727−
4728−-- | Only allows valid group number references (1-9).
4729−mkRRGroupRefNum :: Int -> Maybe RRGroupRefNum
4730−mkRRGroupRefNum i
4731− | i >= (rrGroupRefNum minBound) && i <= (rrGroupRefNum maxBound) =
4732− Just $ RRGroupRefNum i
4733− | otherwise = Nothing
4734−
4735−
4736−-- | Reasonable defaults for snapshot restores
4737−--
4738−-- * snapRestoreWaitForCompletion False
4739−-- * snapRestoreIndices Nothing
4740−-- * snapRestoreIgnoreUnavailable False
4741−-- * snapRestoreIncludeGlobalState True
4742−-- * snapRestoreRenamePattern Nothing
4743−-- * snapRestoreRenameReplacement Nothing
4744−-- * snapRestorePartial False
4745−-- * snapRestoreIncludeAliases True
4746−-- * snapRestoreIndexSettingsOverrides Nothing
4747−-- * snapRestoreIgnoreIndexSettings Nothing
4748−defaultSnapshotRestoreSettings :: SnapshotRestoreSettings
4749−defaultSnapshotRestoreSettings = SnapshotRestoreSettings {
4750− snapRestoreWaitForCompletion = False
4751− , snapRestoreIndices = Nothing
4752− , snapRestoreIgnoreUnavailable = False
4753− , snapRestoreIncludeGlobalState = True
4754− , snapRestoreRenamePattern = Nothing
4755− , snapRestoreRenameReplacement = Nothing
4756− , snapRestorePartial = False
4757− , snapRestoreIncludeAliases = True
4758− , snapRestoreIndexSettingsOverrides = Nothing
4759− , snapRestoreIgnoreIndexSettings = Nothing
4760− }
4761−
4762−
4763−-- | Index settings that can be overridden. The docs only mention you
4764−-- can update number of replicas, but there may be more. You
4765−-- definitely cannot override shard count.
4766−data RestoreIndexSettings = RestoreIndexSettings {
4767− restoreOverrideReplicas :: Maybe ReplicaCount
4768− } deriving (Show, Eq, Generic, Typeable)
4769−
4770−
4771−instance ToJSON RestoreIndexSettings where
4772− toJSON RestoreIndexSettings {..} = object prs
4773− where
4774− prs = catMaybes [("index.number_of_replicas" .=) <$> restoreOverrideReplicas]
4775−
4776−
4777−instance FromJSON NodesInfo where
4778− parseJSON = withObject "NodesInfo" parse
4779− where
4780− parse o = do
4781− nodes <- o .: "nodes"
4782− infos <- forM (HM.toList nodes) $ \(fullNID, v) -> do
4783− node <- parseJSON v
4784− parseNodeInfo (FullNodeId fullNID) node
4785− cn <- o .: "cluster_name"
4786− return (NodesInfo infos cn)
4787−
4788−instance FromJSON NodesStats where
4789− parseJSON = withObject "NodesStats" parse
4790− where
4791− parse o = do
4792− nodes <- o .: "nodes"
4793− stats <- forM (HM.toList nodes) $ \(fullNID, v) -> do
4794− node <- parseJSON v
4795− parseNodeStats (FullNodeId fullNID) node
4796− cn <- o .: "cluster_name"
4797− return (NodesStats stats cn)
4798−
4799−instance FromJSON NodeBreakerStats where
4800− parseJSON = withObject "NodeBreakerStats" parse
4801− where
4802− parse o = NodeBreakerStats <$> o .: "tripped"
4803− <*> o .: "overhead"
4804− <*> o .: "estimated_size_in_bytes"
4805− <*> o .: "limit_size_in_bytes"
4806−
4807−instance FromJSON NodeHTTPStats where
4808− parseJSON = withObject "NodeHTTPStats" parse
4809− where
4810− parse o = NodeHTTPStats <$> o .: "total_opened"
4811− <*> o .: "current_open"
4812−
4813−instance FromJSON NodeTransportStats where
4814− parseJSON = withObject "NodeTransportStats" parse
4815− where
4816− parse o = NodeTransportStats <$> o .: "tx_size_in_bytes"
4817− <*> o .: "tx_count"
4818− <*> o .: "rx_size_in_bytes"
4819− <*> o .: "rx_count"
4820− <*> o .: "server_open"
4821−
4822−instance FromJSON NodeFSStats where
4823− parseJSON = withObject "NodeFSStats" parse
4824− where
4825− parse o = NodeFSStats <$> o .: "data"
4826− <*> o .: "total"
4827− <*> (posixMS <$> o .: "timestamp")
4828−
4829−instance FromJSON NodeDataPathStats where
4830− parseJSON = withObject "NodeDataPathStats" parse
4831− where
4832− parse o =
4833− NodeDataPathStats <$> (fmap unStringlyTypedDouble <$> o .:? "disk_service_time")
4834− <*> (fmap unStringlyTypedDouble <$> o .:? "disk_queue")
4835− <*> o .:? "disk_io_size_in_bytes"
4836− <*> o .:? "disk_write_size_in_bytes"
4837− <*> o .:? "disk_read_size_in_bytes"
4838− <*> o .:? "disk_io_op"
4839− <*> o .:? "disk_writes"
4840− <*> o .:? "disk_reads"
4841− <*> o .: "available_in_bytes"
4842− <*> o .: "free_in_bytes"
4843− <*> o .: "total_in_bytes"
4844− <*> o .:? "type"
4845− <*> o .: "dev"
4846− <*> o .: "mount"
4847− <*> o .: "path"
4848−
4849−newtype StringlyTypedDouble = StringlyTypedDouble { unStringlyTypedDouble :: Double }
4850−
4851−
4852−instance FromJSON StringlyTypedDouble where
4853− parseJSON = fmap StringlyTypedDouble . parseJSON . unStringlyTypeJSON
4854−
4855−
4856−instance FromJSON NodeFSTotalStats where
4857− parseJSON = withObject "NodeFSTotalStats" parse
4858− where
4859− parse o = NodeFSTotalStats <$> (fmap unStringlyTypedDouble <$> o .:? "disk_service_time")
4860− <*> (fmap unStringlyTypedDouble <$> o .:? "disk_queue")
4861− <*> o .:? "disk_io_size_in_bytes"
4862− <*> o .:? "disk_write_size_in_bytes"
4863− <*> o .:? "disk_read_size_in_bytes"
4864− <*> o .:? "disk_io_op"
4865− <*> o .:? "disk_writes"
4866− <*> o .:? "disk_reads"
4867− <*> o .: "available_in_bytes"
4868− <*> o .: "free_in_bytes"
4869− <*> o .: "total_in_bytes"
4870−
4871−instance FromJSON NodeNetworkStats where
4872− parseJSON = withObject "NodeNetworkStats" parse
4873− where
4874− parse o = do
4875− tcp <- o .: "tcp"
4876− NodeNetworkStats <$> tcp .: "out_rsts"
4877− <*> tcp .: "in_errs"
4878− <*> tcp .: "attempt_fails"
4879− <*> tcp .: "estab_resets"
4880− <*> tcp .: "retrans_segs"
4881− <*> tcp .: "out_segs"
4882− <*> tcp .: "in_segs"
4883− <*> tcp .: "curr_estab"
4884− <*> tcp .: "passive_opens"
4885− <*> tcp .: "active_opens"
4886−
4887−instance FromJSON NodeThreadPoolsStats where
4888− parseJSON = withObject "NodeThreadPoolsStats" parse
4889− where
4890− parse o = NodeThreadPoolsStats <$> o .: "snapshot"
4891− <*> o .: "bulk"
4892− <*> o .: "merge"
4893− <*> o .: "get"
4894− <*> o .: "management"
4895− <*> o .:? "fetch_shard_store"
4896− <*> o .: "optimize"
4897− <*> o .: "flush"
4898− <*> o .: "search"
4899− <*> o .: "warmer"
4900− <*> o .: "generic"
4901− <*> o .: "suggest"
4902− <*> o .: "refresh"
4903− <*> o .: "index"
4904− <*> o .:? "listener"
4905− <*> o .:? "fetch_shard_started"
4906− <*> o .: "percolate"
4907−instance FromJSON NodeThreadPoolStats where
4908− parseJSON = withObject "NodeThreadPoolStats" parse
4909− where
4910− parse o = NodeThreadPoolStats <$> o .: "completed"
4911− <*> o .: "largest"
4912− <*> o .: "rejected"
4913− <*> o .: "active"
4914− <*> o .: "queue"
4915− <*> o .: "threads"
4916−
4917−instance FromJSON NodeJVMStats where
4918− parseJSON = withObject "NodeJVMStats" parse
4919− where
4920− parse o = do
4921− bufferPools <- o .: "buffer_pools"
4922− mapped <- bufferPools .: "mapped"
4923− direct <- bufferPools .: "direct"
4924− gc <- o .: "gc"
4925− collectors <- gc .: "collectors"
4926− oldC <- collectors .: "old"
4927− youngC <- collectors .: "young"
4928− threads <- o .: "threads"
4929− mem <- o .: "mem"
4930− pools <- mem .: "pools"
4931− oldM <- pools .: "old"
4932− survivorM <- pools .: "survivor"
4933− youngM <- pools .: "young"
4934− NodeJVMStats <$> pure mapped
4935− <*> pure direct
4936− <*> pure oldC
4937− <*> pure youngC
4938− <*> threads .: "peak_count"
4939− <*> threads .: "count"
4940− <*> pure oldM
4941− <*> pure survivorM
4942− <*> pure youngM
4943− <*> mem .: "non_heap_committed_in_bytes"
4944− <*> mem .: "non_heap_used_in_bytes"
4945− <*> mem .: "heap_max_in_bytes"
4946− <*> mem .: "heap_committed_in_bytes"
4947− <*> mem .: "heap_used_percent"
4948− <*> mem .: "heap_used_in_bytes"
4949− <*> (unMS <$> o .: "uptime_in_millis")
4950− <*> (posixMS <$> o .: "timestamp")
4951−
4952−instance FromJSON JVMBufferPoolStats where
4953− parseJSON = withObject "JVMBufferPoolStats" parse
4954− where
4955− parse o = JVMBufferPoolStats <$> o .: "total_capacity_in_bytes"
4956− <*> o .: "used_in_bytes"
4957− <*> o .: "count"
4958−
4959−instance FromJSON JVMGCStats where
4960− parseJSON = withObject "JVMGCStats" parse
4961− where
4962− parse o = JVMGCStats <$> (unMS <$> o .: "collection_time_in_millis")
4963− <*> o .: "collection_count"
4964−
4965−instance FromJSON JVMPoolStats where
4966− parseJSON = withObject "JVMPoolStats" parse
4967− where
4968− parse o = JVMPoolStats <$> o .: "peak_max_in_bytes"
4969− <*> o .: "peak_used_in_bytes"
4970− <*> o .: "max_in_bytes"
4971− <*> o .: "used_in_bytes"
4972−
4973−instance FromJSON NodeProcessStats where
4974− parseJSON = withObject "NodeProcessStats" parse
4975− where
4976− parse o = do
4977− mem <- o .: "mem"
4978− cpu <- o .: "cpu"
4979− NodeProcessStats <$> mem .: "total_virtual_in_bytes"
4980− <*> mem .: "share_in_bytes"
4981− <*> mem .: "resident_in_bytes"
4982− <*> (unMS <$> cpu .: "total_in_millis")
4983− <*> (unMS <$> cpu .: "user_in_millis")
4984− <*> (unMS <$> cpu .: "sys_in_millis")
4985− <*> cpu .: "percent"
4986− <*> o .: "open_file_descriptors"
4987− <*> (posixMS <$> o .: "timestamp")
4988−
4989−instance FromJSON NodeOSStats where
4990− parseJSON = withObject "NodeOSStats" parse
4991− where
4992− parse o = do
4993− swap <- o .: "swap"
4994− mem <- o .: "mem"
4995− cpu <- o .: "cpu"
4996− load <- o .:? "load_average"
4997− NodeOSStats <$> swap .: "free_in_bytes"
4998− <*> swap .: "used_in_bytes"
4999− <*> mem .: "actual_used_in_bytes"
5000− <*> mem .: "actual_free_in_bytes"
5001− <*> mem .: "used_percent"
5002− <*> mem .: "free_percent"
5003− <*> mem .: "used_in_bytes"
5004− <*> mem .: "free_in_bytes"
5005− <*> cpu .: "stolen"
5006− <*> cpu .: "usage"
5007− <*> cpu .: "idle"
5008− <*> cpu .: "user"
5009− <*> cpu .: "sys"
5010− <*> pure load
5011− <*> (unMS <$> o .: "uptime_in_millis")
5012− <*> (posixMS <$> o .: "timestamp")
5013−
5014−instance FromJSON LoadAvgs where
5015− parseJSON = withArray "LoadAvgs" parse
5016− where
5017− parse v = case V.toList v of
5018− [one, five, fifteen] -> LoadAvgs <$> parseJSON one
5019− <*> parseJSON five
5020− <*> parseJSON fifteen
5021− _ -> fail "Expecting a triple of Doubles"
5022−
5023−instance FromJSON NodeIndicesStats where
5024− parseJSON = withObject "NodeIndicesStats" parse
5025− where
5026− parse o = do
5027− let (.::) mv k = case mv of
5028− Just v -> Just <$> v .: k
5029− Nothing -> pure Nothing
5030− mRecovery <- o .:? "recovery"
5031− mQueryCache <- o .:? "query_cache"
5032− suggest <- o .: "suggest"
5033− translog <- o .: "translog"
5034− segments <- o .: "segments"
5035− completion <- o .: "completion"
5036− percolate <- o .: "percolate"
5037− fielddata <- o .: "fielddata"
5038− idCache <- o .: "id_cache"
5039− filterCache <- o .: "filter_cache"
5040− warmer <- o .: "warmer"
5041− flush <- o .: "flush"
5042− refresh <- o .: "refresh"
5043− merges <- o .: "merges"
5044− search <- o .: "search"
5045− getStats <- o .: "get"
5046− indexing <- o .: "indexing"
5047− store <- o .: "store"
5048− docs <- o .: "docs"
5049− NodeIndicesStats <$> (fmap unMS <$> mRecovery .:: "throttle_time_in_millis")
5050− <*> mRecovery .:: "current_as_target"
5051− <*> mRecovery .:: "current_as_source"
5052− <*> mQueryCache .:: "miss_count"
5053− <*> mQueryCache .:: "hit_count"
5054− <*> mQueryCache .:: "evictions"
5055− <*> mQueryCache .:: "memory_size_in_bytes"
5056− <*> suggest .: "current"
5057− <*> (unMS <$> suggest .: "time_in_millis")
5058− <*> suggest .: "total"
5059− <*> translog .: "size_in_bytes"
5060− <*> translog .: "operations"
5061− <*> segments .:? "fixed_bit_set_memory_in_bytes"
5062− <*> segments .: "version_map_memory_in_bytes"
5063− <*> segments .:? "index_writer_max_memory_in_bytes"
5064− <*> segments .: "index_writer_memory_in_bytes"
5065− <*> segments .: "memory_in_bytes"
5066− <*> segments .: "count"
5067− <*> completion .: "size_in_bytes"
5068− <*> percolate .: "queries"
5069− <*> percolate .: "memory_size_in_bytes"
5070− <*> percolate .: "current"
5071− <*> (unMS <$> percolate .: "time_in_millis")
5072− <*> percolate .: "total"
5073− <*> fielddata .: "evictions"
5074− <*> fielddata .: "memory_size_in_bytes"
5075− <*> idCache .: "memory_size_in_bytes"
5076− <*> filterCache .: "evictions"
5077− <*> filterCache .: "memory_size_in_bytes"
5078− <*> (unMS <$> warmer .: "total_time_in_millis")
5079− <*> warmer .: "total"
5080− <*> warmer .: "current"
5081− <*> (unMS <$> flush .: "total_time_in_millis")
5082− <*> flush .: "total"
5083− <*> (unMS <$> refresh .: "total_time_in_millis")
5084− <*> refresh .: "total"
5085− <*> merges .: "total_size_in_bytes"
5086− <*> merges .: "total_docs"
5087− <*> (unMS <$> merges .: "total_time_in_millis")
5088− <*> merges .: "total"
5089− <*> merges .: "current_size_in_bytes"
5090− <*> merges .: "current_docs"
5091− <*> merges .: "current"
5092− <*> search .: "fetch_current"
5093− <*> (unMS <$> search .: "fetch_time_in_millis")
5094− <*> search .: "fetch_total"
5095− <*> search .: "query_current"
5096− <*> (unMS <$> search .: "query_time_in_millis")
5097− <*> search .: "query_total"
5098− <*> search .: "open_contexts"
5099− <*> getStats .: "current"
5100− <*> (unMS <$> getStats .: "missing_time_in_millis")
5101− <*> getStats .: "missing_total"
5102− <*> (unMS <$> getStats .: "exists_time_in_millis")
5103− <*> getStats .: "exists_total"
5104− <*> (unMS <$> getStats .: "time_in_millis")
5105− <*> getStats .: "total"
5106− <*> (fmap unMS <$> indexing .:? "throttle_time_in_millis")
5107− <*> indexing .:? "is_throttled"
5108− <*> indexing .:? "noop_update_total"
5109− <*> indexing .: "delete_current"
5110− <*> (unMS <$> indexing .: "delete_time_in_millis")
5111− <*> indexing .: "delete_total"
5112− <*> indexing .: "index_current"
5113− <*> (unMS <$> indexing .: "index_time_in_millis")
5114− <*> indexing .: "index_total"
5115− <*> (unMS <$> store .: "throttle_time_in_millis")
5116− <*> store .: "size_in_bytes"
5117− <*> docs .: "deleted"
5118− <*> docs .: "count"
5119−
5120−instance FromJSON NodeBreakersStats where
5121− parseJSON = withObject "NodeBreakersStats" parse
5122− where
5123− parse o = NodeBreakersStats <$> o .: "parent"
5124− <*> o .: "request"
5125− <*> o .: "fielddata"
5126−
5127−parseNodeStats :: FullNodeId -> Object -> Parser NodeStats
5128−parseNodeStats fnid o = do
5129− NodeStats <$> o .: "name"
5130− <*> pure fnid
5131− <*> o .:? "breakers"
5132− <*> o .: "http"
5133− <*> o .: "transport"
5134− <*> o .: "fs"
5135− <*> o .: "network"
5136− <*> o .: "thread_pool"
5137− <*> o .: "jvm"
5138− <*> o .: "process"
5139− <*> o .: "os"
5140− <*> o .: "indices"
5141−
5142−parseNodeInfo :: FullNodeId -> Object -> Parser NodeInfo
5143−parseNodeInfo nid o =
5144− NodeInfo <$> o .: "http_address"
5145− <*> o .: "build"
5146− <*> o .: "version"
5147− <*> o .: "ip"
5148− <*> o .: "host"
5149− <*> o .: "transport_address"
5150− <*> o .: "name"
5151− <*> pure nid
5152− <*> o .: "plugins"
5153− <*> o .: "http"
5154− <*> o .: "transport"
5155− <*> o .: "network"
5156− <*> o .: "thread_pool"
5157− <*> o .: "jvm"
5158− <*> o .: "process"
5159− <*> o .: "os"
5160− <*> o .: "settings"
5161−
5162−instance FromJSON NodePluginInfo where
5163− parseJSON = withObject "NodePluginInfo" parse
5164− where
5165− parse o = NodePluginInfo <$> o .: "site"
5166− <*> o .: "jvm"
5167− <*> o .: "description"
5168− <*> o .: "version"
5169− <*> o .: "name"
5170−
5171−instance FromJSON NodeHTTPInfo where
5172− parseJSON = withObject "NodeHTTPInfo" parse
5173− where
5174− parse o = NodeHTTPInfo <$> o .: "max_content_length_in_bytes"
5175− <*> parseJSON (Object o)
5176−
5177−instance FromJSON BoundTransportAddress where
5178− parseJSON = withObject "BoundTransportAddress" parse
5179− where
5180− parse o = BoundTransportAddress <$> o .: "publish_address"
5181− <*> o .: "bound_address"
5182−
5183−instance FromJSON NodeOSInfo where
5184− parseJSON = withObject "NodeOSInfo" parse
5185− where
5186− parse o = do
5187− swap <- o .: "swap"
5188− mem <- o .: "mem"
5189− NodeOSInfo <$> swap .: "total_in_bytes"
5190− <*> mem .: "total_in_bytes"
5191− <*> o .: "cpu"
5192− <*> o .: "available_processors"
5193− <*> (unMS <$> o .: "refresh_interval_in_millis")
5194−
5195−
5196−instance FromJSON CPUInfo where
5197− parseJSON = withObject "CPUInfo" parse
5198− where
5199− parse o = CPUInfo <$> o .: "cache_size_in_bytes"
5200− <*> o .: "cores_per_socket"
5201− <*> o .: "total_sockets"
5202− <*> o .: "total_cores"
5203− <*> o .: "mhz"
5204− <*> o .: "model"
5205− <*> o .: "vendor"
5206−
5207−instance FromJSON NodeProcessInfo where
5208− parseJSON = withObject "NodeProcessInfo" parse
5209− where
5210− parse o = NodeProcessInfo <$> o .: "mlockall"
5211− <*> o .: "max_file_descriptors"
5212− <*> o .: "id"
5213− <*> (unMS <$> o .: "refresh_interval_in_millis")
5214−
5215−instance FromJSON NodeJVMInfo where
5216− parseJSON = withObject "NodeJVMInfo" parse
5217− where
5218− parse o = NodeJVMInfo <$> o .: "memory_pools"
5219− <*> o .: "gc_collectors"
5220− <*> o .: "mem"
5221− <*> (posixMS <$> o .: "start_time_in_millis")
5222− <*> o .: "vm_vendor"
5223− <*> o .: "vm_version"
5224− <*> o .: "vm_name"
5225− <*> (unJVMVersion <$> o .: "version")
5226− <*> o .: "pid"
5227−
5228−instance FromJSON JVMVersion where
5229− parseJSON (String t) =
5230− JVMVersion <$> parseJSON (String (T.replace "_" "." t))
5231− parseJSON v = JVMVersion <$> parseJSON v
5232−
5233−instance FromJSON JVMMemoryInfo where
5234− parseJSON = withObject "JVMMemoryInfo" parse
5235− where
5236− parse o = JVMMemoryInfo <$> o .: "direct_max_in_bytes"
5237− <*> o .: "non_heap_max_in_bytes"
5238− <*> o .: "non_heap_init_in_bytes"
5239− <*> o .: "heap_max_in_bytes"
5240− <*> o .: "heap_init_in_bytes"
5241−
5242−instance FromJSON NodeThreadPoolsInfo where
5243− parseJSON = withObject "NodeThreadPoolsInfo" parse
5244− where
5245− parse o = NodeThreadPoolsInfo <$> o .: "refresh"
5246− <*> o .: "management"
5247− <*> o .: "percolate"
5248− <*> o .:? "listener"
5249− <*> o .:? "fetch_shard_started"
5250− <*> o .: "search"
5251− <*> o .: "flush"
5252− <*> o .: "warmer"
5253− <*> o .: "optimize"
5254− <*> o .: "bulk"
5255− <*> o .: "suggest"
5256− <*> o .: "merge"
5257− <*> o .: "snapshot"
5258− <*> o .: "get"
5259− <*> o .:? "fetch_shard_store"
5260− <*> o .: "index"
5261− <*> o .: "generic"
5262−
5263−instance FromJSON NodeThreadPoolInfo where
5264− parseJSON = withObject "NodeThreadPoolInfo" parse
5265− where
5266− parse o = do
5267− ka <- maybe (return Nothing) (fmap Just . parseStringInterval) =<< o .:? "keep_alive"
5268− NodeThreadPoolInfo <$> (parseJSON . unStringlyTypeJSON =<< o .: "queue_size")
5269− <*> pure ka
5270− <*> o .:? "min"
5271− <*> o .:? "max"
5272− <*> o .: "type"
5273−
5274−parseStringInterval :: (Monad m) => String -> m NominalDiffTime
5275−parseStringInterval s = case span isNumber s of
5276− ("", _) -> fail "Invalid interval"
5277− (nS, unitS) -> case (readMay nS, readMay unitS) of
5278− (Just n, Just unit) -> return (fromInteger (n * unitNDT unit))
5279− (Nothing, _) -> fail "Invalid interval number"
5280− (_, Nothing) -> fail "Invalid interval unit"
5281− where
5282− unitNDT Seconds = 1
5283− unitNDT Minutes = 60
5284− unitNDT Hours = 60 * 60
5285− unitNDT Days = 24 * 60 * 60
5286− unitNDT Weeks = 7 * 24 * 60 * 60
5287−
5288−instance FromJSON ThreadPoolSize where
5289− parseJSON v = parseAsNumber v <|> parseAsString v
5290− where
5291− parseAsNumber = parseAsInt <=< parseJSON
5292− parseAsInt (-1) = return ThreadPoolUnbounded
5293− parseAsInt n
5294− | n >= 0 = return (ThreadPoolBounded n)
5295− | otherwise = fail "Thread pool size must be >= -1."
5296− parseAsString = withText "ThreadPoolSize" $ \t ->
5297− case first (readMay . T.unpack) (T.span isNumber t) of
5298− (Just n, "k") -> return (ThreadPoolBounded (n * 1000))
5299− (Just n, "") -> return (ThreadPoolBounded n)
5300− _ -> fail ("Invalid thread pool size " <> T.unpack t)
5301−
5302−instance FromJSON ThreadPoolType where
5303− parseJSON = withText "ThreadPoolType" parse
5304− where
5305− parse "scaling" = return ThreadPoolScaling
5306− parse "fixed" = return ThreadPoolFixed
5307− parse "cached" = return ThreadPoolCached
5308− parse e = fail ("Unexpected thread pool type" <> T.unpack e)
5309−
5310−instance FromJSON NodeTransportInfo where
5311− parseJSON = withObject "NodeTransportInfo" parse
5312− where
5313− parse o = NodeTransportInfo <$> (maybe (return mempty) parseProfiles =<< o .:? "profiles")
5314− <*> parseJSON (Object o)
5315− parseProfiles (Object o) | HM.null o = return []
5316− parseProfiles v@(Array _) = parseJSON v
5317− parseProfiles Null = return []
5318− parseProfiles _ = fail "Could not parse profiles"
5319−
5320−instance FromJSON NodeNetworkInfo where
5321− parseJSON = withObject "NodeNetworkInfo" parse
5322− where
5323− parse o = NodeNetworkInfo <$> o .: "primary_interface"
5324− <*> (unMS <$> o .: "refresh_interval_in_millis")
5325−
5326−
5327−instance FromJSON NodeNetworkInterface where
5328− parseJSON = withObject "NodeNetworkInterface" parse
5329− where
5330− parse o = NodeNetworkInterface <$> o .: "mac_address"
5331− <*> o .: "name"
5332− <*> o .: "address"
5333−
5334−newtype MaybeNA a = MaybeNA { unMaybeNA :: Maybe a }
5335− deriving (Show, Eq)
5336−
5337−instance FromJSON a => FromJSON (MaybeNA a) where
5338− parseJSON (String "NA") = pure $ MaybeNA Nothing
5339− parseJSON o = MaybeNA . Just <$> parseJSON o
5340−
5341−
5342−data Suggest = Suggest { suggestText :: Text
5343− , suggestName :: Text
5344− , suggestType :: SuggestType
5345− }
5346− deriving (Show, Generic, Eq, Read, Typeable)
5347−
5348−instance ToJSON Suggest where
5349− toJSON Suggest{..} = object [ "text" .= suggestText
5350− , suggestName .= suggestType
5351− ]
5352−
5353−instance FromJSON Suggest where
5354− parseJSON (Object o) = do
5355− suggestText' <- o .: "text"
5356− let dropTextList = HM.toList $ HM.filterWithKey (\x _ -> x /= "text") o
5357− suggestName' <- case dropTextList of
5358− [(x, _)] -> return x
5359− _ -> fail "error parsing Suggest field name"
5360− suggestType' <- o .: suggestName'
5361− return $ Suggest suggestText' suggestName' suggestType'
5362− parseJSON x = typeMismatch "Suggest" x
5363−
5364−data SuggestType = SuggestTypePhraseSuggester PhraseSuggester
5365− deriving (Show, Generic, Eq, Read, Typeable)
5366−
5367−instance ToJSON SuggestType where
5368− toJSON (SuggestTypePhraseSuggester x) = object ["phrase" .= x]
5369−
5370−instance FromJSON SuggestType where
5371− parseJSON = withObject "SuggestType" parse
5372− where parse o = phraseSuggester `taggedWith` "phrase"
5373− where taggedWith parser k = parser =<< o .: k
5374− phraseSuggester = pure . SuggestTypePhraseSuggester
5375−
5376−data PhraseSuggester =
5377− PhraseSuggester { phraseSuggesterField :: FieldName
5378− , phraseSuggesterGramSize :: Maybe Int
5379− , phraseSuggesterRealWordErrorLikelihood :: Maybe Int
5380− , phraseSuggesterConfidence :: Maybe Int
5381− , phraseSuggesterMaxErrors :: Maybe Int
5382− , phraseSuggesterSeparator :: Maybe Text
5383− , phraseSuggesterSize :: Maybe Size
5384− , phraseSuggesterAnalyzer :: Maybe Analyzer
5385− , phraseSuggesterShardSize :: Maybe Int
5386− , phraseSuggesterHighlight :: Maybe PhraseSuggesterHighlighter
5387− , phraseSuggesterCollate :: Maybe PhraseSuggesterCollate
5388− , phraseSuggesterCandidateGenerators :: [DirectGenerators]
5389− }
5390− deriving (Show, Generic, Eq, Read, Typeable)
5391−
5392−instance ToJSON PhraseSuggester where
5393− toJSON PhraseSuggester{..} = omitNulls [ "field" .= phraseSuggesterField
5394− , "gram_size" .= phraseSuggesterGramSize
5395− , "real_word_error_likelihood" .= phraseSuggesterRealWordErrorLikelihood
5396− , "confidence" .= phraseSuggesterConfidence
5397− , "max_errors" .= phraseSuggesterMaxErrors
5398− , "separator" .= phraseSuggesterSeparator
5399− , "size" .= phraseSuggesterSize
5400− , "analyzer" .= phraseSuggesterAnalyzer
5401− , "shard_size" .= phraseSuggesterShardSize
5402− , "highlight" .= phraseSuggesterHighlight
5403− , "collate" .= phraseSuggesterCollate
5404− , "direct_generator" .= phraseSuggesterCandidateGenerators
5405− ]
5406−
5407−instance FromJSON PhraseSuggester where
5408− parseJSON = withObject "PhraseSuggester" parse
5409− where parse o = PhraseSuggester
5410− <$> o .: "field"
5411− <*> o .:? "gram_size"
5412− <*> o .:? "real_word_error_likelihood"
5413− <*> o .:? "confidence"
5414− <*> o .:? "max_errors"
5415− <*> o .:? "separator"
5416− <*> o .:? "size"
5417− <*> o .:? "analyzer"
5418− <*> o .:? "shard_size"
5419− <*> o .:? "highlight"
5420− <*> o .:? "collate"
5421− <*> o .:? "direct_generator" .!= []
5422−
5423−mkPhraseSuggester :: FieldName -> PhraseSuggester
5424−mkPhraseSuggester fName =
5425− PhraseSuggester fName Nothing Nothing Nothing Nothing Nothing Nothing
5426− Nothing Nothing Nothing Nothing []
5427−
5428−data PhraseSuggesterHighlighter =
5429− PhraseSuggesterHighlighter { phraseSuggesterHighlighterPreTag :: Text
5430− , phraseSuggesterHighlighterPostTag :: Text
5431− }
5432− deriving (Show, Generic, Eq, Read, Typeable)
5433−
5434−instance ToJSON PhraseSuggesterHighlighter where
5435− toJSON PhraseSuggesterHighlighter{..} =
5436− object [ "pre_tag" .= phraseSuggesterHighlighterPreTag
5437− , "post_tag" .= phraseSuggesterHighlighterPostTag
5438− ]
5439−
5440−instance FromJSON PhraseSuggesterHighlighter where
5441− parseJSON = withObject "PhraseSuggesterHighlighter" parse
5442− where parse o = PhraseSuggesterHighlighter
5443− <$> o .: "pre_tag"
5444− <*> o .: "post_tag"
5445−
5446−data PhraseSuggesterCollate =
5447− PhraseSuggesterCollate { phraseSuggesterCollateTemplateQuery :: TemplateQueryInline
5448− , phraseSuggesterCollatePrune :: Bool
5449− }
5450− deriving (Show, Generic, Eq, Read, Typeable)
5451−
5452−instance ToJSON PhraseSuggesterCollate where
5453− toJSON PhraseSuggesterCollate{..} = object [ "query" .= object
5454− [ "inline" .= (inline phraseSuggesterCollateTemplateQuery)
5455− ]
5456− , "params" .= (params phraseSuggesterCollateTemplateQuery)
5457− , "prune" .= phraseSuggesterCollatePrune
5458− ]
5459−
5460−instance FromJSON PhraseSuggesterCollate where
5461− parseJSON (Object o) = do
5462− query' <- o .: "query"
5463− inline' <- query' .: "inline"
5464− params' <- o .: "params"
5465− prune' <- o .:? "prune" .!= False
5466− return $ PhraseSuggesterCollate (TemplateQueryInline inline' params') prune'
5467− parseJSON x = typeMismatch "PhraseSuggesterCollate" x
5468−
5469−data SuggestOptions =
5470− SuggestOptions { suggestOptionsText :: Text
5471− , suggestOptionsScore :: Double
5472− , suggestOptionsFreq :: Maybe Int
5473− , suggestOptionsHighlighted :: Maybe Text
5474− }
5475− deriving (Eq, Read, Show)
5476−
5477−instance FromJSON SuggestOptions where
5478− parseJSON = withObject "SuggestOptions" parse
5479− where parse o = SuggestOptions
5480− <$> o .: "text"
5481− <*> o .: "score"
5482− <*> o .:? "freq"
5483− <*> o .:? "highlighted"
5484−
5485−data SuggestResponse =
5486− SuggestResponse { suggestResponseText :: Text
5487− , suggestResponseOffset :: Int
5488− , suggestResponseLength :: Int
5489− , suggestResponseOptions :: [SuggestOptions]
5490− }
5491− deriving (Eq, Read, Show)
5492−
5493−instance FromJSON SuggestResponse where
5494− parseJSON = withObject "SuggestResponse" parse
5495− where parse o = SuggestResponse
5496− <$> o .: "text"
5497− <*> o .: "offset"
5498− <*> o .: "length"
5499− <*> o .: "options"
5500−
5501−data NamedSuggestionResponse =
5502− NamedSuggestionResponse { nsrName :: Text
5503− , nsrResponses :: [SuggestResponse]
5504− }
5505− deriving (Eq, Read, Show)
5506−
5507−instance FromJSON NamedSuggestionResponse where
5508− parseJSON (Object o) = do
5509− suggestionName' <- case HM.toList o of
5510− [(x, _)] -> return x
5511− _ -> fail "error parsing NamedSuggestionResponse name"
5512− suggestionResponses' <- o .: suggestionName'
5513− return $ NamedSuggestionResponse suggestionName' suggestionResponses'
5514−
5515− parseJSON x = typeMismatch "NamedSuggestionResponse" x
5516−
5517−data DirectGeneratorSuggestModeTypes = DirectGeneratorSuggestModeMissing
5518− | DirectGeneratorSuggestModePopular
5519− | DirectGeneratorSuggestModeAlways
5520− deriving (Show, Eq, Read, Generic, Typeable)
5521−
5522−instance ToJSON DirectGeneratorSuggestModeTypes where
5523− toJSON DirectGeneratorSuggestModeMissing = "missing"
5524− toJSON DirectGeneratorSuggestModePopular = "popular"
5525− toJSON DirectGeneratorSuggestModeAlways = "always"
5526−
5527−instance FromJSON DirectGeneratorSuggestModeTypes where
5528− parseJSON = withText "DirectGeneratorSuggestModeTypes" parse
5529− where parse "missing" = pure DirectGeneratorSuggestModeMissing
5530− parse "popular" = pure DirectGeneratorSuggestModePopular
5531− parse "always" = pure DirectGeneratorSuggestModeAlways
5532− parse f = fail ("Unexpected DirectGeneratorSuggestModeTypes: " <> show f)
5533−
5534−data DirectGenerators = DirectGenerators
5535− { directGeneratorsField :: FieldName
5536− , directGeneratorsSize :: Maybe Int
5537− , directGeneratorSuggestMode :: DirectGeneratorSuggestModeTypes
5538− , directGeneratorMaxEdits :: Maybe Double
5539− , directGeneratorPrefixLength :: Maybe Int
5540− , directGeneratorMinWordLength :: Maybe Int
5541− , directGeneratorMaxInspections :: Maybe Int
5542− , directGeneratorMinDocFreq :: Maybe Double
5543− , directGeneratorMaxTermFreq :: Maybe Double
5544− , directGeneratorPreFilter :: Maybe Text
5545− , directGeneratorPostFilter :: Maybe Text
5546− }
5547− deriving (Show, Eq, Read, Generic, Typeable)
5548−
5549−
5550−instance ToJSON DirectGenerators where
5551− toJSON DirectGenerators{..} = omitNulls [ "field" .= directGeneratorsField
5552− , "size" .= directGeneratorsSize
5553− , "suggest_mode" .= directGeneratorSuggestMode
5554− , "max_edits" .= directGeneratorMaxEdits
5555− , "prefix_length" .= directGeneratorPrefixLength
5556− , "min_word_length" .= directGeneratorMinWordLength
5557− , "max_inspections" .= directGeneratorMaxInspections
5558− , "min_doc_freq" .= directGeneratorMinDocFreq
5559− , "max_term_freq" .= directGeneratorMaxTermFreq
5560− , "pre_filter" .= directGeneratorPreFilter
5561− , "post_filter" .= directGeneratorPostFilter
5562− ]
5563−
5564−instance FromJSON DirectGenerators where
5565− parseJSON = withObject "DirectGenerators" parse
5566− where parse o = DirectGenerators
5567− <$> o .: "field"
5568− <*> o .:? "size"
5569− <*> o .: "suggest_mode"
5570− <*> o .:? "max_edits"
5571− <*> o .:? "prefix_length"
5572− <*> o .:? "min_word_length"
5573− <*> o .:? "max_inspections"
5574− <*> o .:? "min_doc_freq"
5575− <*> o .:? "max_term_freq"
5576− <*> o .:? "pre_filter"
5577− <*> o .:? "post_filter"
5578−
5579−mkDirectGenerators :: FieldName -> DirectGenerators
5580−mkDirectGenerators fn = DirectGenerators fn Nothing DirectGeneratorSuggestModeMissing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing
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−5491
@@ -1,5491 +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− , Compression(..)
78− , ReplicaBounds(..)
79− , Bytes(..)
80− , gigabytes
81− , megabytes
82− , kilobytes
83− , FSType(..)
84− , InitialShardCount(..)
85− , NodeAttrFilter(..)
86− , NodeAttrName(..)
87− , CompoundFormat(..)
88− , IndexTemplate(..)
89− , Server(..)
90− , Reply
91− , EsResult(..)
92− , EsResultFound(..)
93− , EsError(..)
94− , EsProtocolException(..)
95− , IndexAlias(..)
96− , IndexAliasName(..)
97− , IndexAliasAction(..)
98− , IndexAliasCreate(..)
99− , IndexAliasSummary(..)
100− , IndexAliasesSummary(..)
101− , AliasRouting(..)
102− , SearchAliasRouting(..)
103− , IndexAliasRouting(..)
104− , RoutingValue(..)
105− , DocVersion
106− , ExternalDocVersion(..)
107− , VersionControl(..)
108− , DocumentParent(..)
109− , IndexDocumentSettings(..)
110− , Query(..)
111− , Search(..)
112− , SearchType(..)
113− , SearchResult(..)
114− , ScrollId(..)
115− , SearchHits(..)
116− , TrackSortScores
117− , From(..)
118− , Size(..)
119− , Source(..)
120− , PatternOrPatterns(..)
121− , Include(..)
122− , Exclude(..)
123− , Pattern(..)
124− , ShardResult(..)
125− , Hit(..)
126− , Filter(..)
127− , Seminearring(..)
128− , BoolMatch(..)
129− , Term(..)
130− , GeoPoint(..)
131− , GeoBoundingBoxConstraint(..)
132− , GeoBoundingBox(..)
133− , GeoFilterType(..)
134− , Distance(..)
135− , DistanceUnit(..)
136− , DistanceType(..)
137− , DistanceRange(..)
138− , OptimizeBbox(..)
139− , LatLon(..)
140− , RangeValue(..)
141− , RangeExecution(..)
142− , LessThan(..)
143− , LessThanEq(..)
144− , GreaterThan(..)
145− , GreaterThanEq(..)
146− , LessThanD(..)
147− , LessThanEqD(..)
148− , GreaterThanD(..)
149− , GreaterThanEqD(..)
150− , Regexp(..)
151− , RegexpFlags(..)
152− , RegexpFlag(..)
153− , FieldName(..)
154− , Script(..)
155− , IndexName(..)
156− , IndexSelection(..)
157− , NodeSelection(..)
158− , NodeSelector(..)
159− , ForceMergeIndexSettings(..)
160− , defaultForceMergeIndexSettings
161− , TemplateName(..)
162− , TemplatePattern(..)
163− , MappingName(..)
164− , DocId(..)
165− , CacheName(..)
166− , CacheKey(..)
167− , BulkOperation(..)
168− , ReplicaCount(..)
169− , ShardCount(..)
170− , Sort
171− , SortMode(..)
172− , SortOrder(..)
173− , SortSpec(..)
174− , DefaultSort(..)
175− , Missing(..)
176− , OpenCloseIndex(..)
177− , Method
178− , Boost(..)
179− , MatchQuery(..)
180− , MultiMatchQuery(..)
181− , BoolQuery(..)
182− , BoostingQuery(..)
183− , CommonTermsQuery(..)
184− , DisMaxQuery(..)
185− , FuzzyLikeThisQuery(..)
186− , FuzzyLikeFieldQuery(..)
187− , FuzzyQuery(..)
188− , HasChildQuery(..)
189− , HasParentQuery(..)
190− , IndicesQuery(..)
191− , MoreLikeThisQuery(..)
192− , MoreLikeThisFieldQuery(..)
193− , NestedQuery(..)
194− , PrefixQuery(..)
195− , QueryStringQuery(..)
196− , SimpleQueryStringQuery(..)
197− , RangeQuery(..)
198− , RegexpQuery(..)
199− , QueryString(..)
200− , TemplateQueryInline(..)
201− , TemplateQueryKeyValuePairs(..)
202− , BooleanOperator(..)
203− , ZeroTermsQuery(..)
204− , CutoffFrequency(..)
205− , Analyzer(..)
206− , Tokenizer(..)
207− , MaxExpansions(..)
208− , Lenient(..)
209− , MatchQueryType(..)
210− , MultiMatchQueryType(..)
211− , Tiebreaker(..)
212− , MinimumMatch(..)
213− , DisableCoord(..)
214− , CommonMinimumMatch(..)
215− , MinimumMatchHighLow(..)
216− , PrefixLength(..)
217− , Fuzziness(..)
218− , IgnoreTermFrequency(..)
219− , MaxQueryTerms(..)
220− , ScoreType(..)
221− , Score
222− , Cache
223− , TypeName(..)
224− , BoostTerms(..)
225− , MaxWordLength(..)
226− , MinWordLength(..)
227− , MaxDocFrequency(..)
228− , MinDocFrequency(..)
229− , PhraseSlop(..)
230− , StopWord(..)
231− , QueryPath(..)
232− , MinimumTermFrequency(..)
233− , PercentMatch(..)
234− , FieldDefinition(..)
235− , MappingField(..)
236− , Mapping(..)
237− , AllowLeadingWildcard(..)
238− , LowercaseExpanded(..)
239− , GeneratePhraseQueries(..)
240− , Locale(..)
241− , AnalyzeWildcard(..)
242− , EnablePositionIncrements(..)
243− , SimpleQueryFlag(..)
244− , FieldOrFields(..)
245− , Monoid(..)
246− , ToJSON(..)
247− , Interval(..)
248− , TimeInterval(..)
249− , ExecutionHint(..)
250− , CollectionMode(..)
251− , TermOrder(..)
252− , TermInclusion(..)
253− , SnapshotRepoSelection(..)
254− , GenericSnapshotRepo(..)
255− , SnapshotRepo(..)
256− , SnapshotRepoConversionError(..)
257− , SnapshotRepoType(..)
258− , GenericSnapshotRepoSettings(..)
259− , SnapshotRepoUpdateSettings(..)
260− , defaultSnapshotRepoUpdateSettings
261− , SnapshotRepoName(..)
262− , SnapshotRepoPattern(..)
263− , SnapshotVerification(..)
264− , SnapshotNodeVerification(..)
265− , FullNodeId(..)
266− , NodeName(..)
267− , ClusterName(..)
268− , NodesInfo(..)
269− , NodesStats(..)
270− , NodeStats(..)
271− , NodeBreakersStats(..)
272− , NodeBreakerStats(..)
273− , NodeHTTPStats(..)
274− , NodeTransportStats(..)
275− , NodeFSStats(..)
276− , NodeDataPathStats(..)
277− , NodeFSTotalStats(..)
278− , NodeNetworkStats(..)
279− , NodeThreadPoolsStats(..)
280− , NodeThreadPoolStats(..)
281− , NodeJVMStats(..)
282− , JVMBufferPoolStats(..)
283− , JVMGCStats(..)
284− , JVMPoolStats(..)
285− , NodeProcessStats(..)
286− , NodeOSStats(..)
287− , LoadAvgs(..)
288− , NodeIndicesStats(..)
289− , EsAddress(..)
290− , PluginName(..)
291− , NodeInfo(..)
292− , NodePluginInfo(..)
293− , NodeHTTPInfo(..)
294− , NodeTransportInfo(..)
295− , BoundTransportAddress(..)
296− , NodeNetworkInfo(..)
297− , MacAddress(..)
298− , NetworkInterfaceName(..)
299− , NodeNetworkInterface(..)
300− , NodeThreadPoolsInfo(..)
301− , NodeThreadPoolInfo(..)
302− , ThreadPoolSize(..)
303− , ThreadPoolType(..)
304− , NodeJVMInfo(..)
305− , JVMMemoryPool(..)
306− , JVMGCCollector(..)
307− , JVMMemoryInfo(..)
308− , PID(..)
309− , NodeOSInfo(..)
310− , CPUInfo(..)
311− , NodeProcessInfo(..)
312− , FsSnapshotRepo(..)
313− , SnapshotCreateSettings(..)
314− , defaultSnapshotCreateSettings
315− , SnapshotSelection(..)
316− , SnapshotPattern(..)
317− , SnapshotInfo(..)
318− , SnapshotShardFailure(..)
319− , ShardId(..)
320− , SnapshotName(..)
321− , SnapshotState(..)
322− , SnapshotRestoreSettings(..)
323− , defaultSnapshotRestoreSettings
324− , RestoreRenamePattern(..)
325− , RestoreRenameToken(..)
326− , RRGroupRefNum
327− , rrGroupRefNum
328− , mkRRGroupRefNum
329− , RestoreIndexSettings(..)
330− , Suggest(..)
331− , SuggestType(..)
332− , PhraseSuggester(..)
333− , PhraseSuggesterHighlighter(..)
334− , PhraseSuggesterCollate(..)
335− , mkPhraseSuggester
336− , SuggestOptions(..)
337− , SuggestResponse(..)
338− , NamedSuggestionResponse(..)
339− , DirectGenerators(..)
340− , mkDirectGenerators
341− , DirectGeneratorSuggestModeTypes (..)
342−
343− , Aggregation(..)
344− , Aggregations
345− , AggregationResults
346− , BucketValue(..)
347− , Bucket(..)
348− , BucketAggregation(..)
349− , TermsAggregation(..)
350− , MissingAggregation(..)
351− , ValueCountAggregation(..)
352− , FilterAggregation(..)
353− , CardinalityAggregation(..)
354− , DateHistogramAggregation(..)
355− , DateRangeAggregation(..)
356− , DateRangeAggRange(..)
357− , DateMathExpr(..)
358− , DateMathAnchor(..)
359− , DateMathModifier(..)
360− , DateMathUnit(..)
361− , TopHitsAggregation(..)
362− , StatisticsAggregation(..)
363−
364− , Highlights(..)
365− , FieldHighlight(..)
366− , HighlightSettings(..)
367− , PlainHighlight(..)
368− , PostingsHighlight(..)
369− , FastVectorHighlight(..)
370− , CommonHighlight(..)
371− , NonPostings(..)
372− , HighlightEncoder(..)
373− , HighlightTag(..)
374− , HitHighlight
375−
376− , MissingResult(..)
377− , TermsResult(..)
378− , DateHistogramResult(..)
379− , DateRangeResult(..)
380− , TopHitResult(..)
381−
382− , EsUsername(..)
383− , EsPassword(..)
384−
385− , Analysis(..)
386− , AnalyzerDefinition(..)
387− , TokenizerDefinition(..)
388− , Ngram(..)
389− , TokenChar(..)
390− ) where
391−
392−import Control.Applicative as A
393−import Control.Arrow (first)
394−import Control.Monad.Catch
395−import Control.Monad.Except
396−import Control.Monad.Reader (MonadReader (..),
397− ReaderT (..))
398−import Control.Monad.State (MonadState)
399−import Control.Monad.Writer (MonadWriter)
400−import Data.Aeson
401−import Data.Aeson.Types (Pair, Parser,
402− emptyObject,
403− parseEither, parseMaybe,
404− typeMismatch)
405−import qualified Data.ByteString.Lazy.Char8 as L
406−import Data.Char
407−import Data.Hashable (Hashable)
408−import qualified Data.HashMap.Strict as HM
409−import Data.List (foldl', intercalate,
410− nub)
411−import Data.List.NonEmpty (NonEmpty (..), toList)
412−import qualified Data.Map.Strict as M
413−import Data.Maybe
414−import Data.Scientific (Scientific)
415−import Data.Semigroup
416−import Data.Text (Text)
417−import qualified Data.Text as T
418−import Data.Time.Calendar
419−import Data.Time.Clock (NominalDiffTime,
420− UTCTime)
421−import Data.Time.Clock.POSIX
422−import qualified Data.Traversable as DT
423−import Data.Typeable (Typeable)
424−import qualified Data.Vector as V
425−import qualified Data.Version as Vers
426−import GHC.Enum
427−import GHC.Generics (Generic)
428−import Network.HTTP.Client
429−import qualified Network.HTTP.Types.Method as NHTM
430−import qualified Text.ParserCombinators.ReadP as RP
431−import qualified Text.Read as TR
432−
433−import Database.V5.Bloodhound.Types.Class
434−import Database.V5.Bloodhound.Types.Internal
435−
436−-- $setup
437−-- >>> :set -XOverloadedStrings
438−-- >>> import Data.Aeson
439−-- >>> import Database.V5.Bloodhound
440−-- >>> let testServer = (Server "http://localhost:9200")
441−-- >>> let testIndex = IndexName "twitter"
442−-- >>> let testMapping = MappingName "tweet"
443−-- >>> let defaultIndexSettings = IndexSettings (ShardCount 3) (ReplicaCount 2)
444−
445−-- defaultIndexSettings is exported by Database.Bloodhound as well
446−-- no trailing slashes in servers, library handles building the path.
447−
448−-- | Create a 'BHEnv' with all optional fields defaulted. HTTP hook
449−-- will be a noop. You can use the exported fields to customize it further, e.g.:
450−--
451−-- >> (mkBHEnv myServer myManager) { bhRequestHook = customHook }
452−mkBHEnv :: Server -> Manager -> BHEnv
453−mkBHEnv s m = BHEnv s m return
454−
455−newtype BH m a = BH {
456− unBH :: ReaderT BHEnv m a
457− } deriving ( Functor
458− , A.Applicative
459− , Monad
460− , MonadIO
461− , MonadState s
462− , MonadWriter w
463− , MonadError e
464− , Alternative
465− , MonadPlus
466− , MonadFix
467− , MonadThrow
468− , MonadCatch
469− , MonadMask)
470−
471−instance MonadTrans BH where
472− lift = BH . lift
473−
474−instance (MonadReader r m) => MonadReader r (BH m) where
475− ask = lift ask
476− local f (BH (ReaderT m)) = BH $ ReaderT $ \r ->
477− local f (m r)
478−
479−instance (Functor m, Applicative m, MonadIO m) => MonadBH (BH m) where
480− getBHEnv = BH getBHEnv
481−
482−runBH :: BHEnv -> BH m a -> m a
483−runBH e f = runReaderT (unBH f) e
484−
485−{-| 'Version' is embedded in 'Status' -}
486−data Version = Version { number :: VersionNumber
487− , build_hash :: BuildHash
488− , build_date :: UTCTime
489− , build_snapshot :: Bool
490− , lucene_version :: VersionNumber } deriving (Eq, Read, Show, Generic, Typeable)
491−
492−-- | Traditional software versioning number
493−newtype VersionNumber = VersionNumber { versionNumber :: Vers.Version
494− } deriving (Eq, Read, Show, Generic, Typeable, Ord)
495−
496−{-| 'Status' is a data type for describing the JSON body returned by
497− Elasticsearch when you query its status. This was deprecated in 1.2.0.
498−
499− <http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/indices-status.html#indices-status>
500−-}
501−
502−data Status = Status { name :: Text
503− , cluster_name :: Text
504− , cluster_uuid :: Text
505− , version :: Version
506− , tagline :: Text } deriving (Eq, Read, Show, Generic)
507−
508−{-| 'IndexSettings' is used to configure the shards and replicas when you create
509− an Elasticsearch Index.
510−
511− <http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/indices-create-index.html>
512−-}
513−
514−data IndexSettings =
515− IndexSettings { indexShards :: ShardCount
516− , indexReplicas :: ReplicaCount } deriving (Eq, Read, Show, Generic, Typeable)
517−
518−{-| 'defaultIndexSettings' is an 'IndexSettings' with 3 shards and 2 replicas. -}
519−defaultIndexSettings :: IndexSettings
520−defaultIndexSettings = IndexSettings (ShardCount 3) (ReplicaCount 2)
521−
522−
523−{-| 'ForceMergeIndexSettings' is used to configure index optimization. See
524− <https://www.elastic.co/guide/en/elasticsearch/reference/current/indices-forcemerge.html>
525− for more info.
526−-}
527−data ForceMergeIndexSettings =
528− ForceMergeIndexSettings { maxNumSegments :: Maybe Int
529− -- ^ 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.
530− , onlyExpungeDeletes :: Bool
531− -- ^ 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.
532− , flushAfterOptimize :: Bool
533− -- ^ Should a flush be performed after the optimize.
534− } deriving (Eq, Show, Generic, Typeable)
535−
536−
537−{-| 'defaultForceMergeIndexSettings' implements the default settings that
538− ElasticSearch uses for index optimization. 'maxNumSegments' is Nothing,
539− 'onlyExpungeDeletes' is False, and flushAfterOptimize is True.
540−-}
541−defaultForceMergeIndexSettings :: ForceMergeIndexSettings
542−defaultForceMergeIndexSettings = ForceMergeIndexSettings Nothing False True
543−
544−{-| 'UpdatableIndexSetting' are settings which may be updated after an index is created.
545−
546− <https://www.elastic.co/guide/en/elasticsearch/reference/current/indices-update-settings.html>
547−-}
548−data UpdatableIndexSetting = NumberOfReplicas ReplicaCount
549− -- ^ The number of replicas each shard has.
550− | AutoExpandReplicas ReplicaBounds
551− | BlocksReadOnly Bool
552− -- ^ Set to True to have the index read only. False to allow writes and metadata changes.
553− | BlocksRead Bool
554− -- ^ Set to True to disable read operations against the index.
555− | BlocksWrite Bool
556− -- ^ Set to True to disable write operations against the index.
557− | BlocksMetaData Bool
558− -- ^ Set to True to disable metadata operations against the index.
559− | RefreshInterval NominalDiffTime
560− -- ^ The async refresh interval of a shard
561− | IndexConcurrency Int
562− | FailOnMergeFailure Bool
563− | TranslogFlushThresholdOps Int
564− -- ^ When to flush on operations.
565− | TranslogFlushThresholdSize Bytes
566− -- ^ When to flush based on translog (bytes) size.
567− | TranslogFlushThresholdPeriod NominalDiffTime
568− -- ^ When to flush based on a period of not flushing.
569− | TranslogDisableFlush Bool
570− -- ^ Disables flushing. Note, should be set for a short interval and then enabled.
571− | CacheFilterMaxSize (Maybe Bytes)
572− -- ^ The maximum size of filter cache (per segment in shard).
573− | CacheFilterExpire (Maybe NominalDiffTime)
574− -- ^ The expire after access time for filter cache.
575− | GatewaySnapshotInterval NominalDiffTime
576− -- ^ The gateway snapshot interval (only applies to shared gateways).
577− | RoutingAllocationInclude (NonEmpty NodeAttrFilter)
578− -- ^ A node matching any rule will be allowed to host shards from the index.
579− | RoutingAllocationExclude (NonEmpty NodeAttrFilter)
580− -- ^ A node matching any rule will NOT be allowed to host shards from the index.
581− | RoutingAllocationRequire (NonEmpty NodeAttrFilter)
582− -- ^ Only nodes matching all rules will be allowed to host shards from the index.
583− | RoutingAllocationEnable AllocationPolicy
584− -- ^ Enables shard allocation for a specific index.
585− | RoutingAllocationShardsPerNode ShardCount
586− -- ^ Controls the total number of shards (replicas and primaries) allowed to be allocated on a single node.
587− | RecoveryInitialShards InitialShardCount
588− -- ^ When using local gateway a particular shard is recovered only if there can be allocated quorum shards in the cluster.
589− | GCDeletes NominalDiffTime
590− | TTLDisablePurge Bool
591− -- ^ Disables temporarily the purge of expired docs.
592− | TranslogFSType FSType
593− | CompressionSetting Compression
594− | IndexCompoundFormat CompoundFormat
595− | IndexCompoundOnFlush Bool
596− | WarmerEnabled Bool
597− | MappingTotalFieldsLimit Int
598− | AnalysisSetting Analysis
599− -- ^ Analysis is not a dynamic setting and can only be performed on a closed index.
600− deriving (Eq, Show, Generic, Typeable)
601−
602−data Analysis = Analysis
603− { analysisAnalyzer :: M.Map Text AnalyzerDefinition
604− , analysisTokenizer :: M.Map Text TokenizerDefinition
605− } deriving (Eq,Show,Generic,Typeable)
606−
607−instance ToJSON Analysis where
608− toJSON (Analysis analyzer tokenizer) = object
609− [ "analyzer" .= analyzer
610− , "tokenizer" .= tokenizer
611− ]
612−
613−instance FromJSON Analysis where
614− parseJSON = withObject "Analysis" $ \m -> Analysis
615− <$> m .: "analyzer"
616− <*> m .: "tokenizer"
617−
618−data AnalyzerDefinition = AnalyzerDefinition
619− { analyzerDefinitionTokenizer :: Maybe Tokenizer
620− } deriving (Eq,Show,Generic,Typeable)
621−
622−instance ToJSON AnalyzerDefinition where
623− toJSON (AnalyzerDefinition tokenizer) = object $ catMaybes
624− [ fmap ("tokenizer" .=) tokenizer
625− ]
626−
627−instance FromJSON AnalyzerDefinition where
628− parseJSON = withObject "AnalyzerDefinition" $ \m -> AnalyzerDefinition
629− <$> m .:? "tokenizer"
630−
631−
632−data TokenizerDefinition
633− = TokenizerDefinitionNgram Ngram
634− deriving (Eq,Show,Generic,Typeable)
635−
636−instance ToJSON TokenizerDefinition where
637− toJSON x = case x of
638− TokenizerDefinitionNgram (Ngram minGram maxGram tokenChars) -> object
639− [ "type" .= ("ngram" :: Text)
640− , "min_gram" .= minGram
641− , "max_gram" .= maxGram
642− , "token_chars" .= tokenChars
643− ]
644−
645−instance FromJSON TokenizerDefinition where
646− parseJSON = withObject "TokenizerDefinition" $ \m -> do
647− typ <- m .: "type" :: Parser Text
648− case typ of
649− "ngram" -> fmap TokenizerDefinitionNgram $ Ngram
650− <$> (fmap unStringlyTypedInt (m .: "min_gram"))
651− <*> (fmap unStringlyTypedInt (m .: "max_gram"))
652− <*> m .: "token_chars"
653− _ -> fail "invalid TokenizerDefinition"
654−
655−data Ngram = Ngram
656− { ngramMinGram :: Int
657− , ngramMaxGram :: Int
658− , ngramTokenChars :: [TokenChar]
659− } deriving (Eq,Show,Generic,Typeable)
660−
661−data TokenChar = TokenLetter | TokenDigit | TokenWhitespace | TokenPunctuation | TokenSymbol
662− deriving (Eq,Read,Show,Generic,Typeable)
663−
664−instance ToJSON TokenChar where
665− toJSON t = String $ case t of
666− TokenLetter -> "letter"
667− TokenDigit -> "digit"
668− TokenWhitespace -> "whitespace"
669− TokenPunctuation -> "punctuation"
670− TokenSymbol -> "symbol"
671−
672−instance FromJSON TokenChar where
673− parseJSON = withText "TokenChar" $ \t -> case t of
674− "letter" -> return TokenLetter
675− "digit" -> return TokenDigit
676− "whitespace" -> return TokenWhitespace
677− "punctuation" -> return TokenPunctuation
678− "symbol" -> return TokenSymbol
679− _ -> fail "invalid TokenChar"
680−
681−data AllocationPolicy = AllocAll
682− -- ^ Allows shard allocation for all shards.
683− | AllocPrimaries
684− -- ^ Allows shard allocation only for primary shards.
685− | AllocNewPrimaries
686− -- ^ Allows shard allocation only for primary shards for new indices.
687− | AllocNone
688− -- ^ No shard allocation is allowed
689− deriving (Eq, Read, Show, Generic, Typeable)
690−
691−data ReplicaBounds = ReplicasBounded Int Int
692− | ReplicasLowerBounded Int
693− | ReplicasUnbounded
694− deriving (Eq, Read, Show, Generic, Typeable)
695−
696−data Compression
697− = CompressionDefault
698− -- ^ Compress with LZ4
699− | CompressionBest
700− -- ^ Compress with DEFLATE. Elastic
701− -- <https://www.elastic.co/blog/elasticsearch-storage-the-true-story-2.0 blogs>
702− -- that this can reduce disk use by 15%-25%.
703− deriving (Eq,Show,Generic,Typeable)
704−
705−instance ToJSON Compression where
706− toJSON x = case x of
707− CompressionDefault -> toJSON ("default" :: Text)
708− CompressionBest -> toJSON ("best_compression" :: Text)
709−
710−instance FromJSON Compression where
711− parseJSON = withText "Compression" $ \t -> case t of
712− "default" -> return CompressionDefault
713− "best_compression" -> return CompressionBest
714− _ -> fail "invalid compression codec"
715−
716−-- | A measure of bytes used for various configurations. You may want
717−-- to use smart constructors like 'gigabytes' for larger values.
718−--
719−-- >>> gigabytes 9
720−-- Bytes 9000000000
721−--
722−-- >>> megabytes 9
723−-- Bytes 9000000
724−--
725−-- >>> kilobytes 9
726−-- Bytes 9000
727−newtype Bytes = Bytes Int deriving (Eq, Read, Show, Generic, Typeable, Ord, ToJSON, FromJSON)
728−
729−gigabytes :: Int -> Bytes
730−gigabytes n = megabytes (1000 * n)
731−
732−
733−megabytes :: Int -> Bytes
734−megabytes n = kilobytes (1000 * n)
735−
736−
737−kilobytes :: Int -> Bytes
738−kilobytes n = Bytes (1000 * n)
739−
740−
741−data FSType = FSSimple
742− | FSBuffered deriving (Eq, Read, Show, Generic, Typeable, Ord)
743−
744−data InitialShardCount = QuorumShards
745− | QuorumMinus1Shards
746− | FullShards
747− | FullMinus1Shards
748− | ExplicitShards Int
749− deriving (Eq, Read, Show, Generic, Typeable)
750−
751−data NodeAttrFilter = NodeAttrFilter { nodeAttrFilterName :: NodeAttrName
752− , nodeAttrFilterValues :: NonEmpty Text}
753− deriving (Eq, Read, Show, Generic, Ord, Typeable)
754−
755−newtype NodeAttrName = NodeAttrName Text deriving (Eq, Read, Show, Ord, Generic, Typeable)
756−
757−data CompoundFormat = CompoundFileFormat Bool
758− | MergeSegmentVsTotalIndex Double
759− -- ^ percentage between 0 and 1 where 0 is false, 1 is true
760− deriving (Eq, Read, Show, Generic, Typeable)
761−
762−newtype NominalDiffTimeJSON = NominalDiffTimeJSON { ndtJSON :: NominalDiffTime }
763−
764−data IndexSettingsSummary = IndexSettingsSummary { sSummaryIndexName :: IndexName
765− , sSummaryFixedSettings :: IndexSettings
766− , sSummaryUpdateable :: [UpdatableIndexSetting]}
767− deriving (Eq, Show, Generic, Typeable)
768−
769−{-| 'Reply' and 'Method' are type synonyms from 'Network.HTTP.Types.Method.Method' -}
770−type Reply = Network.HTTP.Client.Response L.ByteString
771−type Method = NHTM.Method
772−
773−{-| 'OpenCloseIndex' is a sum type for opening and closing indices.
774−
775− <http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/indices-open-close.html>
776−-}
777−data OpenCloseIndex = OpenIndex | CloseIndex deriving (Eq, Read, Show, Generic, Typeable)
778−
779−data FieldType = GeoPointType
780− | GeoShapeType
781− | FloatType
782− | IntegerType
783− | LongType
784− | ShortType
785− | ByteType deriving (Eq, Read, Show, Generic, Typeable)
786−
787−data FieldDefinition =
788− FieldDefinition { fieldType :: FieldType } deriving (Eq, Read, Show, Generic, Typeable)
789−
790−{-| An 'IndexTemplate' defines a template that will automatically be
791− applied to new indices created. The templates include both
792− 'IndexSettings' and mappings, and a simple 'TemplatePattern' that
793− controls if the template will be applied to the index created.
794− Specify mappings as follows: @[toJSON TweetMapping, ...]@
795−
796− https://www.elastic.co/guide/en/elasticsearch/reference/1.7/indices-templates.html
797−-}
798−data IndexTemplate =
799− IndexTemplate { templatePattern :: TemplatePattern
800− , templateSettings :: Maybe IndexSettings
801− , templateMappings :: [Value]
802− }
803−
804−data MappingField =
805− MappingField { mappingFieldName :: FieldName
806− , fieldDefinition :: FieldDefinition } deriving (Eq, Read, Show, Generic, Typeable)
807−
808−{-| Support for type reification of 'Mapping's is currently incomplete, for
809− now the mapping API verbiage expects a 'ToJSON'able blob.
810−
811− Indexes have mappings, mappings are schemas for the documents contained in the
812− index. I'd recommend having only one mapping per index, always having a mapping,
813− and keeping different kinds of documents separated if possible.
814−-}
815−data Mapping = Mapping { typeName :: TypeName
816− , mappingFields :: [MappingField] } deriving (Eq, Read, Show, Generic, Typeable)
817−
818−{-| 'BulkOperation' is a sum type for expressing the four kinds of bulk
819− operation index, create, delete, and update. 'BulkIndex' behaves like an
820− "upsert", 'BulkCreate' will fail if a document already exists at the DocId.
821−
822− <http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/docs-bulk.html#docs-bulk>
823−-}
824−data BulkOperation =
825− BulkIndex IndexName MappingName DocId Value
826− | BulkCreate IndexName MappingName DocId Value
827− | BulkCreateEncoding IndexName MappingName DocId Encoding
828− | BulkDelete IndexName MappingName DocId
829− | BulkUpdate IndexName MappingName DocId Value deriving (Eq, Show, Generic, Typeable)
830−
831−{-| 'EsResult' describes the standard wrapper JSON document that you see in
832− successful Elasticsearch lookups or lookups that couldn't find the document.
833−-}
834−data EsResult a = EsResult { _index :: Text
835− , _type :: Text
836− , _id :: Text
837− , foundResult :: Maybe (EsResultFound a)} deriving (Eq, Read, Show, Generic, Typeable)
838−
839−{-| 'EsResultFound' contains the document and its metadata inside of an
840− 'EsResult' when the document was successfully found.
841−-}
842−data EsResultFound a = EsResultFound { _version :: DocVersion
843− , _source :: a } deriving (Eq, Read, Show, Generic, Typeable)
844−
845−{-| 'EsError' is the generic type that will be returned when there was a
846− problem. If you can't parse the expected response, its a good idea to
847− try parsing this.
848−-}
849−data EsError = EsError { errorStatus :: Int
850− , errorMessage :: Text } deriving (Eq, Read, Show, Generic, Typeable)
851−
852−{-| 'EsProtocolException' will be thrown if Bloodhound cannot parse a response
853−returned by the ElasticSearch server. If you encounter this error, please
854−verify that your domain data types and FromJSON instances are working properly
855−(for example, the 'a' of '[Hit a]' in 'SearchResult.searchHits.hits'). If you're
856−sure that your mappings are correct, then this error may be an indication of an
857−incompatibility between Bloodhound and ElasticSearch. Please open a bug report
858−and be sure to include the exception body.
859−-}
860−data EsProtocolException = EsProtocolException { esProtoExBody :: L.ByteString }
861− deriving (Eq, Read, Show, Generic, Typeable)
862−
863−instance Exception EsProtocolException
864−
865−data IndexAlias = IndexAlias { srcIndex :: IndexName
866− , indexAlias :: IndexAliasName } deriving (Eq, Read, Show, Generic, Typeable)
867−
868−newtype IndexAliasName = IndexAliasName { indexAliasName :: IndexName } deriving (Eq, Read, Show, Generic, ToJSON)
869−
870−data IndexAliasAction = AddAlias IndexAlias IndexAliasCreate
871− | RemoveAlias IndexAlias deriving (Read, Show, Eq, Generic, Typeable)
872−
873−data IndexAliasCreate = IndexAliasCreate { aliasCreateRouting :: Maybe AliasRouting
874− , aliasCreateFilter :: Maybe Filter}
875− deriving (Read, Show, Eq, Generic, Typeable)
876−
877−data AliasRouting = AllAliasRouting RoutingValue
878− | GranularAliasRouting (Maybe SearchAliasRouting) (Maybe IndexAliasRouting)
879− deriving (Read, Show, Eq, Generic, Typeable)
880−
881−newtype SearchAliasRouting = SearchAliasRouting (NonEmpty RoutingValue) deriving (Read, Show, Eq, Generic, Typeable)
882−
883−newtype IndexAliasRouting = IndexAliasRouting RoutingValue deriving (Read, Show, Eq, Generic, ToJSON, FromJSON, Typeable)
884−
885−newtype RoutingValue = RoutingValue { routingValue :: Text } deriving (Read, Show, Eq, Generic, ToJSON, FromJSON, Typeable)
886−
887−newtype IndexAliasesSummary = IndexAliasesSummary { indexAliasesSummary :: [IndexAliasSummary] } deriving (Read, Show, Eq, Generic, Typeable)
888−
889−{-| 'IndexAliasSummary' is a summary of an index alias configured for a server. -}
890−data IndexAliasSummary = IndexAliasSummary { indexAliasSummaryAlias :: IndexAlias
891− , indexAliasSummaryCreate :: IndexAliasCreate} deriving (Read, Show, Eq, Generic, Typeable)
892−
893−{-| 'DocVersion' is an integer version number for a document between 1
894−and 9.2e+18 used for <<https://www.elastic.co/guide/en/elasticsearch/guide/current/optimistic-concurrency-control.html optimistic concurrency control>>.
895−-}
896−newtype DocVersion = DocVersion {
897− docVersionNumber :: Int
898− } deriving (Eq, Read, Show, Generic, Ord, ToJSON)
899−
900−-- | Smart constructor for in-range doc version
901−mkDocVersion :: Int -> Maybe DocVersion
902−mkDocVersion i
903− | i >= (docVersionNumber minBound) && i <= (docVersionNumber maxBound) =
904− Just $ DocVersion i
905− | otherwise = Nothing
906−
907−
908−{-| 'ExternalDocVersion' is a convenience wrapper if your code uses its
909−own version numbers instead of ones from ES.
910−-}
911−newtype ExternalDocVersion = ExternalDocVersion DocVersion
912− deriving (Eq, Read, Show, Generic, Ord, Bounded, Enum, ToJSON)
913−
914−{-| 'VersionControl' is specified when indexing documents as a
915−optimistic concurrency control.
916−-}
917−data VersionControl = NoVersionControl
918− -- ^ Don't send a version. This is a pure overwrite.
919− | InternalVersion DocVersion
920− -- ^ Use the default ES versioning scheme. Only
921− -- index the document if the version is the same
922− -- as the one specified. Only applicable to
923− -- updates, as you should be getting Version from
924− -- a search result.
925− | ExternalGT ExternalDocVersion
926− -- ^ Use your own version numbering. Only index
927− -- the document if the version is strictly higher
928− -- OR the document doesn't exist. The given
929− -- version will be used as the new version number
930− -- for the stored document. N.B. All updates must
931− -- increment this number, meaning there is some
932− -- global, external ordering of updates.
933− | ExternalGTE ExternalDocVersion
934− -- ^ Use your own version numbering. Only index
935− -- the document if the version is equal or higher
936− -- than the stored version. Will succeed if there
937− -- is no existing document. The given version will
938− -- be used as the new version number for the
939− -- stored document. Use with care, as this could
940− -- result in data loss.
941− | ForceVersion ExternalDocVersion
942− -- ^ The document will always be indexed and the
943− -- given version will be the new version. This is
944− -- typically used for correcting errors. Use with
945− -- care, as this could result in data loss.
946− deriving (Read, Show, Eq, Generic, Ord)
947−
948−{-| 'DocumentParent' is used to specify a parent document.
949−-}
950−newtype DocumentParent = DocumentParent DocId
951− deriving (Eq, Read, Show, Generic, Typeable)
952−
953−{-| 'IndexDocumentSettings' are special settings supplied when indexing
954−a document. For the best backwards compatiblity when new fields are
955−added, you should probably prefer to start with 'defaultIndexDocumentSettings'
956−-}
957−data IndexDocumentSettings =
958− IndexDocumentSettings { idsVersionControl :: VersionControl
959− , idsParent :: Maybe DocumentParent
960− } deriving (Eq, Read, Show, Generic, Typeable)
961−
962−{-| Reasonable default settings. Chooses no version control and no parent.
963−-}
964−defaultIndexDocumentSettings :: IndexDocumentSettings
965−defaultIndexDocumentSettings = IndexDocumentSettings NoVersionControl Nothing
966−
967−{-| 'Sort' is a synonym for a list of 'SortSpec's. Sort behavior is order
968− dependent with later sorts acting as tie-breakers for earlier sorts.
969−-}
970−type Sort = [SortSpec]
971−
972−{-| The two main kinds of 'SortSpec' are 'DefaultSortSpec' and
973− 'GeoDistanceSortSpec'. The latter takes a 'SortOrder', 'GeoPoint', and
974− 'DistanceUnit' to express "nearness" to a single geographical point as a
975− sort specification.
976−
977−<http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/search-request-sort.html#search-request-sort>
978−-}
979−data SortSpec = DefaultSortSpec DefaultSort
980− | GeoDistanceSortSpec SortOrder GeoPoint DistanceUnit deriving (Eq, Read, Show, Generic, Typeable)
981−
982−{-| 'DefaultSort' is usually the kind of 'SortSpec' you'll want. There's a
983− 'mkSort' convenience function for when you want to specify only the most
984− common parameters.
985−
986− The `ignoreUnmapped`, when `Just` field is used to set the elastic 'unmapped_type'
987−
988−<http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/search-request-sort.html#search-request-sort>
989−-}
990−data DefaultSort =
991− DefaultSort { sortFieldName :: FieldName
992− , sortOrder :: SortOrder
993− -- default False
994− , ignoreUnmapped :: Maybe Text
995− , sortMode :: Maybe SortMode
996− , missingSort :: Maybe Missing
997− , nestedFilter :: Maybe Filter } deriving (Eq, Read, Show, Generic, Typeable)
998−
999−{-| 'SortOrder' is 'Ascending' or 'Descending', as you might expect. These get
1000− encoded into "asc" or "desc" when turned into JSON.
1001−
1002−<http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/search-request-sort.html#search-request-sort>
1003−-}
1004−data SortOrder = Ascending
1005− | Descending deriving (Eq, Read, Show, Generic, Typeable)
1006−
1007−{-| 'Missing' prescribes how to handle missing fields. A missing field can be
1008− sorted last, first, or using a custom value as a substitute.
1009−
1010−<http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/search-request-sort.html#_missing_values>
1011−-}
1012−data Missing = LastMissing
1013− | FirstMissing
1014− | CustomMissing Text deriving (Eq, Read, Show, Generic, Typeable)
1015−
1016−{-| 'SortMode' prescribes how to handle sorting array/multi-valued fields.
1017−
1018−http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/search-request-sort.html#_sort_mode_option
1019−-}
1020−data SortMode = SortMin
1021− | SortMax
1022− | SortSum
1023− | SortAvg deriving (Eq, Read, Show, Generic, Typeable)
1024−
1025−{-| 'mkSort' defaults everything but the 'FieldName' and the 'SortOrder' so
1026− that you can concisely describe the usual kind of 'SortSpec's you want.
1027−-}
1028−mkSort :: FieldName -> SortOrder -> DefaultSort
1029−mkSort fieldName sOrder = DefaultSort fieldName sOrder Nothing Nothing Nothing Nothing
1030−
1031−{-| 'Cache' is for telling ES whether it should cache a 'Filter' not.
1032− 'Query's cannot be cached.
1033−-}
1034−type Cache = Bool -- caching on/off
1035−defaultCache :: Cache
1036−defaultCache = False
1037−
1038−{-| 'PrefixValue' is used in 'PrefixQuery' as the main query component.
1039−-}
1040−-- type PrefixValue = Text
1041−
1042−{-| 'BooleanOperator' is the usual And/Or operators with an ES compatible
1043− JSON encoding baked in. Used all over the place.
1044−-}
1045−data BooleanOperator = And | Or deriving (Eq, Read, Show, Generic, Typeable)
1046−
1047−{-| 'ShardCount' is part of 'IndexSettings'
1048−-}
1049−newtype ShardCount = ShardCount Int deriving (Eq, Read, Show, Generic, ToJSON, Typeable)
1050−
1051−{-| 'ReplicaCount' is part of 'IndexSettings'
1052−-}
1053−newtype ReplicaCount = ReplicaCount Int deriving (Eq, Read, Show, Generic, ToJSON, Typeable)
1054−
1055−{-| 'IndexName' is used to describe which index to query/create/delete
1056−-}
1057−newtype IndexName = IndexName Text deriving (Eq, Generic, Read, Show, ToJSON, FromJSON, Typeable)
1058−
1059−{-| 'IndexSelection' is used for APIs which take a single index, a list of
1060− indexes, or the special @_all@ index.
1061−-}
1062−--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.
1063−data IndexSelection = IndexList (NonEmpty IndexName)
1064− | AllIndexes deriving (Eq, Generic, Show, Typeable)
1065−
1066−{-| '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.
1067−-}
1068−data NodeSelection = LocalNode
1069− -- ^ Whatever node receives this request
1070− | NodeList (NonEmpty NodeSelector)
1071− | AllNodes deriving (Eq, Generic, Show, Typeable)
1072−
1073−
1074−-- | An exact match or pattern to identify a node. Note that All of
1075−-- these options support wildcarding, so your node name, server, attr
1076−-- name can all contain * characters to be a fuzzy match.
1077−data NodeSelector = NodeByName NodeName
1078− | NodeByFullNodeId FullNodeId
1079− | NodeByHost Server
1080− -- ^ e.g. 10.0.0.1 or even 10.0.0.*
1081− | NodeByAttribute NodeAttrName Text
1082− -- ^ NodeAttrName can be a pattern, e.g. rack*. The value can too.
1083− deriving (Eq, Generic, Show, Typeable)
1084−
1085−{-| 'TemplateName' is used to describe which template to query/create/delete
1086−-}
1087−newtype TemplateName = TemplateName Text deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1088−
1089−{-| 'TemplatePattern' represents a pattern which is matched against index names
1090−-}
1091−newtype TemplatePattern = TemplatePattern Text deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1092−
1093−{-| 'MappingName' is part of mappings which are how ES describes and schematizes
1094− the data in the indices.
1095−-}
1096−newtype MappingName = MappingName Text deriving (Eq, Generic, Read, Show, ToJSON, FromJSON, Typeable)
1097−
1098−{-| 'DocId' is a generic wrapper value for expressing unique Document IDs.
1099− Can be set by the user or created by ES itself. Often used in client
1100− functions for poking at specific documents.
1101−-}
1102−newtype DocId = DocId Text deriving (Eq, Generic, Read, Show, ToJSON, FromJSON, Typeable)
1103−
1104−{-| 'QueryString' is used to wrap query text bodies, be they human written or not.
1105−-}
1106−newtype QueryString = QueryString Text deriving (Eq, Generic, Read, Show, ToJSON, FromJSON, Typeable)
1107−
1108−{-| 'FieldName' is used all over the place wherever a specific field within
1109− a document needs to be specified, usually in 'Query's or 'Filter's.
1110−-}
1111−newtype FieldName = FieldName Text deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1112−
1113−
1114−{-| 'Script' is often used in place of 'FieldName' to specify more
1115−complex ways of extracting a value from a document.
1116−-}
1117−newtype Script = Script { scriptText :: Text } deriving (Eq, Read, Show, Generic, Typeable)
1118−
1119−{-| 'CacheName' is used in 'RegexpFilter' for describing the
1120− 'CacheKey' keyed caching behavior.
1121−-}
1122−newtype CacheName = CacheName Text deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1123−
1124−{-| 'CacheKey' is used in 'RegexpFilter' to key regex caching.
1125−-}
1126−newtype CacheKey =
1127− CacheKey Text deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1128−newtype Existence =
1129− Existence Bool deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1130−newtype NullValue =
1131− NullValue Bool deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1132−newtype CutoffFrequency =
1133− CutoffFrequency Double deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1134−newtype Analyzer =
1135− Analyzer Text deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1136−newtype Tokenizer =
1137− Tokenizer Text deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1138−newtype MaxExpansions =
1139− MaxExpansions Int deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1140−
1141−{-| 'Lenient', if set to true, will cause format based failures to be
1142− ignored. I don't know what the bloody default is, Elasticsearch
1143− documentation didn't say what it was. Let me know if you figure it out.
1144−-}
1145−newtype Lenient =
1146− Lenient Bool deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1147−newtype Tiebreaker =
1148− Tiebreaker Double deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1149−newtype Boost =
1150− Boost Double deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1151−newtype BoostTerms =
1152− BoostTerms Double deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1153−
1154−{-| 'MinimumMatch' controls how many should clauses in the bool query should
1155− match. Can be an absolute value (2) or a percentage (30%) or a
1156− combination of both.
1157−-}
1158−newtype MinimumMatch =
1159− MinimumMatch Int deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1160−newtype DisableCoord =
1161− DisableCoord Bool deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1162−newtype IgnoreTermFrequency =
1163− IgnoreTermFrequency Bool deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1164−newtype MinimumTermFrequency =
1165− MinimumTermFrequency Int deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1166−newtype MaxQueryTerms =
1167− MaxQueryTerms Int deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1168−newtype Fuzziness =
1169− Fuzziness Double deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1170−
1171−{-| 'PrefixLength' is the prefix length used in queries, defaults to 0. -}
1172−newtype PrefixLength =
1173− PrefixLength Int deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1174−newtype TypeName =
1175− TypeName Text deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1176−newtype PercentMatch =
1177− PercentMatch Double deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1178−newtype StopWord =
1179− StopWord Text deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1180−newtype QueryPath =
1181− QueryPath Text deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1182−
1183−{-| Allowing a wildcard at the beginning of a word (eg "*ing") is particularly
1184− heavy, because all terms in the index need to be examined, just in case
1185− they match. Leading wildcards can be disabled by setting
1186− 'AllowLeadingWildcard' to false. -}
1187−newtype AllowLeadingWildcard =
1188− AllowLeadingWildcard Bool deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1189−newtype LowercaseExpanded =
1190− LowercaseExpanded Bool deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1191−newtype EnablePositionIncrements =
1192− EnablePositionIncrements Bool deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1193−
1194−{-| By default, wildcard terms in a query are not analyzed.
1195− Setting 'AnalyzeWildcard' to true enables best-effort analysis.
1196−-}
1197−newtype AnalyzeWildcard = AnalyzeWildcard Bool deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1198−
1199−{-| 'GeneratePhraseQueries' defaults to false.
1200−-}
1201−newtype GeneratePhraseQueries =
1202− GeneratePhraseQueries Bool deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1203−
1204−{-| 'Locale' is used for string conversions - defaults to ROOT.
1205−-}
1206−newtype Locale = Locale Text deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1207−newtype MaxWordLength = MaxWordLength Int deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1208−newtype MinWordLength = MinWordLength Int deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1209−
1210−{-| 'PhraseSlop' sets the default slop for phrases, 0 means exact
1211− phrase matches. Default is 0.
1212−-}
1213−newtype PhraseSlop = PhraseSlop Int deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1214−newtype MinDocFrequency = MinDocFrequency Int deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1215−newtype MaxDocFrequency = MaxDocFrequency Int deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1216−
1217−-- | Newtype wrapper to parse ES's concerning tendency to in some APIs return a floating point number of milliseconds since epoch ಠ_ಠ
1218−newtype POSIXMS = POSIXMS { posixMS :: UTCTime }
1219−
1220−{-| 'unpackId' is a silly convenience function that gets used once.
1221−-}
1222−unpackId :: DocId -> Text
1223−unpackId (DocId docId) = docId
1224−
1225−type TrackSortScores = Bool
1226−newtype From = From Int deriving (Eq, Read, Show, Generic, ToJSON)
1227−newtype Size = Size Int deriving (Eq, Read, Show, Generic, ToJSON, FromJSON)
1228−
1229−data Search = Search { queryBody :: Maybe Query
1230− , filterBody :: Maybe Filter
1231− , sortBody :: Maybe Sort
1232− , aggBody :: Maybe Aggregations
1233− , highlight :: Maybe Highlights
1234− -- default False
1235− , trackSortScores :: TrackSortScores
1236− , from :: From
1237− , size :: Size
1238− , searchType :: SearchType
1239− , fields :: Maybe [FieldName]
1240− , source :: Maybe Source
1241− , suggestBody :: Maybe Suggest -- ^ Only one Suggestion request / response per Search is supported.
1242− } deriving (Eq, Read, Show, Generic, Typeable)
1243−
1244−data SearchType = SearchTypeQueryThenFetch
1245− | SearchTypeDfsQueryThenFetch
1246− deriving (Eq, Read, Show, Generic, Typeable)
1247−
1248−data Source =
1249− NoSource
1250− | SourcePatterns PatternOrPatterns
1251− | SourceIncludeExclude Include Exclude
1252− deriving (Read, Show, Eq, Generic, Typeable)
1253−
1254−data PatternOrPatterns = PopPattern Pattern
1255− | PopPatterns [Pattern] deriving (Eq, Read, Show, Generic, Typeable)
1256−
1257−data Include = Include [Pattern] deriving (Eq, Read, Show, Generic, Typeable)
1258−data Exclude = Exclude [Pattern] deriving (Eq, Read, Show, Generic, Typeable)
1259−
1260−newtype Pattern = Pattern Text deriving (Eq, Read, Show, Generic, Typeable)
1261−
1262−data Highlights = Highlights { globalsettings :: Maybe HighlightSettings
1263− , highlightFields :: [FieldHighlight]
1264− } deriving (Read, Show, Eq, Generic, Typeable)
1265−
1266−data FieldHighlight = FieldHighlight FieldName (Maybe HighlightSettings)
1267− deriving (Read, Show, Eq, Generic, Typeable)
1268−
1269−
1270−data HighlightSettings = Plain PlainHighlight
1271− | Postings PostingsHighlight
1272− | FastVector FastVectorHighlight
1273− deriving (Read, Show, Eq, Generic, Typeable)
1274−data PlainHighlight =
1275− PlainHighlight { plainCommon :: Maybe CommonHighlight
1276− , plainNonPost :: Maybe NonPostings } deriving (Read, Show, Eq, Generic, Typeable)
1277−
1278− -- This requires that index_options are set to 'offset' in the mapping.
1279−data PostingsHighlight = PostingsHighlight (Maybe CommonHighlight) deriving (Read, Show, Eq, Generic, Typeable)
1280−
1281−-- This requires that term_vector is set to 'with_positions_offsets' in the mapping.
1282−data FastVectorHighlight =
1283− FastVectorHighlight { fvCommon :: Maybe CommonHighlight
1284− , fvNonPostSettings :: Maybe NonPostings
1285− , boundaryChars :: Maybe Text
1286− , boundaryMaxScan :: Maybe Int
1287− , fragmentOffset :: Maybe Int
1288− , matchedFields :: [Text]
1289− , phraseLimit :: Maybe Int
1290− } deriving (Read, Show, Eq, Generic, Typeable)
1291−
1292−data CommonHighlight =
1293− CommonHighlight { order :: Maybe Text
1294− , forceSource :: Maybe Bool
1295− , tag :: Maybe HighlightTag
1296− , encoder :: Maybe HighlightEncoder
1297− , noMatchSize :: Maybe Int
1298− , highlightQuery :: Maybe Query
1299− , requireFieldMatch :: Maybe Bool
1300− } deriving (Read, Show, Eq, Generic, Typeable)
1301−
1302−-- Settings that are only applicable to FastVector and Plain highlighters.
1303−data NonPostings =
1304− NonPostings { fragmentSize :: Maybe Int
1305− , numberOfFragments :: Maybe Int} deriving (Read, Show, Eq, Generic, Typeable)
1306−
1307−data HighlightEncoder = DefaultEncoder
1308− | HTMLEncoder
1309− deriving (Read, Show, Eq, Generic, Typeable)
1310−
1311−-- NOTE: Should the tags use some kind of HTML type, rather than Text?
1312−data HighlightTag = TagSchema Text
1313− | CustomTags ([Text], [Text]) -- Only uses more than the first value in the lists if fvh
1314− deriving (Read, Show, Eq, Generic, Typeable)
1315−
1316−
1317−data Query =
1318− TermQuery Term (Maybe Boost)
1319− | TermsQuery Text (NonEmpty Text)
1320− | QueryMatchQuery MatchQuery
1321− | QueryMultiMatchQuery MultiMatchQuery
1322− | QueryBoolQuery BoolQuery
1323− | QueryBoostingQuery BoostingQuery
1324− | QueryCommonTermsQuery CommonTermsQuery
1325− | ConstantScoreQuery Query Boost
1326− | QueryDisMaxQuery DisMaxQuery
1327− | QueryFuzzyLikeThisQuery FuzzyLikeThisQuery
1328− | QueryFuzzyLikeFieldQuery FuzzyLikeFieldQuery
1329− | QueryFuzzyQuery FuzzyQuery
1330− | QueryHasChildQuery HasChildQuery
1331− | QueryHasParentQuery HasParentQuery
1332− | IdsQuery MappingName [DocId]
1333− | QueryIndicesQuery IndicesQuery
1334− | MatchAllQuery (Maybe Boost)
1335− | QueryMoreLikeThisQuery MoreLikeThisQuery
1336− | QueryMoreLikeThisFieldQuery MoreLikeThisFieldQuery
1337− | QueryNestedQuery NestedQuery
1338− | QueryPrefixQuery PrefixQuery
1339− | QueryQueryStringQuery QueryStringQuery
1340− | QuerySimpleQueryStringQuery SimpleQueryStringQuery
1341− | QueryRangeQuery RangeQuery
1342− | QueryRegexpQuery RegexpQuery
1343− | QueryExistsQuery FieldName
1344− | QueryMatchNoneQuery
1345− | QueryTemplateQueryInline TemplateQueryInline
1346− deriving (Eq, Read, Show, Generic, Typeable)
1347−
1348−-- | As of Elastic 2.0, 'Filters' are just 'Queries' housed in a Bool Query, and
1349−-- flagged in a different context.
1350−newtype Filter = Filter { unFilter :: Query }
1351− deriving (Eq, Read, Show, Generic, Typeable)
1352−
1353−instance ToJSON Filter where
1354− toJSON = toJSON . unFilter
1355−
1356−instance FromJSON Filter where
1357− parseJSON v = Filter <$> parseJSON v
1358−
1359−data RegexpQuery =
1360− RegexpQuery { regexpQueryField :: FieldName
1361− , regexpQuery :: Regexp
1362− , regexpQueryFlags :: RegexpFlags
1363− , regexpQueryBoost :: Maybe Boost
1364− } deriving (Eq, Read, Show, Generic, Typeable)
1365−
1366−data RangeQuery =
1367− RangeQuery { rangeQueryField :: FieldName
1368− , rangeQueryRange :: RangeValue
1369− , rangeQueryBoost :: Boost } deriving (Eq, Read, Show, Generic, Typeable)
1370−
1371−mkRangeQuery :: FieldName -> RangeValue -> RangeQuery
1372−mkRangeQuery f r = RangeQuery f r (Boost 1.0)
1373−
1374−data SimpleQueryStringQuery =
1375− SimpleQueryStringQuery
1376− { simpleQueryStringQuery :: QueryString
1377− , simpleQueryStringField :: Maybe FieldOrFields
1378− , simpleQueryStringOperator :: Maybe BooleanOperator
1379− , simpleQueryStringAnalyzer :: Maybe Analyzer
1380− , simpleQueryStringFlags :: Maybe (NonEmpty SimpleQueryFlag)
1381− , simpleQueryStringLowercaseExpanded :: Maybe LowercaseExpanded
1382− , simpleQueryStringLocale :: Maybe Locale
1383− } deriving (Eq, Read, Show, Generic, Typeable)
1384−
1385−data SimpleQueryFlag =
1386− SimpleQueryAll
1387− | SimpleQueryNone
1388− | SimpleQueryAnd
1389− | SimpleQueryOr
1390− | SimpleQueryPrefix
1391− | SimpleQueryPhrase
1392− | SimpleQueryPrecedence
1393− | SimpleQueryEscape
1394− | SimpleQueryWhitespace
1395− | SimpleQueryFuzzy
1396− | SimpleQueryNear
1397− | SimpleQuerySlop deriving (Eq, Read, Show, Generic, Typeable)
1398−
1399−-- use_dis_max and tie_breaker when fields are plural?
1400−data QueryStringQuery =
1401− QueryStringQuery
1402− { queryStringQuery :: QueryString
1403− , queryStringDefaultField :: Maybe FieldName
1404− , queryStringOperator :: Maybe BooleanOperator
1405− , queryStringAnalyzer :: Maybe Analyzer
1406− , queryStringAllowLeadingWildcard :: Maybe AllowLeadingWildcard
1407− , queryStringLowercaseExpanded :: Maybe LowercaseExpanded
1408− , queryStringEnablePositionIncrements :: Maybe EnablePositionIncrements
1409− , queryStringFuzzyMaxExpansions :: Maybe MaxExpansions
1410− , queryStringFuzziness :: Maybe Fuzziness
1411− , queryStringFuzzyPrefixLength :: Maybe PrefixLength
1412− , queryStringPhraseSlop :: Maybe PhraseSlop
1413− , queryStringBoost :: Maybe Boost
1414− , queryStringAnalyzeWildcard :: Maybe AnalyzeWildcard
1415− , queryStringGeneratePhraseQueries :: Maybe GeneratePhraseQueries
1416− , queryStringMinimumShouldMatch :: Maybe MinimumMatch
1417− , queryStringLenient :: Maybe Lenient
1418− , queryStringLocale :: Maybe Locale
1419− } deriving (Eq, Read, Show, Generic, Typeable)
1420−
1421−mkQueryStringQuery :: QueryString -> QueryStringQuery
1422−mkQueryStringQuery qs =
1423− QueryStringQuery qs Nothing Nothing
1424− Nothing Nothing Nothing Nothing
1425− Nothing Nothing Nothing Nothing
1426− Nothing Nothing Nothing Nothing
1427− Nothing Nothing
1428−
1429−data FieldOrFields = FofField FieldName
1430− | FofFields (NonEmpty FieldName) deriving (Eq, Read, Show, Generic, Typeable)
1431−
1432−data PrefixQuery =
1433− PrefixQuery
1434− { prefixQueryField :: FieldName
1435− , prefixQueryPrefixValue :: Text
1436− , prefixQueryBoost :: Maybe Boost } deriving (Eq, Read, Show, Generic, Typeable)
1437−
1438−data NestedQuery =
1439− NestedQuery
1440− { nestedQueryPath :: QueryPath
1441− , nestedQueryScoreType :: ScoreType
1442− , nestedQuery :: Query } deriving (Eq, Read, Show, Generic, Typeable)
1443−
1444−data MoreLikeThisFieldQuery =
1445− MoreLikeThisFieldQuery
1446− { moreLikeThisFieldText :: Text
1447− , moreLikeThisFieldFields :: FieldName
1448− -- default 0.3 (30%)
1449− , moreLikeThisFieldPercentMatch :: Maybe PercentMatch
1450− , moreLikeThisFieldMinimumTermFreq :: Maybe MinimumTermFrequency
1451− , moreLikeThisFieldMaxQueryTerms :: Maybe MaxQueryTerms
1452− , moreLikeThisFieldStopWords :: Maybe (NonEmpty StopWord)
1453− , moreLikeThisFieldMinDocFrequency :: Maybe MinDocFrequency
1454− , moreLikeThisFieldMaxDocFrequency :: Maybe MaxDocFrequency
1455− , moreLikeThisFieldMinWordLength :: Maybe MinWordLength
1456− , moreLikeThisFieldMaxWordLength :: Maybe MaxWordLength
1457− , moreLikeThisFieldBoostTerms :: Maybe BoostTerms
1458− , moreLikeThisFieldBoost :: Maybe Boost
1459− , moreLikeThisFieldAnalyzer :: Maybe Analyzer
1460− } deriving (Eq, Read, Show, Generic, Typeable)
1461−
1462−data MoreLikeThisQuery =
1463− MoreLikeThisQuery
1464− { moreLikeThisText :: Text
1465− , moreLikeThisFields :: Maybe (NonEmpty FieldName)
1466− -- default 0.3 (30%)
1467− , moreLikeThisPercentMatch :: Maybe PercentMatch
1468− , moreLikeThisMinimumTermFreq :: Maybe MinimumTermFrequency
1469− , moreLikeThisMaxQueryTerms :: Maybe MaxQueryTerms
1470− , moreLikeThisStopWords :: Maybe (NonEmpty StopWord)
1471− , moreLikeThisMinDocFrequency :: Maybe MinDocFrequency
1472− , moreLikeThisMaxDocFrequency :: Maybe MaxDocFrequency
1473− , moreLikeThisMinWordLength :: Maybe MinWordLength
1474− , moreLikeThisMaxWordLength :: Maybe MaxWordLength
1475− , moreLikeThisBoostTerms :: Maybe BoostTerms
1476− , moreLikeThisBoost :: Maybe Boost
1477− , moreLikeThisAnalyzer :: Maybe Analyzer
1478− } deriving (Eq, Read, Show, Generic, Typeable)
1479−
1480−data IndicesQuery =
1481− IndicesQuery
1482− { indicesQueryIndices :: [IndexName]
1483− , indicesQuery :: Query
1484− -- default "all"
1485− , indicesQueryNoMatch :: Maybe Query } deriving (Eq, Read, Show, Generic, Typeable)
1486−
1487−data HasParentQuery =
1488− HasParentQuery
1489− { hasParentQueryType :: TypeName
1490− , hasParentQuery :: Query
1491− , hasParentQueryScoreType :: Maybe ScoreType } deriving (Eq, Read, Show, Generic, Typeable)
1492−
1493−data HasChildQuery =
1494− HasChildQuery
1495− { hasChildQueryType :: TypeName
1496− , hasChildQuery :: Query
1497− , hasChildQueryScoreType :: Maybe ScoreType } deriving (Eq, Read, Show, Generic, Typeable)
1498−
1499−data ScoreType =
1500− ScoreTypeMax
1501− | ScoreTypeSum
1502− | ScoreTypeAvg
1503− | ScoreTypeNone deriving (Eq, Read, Show, Generic, Typeable)
1504−
1505−data FuzzyQuery =
1506− FuzzyQuery { fuzzyQueryField :: FieldName
1507− , fuzzyQueryValue :: Text
1508− , fuzzyQueryPrefixLength :: PrefixLength
1509− , fuzzyQueryMaxExpansions :: MaxExpansions
1510− , fuzzyQueryFuzziness :: Fuzziness
1511− , fuzzyQueryBoost :: Maybe Boost
1512− } deriving (Eq, Read, Show, Generic, Typeable)
1513−
1514−data FuzzyLikeFieldQuery =
1515− FuzzyLikeFieldQuery
1516− { fuzzyLikeField :: FieldName
1517− -- anaphora is good for the soul.
1518− , fuzzyLikeFieldText :: Text
1519− , fuzzyLikeFieldMaxQueryTerms :: MaxQueryTerms
1520− , fuzzyLikeFieldIgnoreTermFrequency :: IgnoreTermFrequency
1521− , fuzzyLikeFieldFuzziness :: Fuzziness
1522− , fuzzyLikeFieldPrefixLength :: PrefixLength
1523− , fuzzyLikeFieldBoost :: Boost
1524− , fuzzyLikeFieldAnalyzer :: Maybe Analyzer
1525− } deriving (Eq, Read, Show, Generic, Typeable)
1526−
1527−data FuzzyLikeThisQuery =
1528− FuzzyLikeThisQuery
1529− { fuzzyLikeFields :: [FieldName]
1530− , fuzzyLikeText :: Text
1531− , fuzzyLikeMaxQueryTerms :: MaxQueryTerms
1532− , fuzzyLikeIgnoreTermFrequency :: IgnoreTermFrequency
1533− , fuzzyLikeFuzziness :: Fuzziness
1534− , fuzzyLikePrefixLength :: PrefixLength
1535− , fuzzyLikeBoost :: Boost
1536− , fuzzyLikeAnalyzer :: Maybe Analyzer
1537− } deriving (Eq, Read, Show, Generic, Typeable)
1538−
1539−data DisMaxQuery =
1540− DisMaxQuery { disMaxQueries :: [Query]
1541− -- default 0.0
1542− , disMaxTiebreaker :: Tiebreaker
1543− , disMaxBoost :: Maybe Boost
1544− } deriving (Eq, Read, Show, Generic, Typeable)
1545−
1546−data MatchQuery =
1547− MatchQuery { matchQueryField :: FieldName
1548− , matchQueryQueryString :: QueryString
1549− , matchQueryOperator :: BooleanOperator
1550− , matchQueryZeroTerms :: ZeroTermsQuery
1551− , matchQueryCutoffFrequency :: Maybe CutoffFrequency
1552− , matchQueryMatchType :: Maybe MatchQueryType
1553− , matchQueryAnalyzer :: Maybe Analyzer
1554− , matchQueryMaxExpansions :: Maybe MaxExpansions
1555− , matchQueryLenient :: Maybe Lenient
1556− , matchQueryBoost :: Maybe Boost
1557− , matchQueryMinimumShouldMatch :: Maybe Text
1558− } deriving (Eq, Read, Show, Generic, Typeable)
1559−
1560−{-| 'mkMatchQuery' is a convenience function that defaults the less common parameters,
1561− enabling you to provide only the 'FieldName' and 'QueryString' to make a 'MatchQuery'
1562−-}
1563−mkMatchQuery :: FieldName -> QueryString -> MatchQuery
1564−mkMatchQuery field query = MatchQuery field query Or ZeroTermsNone Nothing Nothing Nothing Nothing Nothing Nothing Nothing
1565−
1566−data MatchQueryType =
1567− MatchPhrase
1568− | MatchPhrasePrefix deriving (Eq, Read, Show, Generic, Typeable)
1569−
1570−data MultiMatchQuery =
1571− MultiMatchQuery { multiMatchQueryFields :: [FieldName]
1572− , multiMatchQueryString :: QueryString
1573− , multiMatchQueryOperator :: BooleanOperator
1574− , multiMatchQueryZeroTerms :: ZeroTermsQuery
1575− , multiMatchQueryTiebreaker :: Maybe Tiebreaker
1576− , multiMatchQueryType :: Maybe MultiMatchQueryType
1577− , multiMatchQueryCutoffFrequency :: Maybe CutoffFrequency
1578− , multiMatchQueryAnalyzer :: Maybe Analyzer
1579− , multiMatchQueryMaxExpansions :: Maybe MaxExpansions
1580− , multiMatchQueryLenient :: Maybe Lenient } deriving (Eq, Read, Show, Generic, Typeable)
1581−
1582−{-| 'mkMultiMatchQuery' is a convenience function that defaults the less common parameters,
1583− enabling you to provide only the list of 'FieldName's and 'QueryString' to
1584− make a 'MultiMatchQuery'.
1585−-}
1586−
1587−mkMultiMatchQuery :: [FieldName] -> QueryString -> MultiMatchQuery
1588−mkMultiMatchQuery matchFields query =
1589− MultiMatchQuery matchFields query
1590− Or ZeroTermsNone Nothing Nothing Nothing Nothing Nothing Nothing
1591−
1592−data MultiMatchQueryType =
1593− MultiMatchBestFields
1594− | MultiMatchMostFields
1595− | MultiMatchCrossFields
1596− | MultiMatchPhrase
1597− | MultiMatchPhrasePrefix deriving (Eq, Read, Show, Generic, Typeable)
1598−
1599−data BoolQuery =
1600− BoolQuery { boolQueryMustMatch :: [Query]
1601− , boolQueryFilter :: [Filter]
1602− , boolQueryMustNotMatch :: [Query]
1603− , boolQueryShouldMatch :: [Query]
1604− , boolQueryMinimumShouldMatch :: Maybe MinimumMatch
1605− , boolQueryBoost :: Maybe Boost
1606− , boolQueryDisableCoord :: Maybe DisableCoord
1607− } deriving (Eq, Read, Show, Generic, Typeable)
1608−
1609−mkBoolQuery :: [Query] -> [Filter] -> [Query] -> [Query] -> BoolQuery
1610−mkBoolQuery must filt mustNot should =
1611− BoolQuery must filt mustNot should Nothing Nothing Nothing
1612−
1613−data BoostingQuery =
1614− BoostingQuery { positiveQuery :: Query
1615− , negativeQuery :: Query
1616− , negativeBoost :: Boost } deriving (Eq, Read, Show, Generic, Typeable)
1617−
1618−data CommonTermsQuery =
1619− CommonTermsQuery { commonField :: FieldName
1620− , commonQuery :: QueryString
1621− , commonCutoffFrequency :: CutoffFrequency
1622− , commonLowFreqOperator :: BooleanOperator
1623− , commonHighFreqOperator :: BooleanOperator
1624− , commonMinimumShouldMatch :: Maybe CommonMinimumMatch
1625− , commonBoost :: Maybe Boost
1626− , commonAnalyzer :: Maybe Analyzer
1627− , commonDisableCoord :: Maybe DisableCoord
1628− } deriving (Eq, Read, Show, Generic, Typeable)
1629−
1630−data CommonMinimumMatch =
1631− CommonMinimumMatchHighLow MinimumMatchHighLow
1632− | CommonMinimumMatch MinimumMatch
1633− deriving (Eq, Read, Show, Generic, Typeable)
1634−
1635−data MinimumMatchHighLow =
1636− MinimumMatchHighLow { lowFreq :: MinimumMatch
1637− , highFreq :: MinimumMatch } deriving (Eq, Read, Show, Generic, Typeable)
1638−
1639−data ZeroTermsQuery = ZeroTermsNone
1640− | ZeroTermsAll deriving (Eq, Read, Show, Generic, Typeable)
1641−
1642−data RangeExecution = RangeExecutionIndex
1643− | RangeExecutionFielddata deriving (Eq, Read, Show, Generic, Typeable)
1644−
1645−newtype Regexp = Regexp Text deriving (Eq, Read, Show, Generic, Typeable, FromJSON)
1646−
1647−data RegexpFlags = AllRegexpFlags
1648− | NoRegexpFlags
1649− | SomeRegexpFlags (NonEmpty RegexpFlag) deriving (Eq, Read, Show, Generic, Typeable)
1650−
1651−data RegexpFlag = AnyString
1652− | Automaton
1653− | Complement
1654− | Empty
1655− | Intersection
1656− | Interval deriving (Eq, Read, Show, Generic, Typeable)
1657−
1658−newtype LessThan = LessThan Double deriving (Eq, Read, Show, Generic, Typeable)
1659−newtype LessThanEq = LessThanEq Double deriving (Eq, Read, Show, Generic, Typeable)
1660−newtype GreaterThan = GreaterThan Double deriving (Eq, Read, Show, Generic, Typeable)
1661−newtype GreaterThanEq = GreaterThanEq Double deriving (Eq, Read, Show, Generic, Typeable)
1662−
1663−newtype LessThanD = LessThanD UTCTime deriving (Eq, Read, Show, Generic, Typeable)
1664−newtype LessThanEqD = LessThanEqD UTCTime deriving (Eq, Read, Show, Generic, Typeable)
1665−newtype GreaterThanD = GreaterThanD UTCTime deriving (Eq, Read, Show, Generic, Typeable)
1666−newtype GreaterThanEqD = GreaterThanEqD UTCTime deriving (Eq, Read, Show, Generic, Typeable)
1667−
1668−data RangeValue = RangeDateLte LessThanEqD
1669− | RangeDateLt LessThanD
1670− | RangeDateGte GreaterThanEqD
1671− | RangeDateGt GreaterThanD
1672− | RangeDateGtLt GreaterThanD LessThanD
1673− | RangeDateGteLte GreaterThanEqD LessThanEqD
1674− | RangeDateGteLt GreaterThanEqD LessThanD
1675− | RangeDateGtLte GreaterThanD LessThanEqD
1676− | RangeDoubleLte LessThanEq
1677− | RangeDoubleLt LessThan
1678− | RangeDoubleGte GreaterThanEq
1679− | RangeDoubleGt GreaterThan
1680− | RangeDoubleGtLt GreaterThan LessThan
1681− | RangeDoubleGteLte GreaterThanEq LessThanEq
1682− | RangeDoubleGteLt GreaterThanEq LessThan
1683− | RangeDoubleGtLte GreaterThan LessThanEq
1684− deriving (Eq, Read, Show, Generic, Typeable)
1685−
1686−rangeValueToPair :: RangeValue -> [Pair]
1687−rangeValueToPair rv = case rv of
1688− RangeDateLte (LessThanEqD t) -> ["lte" .= t]
1689− RangeDateGte (GreaterThanEqD t) -> ["gte" .= t]
1690− RangeDateLt (LessThanD t) -> ["lt" .= t]
1691− RangeDateGt (GreaterThanD t) -> ["gt" .= t]
1692− RangeDateGteLte (GreaterThanEqD l) (LessThanEqD g) -> ["gte" .= l, "lte" .= g]
1693− RangeDateGtLte (GreaterThanD l) (LessThanEqD g) -> ["gt" .= l, "lte" .= g]
1694− RangeDateGteLt (GreaterThanEqD l) (LessThanD g) -> ["gte" .= l, "lt" .= g]
1695− RangeDateGtLt (GreaterThanD l) (LessThanD g) -> ["gt" .= l, "lt" .= g]
1696− RangeDoubleLte (LessThanEq t) -> ["lte" .= t]
1697− RangeDoubleGte (GreaterThanEq t) -> ["gte" .= t]
1698− RangeDoubleLt (LessThan t) -> ["lt" .= t]
1699− RangeDoubleGt (GreaterThan t) -> ["gt" .= t]
1700− RangeDoubleGteLte (GreaterThanEq l) (LessThanEq g) -> ["gte" .= l, "lte" .= g]
1701− RangeDoubleGtLte (GreaterThan l) (LessThanEq g) -> ["gt" .= l, "lte" .= g]
1702− RangeDoubleGteLt (GreaterThanEq l) (LessThan g) -> ["gte" .= l, "lt" .= g]
1703− RangeDoubleGtLt (GreaterThan l) (LessThan g) -> ["gt" .= l, "lt" .= g]
1704−
1705−data Term = Term { termField :: Text
1706− , termValue :: Text } deriving (Eq, Read, Show, Generic, Typeable)
1707−
1708−data BoolMatch = MustMatch Term Cache
1709− | MustNotMatch Term Cache
1710− | ShouldMatch [Term] Cache deriving (Eq, Read, Show, Generic, Typeable)
1711−
1712−-- "memory" or "indexed"
1713−data GeoFilterType = GeoFilterMemory
1714− | GeoFilterIndexed deriving (Eq, Read, Show, Generic, Typeable)
1715−
1716−data LatLon = LatLon { lat :: Double
1717− , lon :: Double } deriving (Eq, Read, Show, Generic, Typeable)
1718−
1719−data GeoBoundingBox =
1720− GeoBoundingBox { topLeft :: LatLon
1721− , bottomRight :: LatLon } deriving (Eq, Read, Show, Generic, Typeable)
1722−
1723−data GeoBoundingBoxConstraint =
1724− GeoBoundingBoxConstraint { geoBBField :: FieldName
1725− , constraintBox :: GeoBoundingBox
1726− , bbConstraintcache :: Cache
1727− , geoType :: GeoFilterType
1728− } deriving (Eq, Read, Show, Generic, Typeable)
1729−
1730−data GeoPoint =
1731− GeoPoint { geoField :: FieldName
1732− , latLon :: LatLon} deriving (Eq, Read, Show, Generic, Typeable)
1733−
1734−data DistanceUnit = Miles
1735− | Yards
1736− | Feet
1737− | Inches
1738− | Kilometers
1739− | Meters
1740− | Centimeters
1741− | Millimeters
1742− | NauticalMiles deriving (Eq, Read, Show, Generic, Typeable)
1743−
1744−data DistanceType = Arc
1745− | SloppyArc -- doesn't exist <1.0
1746− | Plane deriving (Eq, Read, Show, Generic, Typeable)
1747−
1748−data OptimizeBbox = OptimizeGeoFilterType GeoFilterType
1749− | NoOptimizeBbox deriving (Eq, Read, Show, Generic, Typeable)
1750−
1751−data Distance =
1752− Distance { coefficient :: Double
1753− , unit :: DistanceUnit } deriving (Eq, Read, Show, Generic, Typeable)
1754−
1755−data DistanceRange =
1756− DistanceRange { distanceFrom :: Distance
1757− , distanceTo :: Distance } deriving (Eq, Read, Show, Generic, Typeable)
1758−
1759−type TemplateQueryKey = Text
1760−type TemplateQueryValue = Text
1761−
1762−newtype TemplateQueryKeyValuePairs = TemplateQueryKeyValuePairs (HM.HashMap TemplateQueryKey TemplateQueryValue)
1763− deriving (Eq, Read, Show, Generic)
1764−
1765−instance ToJSON TemplateQueryKeyValuePairs where
1766− toJSON (TemplateQueryKeyValuePairs x) = Object $ HM.map toJSON x
1767−
1768−instance FromJSON TemplateQueryKeyValuePairs where
1769− parseJSON (Object o) = pure . TemplateQueryKeyValuePairs $ HM.mapMaybe getValue o
1770− where getValue (String x) = Just x
1771− getValue _ = Nothing
1772− parseJSON _ = fail "error parsing TemplateQueryKeyValuePairs"
1773−
1774−data TemplateQueryInline =
1775− TemplateQueryInline { inline :: Query
1776− , params :: TemplateQueryKeyValuePairs
1777− }
1778− deriving (Eq, Read, Show, Generic, Typeable)
1779−
1780−instance ToJSON TemplateQueryInline where
1781− toJSON TemplateQueryInline{..} = object [ "inline" .= inline
1782− , "params" .= params
1783− ]
1784−
1785−instance FromJSON TemplateQueryInline where
1786− parseJSON = withObject "TemplateQueryInline" parse
1787− where parse o = TemplateQueryInline
1788− <$> o .: "inline"
1789− <*> o .: "params"
1790−
1791−
1792−data SearchResult a =
1793− SearchResult { took :: Int
1794− , timedOut :: Bool
1795− , shards :: ShardResult
1796− , searchHits :: SearchHits a
1797− , aggregations :: Maybe AggregationResults
1798− , scrollId :: Maybe ScrollId
1799− , suggest :: Maybe NamedSuggestionResponse -- ^ Only one Suggestion request / response per Search is supported.
1800− }
1801− deriving (Eq, Read, Show, Generic, Typeable)
1802−
1803−newtype ScrollId = ScrollId Text deriving (Eq, Read, Show, Generic, Ord, ToJSON, FromJSON)
1804−
1805−type Score = Maybe Double
1806−
1807−data SearchHits a =
1808− SearchHits { hitsTotal :: Int
1809− , maxScore :: Score
1810− , hits :: [Hit a] } deriving (Eq, Read, Show, Generic, Typeable)
1811−
1812−instance Semigroup (SearchHits a) where
1813− (SearchHits ta ma ha) <> (SearchHits tb mb hb) = SearchHits (ta + tb) (max ma mb) (ha <> hb)
1814−
1815−instance Monoid (SearchHits a) where
1816− mempty = SearchHits 0 Nothing mempty
1817− mappend = (<>)
1818−
1819−data Hit a =
1820− Hit { hitIndex :: IndexName
1821− , hitType :: MappingName
1822− , hitDocId :: DocId
1823− , hitScore :: Score
1824− , hitSource :: Maybe a
1825− , hitHighlight :: Maybe HitHighlight } deriving (Eq, Read, Show, Generic, Typeable)
1826−
1827−data ShardResult =
1828− ShardResult { shardTotal :: Int
1829− , shardsSuccessful :: Int
1830− , shardsFailed :: Int } deriving (Eq, Read, Show, Generic, Typeable)
1831−
1832−type HitHighlight = M.Map Text [Text]
1833−
1834−showText :: Show a => a -> Text
1835−showText = T.pack . show
1836−
1837−readMay :: Read a => String -> Maybe a
1838−readMay s = case reads s of
1839− (a, ""):_ -> Just a
1840− _ -> Nothing
1841−
1842−parseReadText :: Read a => Text -> Parser a
1843−parseReadText = maybe mzero return . readMay . T.unpack
1844−
1845−type Aggregations = M.Map Text Aggregation
1846−
1847−emptyAggregations :: Aggregations
1848−emptyAggregations = M.empty
1849−
1850−mkAggregations :: Text -> Aggregation -> Aggregations
1851−mkAggregations name aggregation = M.insert name aggregation emptyAggregations
1852−
1853−data TermOrder = TermOrder{ termSortField :: Text
1854− , termSortOrder :: SortOrder } deriving (Eq, Read, Show, Generic, Typeable)
1855−
1856−data TermInclusion = TermInclusion Text
1857− | TermPattern Text Text deriving (Eq, Read, Show, Generic, Typeable)
1858−
1859−data CollectionMode = BreadthFirst
1860− | DepthFirst deriving (Eq, Read, Show, Generic, Typeable)
1861−
1862−data ExecutionHint = Ordinals
1863− | GlobalOrdinals
1864− | GlobalOrdinalsHash
1865− | GlobalOrdinalsLowCardinality
1866− | Map deriving (Eq, Read, Show, Generic, Typeable)
1867−
1868−data TimeInterval = Weeks
1869− | Days
1870− | Hours
1871− | Minutes
1872− | Seconds deriving Eq
1873−
1874−data Interval = Year
1875− | Quarter
1876− | Month
1877− | Week
1878− | Day
1879− | Hour
1880− | Minute
1881− | Second deriving (Eq, Read, Show, Generic, Typeable)
1882−
1883−data Aggregation = TermsAgg TermsAggregation
1884− | CardinalityAgg CardinalityAggregation
1885− | DateHistogramAgg DateHistogramAggregation
1886− | ValueCountAgg ValueCountAggregation
1887− | FilterAgg FilterAggregation
1888− | DateRangeAgg DateRangeAggregation
1889− | MissingAgg MissingAggregation
1890− | TopHitsAgg TopHitsAggregation
1891− | StatsAgg StatisticsAggregation
1892− deriving (Eq, Read, Show, Generic, Typeable)
1893−
1894−data TopHitsAggregation = TopHitsAggregation
1895− { taFrom :: Maybe From
1896− , taSize :: Maybe Size
1897− , taSort :: Maybe Sort
1898− } deriving (Eq, Read, Show)
1899−
1900−data MissingAggregation = MissingAggregation
1901− { maField :: Text
1902− } deriving (Eq, Read, Show, Generic, Typeable)
1903−
1904−data TermsAggregation = TermsAggregation { term :: Either Text Text
1905− , termInclude :: Maybe TermInclusion
1906− , termExclude :: Maybe TermInclusion
1907− , termOrder :: Maybe TermOrder
1908− , termMinDocCount :: Maybe Int
1909− , termSize :: Maybe Int
1910− , termShardSize :: Maybe Int
1911− , termCollectMode :: Maybe CollectionMode
1912− , termExecutionHint :: Maybe ExecutionHint
1913− , termAggs :: Maybe Aggregations
1914− } deriving (Eq, Read, Show, Generic, Typeable)
1915−
1916−data CardinalityAggregation = CardinalityAggregation { cardinalityField :: FieldName,
1917− precisionThreshold :: Maybe Int
1918− } deriving (Eq, Read, Show, Generic, Typeable)
1919−
1920−data DateHistogramAggregation = DateHistogramAggregation { dateField :: FieldName
1921− , dateInterval :: Interval
1922− , dateFormat :: Maybe Text
1923− -- pre and post deprecated in 1.5
1924− , datePreZone :: Maybe Text
1925− , datePostZone :: Maybe Text
1926− , datePreOffset :: Maybe Text
1927− , datePostOffset :: Maybe Text
1928− , dateAggs :: Maybe Aggregations
1929− } deriving (Eq, Read, Show, Generic, Typeable)
1930−
1931−
1932−data DateRangeAggregation = DateRangeAggregation { draField :: FieldName
1933− , draFormat :: Maybe Text
1934− , draRanges :: NonEmpty DateRangeAggRange
1935− } deriving (Eq, Read, Show, Generic, Typeable)
1936−
1937−data DateRangeAggRange = DateRangeFrom DateMathExpr
1938− | DateRangeTo DateMathExpr
1939− | DateRangeFromAndTo DateMathExpr DateMathExpr deriving (Eq, Read, Show, Generic, Typeable)
1940−
1941−-- | See <https://www.elastic.co/guide/en/elasticsearch/reference/current/common-options.html#date-math> for more information.
1942−data DateMathExpr = DateMathExpr DateMathAnchor [DateMathModifier] deriving (Eq, Read, Show, Generic, Typeable)
1943−
1944−
1945−-- | Starting point for a date range. This along with the 'DateMathModifiers' gets you the date ES will start from.
1946−data DateMathAnchor = DMNow
1947− | DMDate Day deriving (Eq, Read, Show, Generic, Typeable)
1948−
1949−data DateMathModifier = AddTime Int DateMathUnit
1950− | SubtractTime Int DateMathUnit
1951− | RoundDownTo DateMathUnit deriving (Eq, Read, Show, Generic, Typeable)
1952−
1953−data DateMathUnit = DMYear
1954− | DMMonth
1955− | DMWeek
1956− | DMDay
1957− | DMHour
1958− | DMMinute
1959− | DMSecond deriving (Eq, Read, Show, Generic, Typeable)
1960−
1961−-- | See <https://www.elastic.co/guide/en/elasticsearch/reference/current/search-aggregations-metrics-valuecount-aggregation.html> for more information.
1962−data ValueCountAggregation = FieldValueCount FieldName
1963− | ScriptValueCount Script deriving (Eq, Read, Show, Generic, Typeable)
1964−
1965−-- | 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.
1966−data FilterAggregation = FilterAggregation { faFilter :: Filter
1967− , faAggs :: Maybe Aggregations} deriving (Eq, Read, Show, Generic, Typeable)
1968−
1969−data StatisticsAggregation = StatisticsAggregation { statsType :: StatsType
1970− , statsField :: FieldName } deriving (Eq, Read, Show, Generic, Typeable)
1971−
1972−data StatsType
1973− = Basic
1974− | Extended
1975− deriving (Eq, Read, Show, Generic, Typeable)
1976−
1977−mkTermsAggregation :: Text -> TermsAggregation
1978−mkTermsAggregation t = TermsAggregation (Left t) Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing
1979−
1980−mkTermsScriptAggregation :: Text -> TermsAggregation
1981−mkTermsScriptAggregation t = TermsAggregation (Right t) Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing
1982−
1983−mkDateHistogram :: FieldName -> Interval -> DateHistogramAggregation
1984−mkDateHistogram t i = DateHistogramAggregation t i Nothing Nothing Nothing Nothing Nothing Nothing
1985−
1986−mkCardinalityAggregation :: FieldName -> CardinalityAggregation
1987−mkCardinalityAggregation t = CardinalityAggregation t Nothing
1988−
1989−mkStatsAggregation :: FieldName -> StatisticsAggregation
1990−mkStatsAggregation = StatisticsAggregation Basic
1991−
1992−mkExtendedStatsAggregation :: FieldName -> StatisticsAggregation
1993−mkExtendedStatsAggregation = StatisticsAggregation Extended
1994−
1995−instance ToJSON Version where
1996− toJSON Version {..} = object ["number" .= number
1997− ,"build_hash" .= build_hash
1998− ,"build_date" .= build_date
1999− ,"build_snapshot" .= build_snapshot
2000− ,"lucene_version" .= lucene_version]
2001−
2002−instance FromJSON Version where
2003− parseJSON = withObject "Version" parse
2004− where parse o = Version
2005− <$> o .: "number"
2006− <*> o .: "build_hash"
2007− <*> o .: "build_date"
2008− <*> o .: "build_snapshot"
2009− <*> o .: "lucene_version"
2010−
2011−instance ToJSON VersionNumber where
2012− toJSON = toJSON . Vers.showVersion . versionNumber
2013−
2014−instance FromJSON VersionNumber where
2015− parseJSON = withText "VersionNumber" (parse . T.unpack)
2016− where
2017− parse s = case filter (null . snd)(RP.readP_to_S Vers.parseVersion s) of
2018− [(v, _)] -> pure (VersionNumber v)
2019− [] -> fail ("Invalid version string " ++ s)
2020− xs -> fail ("Ambiguous version string " ++ s ++ " (" ++ intercalate ", " (Vers.showVersion . fst <$> xs) ++ ")")
2021−
2022−instance ToJSON TermOrder where
2023− toJSON (TermOrder termSortField termSortOrder) = object [termSortField .= termSortOrder]
2024−
2025−instance ToJSON TermInclusion where
2026− toJSON (TermInclusion x) = toJSON x
2027− toJSON (TermPattern pattern flags) = omitNulls [ "pattern" .= pattern,
2028− "flags" .= flags]
2029−
2030−instance ToJSON CollectionMode where
2031− toJSON BreadthFirst = "breadth_first"
2032− toJSON DepthFirst = "depth_first"
2033−
2034−instance ToJSON ExecutionHint where
2035− toJSON Ordinals = "ordinals"
2036− toJSON GlobalOrdinals = "global_ordinals"
2037− toJSON GlobalOrdinalsHash = "global_ordinals_hash"
2038− toJSON GlobalOrdinalsLowCardinality = "global_ordinals_low_cardinality"
2039− toJSON Map = "map"
2040−
2041−instance ToJSON Interval where
2042− toJSON Year = "year"
2043− toJSON Quarter = "quarter"
2044− toJSON Month = "month"
2045− toJSON Week = "week"
2046− toJSON Day = "day"
2047− toJSON Hour = "hour"
2048− toJSON Minute = "minute"
2049− toJSON Second = "second"
2050−
2051−instance Show TimeInterval where
2052− show Weeks = "w"
2053− show Days = "d"
2054− show Hours = "h"
2055− show Minutes = "m"
2056− show Seconds = "s"
2057−
2058−instance Read TimeInterval where
2059− readPrec = f =<< TR.get
2060− where
2061− f 'w' = return Weeks
2062− f 'd' = return Days
2063− f 'h' = return Hours
2064− f 'm' = return Minutes
2065− f 's' = return Seconds
2066− f _ = fail "TimeInterval expected one of w, d, h, m, s"
2067−
2068−instance ToJSON Aggregation where
2069− toJSON (TermsAgg (TermsAggregation term include exclude order minDocCount size shardSize collectMode executionHint termAggs)) =
2070− omitNulls ["terms" .= omitNulls [ toJSON' term,
2071− "include" .= include,
2072− "exclude" .= exclude,
2073− "order" .= order,
2074− "min_doc_count" .= minDocCount,
2075− "size" .= size,
2076− "shard_size" .= shardSize,
2077− "collect_mode" .= collectMode,
2078− "execution_hint" .= executionHint
2079− ],
2080− "aggs" .= termAggs ]
2081− where
2082− toJSON' x = case x of { Left y -> "field" .= y; Right y -> "script" .= y }
2083−
2084− toJSON (CardinalityAgg (CardinalityAggregation field precisionThreshold)) =
2085− object ["cardinality" .= omitNulls [ "field" .= field,
2086− "precisionThreshold" .= precisionThreshold
2087− ]
2088− ]
2089−
2090− toJSON (DateHistogramAgg (DateHistogramAggregation field interval format preZone postZone preOffset postOffset dateHistoAggs)) =
2091− omitNulls ["date_histogram" .= omitNulls [ "field" .= field,
2092− "interval" .= interval,
2093− "format" .= format,
2094− "pre_zone" .= preZone,
2095− "post_zone" .= postZone,
2096− "pre_offset" .= preOffset,
2097− "post_offset" .= postOffset
2098− ],
2099− "aggs" .= dateHistoAggs ]
2100− toJSON (ValueCountAgg a) = object ["value_count" .= v]
2101− where v = case a of
2102− (FieldValueCount (FieldName n)) -> object ["field" .= n]
2103− (ScriptValueCount (Script s)) -> object ["script" .= s]
2104− toJSON (FilterAgg (FilterAggregation filt ags)) =
2105− omitNulls [ "filter" .= filt
2106− , "aggs" .= ags]
2107− toJSON (DateRangeAgg a) = object [ "date_range" .= a
2108− ]
2109− toJSON (MissingAgg (MissingAggregation{..})) =
2110− object ["missing" .= object ["field" .= maField]]
2111−
2112− toJSON (TopHitsAgg (TopHitsAggregation mfrom msize msort)) =
2113− omitNulls ["top_hits" .= omitNulls [ "size" .= msize
2114− , "from" .= mfrom
2115− , "sort" .= msort
2116− ]
2117− ]
2118−
2119− toJSON (StatsAgg (StatisticsAggregation typ field)) =
2120− object [stType .= omitNulls [ "field" .= field ]]
2121− where
2122− stType | typ == Basic = "stats"
2123− | otherwise = "extended_stats"
2124−
2125−instance ToJSON DateRangeAggregation where
2126− toJSON DateRangeAggregation {..} =
2127− omitNulls [ "field" .= draField
2128− , "format" .= draFormat
2129− , "ranges" .= toList draRanges
2130− ]
2131−
2132−instance ToJSON DateRangeAggRange where
2133− toJSON (DateRangeFrom e) = object [ "from" .= e ]
2134− toJSON (DateRangeTo e) = object [ "to" .= e ]
2135− toJSON (DateRangeFromAndTo f t) = object [ "from" .= f, "to" .= t ]
2136−
2137−instance ToJSON DateMathExpr where
2138− toJSON (DateMathExpr a mods) = String (fmtA a <> mconcat (fmtMod <$> mods))
2139− where fmtA DMNow = "now"
2140− fmtA (DMDate date) = (T.pack $ showGregorian date) <> "||"
2141− fmtMod (AddTime n u) = "+" <> showText n <> fmtU u
2142− fmtMod (SubtractTime n u) = "-" <> showText n <> fmtU u
2143− fmtMod (RoundDownTo u) = "/" <> fmtU u
2144− fmtU DMYear = "y"
2145− fmtU DMMonth = "M"
2146− fmtU DMWeek = "w"
2147− fmtU DMDay = "d"
2148− fmtU DMHour = "h"
2149− fmtU DMMinute = "m"
2150− fmtU DMSecond = "s"
2151−
2152−
2153−type AggregationResults = M.Map Text Value
2154−
2155−class BucketAggregation a where
2156− key :: a -> BucketValue
2157− docCount :: a -> Int
2158− aggs :: a -> Maybe AggregationResults
2159−
2160−
2161−data Bucket a = Bucket { buckets :: [a]} deriving (Read, Show)
2162−
2163−data BucketValue = TextValue Text
2164− | ScientificValue Scientific
2165− | BoolValue Bool deriving (Read, Show)
2166−
2167−data MissingResult = MissingResult { missingDocCount :: Int } deriving (Show)
2168−
2169−data TopHitResult a = TopHitResult { tarHits :: (SearchHits a)
2170− } deriving Show
2171−
2172−data TermsResult = TermsResult { termKey :: BucketValue
2173− , termsDocCount :: Int
2174− , termsAggs :: Maybe AggregationResults } deriving (Read, Show)
2175−
2176−data DateHistogramResult = DateHistogramResult { dateKey :: Int
2177− , dateKeyStr :: Maybe Text
2178− , dateDocCount :: Int
2179− , dateHistogramAggs :: Maybe AggregationResults } deriving (Read, Show)
2180−
2181−data DateRangeResult = DateRangeResult { dateRangeKey :: Text
2182− , dateRangeFrom :: Maybe UTCTime
2183− , dateRangeFromAsString :: Maybe Text
2184− , dateRangeTo :: Maybe UTCTime
2185− , dateRangeToAsString :: Maybe Text
2186− , dateRangeDocCount :: Int
2187− , dateRangeAggs :: Maybe AggregationResults } deriving (Read, Show, Eq, Generic, Typeable)
2188−
2189−toTerms :: Text -> AggregationResults -> Maybe (Bucket TermsResult)
2190−toTerms = toAggResult
2191−
2192−toDateHistogram :: Text -> AggregationResults -> Maybe (Bucket DateHistogramResult)
2193−toDateHistogram = toAggResult
2194−
2195−toMissing :: Text -> AggregationResults -> Maybe MissingResult
2196−toMissing = toAggResult
2197−
2198−toTopHits :: (FromJSON a) => Text -> AggregationResults -> Maybe (TopHitResult a)
2199−toTopHits = toAggResult
2200−
2201−toAggResult :: (FromJSON a) => Text -> AggregationResults -> Maybe a
2202−toAggResult t a = M.lookup t a >>= deserialize
2203− where deserialize = parseMaybe parseJSON
2204−
2205−instance BucketAggregation TermsResult where
2206− key = termKey
2207− docCount = termsDocCount
2208− aggs = termsAggs
2209−
2210−instance BucketAggregation DateHistogramResult where
2211− key = TextValue . showText . dateKey
2212− docCount = dateDocCount
2213− aggs = dateHistogramAggs
2214−
2215−instance BucketAggregation DateRangeResult where
2216− key = TextValue . dateRangeKey
2217− docCount = dateRangeDocCount
2218− aggs = dateRangeAggs
2219−
2220−instance (FromJSON a) => FromJSON (Bucket a) where
2221− parseJSON (Object v) = Bucket <$>
2222− v .: "buckets"
2223− parseJSON _ = mempty
2224−
2225−instance FromJSON BucketValue where
2226− parseJSON (String t) = return $ TextValue t
2227− parseJSON (Number s) = return $ ScientificValue s
2228− parseJSON (Bool b) = return $ BoolValue b
2229− parseJSON _ = mempty
2230−
2231−instance FromJSON MissingResult where
2232− parseJSON = withObject "MissingResult" parse
2233− where parse v = MissingResult <$> v .: "doc_count"
2234−
2235−instance FromJSON TermsResult where
2236− parseJSON (Object v) = TermsResult <$>
2237− v .: "key" <*>
2238− v .: "doc_count" <*>
2239− (pure $ getNamedSubAgg v ["key", "doc_count"])
2240− parseJSON _ = mempty
2241−
2242−instance FromJSON DateHistogramResult where
2243− parseJSON (Object v) = DateHistogramResult <$>
2244− v .: "key" <*>
2245− v .:? "key_as_string" <*>
2246− v .: "doc_count" <*>
2247− (pure $ getNamedSubAgg v [ "key"
2248− , "doc_count"
2249− , "key_as_string"
2250− ]
2251− )
2252− parseJSON _ = mempty
2253−
2254−instance FromJSON DateRangeResult where
2255− parseJSON = withObject "DateRangeResult" parse
2256− where parse v = DateRangeResult <$>
2257− v .: "key" <*>
2258− (fmap posixMS <$> v .:? "from") <*>
2259− v .:? "from_as_string" <*>
2260− (fmap posixMS <$> v .:? "to") <*>
2261− v .:? "to_as_string" <*>
2262− v .: "doc_count" <*>
2263− (pure $ getNamedSubAgg v [ "key"
2264− , "from"
2265− , "from_as_string"
2266− , "to"
2267− , "to_as_string"
2268− , "doc_count"
2269− ]
2270− )
2271−
2272−instance FromJSON POSIXMS where
2273− parseJSON = withScientific "POSIXMS" (return . parse)
2274− where parse n = let n' = truncate n :: Integer
2275− in POSIXMS (posixSecondsToUTCTime (fromInteger (n' `div` 1000)))
2276−
2277−instance (FromJSON a) => FromJSON (TopHitResult a) where
2278− parseJSON (Object v) = TopHitResult <$>
2279− v .: "hits"
2280− parseJSON _ = fail "Failure in FromJSON (TopHitResult a)"
2281−
2282−fieldTagged :: Monad m => (FieldName -> Object -> m a) -> Object -> m a
2283−fieldTagged f o = case HM.toList o of
2284− [(k, Object o')] -> f (FieldName k) o'
2285− _ -> fail "Expected object with 1 field-named key"
2286−
2287−-- Try to get an AggregationResults when we don't know the
2288−-- field name. We filter out the known keys to try to minimize the noise.
2289−getNamedSubAgg :: Object -> [Text] -> Maybe AggregationResults
2290−getNamedSubAgg o knownKeys = maggRes
2291− where unknownKeys = HM.filterWithKey (\k _ -> k `notElem` knownKeys) o
2292− maggRes
2293− | HM.null unknownKeys = Nothing
2294− | otherwise = Just . M.fromList $ HM.toList unknownKeys
2295−
2296−instance ToJSON GeoPoint where
2297− toJSON (GeoPoint (FieldName geoPointField) geoPointLatLon) =
2298− object [ geoPointField .= geoPointLatLon ]
2299−
2300−
2301−instance ToJSON Query where
2302− toJSON (TermQuery (Term termQueryField termQueryValue) boost) =
2303− object [ "term" .=
2304− object [termQueryField .= object merged]]
2305− where
2306− base = [ "value" .= termQueryValue ]
2307− boosted = maybe [] (return . ("boost" .=)) boost
2308− merged = mappend base boosted
2309−
2310− toJSON (TermsQuery fieldName terms) =
2311− object [ "terms" .= object conjoined ]
2312− where conjoined = [fieldName .= terms]
2313−
2314− toJSON (IdsQuery idsQueryMappingName docIds) =
2315− object [ "ids" .= object conjoined ]
2316− where conjoined = [ "type" .= idsQueryMappingName
2317− , "values" .= fmap toJSON docIds ]
2318−
2319− toJSON (QueryQueryStringQuery qQueryStringQuery) =
2320− object [ "query_string" .= qQueryStringQuery ]
2321−
2322− toJSON (QueryMatchQuery matchQuery) =
2323− object [ "match" .= matchQuery ]
2324−
2325− toJSON (QueryMultiMatchQuery multiMatchQuery) =
2326− toJSON multiMatchQuery
2327−
2328− toJSON (QueryBoolQuery boolQuery) =
2329− object [ "bool" .= boolQuery ]
2330−
2331− toJSON (QueryBoostingQuery boostingQuery) =
2332− object [ "boosting" .= boostingQuery ]
2333−
2334− toJSON (QueryCommonTermsQuery commonTermsQuery) =
2335− object [ "common" .= commonTermsQuery ]
2336−
2337− toJSON (ConstantScoreQuery query boost) =
2338− object ["constant_score" .= object ["query" .= query
2339− , "boost" .= boost]]
2340−
2341− toJSON (QueryDisMaxQuery disMaxQuery) =
2342− object [ "dis_max" .= disMaxQuery ]
2343−
2344− toJSON (QueryFuzzyLikeThisQuery fuzzyQuery) =
2345− object [ "fuzzy_like_this" .= fuzzyQuery ]
2346−
2347− toJSON (QueryFuzzyLikeFieldQuery fuzzyFieldQuery) =
2348− object [ "fuzzy_like_this_field" .= fuzzyFieldQuery ]
2349−
2350− toJSON (QueryFuzzyQuery fuzzyQuery) =
2351− object [ "fuzzy" .= fuzzyQuery ]
2352−
2353− toJSON (QueryHasChildQuery childQuery) =
2354− object [ "has_child" .= childQuery ]
2355−
2356− toJSON (QueryHasParentQuery parentQuery) =
2357− object [ "has_parent" .= parentQuery ]
2358−
2359− toJSON (QueryIndicesQuery qIndicesQuery) =
2360− object [ "indices" .= qIndicesQuery ]
2361−
2362− toJSON (MatchAllQuery boost) =
2363− object [ "match_all" .= omitNulls [ "boost" .= boost ] ]
2364−
2365− toJSON (QueryMoreLikeThisQuery query) =
2366− object [ "more_like_this" .= query ]
2367−
2368− toJSON (QueryMoreLikeThisFieldQuery query) =
2369− object [ "more_like_this_field" .= query ]
2370−
2371− toJSON (QueryNestedQuery query) =
2372− object [ "nested" .= query ]
2373−
2374− toJSON (QueryPrefixQuery query) =
2375− object [ "prefix" .= query ]
2376−
2377− toJSON (QueryRangeQuery query) =
2378− object [ "range" .= query ]
2379−
2380− toJSON (QueryRegexpQuery query) =
2381− object [ "regexp" .= query ]
2382−
2383− toJSON (QuerySimpleQueryStringQuery query) =
2384− object [ "simple_query_string" .= query ]
2385−
2386− toJSON (QueryExistsQuery (FieldName fieldName)) =
2387− object ["exists" .= object
2388− ["field" .= fieldName]
2389− ]
2390− toJSON QueryMatchNoneQuery =
2391− object ["match_none" .= object []]
2392−
2393− toJSON (QueryTemplateQueryInline templateQuery) =
2394− object [ "template" .= templateQuery ]
2395−
2396−instance FromJSON Query where
2397− parseJSON v = withObject "Query" parse v
2398− where parse o = termQuery `taggedWith` "term"
2399− <|> termsQuery `taggedWith` "terms"
2400− <|> idsQuery `taggedWith` "ids"
2401− <|> queryQueryStringQuery `taggedWith` "query_string"
2402− <|> queryMatchQuery `taggedWith` "match"
2403− <|> queryMultiMatchQuery
2404− <|> queryBoolQuery `taggedWith` "bool"
2405− <|> queryBoostingQuery `taggedWith` "boosting"
2406− <|> queryCommonTermsQuery `taggedWith` "common"
2407− <|> constantScoreQuery `taggedWith` "constant_score"
2408− <|> queryDisMaxQuery `taggedWith` "dis_max"
2409− <|> queryFuzzyLikeThisQuery `taggedWith` "fuzzy_like_this"
2410− <|> queryFuzzyLikeFieldQuery `taggedWith` "fuzzy_like_this_field"
2411− <|> queryFuzzyQuery `taggedWith` "fuzzy"
2412− <|> queryHasChildQuery `taggedWith` "has_child"
2413− <|> queryHasParentQuery `taggedWith` "has_parent"
2414− <|> queryIndicesQuery `taggedWith` "indices"
2415− <|> matchAllQuery `taggedWith` "match_all"
2416− <|> queryMoreLikeThisQuery `taggedWith` "more_like_this"
2417− <|> queryMoreLikeThisFieldQuery `taggedWith` "more_like_this_field"
2418− <|> queryNestedQuery `taggedWith` "nested"
2419− <|> queryPrefixQuery `taggedWith` "prefix"
2420− <|> queryRangeQuery `taggedWith` "range"
2421− <|> queryRegexpQuery `taggedWith` "regexp"
2422− <|> querySimpleQueryStringQuery `taggedWith` "simple_query_string"
2423− <|> queryTemplateQueryInline `taggedWith` "template"
2424− where taggedWith parser k = parser =<< o .: k
2425− termQuery = fieldTagged $ \(FieldName fn) o ->
2426− TermQuery <$> (Term fn <$> o .: "value") <*> o .:? "boost"
2427− termsQuery o = case HM.toList o of
2428− [(fn, vs)] -> do vals <- parseJSON vs
2429− case vals of
2430− x:xs -> return (TermsQuery fn (x :| xs))
2431− _ -> fail "Expected non empty list of values"
2432− _ -> fail "Expected object with 1 field-named key"
2433− idsQuery o = IdsQuery <$> o .: "type"
2434− <*> o .: "values"
2435− queryQueryStringQuery = pure . QueryQueryStringQuery
2436− queryMatchQuery = pure . QueryMatchQuery
2437− queryMultiMatchQuery = QueryMultiMatchQuery <$> parseJSON v
2438− queryBoolQuery = pure . QueryBoolQuery
2439− queryBoostingQuery = pure . QueryBoostingQuery
2440− queryCommonTermsQuery = pure . QueryCommonTermsQuery
2441− constantScoreQuery o = case HM.lookup "query" o of
2442− Just x -> ConstantScoreQuery <$> parseJSON x
2443− <*> o .: "boost"
2444− _ -> fail "Does not appear to be a ConstantScoreQuery"
2445− queryDisMaxQuery = pure . QueryDisMaxQuery
2446− queryFuzzyLikeThisQuery = pure . QueryFuzzyLikeThisQuery
2447− queryFuzzyLikeFieldQuery = pure . QueryFuzzyLikeFieldQuery
2448− queryFuzzyQuery = pure . QueryFuzzyQuery
2449− queryHasChildQuery = pure . QueryHasChildQuery
2450− queryHasParentQuery = pure . QueryHasParentQuery
2451− queryIndicesQuery = pure . QueryIndicesQuery
2452− matchAllQuery o = MatchAllQuery <$> o .:? "boost"
2453− queryMoreLikeThisQuery = pure . QueryMoreLikeThisQuery
2454− queryMoreLikeThisFieldQuery = pure . QueryMoreLikeThisFieldQuery
2455− queryNestedQuery = pure . QueryNestedQuery
2456− queryPrefixQuery = pure . QueryPrefixQuery
2457− queryRangeQuery = pure . QueryRangeQuery
2458− queryRegexpQuery = pure . QueryRegexpQuery
2459− querySimpleQueryStringQuery = pure . QuerySimpleQueryStringQuery
2460− -- queryExistsQuery o = QueryExistsQuery <$> o .: "field"
2461− queryTemplateQueryInline = pure . QueryTemplateQueryInline
2462−
2463−
2464−omitNulls :: [(Text, Value)] -> Value
2465−omitNulls = object . filter notNull where
2466− notNull (_, Null) = False
2467− notNull (_, Array a) = (not . V.null) a
2468− notNull _ = True
2469−
2470−instance ToJSON SimpleQueryStringQuery where
2471− toJSON SimpleQueryStringQuery {..} =
2472− omitNulls (base ++ maybeAdd)
2473− where base = [ "query" .= simpleQueryStringQuery ]
2474− maybeAdd = [ "fields" .= simpleQueryStringField
2475− , "default_operator" .= simpleQueryStringOperator
2476− , "analyzer" .= simpleQueryStringAnalyzer
2477− , "flags" .= simpleQueryStringFlags
2478− , "lowercase_expanded_terms" .= simpleQueryStringLowercaseExpanded
2479− , "locale" .= simpleQueryStringLocale ]
2480−
2481−instance FromJSON SimpleQueryStringQuery where
2482− parseJSON = withObject "SimpleQueryStringQuery" parse
2483− where parse o = SimpleQueryStringQuery <$> o .: "query"
2484− <*> o .:? "fields"
2485− <*> o .:? "default_operator"
2486− <*> o .:? "analyzer"
2487− <*> (parseFlags <$> o .:? "flags")
2488− <*> o .:? "lowercase_expanded_terms"
2489− <*> o .:? "locale"
2490− parseFlags (Just (x:xs)) = Just (x :| xs)
2491− parseFlags _ = Nothing
2492−
2493−instance ToJSON FieldOrFields where
2494− toJSON (FofField fieldName) =
2495− toJSON fieldName
2496− toJSON (FofFields fieldNames) =
2497− toJSON fieldNames
2498−
2499−instance FromJSON FieldOrFields where
2500− parseJSON v = FofField <$> parseJSON v
2501− <|> FofFields <$> (parseNEJSON =<< parseJSON v)
2502−
2503−instance ToJSON SimpleQueryFlag where
2504− toJSON SimpleQueryAll = "ALL"
2505− toJSON SimpleQueryNone = "NONE"
2506− toJSON SimpleQueryAnd = "AND"
2507− toJSON SimpleQueryOr = "OR"
2508− toJSON SimpleQueryPrefix = "PREFIX"
2509− toJSON SimpleQueryPhrase = "PHRASE"
2510− toJSON SimpleQueryPrecedence = "PRECEDENCE"
2511− toJSON SimpleQueryEscape = "ESCAPE"
2512− toJSON SimpleQueryWhitespace = "WHITESPACE"
2513− toJSON SimpleQueryFuzzy = "FUZZY"
2514− toJSON SimpleQueryNear = "NEAR"
2515− toJSON SimpleQuerySlop = "SLOP"
2516−
2517−instance FromJSON SimpleQueryFlag where
2518− parseJSON = withText "SimpleQueryFlag" parse
2519− where parse "ALL" = pure SimpleQueryAll
2520− parse "NONE" = pure SimpleQueryNone
2521− parse "AND" = pure SimpleQueryAnd
2522− parse "OR" = pure SimpleQueryOr
2523− parse "PREFIX" = pure SimpleQueryPrefix
2524− parse "PHRASE" = pure SimpleQueryPhrase
2525− parse "PRECEDENCE" = pure SimpleQueryPrecedence
2526− parse "ESCAPE" = pure SimpleQueryEscape
2527− parse "WHITESPACE" = pure SimpleQueryWhitespace
2528− parse "FUZZY" = pure SimpleQueryFuzzy
2529− parse "NEAR" = pure SimpleQueryNear
2530− parse "SLOP" = pure SimpleQuerySlop
2531− parse f = fail ("Unexpected SimpleQueryFlag: " <> show f)
2532−
2533−instance ToJSON RegexpQuery where
2534− toJSON (RegexpQuery (FieldName rqQueryField)
2535− (Regexp regexpQueryQuery) rqQueryFlags
2536− rqQueryBoost) =
2537− object [ rqQueryField .= omitNulls base ]
2538− where base = [ "value" .= regexpQueryQuery
2539− , "flags" .= rqQueryFlags
2540− , "boost" .= rqQueryBoost ]
2541−
2542−instance FromJSON RegexpQuery where
2543− parseJSON = withObject "RegexpQuery" parse
2544− where parse = fieldTagged $ \fn o ->
2545− RegexpQuery fn
2546− <$> o .: "value"
2547− <*> o .: "flags"
2548− <*> o .:? "boost"
2549−
2550−instance ToJSON QueryStringQuery where
2551− toJSON (QueryStringQuery qsQueryString
2552− qsDefaultField qsOperator
2553− qsAnalyzer qsAllowWildcard
2554− qsLowercaseExpanded qsEnablePositionIncrements
2555− qsFuzzyMaxExpansions qsFuzziness
2556− qsFuzzyPrefixLength qsPhraseSlop
2557− qsBoost qsAnalyzeWildcard
2558− qsGeneratePhraseQueries qsMinimumShouldMatch
2559− qsLenient qsLocale) =
2560− omitNulls base
2561− where
2562− base = [ "query" .= qsQueryString
2563− , "default_field" .= qsDefaultField
2564− , "default_operator" .= qsOperator
2565− , "analyzer" .= qsAnalyzer
2566− , "allow_leading_wildcard" .= qsAllowWildcard
2567− , "lowercase_expanded_terms" .= qsLowercaseExpanded
2568− , "enable_position_increments" .= qsEnablePositionIncrements
2569− , "fuzzy_max_expansions" .= qsFuzzyMaxExpansions
2570− , "fuzziness" .= qsFuzziness
2571− , "fuzzy_prefix_length" .= qsFuzzyPrefixLength
2572− , "phrase_slop" .= qsPhraseSlop
2573− , "boost" .= qsBoost
2574− , "analyze_wildcard" .= qsAnalyzeWildcard
2575− , "auto_generate_phrase_queries" .= qsGeneratePhraseQueries
2576− , "minimum_should_match" .= qsMinimumShouldMatch
2577− , "lenient" .= qsLenient
2578− , "locale" .= qsLocale ]
2579−
2580−instance FromJSON QueryStringQuery where
2581− parseJSON = withObject "QueryStringQuery" parse
2582− where parse o = QueryStringQuery
2583− <$> o .: "query"
2584− <*> o .:? "default_field"
2585− <*> o .:? "default_operator"
2586− <*> o .:? "analyzer"
2587− <*> o .:? "allow_leading_wildcard"
2588− <*> o .:? "lowercase_expanded_terms"
2589− <*> o .:? "enable_position_increments"
2590− <*> o .:? "fuzzy_max_expansions"
2591− <*> o .:? "fuzziness"
2592− <*> o .:? "fuzzy_prefix_length"
2593− <*> o .:? "phrase_slop"
2594− <*> o .:? "boost"
2595− <*> o .:? "analyze_wildcard"
2596− <*> o .:? "auto_generate_phrase_queries"
2597− <*> o .:? "minimum_should_match"
2598− <*> o .:? "lenient"
2599− <*> o .:? "locale"
2600−
2601−instance ToJSON RangeQuery where
2602− toJSON (RangeQuery (FieldName fieldName) range boost) =
2603− object [ fieldName .= object conjoined ]
2604− where conjoined = [ "boost" .= boost ] ++ (rangeValueToPair range)
2605−
2606−instance FromJSON RangeQuery where
2607− parseJSON = withObject "RangeQuery" parse
2608− where parse = fieldTagged $ \fn o ->
2609− RangeQuery fn
2610− <$> parseJSON (Object o)
2611− <*> o .: "boost"
2612−
2613−instance FromJSON RangeValue where
2614− parseJSON = withObject "RangeValue" parse
2615− where parse o = parseDate o
2616− <|> parseDouble o
2617− parseDate o = do lt <- o .:? "lt"
2618− lte <- o .:? "lte"
2619− gt <- o .:? "gt"
2620− gte <- o .:? "gte"
2621− case (lt, lte, gt, gte) of
2622− (Just a, _, Just b, _) -> return (RangeDateGtLt (GreaterThanD b) (LessThanD a))
2623− (Just a, _, _, Just b)-> return (RangeDateGteLt (GreaterThanEqD b) (LessThanD a))
2624− (_, Just a, Just b, _)-> return (RangeDateGtLte (GreaterThanD b) (LessThanEqD a))
2625− (_, Just a, _, Just b)-> return (RangeDateGteLte (GreaterThanEqD b) (LessThanEqD a))
2626− (_, _, Just a, _)-> return (RangeDateGt (GreaterThanD a))
2627− (Just a, _, _, _)-> return (RangeDateLt (LessThanD a))
2628− (_, _, _, Just a)-> return (RangeDateGte (GreaterThanEqD a))
2629− (_, Just a, _, _)-> return (RangeDateLte (LessThanEqD a))
2630− (Nothing, Nothing, Nothing, Nothing) -> mzero
2631− parseDouble o = do lt <- o .:? "lt"
2632− lte <- o .:? "lte"
2633− gt <- o .:? "gt"
2634− gte <- o .:? "gte"
2635− case (lt, lte, gt, gte) of
2636− (Just a, _, Just b, _) -> return (RangeDoubleGtLt (GreaterThan b) (LessThan a))
2637− (Just a, _, _, Just b)-> return (RangeDoubleGteLt (GreaterThanEq b) (LessThan a))
2638− (_, Just a, Just b, _)-> return (RangeDoubleGtLte (GreaterThan b) (LessThanEq a))
2639− (_, Just a, _, Just b)-> return (RangeDoubleGteLte (GreaterThanEq b) (LessThanEq a))
2640− (_, _, Just a, _)-> return (RangeDoubleGt (GreaterThan a))
2641− (Just a, _, _, _)-> return (RangeDoubleLt (LessThan a))
2642− (_, _, _, Just a)-> return (RangeDoubleGte (GreaterThanEq a))
2643− (_, Just a, _, _)-> return (RangeDoubleLte (LessThanEq a))
2644− (Nothing, Nothing, Nothing, Nothing) -> mzero
2645−
2646−instance ToJSON PrefixQuery where
2647− toJSON (PrefixQuery (FieldName fieldName) queryValue boost) =
2648− object [ fieldName .= omitNulls base ]
2649− where base = [ "value" .= queryValue
2650− , "boost" .= boost ]
2651−
2652−instance FromJSON PrefixQuery where
2653− parseJSON = withObject "PrefixQuery" parse
2654− where parse = fieldTagged $ \fn o ->
2655− PrefixQuery fn
2656− <$> o .: "value"
2657− <*> o .:? "boost"
2658−
2659−instance ToJSON NestedQuery where
2660− toJSON (NestedQuery nqPath nqScoreType nqQuery) =
2661− object [ "path" .= nqPath
2662− , "score_mode" .= nqScoreType
2663− , "query" .= nqQuery ]
2664−
2665−instance FromJSON NestedQuery where
2666− parseJSON = withObject "NestedQuery" parse
2667− where parse o = NestedQuery
2668− <$> o .: "path"
2669− <*> o .: "score_mode"
2670− <*> o .: "query"
2671−
2672−instance ToJSON MoreLikeThisFieldQuery where
2673− toJSON (MoreLikeThisFieldQuery text (FieldName fieldName)
2674− percent mtf mqt stopwords mindf maxdf
2675− minwl maxwl boostTerms boost analyzer) =
2676− object [ fieldName .= omitNulls base ]
2677− where base = [ "like_text" .= text
2678− , "percent_terms_to_match" .= percent
2679− , "min_term_freq" .= mtf
2680− , "max_query_terms" .= mqt
2681− , "stop_words" .= stopwords
2682− , "min_doc_freq" .= mindf
2683− , "max_doc_freq" .= maxdf
2684− , "min_word_length" .= minwl
2685− , "max_word_length" .= maxwl
2686− , "boost_terms" .= boostTerms
2687− , "boost" .= boost
2688− , "analyzer" .= analyzer ]
2689−
2690−instance FromJSON MoreLikeThisFieldQuery where
2691− parseJSON = withObject "MoreLikeThisFieldQuery" parse
2692− where parse = fieldTagged $ \fn o ->
2693− MoreLikeThisFieldQuery
2694− <$> o .: "like_text"
2695− <*> pure fn
2696− <*> o .:? "percent_terms_to_match"
2697− <*> o .:? "min_term_freq"
2698− <*> o .:? "max_query_terms"
2699− -- <*> (optionalNE =<< o .:? "stop_words")
2700− <*> o .:? "stop_words"
2701− <*> o .:? "min_doc_freq"
2702− <*> o .:? "max_doc_freq"
2703− <*> o .:? "min_word_length"
2704− <*> o .:? "max_word_length"
2705− <*> o .:? "boost_terms"
2706− <*> o .:? "boost"
2707− <*> o .:? "analyzer"
2708− -- optionalNE = maybe (pure Nothing) (fmap Just . parseNEJSON)
2709−
2710−instance ToJSON MoreLikeThisQuery where
2711− toJSON (MoreLikeThisQuery text fields percent
2712− mtf mqt stopwords mindf maxdf
2713− minwl maxwl boostTerms boost analyzer) =
2714− omitNulls base
2715− where base = [ "like_text" .= text
2716− , "fields" .= fields
2717− , "percent_terms_to_match" .= percent
2718− , "min_term_freq" .= mtf
2719− , "max_query_terms" .= mqt
2720− , "stop_words" .= stopwords
2721− , "min_doc_freq" .= mindf
2722− , "max_doc_freq" .= maxdf
2723− , "min_word_length" .= minwl
2724− , "max_word_length" .= maxwl
2725− , "boost_terms" .= boostTerms
2726− , "boost" .= boost
2727− , "analyzer" .= analyzer ]
2728−
2729−instance FromJSON MoreLikeThisQuery where
2730− parseJSON = withObject "MoreLikeThisQuery" parse
2731− where parse o = MoreLikeThisQuery
2732− <$> o .: "like_text"
2733− -- <*> (optionalNE =<< o .:? "fields")
2734− <*> o .:? "fields"
2735− <*> o .:? "percent_terms_to_match"
2736− <*> o .:? "min_term_freq"
2737− <*> o .:? "max_query_terms"
2738− -- <*> (optionalNE =<< o .:? "stop_words")
2739− <*> o .:? "stop_words"
2740− <*> o .:? "min_doc_freq"
2741− <*> o .:? "max_doc_freq"
2742− <*> o .:? "min_word_length"
2743− <*> o .:? "max_word_length"
2744− <*> o .:? "boost_terms"
2745− <*> o .:? "boost"
2746− <*> o .:? "analyzer"
2747− -- optionalNE = maybe (pure Nothing) (fmap Just . parseNEJSON)
2748−
2749−instance ToJSON IndicesQuery where
2750− toJSON (IndicesQuery indices query noMatch) =
2751− omitNulls [ "indices" .= indices
2752− , "no_match_query" .= noMatch
2753− , "query" .= query ]
2754−
2755−instance FromJSON IndicesQuery where
2756− parseJSON = withObject "IndicesQuery" parse
2757− where parse o = IndicesQuery
2758− <$> o .:? "indices" .!= []
2759− <*> o .: "query"
2760− <*> o .:? "no_match_query"
2761−
2762−instance ToJSON HasParentQuery where
2763− toJSON (HasParentQuery queryType query scoreType) =
2764− omitNulls [ "parent_type" .= queryType
2765− , "score_type" .= scoreType
2766− , "query" .= query ]
2767−
2768−instance FromJSON HasParentQuery where
2769− parseJSON = withObject "HasParentQuery" parse
2770− where parse o = HasParentQuery
2771− <$> o .: "parent_type"
2772− <*> o .: "query"
2773− <*> o .:? "score_type"
2774−
2775−instance ToJSON HasChildQuery where
2776− toJSON (HasChildQuery queryType query scoreType) =
2777− omitNulls [ "query" .= query
2778− , "score_type" .= scoreType
2779− , "type" .= queryType ]
2780−
2781−instance FromJSON HasChildQuery where
2782− parseJSON = withObject "HasChildQuery" parse
2783− where parse o = HasChildQuery
2784− <$> o .: "type"
2785− <*> o .: "query"
2786− <*> o .:? "score_type"
2787−
2788−instance ToJSON FuzzyQuery where
2789− toJSON (FuzzyQuery (FieldName fieldName) queryText
2790− prefixLength maxEx fuzziness boost) =
2791− object [ fieldName .= omitNulls base ]
2792− where base = [ "value" .= queryText
2793− , "fuzziness" .= fuzziness
2794− , "prefix_length" .= prefixLength
2795− , "boost" .= boost
2796− , "max_expansions" .= maxEx ]
2797−
2798−instance FromJSON FuzzyQuery where
2799− parseJSON = withObject "FuzzyQuery" parse
2800− where parse = fieldTagged $ \fn o ->
2801− FuzzyQuery fn
2802− <$> o .: "value"
2803− <*> o .: "prefix_length"
2804− <*> o .: "max_expansions"
2805− <*> o .: "fuzziness"
2806− <*> o .:? "boost"
2807−
2808−instance ToJSON FuzzyLikeFieldQuery where
2809− toJSON (FuzzyLikeFieldQuery (FieldName fieldName)
2810− fieldText maxTerms ignoreFreq fuzziness prefixLength
2811− boost analyzer) =
2812− object [ fieldName .=
2813− omitNulls [ "like_text" .= fieldText
2814− , "max_query_terms" .= maxTerms
2815− , "ignore_tf" .= ignoreFreq
2816− , "fuzziness" .= fuzziness
2817− , "prefix_length" .= prefixLength
2818− , "analyzer" .= analyzer
2819− , "boost" .= boost ]]
2820−
2821−instance FromJSON FuzzyLikeFieldQuery where
2822− parseJSON = withObject "FuzzyLikeFieldQuery" parse
2823− where parse = fieldTagged $ \fn o ->
2824− FuzzyLikeFieldQuery fn
2825− <$> o .: "like_text"
2826− <*> o .: "max_query_terms"
2827− <*> o .: "ignore_tf"
2828− <*> o .: "fuzziness"
2829− <*> o .: "prefix_length"
2830− <*> o .: "boost"
2831− <*> o .:? "analyzer"
2832−
2833−instance ToJSON FuzzyLikeThisQuery where
2834− toJSON (FuzzyLikeThisQuery fields text maxTerms
2835− ignoreFreq fuzziness prefixLength boost analyzer) =
2836− omitNulls base
2837− where base = [ "fields" .= fields
2838− , "like_text" .= text
2839− , "max_query_terms" .= maxTerms
2840− , "ignore_tf" .= ignoreFreq
2841− , "fuzziness" .= fuzziness
2842− , "prefix_length" .= prefixLength
2843− , "analyzer" .= analyzer
2844− , "boost" .= boost ]
2845−
2846−instance FromJSON FuzzyLikeThisQuery where
2847− parseJSON = withObject "FuzzyLikeThisQuery" parse
2848− where parse o = FuzzyLikeThisQuery
2849− <$> o .:? "fields" .!= []
2850− <*> o .: "like_text"
2851− <*> o .: "max_query_terms"
2852− <*> o .: "ignore_tf"
2853− <*> o .: "fuzziness"
2854− <*> o .: "prefix_length"
2855− <*> o .: "boost"
2856− <*> o .:? "analyzer"
2857−
2858−instance ToJSON DisMaxQuery where
2859− toJSON (DisMaxQuery queries tiebreaker boost) =
2860− omitNulls base
2861− where base = [ "queries" .= queries
2862− , "boost" .= boost
2863− , "tie_breaker" .= tiebreaker ]
2864−
2865−instance FromJSON DisMaxQuery where
2866− parseJSON = withObject "DisMaxQuery" parse
2867− where parse o = DisMaxQuery
2868− <$> o .:? "queries" .!= []
2869− <*> o .: "tie_breaker"
2870− <*> o .:? "boost"
2871−
2872−instance ToJSON CommonTermsQuery where
2873− toJSON (CommonTermsQuery (FieldName fieldName)
2874− (QueryString query) cf lfo hfo msm
2875− boost analyzer disableCoord) =
2876− object [fieldName .= omitNulls base ]
2877− where base = [ "query" .= query
2878− , "cutoff_frequency" .= cf
2879− , "low_freq_operator" .= lfo
2880− , "minimum_should_match" .= msm
2881− , "boost" .= boost
2882− , "analyzer" .= analyzer
2883− , "disable_coord" .= disableCoord
2884− , "high_freq_operator" .= hfo ]
2885−
2886−instance FromJSON CommonTermsQuery where
2887− parseJSON = withObject "CommonTermsQuery" parse
2888− where parse = fieldTagged $ \fn o ->
2889− CommonTermsQuery fn
2890− <$> o .: "query"
2891− <*> o .: "cutoff_frequency"
2892− <*> o .: "low_freq_operator"
2893− <*> o .: "high_freq_operator"
2894− <*> o .:? "minimum_should_match"
2895− <*> o .:? "boost"
2896− <*> o .:? "analyzer"
2897− <*> o .:? "disable_coord"
2898−
2899−instance ToJSON CommonMinimumMatch where
2900− toJSON (CommonMinimumMatch mm) = toJSON mm
2901− toJSON (CommonMinimumMatchHighLow (MinimumMatchHighLow lowF highF)) =
2902− object [ "low_freq" .= lowF
2903− , "high_freq" .= highF ]
2904−
2905−instance FromJSON CommonMinimumMatch where
2906− parseJSON v = parseMinimum v
2907− <|> parseMinimumHighLow v
2908− where parseMinimum = fmap CommonMinimumMatch . parseJSON
2909− parseMinimumHighLow = fmap CommonMinimumMatchHighLow . withObject "CommonMinimumMatchHighLow" (\o ->
2910− MinimumMatchHighLow
2911− <$> o .: "low_freq"
2912− <*> o .: "high_freq")
2913−
2914−
2915−instance ToJSON BoostingQuery where
2916− toJSON (BoostingQuery bqPositiveQuery bqNegativeQuery bqNegativeBoost) =
2917− object [ "positive" .= bqPositiveQuery
2918− , "negative" .= bqNegativeQuery
2919− , "negative_boost" .= bqNegativeBoost ]
2920−
2921−instance FromJSON BoostingQuery where
2922− parseJSON = withObject "BoostingQuery" parse
2923− where parse o = BoostingQuery
2924− <$> o .: "positive"
2925− <*> o .: "negative"
2926− <*> o .: "negative_boost"
2927−
2928−instance ToJSON BoolQuery where
2929− toJSON (BoolQuery mustM filterM' notM shouldM bqMin boost disableCoord) =
2930− omitNulls base
2931− where base = [ "must" .= mustM
2932− , "filter" .= filterM'
2933− , "must_not" .= notM
2934− , "should" .= shouldM
2935− , "minimum_should_match" .= bqMin
2936− , "boost" .= boost
2937− , "disable_coord" .= disableCoord ]
2938−
2939−instance FromJSON BoolQuery where
2940− parseJSON = withObject "BoolQuery" parse
2941− where parse o = BoolQuery
2942− <$> o .:? "must" .!= []
2943− <*> o .:? "filter" .!= []
2944− <*> o .:? "must_not" .!= []
2945− <*> o .:? "should" .!= []
2946− <*> o .:? "minimum_should_match"
2947− <*> o .:? "boost"
2948− <*> o .:? "disable_coord"
2949−
2950−instance ToJSON MatchQuery where
2951− toJSON (MatchQuery (FieldName fieldName)
2952− (QueryString mqQueryString) booleanOperator
2953− zeroTermsQuery cutoffFrequency matchQueryType
2954− analyzer maxExpansions lenient boost
2955− minShouldMatch
2956− ) =
2957− object [ fieldName .= omitNulls base ]
2958− where base = [ "query" .= mqQueryString
2959− , "operator" .= booleanOperator
2960− , "zero_terms_query" .= zeroTermsQuery
2961− , "cutoff_frequency" .= cutoffFrequency
2962− , "type" .= matchQueryType
2963− , "analyzer" .= analyzer
2964− , "max_expansions" .= maxExpansions
2965− , "lenient" .= lenient
2966− , "boost" .= boost
2967− , "minimum_should_match" .= minShouldMatch
2968− ]
2969−
2970−instance FromJSON MatchQuery where
2971− parseJSON = withObject "MatchQuery" parse
2972− where parse = fieldTagged $ \fn o ->
2973− MatchQuery fn
2974− <$> o .: "query"
2975− <*> o .: "operator"
2976− <*> o .: "zero_terms_query"
2977− <*> o .:? "cutoff_frequency"
2978− <*> o .:? "type"
2979− <*> o .:? "analyzer"
2980− <*> o .:? "max_expansions"
2981− <*> o .:? "lenient"
2982− <*> o .:? "boost"
2983− <*> o .:? "minimum_should_match"
2984−
2985−instance ToJSON MultiMatchQuery where
2986− toJSON (MultiMatchQuery fields (QueryString query) boolOp
2987− ztQ tb mmqt cf analyzer maxEx lenient) =
2988− object ["multi_match" .= omitNulls base]
2989− where base = [ "fields" .= fmap toJSON fields
2990− , "query" .= query
2991− , "operator" .= boolOp
2992− , "zero_terms_query" .= ztQ
2993− , "tie_breaker" .= tb
2994− , "type" .= mmqt
2995− , "cutoff_frequency" .= cf
2996− , "analyzer" .= analyzer
2997− , "max_expansions" .= maxEx
2998− , "lenient" .= lenient ]
2999−
3000−instance FromJSON MultiMatchQuery where
3001− parseJSON = withObject "MultiMatchQuery" parse
3002− where parse raw = do o <- raw .: "multi_match"
3003− MultiMatchQuery
3004− <$> o .:? "fields" .!= []
3005− <*> o .: "query"
3006− <*> o .: "operator"
3007− <*> o .: "zero_terms_query"
3008− <*> o .:? "tie_breaker"
3009− <*> o .:? "type"
3010− <*> o .:? "cutoff_frequency"
3011− <*> o .:? "analyzer"
3012− <*> o .:? "max_expansions"
3013− <*> o .:? "lenient"
3014−
3015−instance ToJSON MultiMatchQueryType where
3016− toJSON MultiMatchBestFields = "best_fields"
3017− toJSON MultiMatchMostFields = "most_fields"
3018− toJSON MultiMatchCrossFields = "cross_fields"
3019− toJSON MultiMatchPhrase = "phrase"
3020− toJSON MultiMatchPhrasePrefix = "phrase_prefix"
3021−
3022−instance FromJSON MultiMatchQueryType where
3023− parseJSON = withText "MultiMatchPhrasePrefix" parse
3024− where parse "best_fields" = pure MultiMatchBestFields
3025− parse "most_fields" = pure MultiMatchMostFields
3026− parse "cross_fields" = pure MultiMatchCrossFields
3027− parse "phrase" = pure MultiMatchPhrase
3028− parse "phrase_prefix" = pure MultiMatchPhrasePrefix
3029− parse t = fail ("Unexpected MultiMatchPhrasePrefix: " <> show t)
3030−
3031−instance ToJSON BooleanOperator where
3032− toJSON And = String "and"
3033− toJSON Or = String "or"
3034−
3035−instance FromJSON BooleanOperator where
3036− parseJSON = withText "BooleanOperator" parse
3037− where parse "and" = pure And
3038− parse "or" = pure Or
3039− parse o = fail ("Unexpected BooleanOperator: " <> show o)
3040−
3041−instance ToJSON ZeroTermsQuery where
3042− toJSON ZeroTermsNone = String "none"
3043− toJSON ZeroTermsAll = String "all"
3044−
3045−instance FromJSON ZeroTermsQuery where
3046− parseJSON = withText "ZeroTermsQuery" parse
3047− where parse "none" = pure ZeroTermsNone
3048− parse "all" = pure ZeroTermsAll
3049− parse q = fail ("Unexpected ZeroTermsQuery: " <> show q)
3050−
3051−instance ToJSON MatchQueryType where
3052− toJSON MatchPhrase = "phrase"
3053− toJSON MatchPhrasePrefix = "phrase_prefix"
3054−
3055−instance FromJSON MatchQueryType where
3056− parseJSON = withText "MatchQueryType" parse
3057− where parse "phrase" = pure MatchPhrase
3058− parse "phrase_prefix" = pure MatchPhrasePrefix
3059− parse t = fail ("Unexpected MatchQueryType: " <> show t)
3060−
3061−instance FromJSON Status where
3062− parseJSON (Object v) = Status <$>
3063− v .: "name" <*>
3064− v .: "cluster_name" <*>
3065− v .: "cluster_uuid" <*>
3066− v .: "version" <*>
3067− v .: "tagline"
3068− parseJSON _ = empty
3069−
3070−
3071−instance ToJSON IndexSettings where
3072− toJSON (IndexSettings s r) = object ["settings" .=
3073− object ["index" .=
3074− object ["number_of_shards" .= s, "number_of_replicas" .= r]
3075− ]
3076− ]
3077−
3078−instance FromJSON IndexSettings where
3079− parseJSON = withObject "IndexSettings" parse
3080− where parse o = do s <- o .: "settings"
3081− i <- s .: "index"
3082− IndexSettings <$> i .: "number_of_shards"
3083− <*> i .: "number_of_replicas"
3084−
3085−instance ToJSON UpdatableIndexSetting where
3086− toJSON (NumberOfReplicas x) = oPath ("index" :| ["number_of_replicas"]) x
3087− toJSON (AutoExpandReplicas x) = oPath ("index" :| ["auto_expand_replicas"]) x
3088− toJSON (RefreshInterval x) = oPath ("index" :| ["refresh_interval"]) (NominalDiffTimeJSON x)
3089− toJSON (IndexConcurrency x) = oPath ("index" :| ["concurrency"]) x
3090− toJSON (FailOnMergeFailure x) = oPath ("index" :| ["fail_on_merge_failure"]) x
3091− toJSON (TranslogFlushThresholdOps x) = oPath ("index" :| ["translog", "flush_threshold_ops"]) x
3092− toJSON (TranslogFlushThresholdSize x) = oPath ("index" :| ["translog", "flush_threshold_size"]) x
3093− toJSON (TranslogFlushThresholdPeriod x) = oPath ("index" :| ["translog", "flush_threshold_period"]) (NominalDiffTimeJSON x)
3094− toJSON (TranslogDisableFlush x) = oPath ("index" :| ["translog", "disable_flush"]) x
3095− toJSON (CacheFilterMaxSize x) = oPath ("index" :| ["cache", "filter", "max_size"]) x
3096− toJSON (CacheFilterExpire x) = oPath ("index" :| ["cache", "filter", "expire"]) (NominalDiffTimeJSON <$> x)
3097− toJSON (GatewaySnapshotInterval x) = oPath ("index" :| ["gateway", "snapshot_interval"]) (NominalDiffTimeJSON x)
3098− toJSON (RoutingAllocationInclude fs) = oPath ("index" :| ["routing", "allocation", "include"]) (attrFilterJSON fs)
3099− toJSON (RoutingAllocationExclude fs) = oPath ("index" :| ["routing", "allocation", "exclude"]) (attrFilterJSON fs)
3100− toJSON (RoutingAllocationRequire fs) = oPath ("index" :| ["routing", "allocation", "require"]) (attrFilterJSON fs)
3101− toJSON (RoutingAllocationEnable x) = oPath ("index" :| ["routing", "allocation", "enable"]) x
3102− toJSON (RoutingAllocationShardsPerNode x) = oPath ("index" :| ["routing", "allocation", "total_shards_per_node"]) x
3103− toJSON (RecoveryInitialShards x) = oPath ("index" :| ["recovery", "initial_shards"]) x
3104− toJSON (GCDeletes x) = oPath ("index" :| ["gc_deletes"]) (NominalDiffTimeJSON x)
3105− toJSON (TTLDisablePurge x) = oPath ("index" :| ["ttl", "disable_purge"]) x
3106− toJSON (TranslogFSType x) = oPath ("index" :| ["translog", "fs", "type"]) x
3107− toJSON (CompressionSetting x) = oPath ("index" :| ["codec"]) x
3108− toJSON (IndexCompoundFormat x) = oPath ("index" :| ["compound_format"]) x
3109− toJSON (IndexCompoundOnFlush x) = oPath ("index" :| ["compound_on_flush"]) x
3110− toJSON (WarmerEnabled x) = oPath ("index" :| ["warmer", "enabled"]) x
3111− toJSON (BlocksReadOnly x) = oPath ("blocks" :| ["read_only"]) x
3112− toJSON (BlocksRead x) = oPath ("blocks" :| ["read"]) x
3113− toJSON (BlocksWrite x) = oPath ("blocks" :| ["write"]) x
3114− toJSON (BlocksMetaData x) = oPath ("blocks" :| ["metadata"]) x
3115− toJSON (MappingTotalFieldsLimit x) = oPath ("index" :| ["mapping","total_fields","limit"]) x
3116− toJSON (AnalysisSetting x) = oPath ("index" :| ["analysis"]) x
3117−
3118−instance FromJSON UpdatableIndexSetting where
3119− parseJSON = withObject "UpdatableIndexSetting" parse
3120− where parse o = numberOfReplicas `taggedAt` ["index", "number_of_replicas"]
3121− <|> autoExpandReplicas `taggedAt` ["index", "auto_expand_replicas"]
3122− <|> refreshInterval `taggedAt` ["index", "refresh_interval"]
3123− <|> indexConcurrency `taggedAt` ["index", "concurrency"]
3124− <|> failOnMergeFailure `taggedAt` ["index", "fail_on_merge_failure"]
3125− <|> translogFlushThresholdOps `taggedAt` ["index", "translog", "flush_threshold_ops"]
3126− <|> translogFlushThresholdSize `taggedAt` ["index", "translog", "flush_threshold_size"]
3127− <|> translogFlushThresholdPeriod `taggedAt` ["index", "translog", "flush_threshold_period"]
3128− <|> translogDisableFlush `taggedAt` ["index", "translog", "disable_flush"]
3129− <|> cacheFilterMaxSize `taggedAt` ["index", "cache", "filter", "max_size"]
3130− <|> cacheFilterExpire `taggedAt` ["index", "cache", "filter", "expire"]
3131− <|> gatewaySnapshotInterval `taggedAt` ["index", "gateway", "snapshot_interval"]
3132− <|> routingAllocationInclude `taggedAt` ["index", "routing", "allocation", "include"]
3133− <|> routingAllocationExclude `taggedAt` ["index", "routing", "allocation", "exclude"]
3134− <|> routingAllocationRequire `taggedAt` ["index", "routing", "allocation", "require"]
3135− <|> routingAllocationEnable `taggedAt` ["index", "routing", "allocation", "enable"]
3136− <|> routingAllocationShardsPerNode `taggedAt` ["index", "routing", "allocation", "total_shards_per_node"]
3137− <|> recoveryInitialShards `taggedAt` ["index", "recovery", "initial_shards"]
3138− <|> gcDeletes `taggedAt` ["index", "gc_deletes"]
3139− <|> ttlDisablePurge `taggedAt` ["index", "ttl", "disable_purge"]
3140− <|> translogFSType `taggedAt` ["index", "translog", "fs", "type"]
3141− <|> compressionSetting `taggedAt` ["index", "codec"]
3142− <|> compoundFormat `taggedAt` ["index", "compound_format"]
3143− <|> compoundOnFlush `taggedAt` ["index", "compound_on_flush"]
3144− <|> warmerEnabled `taggedAt` ["index", "warmer", "enabled"]
3145− <|> blocksReadOnly `taggedAt` ["blocks", "read_only"]
3146− <|> blocksRead `taggedAt` ["blocks", "read"]
3147− <|> blocksWrite `taggedAt` ["blocks", "write"]
3148− <|> blocksMetaData `taggedAt` ["blocks", "metadata"]
3149− <|> mappingTotalFieldsLimit `taggedAt` ["index", "mapping", "total_fields", "limit"]
3150− <|> analysisSetting `taggedAt` ["index", "analysis"]
3151− where taggedAt f ks = taggedAt' f (Object o) ks
3152− taggedAt' f v [] = f =<< (parseJSON v <|> (parseJSON (unStringlyTypeJSON v)))
3153− taggedAt' f v (k:ks) = withObject "Object" (\o -> do v' <- o .: k
3154− taggedAt' f v' ks) v
3155− numberOfReplicas = pure . NumberOfReplicas
3156− autoExpandReplicas = pure . AutoExpandReplicas
3157− refreshInterval = pure . RefreshInterval . ndtJSON
3158− indexConcurrency = pure . IndexConcurrency
3159− failOnMergeFailure = pure . FailOnMergeFailure
3160− translogFlushThresholdOps = pure . TranslogFlushThresholdOps
3161− translogFlushThresholdSize = pure . TranslogFlushThresholdSize
3162− translogFlushThresholdPeriod = pure . TranslogFlushThresholdPeriod . ndtJSON
3163− translogDisableFlush = pure . TranslogDisableFlush
3164− cacheFilterMaxSize = pure . CacheFilterMaxSize
3165− cacheFilterExpire = pure . CacheFilterExpire . fmap ndtJSON
3166− gatewaySnapshotInterval = pure . GatewaySnapshotInterval . ndtJSON
3167− routingAllocationInclude = fmap RoutingAllocationInclude . parseAttrFilter
3168− routingAllocationExclude = fmap RoutingAllocationExclude . parseAttrFilter
3169− routingAllocationRequire = fmap RoutingAllocationRequire . parseAttrFilter
3170− routingAllocationEnable = pure . RoutingAllocationEnable
3171− routingAllocationShardsPerNode = pure . RoutingAllocationShardsPerNode
3172− recoveryInitialShards = pure . RecoveryInitialShards
3173− gcDeletes = pure . GCDeletes . ndtJSON
3174− ttlDisablePurge = pure . TTLDisablePurge
3175− translogFSType = pure . TranslogFSType
3176− compressionSetting = pure . CompressionSetting
3177− compoundFormat = pure . IndexCompoundFormat
3178− compoundOnFlush = pure . IndexCompoundOnFlush
3179− warmerEnabled = pure . WarmerEnabled
3180− blocksReadOnly = pure . BlocksReadOnly
3181− blocksRead = pure . BlocksRead
3182− blocksWrite = pure . BlocksWrite
3183− blocksMetaData = pure . BlocksMetaData
3184− mappingTotalFieldsLimit = pure . MappingTotalFieldsLimit
3185− analysisSetting = pure . AnalysisSetting
3186−
3187−instance FromJSON IndexSettingsSummary where
3188− parseJSON = withObject "IndexSettingsSummary" parse
3189− where parse o = case HM.toList o of
3190− [(ixn, v@(Object o'))] -> IndexSettingsSummary (IndexName ixn)
3191− <$> parseJSON v
3192− <*> (fmap (filter (not . redundant)) . parseSettings =<< o' .: "settings")
3193− _ -> fail "Expected single-key object with index name"
3194− redundant (NumberOfReplicas _) = True
3195− redundant _ = False
3196−
3197−-- | For some reason in several settings APIs, all leaf values get returned
3198−-- as strings. This function attepmts to recover from this for all
3199−-- non-recursive JSON types. If nothing can be done, the value is left alone.
3200−unStringlyTypeJSON :: Value -> Value
3201−unStringlyTypeJSON (String "true") = Bool True
3202−unStringlyTypeJSON (String "false") = Bool False
3203−unStringlyTypeJSON (String "null") = Null
3204−unStringlyTypeJSON v@(String t) = case readMay (T.unpack t) of
3205− Just n -> Number n
3206− Nothing -> v
3207−unStringlyTypeJSON v = v
3208−
3209−
3210−parseSettings :: Object -> Parser [UpdatableIndexSetting]
3211−parseSettings o = do
3212− o' <- o .: "index"
3213− -- slice the index object into singleton hashmaps and try to parse each
3214− parses <- forM (HM.toList o') $ \(k, v) -> do
3215− -- blocks are now nested into the "index" key, which is not how they're serialized
3216− let atRoot = Object (HM.singleton k v)
3217− let atIndex = Object (HM.singleton "index" atRoot)
3218− optional (parseJSON atRoot <|> parseJSON atIndex)
3219− return (catMaybes parses)
3220−
3221−oPath :: ToJSON a => NonEmpty Text -> a -> Value
3222−oPath (k :| []) v = object [k .= v]
3223−oPath (k:| (h:t)) v = object [k .= oPath (h :| t) v]
3224−
3225−attrFilterJSON :: NonEmpty NodeAttrFilter -> Value
3226−attrFilterJSON fs = object [ n .= T.intercalate "," (toList vs)
3227− | NodeAttrFilter (NodeAttrName n) vs <- toList fs]
3228−
3229−parseAttrFilter :: Value -> Parser (NonEmpty NodeAttrFilter)
3230−parseAttrFilter = withObject "NonEmpty NodeAttrFilter" parse
3231− where parse o = case HM.toList o of
3232− [] -> fail "Expected non-empty list of NodeAttrFilters"
3233− x:xs -> DT.mapM (uncurry parse') (x :| xs)
3234− parse' n = withText "Text" $ \t ->
3235− case T.splitOn "," t of
3236− fv:fvs -> return (NodeAttrFilter (NodeAttrName n) (fv :| fvs))
3237− [] -> fail "Expected non-empty list of filter values"
3238−
3239−instance ToJSON ReplicaBounds where
3240− toJSON (ReplicasBounded a b) = String (showText a <> "-" <> showText b)
3241− toJSON (ReplicasLowerBounded a) = String (showText a <> "-all")
3242− toJSON ReplicasUnbounded = Bool False
3243−
3244−instance FromJSON ReplicaBounds where
3245− parseJSON v = withText "ReplicaBounds" parseText v
3246− <|> withBool "ReplicaBounds" parseBool v
3247− where parseText t = case T.splitOn "-" t of
3248− [a, "all"] -> ReplicasLowerBounded <$> parseReadText a
3249− [a, b] -> ReplicasBounded <$> parseReadText a
3250− <*> parseReadText b
3251− _ -> fail ("Could not parse ReplicaBounds: " <> show t)
3252− parseBool False = pure ReplicasUnbounded
3253− parseBool _ = fail "ReplicasUnbounded cannot be represented with True"
3254−
3255−instance ToJSON AllocationPolicy where
3256− toJSON AllocAll = String "all"
3257− toJSON AllocPrimaries = String "primaries"
3258− toJSON AllocNewPrimaries = String "new_primaries"
3259− toJSON AllocNone = String "none"
3260−
3261−instance FromJSON AllocationPolicy where
3262− parseJSON = withText "AllocationPolicy" parse
3263− where parse "all" = pure AllocAll
3264− parse "primaries" = pure AllocPrimaries
3265− parse "new_primaries" = pure AllocNewPrimaries
3266− parse "none" = pure AllocNone
3267− parse t = fail ("Invlaid AllocationPolicy: " <> show t)
3268−
3269−instance ToJSON InitialShardCount where
3270− toJSON QuorumShards = String "quorum"
3271− toJSON QuorumMinus1Shards = String "quorum-1"
3272− toJSON FullShards = String "full"
3273− toJSON FullMinus1Shards = String "full-1"
3274− toJSON (ExplicitShards x) = toJSON x
3275−
3276−instance FromJSON InitialShardCount where
3277− parseJSON v = withText "InitialShardCount" parseText v
3278− <|> ExplicitShards <$> parseJSON v
3279− where parseText "quorum" = pure QuorumShards
3280− parseText "quorum-1" = pure QuorumMinus1Shards
3281− parseText "full" = pure FullShards
3282− parseText "full-1" = pure FullMinus1Shards
3283− parseText _ = mzero
3284−
3285−instance ToJSON FSType where
3286− toJSON FSSimple = "simple"
3287− toJSON FSBuffered = "buffered"
3288−
3289−instance FromJSON FSType where
3290− parseJSON = withText "FSType" parse
3291− where parse "simple" = pure FSSimple
3292− parse "buffered" = pure FSBuffered
3293− parse t = fail ("Invalid FSType: " <> show t)
3294−
3295−instance ToJSON CompoundFormat where
3296− toJSON (CompoundFileFormat x) = Bool x
3297− toJSON (MergeSegmentVsTotalIndex x) = toJSON x
3298−
3299−instance FromJSON CompoundFormat where
3300− parseJSON v = CompoundFileFormat <$> parseJSON v
3301− <|> MergeSegmentVsTotalIndex <$> parseJSON v
3302−
3303−instance ToJSON NominalDiffTimeJSON where
3304− toJSON (NominalDiffTimeJSON t) = String (showText (round t :: Integer) <> "s")
3305−
3306−instance FromJSON NominalDiffTimeJSON where
3307− parseJSON = withText "NominalDiffTime" parse
3308− where parse t = case T.takeEnd 1 t of
3309− "s" -> NominalDiffTimeJSON . fromInteger <$> parseReadText (T.dropEnd 1 t)
3310− _ -> fail "Invalid or missing NominalDiffTime unit (expected s)"
3311−
3312−instance ToJSON IndexTemplate where
3313− toJSON (IndexTemplate p s m) = merge
3314− (object [ "template" .= p
3315− , "mappings" .= foldl' merge (object []) m
3316− ])
3317− (toJSON s)
3318− where
3319− merge (Object o1) (Object o2) = toJSON $ HM.union o1 o2
3320− merge o Null = o
3321− merge _ _ = undefined
3322−
3323−instance (FromJSON a) => FromJSON (EsResult a) where
3324− parseJSON jsonVal@(Object v) = do
3325− found <- v .:? "found" .!= False
3326− fr <- if found
3327− then parseJSON jsonVal
3328− else return Nothing
3329− EsResult <$> v .: "_index" <*>
3330− v .: "_type" <*>
3331− v .: "_id" <*>
3332− pure fr
3333− parseJSON _ = empty
3334−
3335−instance (FromJSON a) => FromJSON (EsResultFound a) where
3336− parseJSON (Object v) = EsResultFound <$>
3337− v .: "_version" <*>
3338− v .: "_source"
3339− parseJSON _ = empty
3340−
3341−instance FromJSON EsError where
3342− parseJSON (Object v) = EsError <$>
3343− v .: "status" <*>
3344− (v .: "error" <|> (v .: "error" >>= (.: "reason")))
3345− parseJSON _ = empty
3346−
3347−instance FromJSON IndexAliasesSummary where
3348− parseJSON = withObject "IndexAliasesSummary" parse
3349− where parse o = IndexAliasesSummary . mconcat <$> mapM (uncurry go) (HM.toList o)
3350− go ixn = withObject "index aliases" $ \ia -> do
3351− aliases <- ia .:? "aliases" .!= mempty
3352− forM (HM.toList aliases) $ \(aName, v) -> do
3353− let indexAlias = IndexAlias (IndexName ixn) (IndexAliasName (IndexName aName))
3354− IndexAliasSummary indexAlias <$> parseJSON v
3355−
3356−
3357−instance ToJSON IndexAliasAction where
3358− toJSON (AddAlias ia opts) = object ["add" .= (iaObj <> optsObj)]
3359− where Object iaObj = toJSON ia
3360− Object optsObj = toJSON opts
3361− toJSON (RemoveAlias ia) = object ["remove" .= iaObj]
3362− where Object iaObj = toJSON ia
3363−
3364−instance ToJSON IndexAlias where
3365− toJSON IndexAlias {..} = object ["index" .= srcIndex
3366− , "alias" .= indexAlias
3367− ]
3368−
3369−instance ToJSON IndexAliasCreate where
3370− toJSON IndexAliasCreate {..} = Object (filterObj <> routingObj)
3371− where filterObj = maybe mempty (HM.singleton "filter" . toJSON) aliasCreateFilter
3372− Object routingObj = maybe (Object mempty) toJSON aliasCreateRouting
3373−
3374−instance ToJSON AliasRouting where
3375− toJSON (AllAliasRouting v) = object ["routing" .= v]
3376− toJSON (GranularAliasRouting srch idx) = object (catMaybes prs)
3377− where prs = [("search_routing" .=) <$> srch
3378− ,("index_routing" .=) <$> idx]
3379−
3380−instance FromJSON AliasRouting where
3381− parseJSON = withObject "AliasRouting" parse
3382− where parse o = parseAll o <|> parseGranular o
3383− parseAll o = AllAliasRouting <$> o .: "routing"
3384− parseGranular o = do
3385− sr <- o .:? "search_routing"
3386− ir <- o .:? "index_routing"
3387− if isNothing sr && isNothing ir
3388− then fail "Both search_routing and index_routing can't be blank"
3389− else return (GranularAliasRouting sr ir)
3390−
3391−instance FromJSON IndexAliasCreate where
3392− parseJSON v = withObject "IndexAliasCreate" parse v
3393− where parse o = IndexAliasCreate <$> optional (parseJSON v)
3394− <*> o .:? "filter"
3395−
3396−instance ToJSON SearchAliasRouting where
3397− toJSON (SearchAliasRouting rvs) = toJSON (T.intercalate "," (routingValue <$> toList rvs))
3398−
3399−instance FromJSON SearchAliasRouting where
3400− parseJSON = withText "SearchAliasRouting" parse
3401− where parse t = SearchAliasRouting <$> parseNEJSON (String <$> T.splitOn "," t)
3402−
3403−instance ToJSON Search where
3404− toJSON (Search mquery sFilter sort searchAggs highlight sTrackSortScores sFrom sSize _ sFields sSource sSuggest) =
3405− omitNulls [ "query" .= query'
3406− , "sort" .= sort
3407− , "aggregations" .= searchAggs
3408− , "highlight" .= highlight
3409− , "from" .= sFrom
3410− , "size" .= sSize
3411− , "track_scores" .= sTrackSortScores
3412− , "fields" .= sFields
3413− , "_source" .= sSource
3414− , "suggest" .= sSuggest]
3415−
3416− where query' = case sFilter of
3417− Nothing -> mquery
3418− Just x -> Just . QueryBoolQuery $ mkBoolQuery (maybeToList mquery) [x] [] []
3419−
3420−instance ToJSON Source where
3421− toJSON NoSource = toJSON False
3422− toJSON (SourcePatterns patterns) = toJSON patterns
3423− toJSON (SourceIncludeExclude incl excl) = object [ "includes" .= incl, "excludes" .= excl ]
3424−
3425−instance ToJSON PatternOrPatterns where
3426− toJSON (PopPattern pattern) = toJSON pattern
3427− toJSON (PopPatterns patterns) = toJSON patterns
3428−
3429−instance ToJSON Include where
3430− toJSON (Include patterns) = toJSON patterns
3431−
3432−instance ToJSON Exclude where
3433− toJSON (Exclude patterns) = toJSON patterns
3434−
3435−instance ToJSON Pattern where
3436− toJSON (Pattern pattern) = toJSON pattern
3437−
3438−
3439−instance ToJSON FieldHighlight where
3440− toJSON (FieldHighlight (FieldName fName) (Just fSettings)) =
3441− object [ fName .= fSettings ]
3442− toJSON (FieldHighlight (FieldName fName) Nothing) =
3443− object [ fName .= emptyObject ]
3444−
3445−instance ToJSON Highlights where
3446− toJSON (Highlights global fields) =
3447− omitNulls (("fields" .= fields)
3448− : highlightSettingsPairs global)
3449−
3450−instance ToJSON HighlightSettings where
3451− toJSON hs = omitNulls (highlightSettingsPairs (Just hs))
3452−
3453−highlightSettingsPairs :: Maybe HighlightSettings -> [Pair]
3454−highlightSettingsPairs Nothing = []
3455−highlightSettingsPairs (Just (Plain plh)) = plainHighPairs (Just plh)
3456−highlightSettingsPairs (Just (Postings ph)) = postHighPairs (Just ph)
3457−highlightSettingsPairs (Just (FastVector fvh)) = fastVectorHighPairs (Just fvh)
3458−
3459−
3460−plainHighPairs :: Maybe PlainHighlight -> [Pair]
3461−plainHighPairs Nothing = []
3462−plainHighPairs (Just (PlainHighlight plCom plNonPost)) =
3463− [ "type" .= String "plain"]
3464− ++ commonHighlightPairs plCom
3465− ++ nonPostingsToPairs plNonPost
3466−
3467−postHighPairs :: Maybe PostingsHighlight -> [Pair]
3468−postHighPairs Nothing = []
3469−postHighPairs (Just (PostingsHighlight pCom)) =
3470− ("type" .= String "postings")
3471− : commonHighlightPairs pCom
3472−
3473−fastVectorHighPairs :: Maybe FastVectorHighlight -> [Pair]
3474−fastVectorHighPairs Nothing = []
3475−fastVectorHighPairs (Just
3476− (FastVectorHighlight fvCom fvNonPostSettings fvBoundChars
3477− fvBoundMaxScan fvFragOff fvMatchedFields
3478− fvPhraseLim)) =
3479− [ "type" .= String "fvh"
3480− , "boundary_chars" .= fvBoundChars
3481− , "boundary_max_scan" .= fvBoundMaxScan
3482− , "fragment_offset" .= fvFragOff
3483− , "matched_fields" .= fvMatchedFields
3484− , "phraseLimit" .= fvPhraseLim]
3485− ++ commonHighlightPairs fvCom
3486− ++ nonPostingsToPairs fvNonPostSettings
3487−
3488−deleteSeveral :: (Eq k, Hashable k) => [k] -> HM.HashMap k v -> HM.HashMap k v
3489−deleteSeveral ks hm = foldr HM.delete hm ks
3490−
3491−commonHighlightPairs :: Maybe CommonHighlight -> [Pair]
3492−commonHighlightPairs Nothing = []
3493−commonHighlightPairs (Just (CommonHighlight chScore chForceSource chTag chEncoder
3494− chNoMatchSize chHighlightQuery
3495− chRequireFieldMatch)) =
3496− [ "order" .= chScore
3497− , "force_source" .= chForceSource
3498− , "encoder" .= chEncoder
3499− , "no_match_size" .= chNoMatchSize
3500− , "highlight_query" .= chHighlightQuery
3501− , "require_fieldMatch" .= chRequireFieldMatch]
3502− ++ highlightTagToPairs chTag
3503−
3504−
3505−nonPostingsToPairs :: Maybe NonPostings -> [Pair]
3506−nonPostingsToPairs Nothing = []
3507−nonPostingsToPairs (Just (NonPostings npFragSize npNumOfFrags)) =
3508− [ "fragment_size" .= npFragSize
3509− , "number_of_fragments" .= npNumOfFrags]
3510−
3511−parseNEJSON :: (FromJSON a) => [Value] -> Parser (NonEmpty a)
3512−parseNEJSON [] = fail "Expected non-empty list"
3513−parseNEJSON (x:xs) = DT.mapM parseJSON (x :| xs)
3514−
3515−
3516−instance ToJSON HighlightEncoder where
3517− toJSON DefaultEncoder = String "default"
3518− toJSON HTMLEncoder = String "html"
3519−
3520−highlightTagToPairs :: Maybe HighlightTag -> [Pair]
3521−highlightTagToPairs (Just (TagSchema _)) = [ "scheme" .= String "default"]
3522−highlightTagToPairs (Just (CustomTags (pre, post))) = [ "pre_tags" .= pre
3523− , "post_tags" .= post]
3524−highlightTagToPairs Nothing = []
3525−
3526−instance ToJSON SortSpec where
3527− toJSON (DefaultSortSpec
3528− (DefaultSort (FieldName dsSortFieldName) dsSortOrder dsIgnoreUnmapped
3529− dsSortMode dsMissingSort dsNestedFilter)) =
3530− object [dsSortFieldName .= omitNulls base] where
3531− base = [ "order" .= dsSortOrder
3532− , "unmapped_type" .= dsIgnoreUnmapped
3533− , "mode" .= dsSortMode
3534− , "missing" .= dsMissingSort
3535− , "nested_filter" .= dsNestedFilter ]
3536−
3537− toJSON (GeoDistanceSortSpec gdsSortOrder (GeoPoint (FieldName field) gdsLatLon) units) =
3538− object [ "unit" .= units
3539− , field .= gdsLatLon
3540− , "order" .= gdsSortOrder ]
3541−
3542−
3543−instance ToJSON SortOrder where
3544− toJSON Ascending = String "asc"
3545− toJSON Descending = String "desc"
3546−
3547−
3548−instance ToJSON SortMode where
3549− toJSON SortMin = String "min"
3550− toJSON SortMax = String "max"
3551− toJSON SortSum = String "sum"
3552− toJSON SortAvg = String "avg"
3553−
3554−
3555−instance ToJSON Missing where
3556− toJSON LastMissing = String "_last"
3557− toJSON FirstMissing = String "_first"
3558− toJSON (CustomMissing txt) = String txt
3559−
3560−
3561−instance ToJSON ScoreType where
3562− toJSON ScoreTypeMax = "max"
3563− toJSON ScoreTypeAvg = "avg"
3564− toJSON ScoreTypeSum = "sum"
3565− toJSON ScoreTypeNone = "none"
3566−
3567−instance FromJSON ScoreType where
3568− parseJSON = withText "ScoreType" parse
3569− where parse "max" = pure ScoreTypeMax
3570− parse "avg" = pure ScoreTypeAvg
3571− parse "sum" = pure ScoreTypeSum
3572− parse "none" = pure ScoreTypeNone
3573− parse t = fail ("Unexpected ScoreType: " <> show t)
3574−
3575−instance ToJSON Distance where
3576− toJSON (Distance dCoefficient dUnit) =
3577− String boltedTogether where
3578− coefText = showText dCoefficient
3579− (String unitText) = toJSON dUnit
3580− boltedTogether = mappend coefText unitText
3581−
3582−instance FromJSON Distance where
3583− parseJSON = withText "Distance" parse
3584− where parse t = Distance <$> parseCoeff nT
3585− <*> parseJSON (String unitT)
3586− where (nT, unitT) = T.span validForNumber t
3587− -- may be a better way to do this
3588− validForNumber '-' = True
3589− validForNumber '.' = True
3590− validForNumber 'e' = True
3591− validForNumber c = isNumber c
3592− parseCoeff "" = fail "Empty string cannot be parsed as number"
3593− parseCoeff s = return (read (T.unpack s))
3594−
3595−instance ToJSON DistanceUnit where
3596− toJSON Miles = String "mi"
3597− toJSON Yards = String "yd"
3598− toJSON Feet = String "ft"
3599− toJSON Inches = String "in"
3600− toJSON Kilometers = String "km"
3601− toJSON Meters = String "m"
3602− toJSON Centimeters = String "cm"
3603− toJSON Millimeters = String "mm"
3604− toJSON NauticalMiles = String "nmi"
3605−
3606−
3607−instance FromJSON DistanceUnit where
3608− parseJSON = withText "DistanceUnit" parse
3609− where parse "mi" = pure Miles
3610− parse "yd" = pure Yards
3611− parse "ft" = pure Feet
3612− parse "in" = pure Inches
3613− parse "km" = pure Kilometers
3614− parse "m" = pure Meters
3615− parse "cm" = pure Centimeters
3616− parse "mm" = pure Millimeters
3617− parse "nmi" = pure NauticalMiles
3618− parse u = fail ("Unrecognized DistanceUnit: " <> show u)
3619−
3620−instance ToJSON DistanceType where
3621− toJSON Arc = String "arc"
3622− toJSON SloppyArc = String "sloppy_arc"
3623− toJSON Plane = String "plane"
3624−
3625−instance FromJSON DistanceType where
3626− parseJSON = withText "DistanceType" parse
3627− where parse "arc" = pure Arc
3628− parse "sloppy_arc" = pure SloppyArc
3629− parse "plane" = pure Plane
3630− parse t = fail ("Unrecognized DistanceType: " <> show t)
3631−
3632−
3633−instance ToJSON OptimizeBbox where
3634− toJSON NoOptimizeBbox = String "none"
3635− toJSON (OptimizeGeoFilterType gft) = toJSON gft
3636−
3637−instance FromJSON OptimizeBbox where
3638− parseJSON v = withText "NoOptimizeBbox" parseNoOptimize v
3639− <|> parseOptimize v
3640− where parseNoOptimize "none" = pure NoOptimizeBbox
3641− parseNoOptimize _ = mzero
3642− parseOptimize = fmap OptimizeGeoFilterType . parseJSON
3643−
3644−instance ToJSON GeoBoundingBoxConstraint where
3645− toJSON (GeoBoundingBoxConstraint
3646− (FieldName gbbcGeoBBField) gbbcConstraintBox cache type') =
3647− object [gbbcGeoBBField .= gbbcConstraintBox
3648− , "_cache" .= cache
3649− , "type" .= type']
3650−
3651−instance FromJSON GeoBoundingBoxConstraint where
3652− parseJSON = withObject "GeoBoundingBoxConstraint" parse
3653− where parse o = case HM.toList (deleteSeveral ["type", "_cache"] o) of
3654− [(fn, v)] -> GeoBoundingBoxConstraint (FieldName fn)
3655− <$> parseJSON v
3656− <*> o .:? "_cache" .!= defaultCache
3657− <*> o .: "type"
3658− _ -> fail "Could not find field name for GeoBoundingBoxConstraint"
3659−
3660−instance ToJSON GeoFilterType where
3661− toJSON GeoFilterMemory = String "memory"
3662− toJSON GeoFilterIndexed = String "indexed"
3663−
3664−instance FromJSON GeoFilterType where
3665− parseJSON = withText "GeoFilterType" parse
3666− where parse "memory" = pure GeoFilterMemory
3667− parse "indexed" = pure GeoFilterIndexed
3668− parse t = fail ("Unrecognized GeoFilterType: " <> show t)
3669−
3670−instance ToJSON GeoBoundingBox where
3671− toJSON (GeoBoundingBox gbbTopLeft gbbBottomRight) =
3672− object ["top_left" .= gbbTopLeft
3673− , "bottom_right" .= gbbBottomRight]
3674−
3675−instance FromJSON GeoBoundingBox where
3676− parseJSON = withObject "GeoBoundingBox" parse
3677− where parse o = GeoBoundingBox
3678− <$> o .: "top_left"
3679− <*> o .: "bottom_right"
3680−
3681−instance ToJSON LatLon where
3682− toJSON (LatLon lLat lLon) =
3683− object ["lat" .= lLat
3684− , "lon" .= lLon]
3685−
3686−instance FromJSON LatLon where
3687− parseJSON = withObject "LatLon" parse
3688− where parse o = LatLon <$> o .: "lat"
3689− <*> o .: "lon"
3690−
3691−-- index for smaller ranges, fielddata for longer ranges
3692−instance ToJSON RangeExecution where
3693− toJSON RangeExecutionIndex = "index"
3694− toJSON RangeExecutionFielddata = "fielddata"
3695−
3696−
3697−instance FromJSON RangeExecution where
3698− parseJSON = withText "RangeExecution" parse
3699− where parse "index" = pure RangeExecutionIndex
3700− parse "fielddata" = pure RangeExecutionFielddata
3701− parse t = error ("Unrecognized RangeExecution " <> show t)
3702−
3703−instance ToJSON RegexpFlags where
3704− toJSON AllRegexpFlags = String "ALL"
3705− toJSON NoRegexpFlags = String "NONE"
3706− toJSON (SomeRegexpFlags (h :| fs)) = String $ T.intercalate "|" flagStrs
3707− where flagStrs = map flagStr . nub $ h:fs
3708− flagStr AnyString = "ANYSTRING"
3709− flagStr Automaton = "AUTOMATON"
3710− flagStr Complement = "COMPLEMENT"
3711− flagStr Empty = "EMPTY"
3712− flagStr Intersection = "INTERSECTION"
3713− flagStr Interval = "INTERVAL"
3714−
3715−instance FromJSON RegexpFlags where
3716− parseJSON = withText "RegexpFlags" parse
3717− where parse "ALL" = pure AllRegexpFlags
3718− parse "NONE" = pure NoRegexpFlags
3719− parse t = SomeRegexpFlags <$> parseNEJSON (String <$> T.splitOn "|" t)
3720−
3721−instance FromJSON RegexpFlag where
3722− parseJSON = withText "RegexpFlag" parse
3723− where parse "ANYSTRING" = pure AnyString
3724− parse "AUTOMATON" = pure Automaton
3725− parse "COMPLEMENT" = pure Complement
3726− parse "EMPTY" = pure Empty
3727− parse "INTERSECTION" = pure Intersection
3728− parse "INTERVAL" = pure Interval
3729− parse f = fail ("Unknown RegexpFlag: " <> show f)
3730−
3731−instance ToJSON Term where
3732− toJSON (Term field value) = object ["term" .= object
3733− [field .= value]]
3734−
3735−instance FromJSON Term where
3736− parseJSON = withObject "Term" parse
3737− where parse o = do termObj <- o .: "term"
3738− case HM.toList termObj of
3739− [(fn, v)] -> Term fn <$> parseJSON v
3740− _ -> fail "Expected object with 1 field-named key"
3741−
3742−instance ToJSON BoolMatch where
3743− toJSON (MustMatch term cache) = object ["must" .= term,
3744− "_cache" .= cache]
3745− toJSON (MustNotMatch term cache) = object ["must_not" .= term,
3746− "_cache" .= cache]
3747− toJSON (ShouldMatch terms cache) = object ["should" .= fmap toJSON terms,
3748− "_cache" .= cache]
3749−
3750−instance FromJSON BoolMatch where
3751− parseJSON = withObject "BoolMatch" parse
3752− where parse o = mustMatch `taggedWith` "must"
3753− <|> mustNotMatch `taggedWith` "must_not"
3754− <|> shouldMatch `taggedWith` "should"
3755− where taggedWith parser k = parser =<< o .: k
3756− mustMatch t = MustMatch t <$> o .:? "_cache" .!= defaultCache
3757− mustNotMatch t = MustNotMatch t <$> o .:? "_cache" .!= defaultCache
3758− shouldMatch t = ShouldMatch t <$> o .:? "_cache" .!= defaultCache
3759−
3760−instance (FromJSON a) => FromJSON (SearchResult a) where
3761− parseJSON (Object v) = SearchResult <$>
3762− v .: "took" <*>
3763− v .: "timed_out" <*>
3764− v .: "_shards" <*>
3765− v .: "hits" <*>
3766− v .:? "aggregations" <*>
3767− v .:? "_scroll_id" <*>
3768− v .:? "suggest"
3769− parseJSON _ = empty
3770−
3771−instance (FromJSON a) => FromJSON (SearchHits a) where
3772− parseJSON (Object v) = SearchHits <$>
3773− v .: "total" <*>
3774− v .: "max_score" <*>
3775− v .: "hits"
3776− parseJSON _ = empty
3777−
3778−instance (FromJSON a) => FromJSON (Hit a) where
3779− parseJSON (Object v) = Hit <$>
3780− v .: "_index" <*>
3781− v .: "_type" <*>
3782− v .: "_id" <*>
3783− v .: "_score" <*>
3784− v .:? "_source" <*>
3785− v .:? "highlight"
3786− parseJSON _ = empty
3787−
3788−instance FromJSON ShardResult where
3789− parseJSON (Object v) = ShardResult <$>
3790− v .: "total" <*>
3791− v .: "successful" <*>
3792− v .: "failed"
3793− parseJSON _ = empty
3794−
3795−
3796−instance FromJSON DocVersion where
3797− parseJSON v = do
3798− i <- parseJSON v
3799− maybe (fail "DocVersion out of range") return $ mkDocVersion i
3800−
3801−-- This insanity is because ES *sometimes* returns Replica/Shard counts as strings
3802−instance FromJSON ReplicaCount where
3803− parseJSON v = parseAsInt v
3804− <|> parseAsString v
3805− where parseAsInt = fmap ReplicaCount . parseJSON
3806− parseAsString = withText "ReplicaCount" (fmap ReplicaCount . parseReadText)
3807−
3808−instance FromJSON ShardCount where
3809− parseJSON v = parseAsInt v
3810− <|> parseAsString v
3811− where parseAsInt = fmap ShardCount . parseJSON
3812− parseAsString = withText "ShardCount" (fmap ShardCount . parseReadText)
3813−
3814−instance Bounded DocVersion where
3815− minBound = DocVersion 1
3816− maxBound = DocVersion 9200000000000000000 -- 9.2e+18
3817−
3818−instance Enum DocVersion where
3819− succ x
3820− | x /= maxBound = DocVersion (succ $ docVersionNumber x)
3821− | otherwise = succError "DocVersion"
3822− pred x
3823− | x /= minBound = DocVersion (pred $ docVersionNumber x)
3824− | otherwise = predError "DocVersion"
3825− toEnum i =
3826− fromMaybe (error $ show i ++ " out of DocVersion range") $ mkDocVersion i
3827− fromEnum = docVersionNumber
3828− enumFrom = boundedEnumFrom
3829− enumFromThen = boundedEnumFromThen
3830−
3831−-- | Username type used for HTTP Basic authentication. See 'basicAuthHook'.
3832−newtype EsUsername = EsUsername { esUsername :: Text } deriving (Read, Show, Eq)
3833−
3834−-- | Password type used for HTTP Basic authentication. See 'basicAuthHook'.
3835−newtype EsPassword = EsPassword { esPassword :: Text } deriving (Read, Show, Eq)
3836−
3837−
3838−data SnapshotRepoSelection = SnapshotRepoList (NonEmpty SnapshotRepoPattern)
3839− | AllSnapshotRepos deriving (Eq, Generic, Show, Typeable)
3840−
3841−
3842−-- | Either specifies an exact repo name or one with globs in it,
3843−-- e.g. @RepoPattern "foo*"@ __NOTE__: Patterns are not supported on ES < 1.7
3844−data SnapshotRepoPattern = ExactRepo SnapshotRepoName
3845− | RepoPattern Text
3846− deriving (Eq, Generic, Show, Typeable)
3847−
3848−-- | The unique name of a snapshot repository.
3849−newtype SnapshotRepoName = SnapshotRepoName { snapshotRepoName :: Text }
3850− deriving (Eq, Ord, Generic, Show, Typeable, ToJSON, FromJSON)
3851−
3852−
3853−-- | A generic representation of a snapshot repo. This is what gets
3854−-- sent to and parsed from the server. For repo types enabled by
3855−-- plugins that aren't exported by this library, consider making a
3856−-- custom type which implements 'SnapshotRepo'. If it is a common repo
3857−-- type, consider submitting a pull request to have it included in the
3858−-- library proper
3859−data GenericSnapshotRepo = GenericSnapshotRepo {
3860− gSnapshotRepoName :: SnapshotRepoName
3861− , gSnapshotRepoType :: SnapshotRepoType
3862− , gSnapshotRepoSettings :: GenericSnapshotRepoSettings
3863− } deriving (Eq, Generic, Show, Typeable)
3864−
3865−
3866−instance SnapshotRepo GenericSnapshotRepo where
3867− toGSnapshotRepo = id
3868− fromGSnapshotRepo = Right
3869−
3870−
3871−newtype SnapshotRepoType = SnapshotRepoType { snapshotRepoType :: Text }
3872− deriving (Eq, Ord, Generic, Show, Typeable, ToJSON, FromJSON)
3873−
3874−
3875−-- | Opaque representation of snapshot repo settings. Instances of
3876−-- 'SnapshotRepo' will produce this.
3877−newtype GenericSnapshotRepoSettings = GenericSnapshotRepoSettings { gSnapshotRepoSettingsObject :: Object }
3878− deriving (Eq, Generic, Show, Typeable, ToJSON)
3879−
3880−
3881− -- Regardless of whether you send strongly typed json, my version of
3882− -- ES sends back stringly typed json in the settings, e.g. booleans
3883− -- as strings, so we'll try to convert them.
3884−instance FromJSON GenericSnapshotRepoSettings where
3885− parseJSON = fmap (GenericSnapshotRepoSettings . fmap unStringlyTypeJSON). parseJSON
3886−
3887−-- | The result of running 'verifySnapshotRepo'.
3888−newtype SnapshotVerification = SnapshotVerification { snapshotNodeVerifications :: [SnapshotNodeVerification] }
3889− deriving (Eq, Generic, Show, Typeable)
3890−
3891−
3892−instance FromJSON SnapshotVerification where
3893− parseJSON = withObject "SnapshotVerification" parse
3894− where
3895− parse o = do
3896− o2 <- o .: "nodes"
3897− SnapshotVerification <$> mapM (uncurry parse') (HM.toList o2)
3898− parse' rawFullId = withObject "SnapshotNodeVerification" $ \o ->
3899− SnapshotNodeVerification (FullNodeId rawFullId) <$> o .: "name"
3900−
3901−
3902−-- | A node that has verified a snapshot
3903−data SnapshotNodeVerification = SnapshotNodeVerification {
3904− snvFullId :: FullNodeId
3905− , snvNodeName :: NodeName
3906− } deriving (Eq, Generic, Show, Typeable)
3907−
3908−
3909−-- | Unique, automatically-generated name assigned to nodes that are
3910−-- usually returned in node-oriented APIs.
3911−newtype FullNodeId = FullNodeId { fullNodeId :: Text }
3912− deriving (Eq, Ord, Generic, Show, Typeable, FromJSON)
3913−
3914−
3915−-- | A human-readable node name that is supplied by the user in the
3916−-- node config or automatically generated by ElasticSearch.
3917−newtype NodeName = NodeName { nodeName :: Text }
3918− deriving (Eq, Ord, Generic, Show, Typeable, FromJSON)
3919−
3920−newtype ClusterName = ClusterName { clusterName :: Text }
3921− deriving (Eq, Ord, Generic, Show, Typeable, FromJSON)
3922−
3923−data NodesInfo = NodesInfo {
3924− nodesInfo :: [NodeInfo]
3925− , nodesClusterName :: ClusterName
3926− } deriving (Eq, Show, Generic, Typeable)
3927−
3928−data NodesStats = NodesStats {
3929− nodesStats :: [NodeStats]
3930− , nodesStatsClusterName :: ClusterName
3931− } deriving (Eq, Show, Generic, Typeable)
3932−
3933−data NodeStats = NodeStats {
3934− nodeStatsName :: NodeName
3935− , nodeStatsFullId :: FullNodeId
3936− , nodeStatsBreakersStats :: Maybe NodeBreakersStats
3937− , nodeStatsHTTP :: NodeHTTPStats
3938− , nodeStatsTransport :: NodeTransportStats
3939− , nodeStatsFS :: NodeFSStats
3940− , nodeStatsNetwork :: Maybe NodeNetworkStats
3941− , nodeStatsThreadPool :: NodeThreadPoolsStats
3942− , nodeStatsJVM :: NodeJVMStats
3943− , nodeStatsProcess :: NodeProcessStats
3944− , nodeStatsOS :: NodeOSStats
3945− , nodeStatsIndices :: NodeIndicesStats
3946− } deriving (Eq, Show, Generic, Typeable)
3947−
3948−data NodeBreakersStats = NodeBreakersStats {
3949− nodeStatsParentBreaker :: NodeBreakerStats
3950− , nodeStatsRequestBreaker :: NodeBreakerStats
3951− , nodeStatsFieldDataBreaker :: NodeBreakerStats
3952− } deriving (Eq, Show, Generic, Typeable)
3953−
3954−data NodeBreakerStats = NodeBreakerStats {
3955− nodeBreakersTripped :: Int
3956− , nodeBreakersOverhead :: Double
3957− , nodeBreakersEstSize :: Bytes
3958− , nodeBreakersLimitSize :: Bytes
3959− } deriving (Eq, Show, Generic, Typeable)
3960−
3961−data NodeHTTPStats = NodeHTTPStats {
3962− nodeHTTPTotalOpened :: Int
3963− , nodeHTTPCurrentOpen :: Int
3964− } deriving (Eq, Show, Generic, Typeable)
3965−
3966−data NodeTransportStats = NodeTransportStats {
3967− nodeTransportTXSize :: Bytes
3968− , nodeTransportCount :: Int
3969− , nodeTransportRXSize :: Bytes
3970− , nodeTransportRXCount :: Int
3971− , nodeTransportServerOpen :: Int
3972− } deriving (Eq, Show, Generic, Typeable)
3973−
3974−data NodeFSStats = NodeFSStats {
3975− nodeFSDataPaths :: [NodeDataPathStats]
3976− , nodeFSTotal :: NodeFSTotalStats
3977− , nodeFSTimestamp :: UTCTime
3978− } deriving (Eq, Show, Generic, Typeable)
3979−
3980−data NodeDataPathStats = NodeDataPathStats {
3981− nodeDataPathDiskServiceTime :: Maybe Double
3982− , nodeDataPathDiskQueue :: Maybe Double
3983− , nodeDataPathIOSize :: Maybe Bytes
3984− , nodeDataPathWriteSize :: Maybe Bytes
3985− , nodeDataPathReadSize :: Maybe Bytes
3986− , nodeDataPathIOOps :: Maybe Int
3987− , nodeDataPathWrites :: Maybe Int
3988− , nodeDataPathReads :: Maybe Int
3989− , nodeDataPathAvailable :: Bytes
3990− , nodeDataPathFree :: Bytes
3991− , nodeDataPathTotal :: Bytes
3992− , nodeDataPathType :: Maybe Text
3993− , nodeDataPathDevice :: Maybe Text
3994− , nodeDataPathMount :: Text
3995− , nodeDataPathPath :: Text
3996− } deriving (Eq, Show, Generic, Typeable)
3997−
3998−data NodeFSTotalStats = NodeFSTotalStats {
3999− nodeFSTotalDiskServiceTime :: Maybe Double
4000− , nodeFSTotalDiskQueue :: Maybe Double
4001− , nodeFSTotalIOSize :: Maybe Bytes
4002− , nodeFSTotalWriteSize :: Maybe Bytes
4003− , nodeFSTotalReadSize :: Maybe Bytes
4004− , nodeFSTotalIOOps :: Maybe Int
4005− , nodeFSTotalWrites :: Maybe Int
4006− , nodeFSTotalReads :: Maybe Int
4007− , nodeFSTotalAvailable :: Bytes
4008− , nodeFSTotalFree :: Bytes
4009− , nodeFSTotalTotal :: Bytes
4010− } deriving (Eq, Show, Generic, Typeable)
4011−
4012−data NodeNetworkStats = NodeNetworkStats {
4013− nodeNetTCPOutRSTs :: Int
4014− , nodeNetTCPInErrs :: Int
4015− , nodeNetTCPAttemptFails :: Int
4016− , nodeNetTCPEstabResets :: Int
4017− , nodeNetTCPRetransSegs :: Int
4018− , nodeNetTCPOutSegs :: Int
4019− , nodeNetTCPInSegs :: Int
4020− , nodeNetTCPCurrEstab :: Int
4021− , nodeNetTCPPassiveOpens :: Int
4022− , nodeNetTCPActiveOpens :: Int
4023− } deriving (Eq, Show, Generic, Typeable)
4024−
4025−data NodeThreadPoolsStats = NodeThreadPoolsStats {
4026− nodeThreadPoolsStatsSnapshot :: NodeThreadPoolStats
4027− , nodeThreadPoolsStatsBulk :: NodeThreadPoolStats
4028− , nodeThreadPoolsStatsMerge :: NodeThreadPoolStats
4029− , nodeThreadPoolsStatsGet :: NodeThreadPoolStats
4030− , nodeThreadPoolsStatsManagement :: NodeThreadPoolStats
4031− , nodeThreadPoolsStatsFetchShardStore :: Maybe NodeThreadPoolStats
4032− , nodeThreadPoolsStatsOptimize :: Maybe NodeThreadPoolStats
4033− , nodeThreadPoolsStatsFlush :: NodeThreadPoolStats
4034− , nodeThreadPoolsStatsSearch :: NodeThreadPoolStats
4035− , nodeThreadPoolsStatsWarmer :: NodeThreadPoolStats
4036− , nodeThreadPoolsStatsGeneric :: NodeThreadPoolStats
4037− , nodeThreadPoolsStatsSuggest :: Maybe NodeThreadPoolStats
4038− , nodeThreadPoolsStatsRefresh :: NodeThreadPoolStats
4039− , nodeThreadPoolsStatsIndex :: NodeThreadPoolStats
4040− , nodeThreadPoolsStatsListener :: Maybe NodeThreadPoolStats
4041− , nodeThreadPoolsStatsFetchShardStarted :: Maybe NodeThreadPoolStats
4042− , nodeThreadPoolsStatsPercolate :: Maybe NodeThreadPoolStats
4043− } deriving (Eq, Show, Generic, Typeable)
4044−
4045−data NodeThreadPoolStats = NodeThreadPoolStats {
4046− nodeThreadPoolCompleted :: Int
4047− , nodeThreadPoolLargest :: Int
4048− , nodeThreadPoolRejected :: Int
4049− , nodeThreadPoolActive :: Int
4050− , nodeThreadPoolQueue :: Int
4051− , nodeThreadPoolThreads :: Int
4052− } deriving (Eq, Show, Generic, Typeable)
4053−
4054−data NodeJVMStats = NodeJVMStats {
4055− nodeJVMStatsMappedBufferPool :: JVMBufferPoolStats
4056− , nodeJVMStatsDirectBufferPool :: JVMBufferPoolStats
4057− , nodeJVMStatsGCOldCollector :: JVMGCStats
4058− , nodeJVMStatsGCYoungCollector :: JVMGCStats
4059− , nodeJVMStatsPeakThreadsCount :: Int
4060− , nodeJVMStatsThreadsCount :: Int
4061− , nodeJVMStatsOldPool :: JVMPoolStats
4062− , nodeJVMStatsSurvivorPool :: JVMPoolStats
4063− , nodeJVMStatsYoungPool :: JVMPoolStats
4064− , nodeJVMStatsNonHeapCommitted :: Bytes
4065− , nodeJVMStatsNonHeapUsed :: Bytes
4066− , nodeJVMStatsHeapMax :: Bytes
4067− , nodeJVMStatsHeapCommitted :: Bytes
4068− , nodeJVMStatsHeapUsedPercent :: Int
4069− , nodeJVMStatsHeapUsed :: Bytes
4070− , nodeJVMStatsUptime :: NominalDiffTime
4071− , nodeJVMStatsTimestamp :: UTCTime
4072− } deriving (Eq, Show, Generic, Typeable)
4073−
4074−data JVMBufferPoolStats = JVMBufferPoolStats {
4075− jvmBufferPoolStatsTotalCapacity :: Bytes
4076− , jvmBufferPoolStatsUsed :: Bytes
4077− , jvmBufferPoolStatsCount :: Int
4078− } deriving (Eq, Show, Generic, Typeable)
4079−
4080−data JVMGCStats = JVMGCStats {
4081− jvmGCStatsCollectionTime :: NominalDiffTime
4082− , jvmGCStatsCollectionCount :: Int
4083− } deriving (Eq, Show, Generic, Typeable)
4084−
4085−data JVMPoolStats = JVMPoolStats {
4086− jvmPoolStatsPeakMax :: Bytes
4087− , jvmPoolStatsPeakUsed :: Bytes
4088− , jvmPoolStatsMax :: Bytes
4089− , jvmPoolStatsUsed :: Bytes
4090− } deriving (Eq, Show, Generic, Typeable)
4091−
4092−data NodeProcessStats = NodeProcessStats {
4093− nodeProcessTimestamp :: UTCTime
4094− , nodeProcessOpenFDs :: Int
4095− , nodeProcessMaxFDs :: Int
4096− , nodeProcessCPUPercent :: Int
4097− , nodeProcessCPUTotal :: NominalDiffTime
4098− , nodeProcessMemTotalVirtual :: Bytes
4099− } deriving (Eq, Show, Generic, Typeable)
4100−
4101−data NodeOSStats = NodeOSStats {
4102− nodeOSTimestamp :: UTCTime
4103− , nodeOSCPUPercent :: Int
4104− , nodeOSLoad :: Maybe LoadAvgs
4105− , nodeOSMemTotal :: Bytes
4106− , nodeOSMemFree :: Bytes
4107− , nodeOSMemFreePercent :: Int
4108− , nodeOSMemUsed :: Bytes
4109− , nodeOSMemUsedPercent :: Int
4110− , nodeOSSwapTotal :: Bytes
4111− , nodeOSSwapFree :: Bytes
4112− , nodeOSSwapUsed :: Bytes
4113− } deriving (Eq, Show, Generic, Typeable)
4114−
4115−data LoadAvgs = LoadAvgs {
4116− loadAvg1Min :: Double
4117− , loadAvg5Min :: Double
4118− , loadAvg15Min :: Double
4119− } deriving (Eq, Show, Generic, Typeable)
4120−
4121−data NodeIndicesStats = NodeIndicesStats {
4122− nodeIndicesStatsRecoveryThrottleTime :: Maybe NominalDiffTime
4123− , nodeIndicesStatsRecoveryCurrentAsTarget :: Maybe Int
4124− , nodeIndicesStatsRecoveryCurrentAsSource :: Maybe Int
4125− , nodeIndicesStatsQueryCacheMisses :: Maybe Int
4126− , nodeIndicesStatsQueryCacheHits :: Maybe Int
4127− , nodeIndicesStatsQueryCacheEvictions :: Maybe Int
4128− , nodeIndicesStatsQueryCacheSize :: Maybe Bytes
4129− , nodeIndicesStatsSuggestCurrent :: Maybe Int
4130− , nodeIndicesStatsSuggestTime :: Maybe NominalDiffTime
4131− , nodeIndicesStatsSuggestTotal :: Maybe Int
4132− , nodeIndicesStatsTranslogSize :: Bytes
4133− , nodeIndicesStatsTranslogOps :: Int
4134− , nodeIndicesStatsSegFixedBitSetMemory :: Maybe Bytes
4135− , nodeIndicesStatsSegVersionMapMemory :: Bytes
4136− , nodeIndicesStatsSegIndexWriterMaxMemory :: Maybe Bytes
4137− , nodeIndicesStatsSegIndexWriterMemory :: Bytes
4138− , nodeIndicesStatsSegMemory :: Bytes
4139− , nodeIndicesStatsSegCount :: Int
4140− , nodeIndicesStatsCompletionSize :: Bytes
4141− , nodeIndicesStatsPercolateQueries :: Maybe Int
4142− , nodeIndicesStatsPercolateMemory :: Maybe Bytes
4143− , nodeIndicesStatsPercolateCurrent :: Maybe Int
4144− , nodeIndicesStatsPercolateTime :: Maybe NominalDiffTime
4145− , nodeIndicesStatsPercolateTotal :: Maybe Int
4146− , nodeIndicesStatsFieldDataEvictions :: Int
4147− , nodeIndicesStatsFieldDataMemory :: Bytes
4148− , nodeIndicesStatsWarmerTotalTime :: NominalDiffTime
4149− , nodeIndicesStatsWarmerTotal :: Int
4150− , nodeIndicesStatsWarmerCurrent :: Int
4151− , nodeIndicesStatsFlushTotalTime :: NominalDiffTime
4152− , nodeIndicesStatsFlushTotal :: Int
4153− , nodeIndicesStatsRefreshTotalTime :: NominalDiffTime
4154− , nodeIndicesStatsRefreshTotal :: Int
4155− , nodeIndicesStatsMergesTotalSize :: Bytes
4156− , nodeIndicesStatsMergesTotalDocs :: Int
4157− , nodeIndicesStatsMergesTotalTime :: NominalDiffTime
4158− , nodeIndicesStatsMergesTotal :: Int
4159− , nodeIndicesStatsMergesCurrentSize :: Bytes
4160− , nodeIndicesStatsMergesCurrentDocs :: Int
4161− , nodeIndicesStatsMergesCurrent :: Int
4162− , nodeIndicesStatsSearchFetchCurrent :: Int
4163− , nodeIndicesStatsSearchFetchTime :: NominalDiffTime
4164− , nodeIndicesStatsSearchFetchTotal :: Int
4165− , nodeIndicesStatsSearchQueryCurrent :: Int
4166− , nodeIndicesStatsSearchQueryTime :: NominalDiffTime
4167− , nodeIndicesStatsSearchQueryTotal :: Int
4168− , nodeIndicesStatsSearchOpenContexts :: Int
4169− , nodeIndicesStatsGetCurrent :: Int
4170− , nodeIndicesStatsGetMissingTime :: NominalDiffTime
4171− , nodeIndicesStatsGetMissingTotal :: Int
4172− , nodeIndicesStatsGetExistsTime :: NominalDiffTime
4173− , nodeIndicesStatsGetExistsTotal :: Int
4174− , nodeIndicesStatsGetTime :: NominalDiffTime
4175− , nodeIndicesStatsGetTotal :: Int
4176− , nodeIndicesStatsIndexingThrottleTime :: Maybe NominalDiffTime
4177− , nodeIndicesStatsIndexingIsThrottled :: Maybe Bool
4178− , nodeIndicesStatsIndexingNoopUpdateTotal :: Maybe Int
4179− , nodeIndicesStatsIndexingDeleteCurrent :: Int
4180− , nodeIndicesStatsIndexingDeleteTime :: NominalDiffTime
4181− , nodeIndicesStatsIndexingDeleteTotal :: Int
4182− , nodeIndicesStatsIndexingIndexCurrent :: Int
4183− , nodeIndicesStatsIndexingIndexTime :: NominalDiffTime
4184− , nodeIndicesStatsIndexingTotal :: Int
4185− , nodeIndicesStatsStoreThrottleTime :: NominalDiffTime
4186− , nodeIndicesStatsStoreSize :: Bytes
4187− , nodeIndicesStatsDocsDeleted :: Int
4188− , nodeIndicesStatsDocsCount :: Int
4189− } deriving (Eq, Show, Generic, Typeable)
4190−
4191−-- | A quirky address format used throughout ElasticSearch. An example
4192−-- would be inet[/1.1.1.1:9200]. inet may be a placeholder for a
4193−-- <https://en.wikipedia.org/wiki/Fully_qualified_domain_name FQDN>.
4194−newtype EsAddress = EsAddress { esAddress :: Text }
4195− deriving (Eq, Ord, Generic, Show, Typeable, FromJSON)
4196−
4197−-- | Typically a 7 character hex string.
4198−newtype BuildHash = BuildHash { buildHash :: Text }
4199− deriving (Eq, Ord, Generic, Read, Show, Typeable, FromJSON, ToJSON)
4200−
4201−newtype PluginName = PluginName { pluginName :: Text }
4202− deriving (Eq, Ord, Generic, Show, Typeable, FromJSON)
4203−
4204−data NodeInfo = NodeInfo {
4205− nodeInfoHTTPAddress :: Maybe EsAddress
4206− , nodeInfoBuild :: BuildHash
4207− , nodeInfoESVersion :: VersionNumber
4208− , nodeInfoIP :: Server
4209− , nodeInfoHost :: Server
4210− , nodeInfoTransportAddress :: EsAddress
4211− , nodeInfoName :: NodeName
4212− , nodeInfoFullId :: FullNodeId
4213− , nodeInfoPlugins :: [NodePluginInfo]
4214− , nodeInfoHTTP :: NodeHTTPInfo
4215− , nodeInfoTransport :: NodeTransportInfo
4216− , nodeInfoNetwork :: Maybe NodeNetworkInfo
4217− , nodeInfoThreadPool :: NodeThreadPoolsInfo
4218− , nodeInfoJVM :: NodeJVMInfo
4219− , nodeInfoProcess :: NodeProcessInfo
4220− , nodeInfoOS :: NodeOSInfo
4221− , nodeInfoSettings :: Object
4222− -- ^ The members of the settings objects are not consistent,
4223− -- dependent on plugins, etc.
4224− } deriving (Eq, Show, Generic, Typeable)
4225−
4226−data NodePluginInfo = NodePluginInfo {
4227− nodePluginSite :: Maybe Bool
4228− -- ^ Is this a site plugin?
4229− , nodePluginJVM :: Maybe Bool
4230− -- ^ Is this plugin running on the JVM
4231− , nodePluginDescription :: Text
4232− , nodePluginVersion :: MaybeNA VersionNumber
4233− , nodePluginName :: PluginName
4234− } deriving (Eq, Show, Generic, Typeable)
4235−
4236−data NodeHTTPInfo = NodeHTTPInfo {
4237− nodeHTTPMaxContentLength :: Bytes
4238− , nodeHTTPTransportAddress :: BoundTransportAddress
4239− } deriving (Eq, Show, Generic, Typeable)
4240−
4241−data NodeTransportInfo = NodeTransportInfo {
4242− nodeTransportProfiles :: [BoundTransportAddress]
4243− , nodeTransportAddress :: BoundTransportAddress
4244− } deriving (Eq, Show, Generic, Typeable)
4245−
4246−data BoundTransportAddress = BoundTransportAddress {
4247− publishAddress :: EsAddress
4248− , boundAddress :: [EsAddress]
4249− } deriving (Eq, Show, Generic, Typeable)
4250−
4251−data NodeNetworkInfo = NodeNetworkInfo {
4252− nodeNetworkPrimaryInterface :: NodeNetworkInterface
4253− , nodeNetworkRefreshInterval :: NominalDiffTime
4254− } deriving (Eq, Show, Generic, Typeable)
4255−
4256−newtype MacAddress = MacAddress { macAddress :: Text }
4257− deriving (Eq, Ord, Generic, Show, Typeable, FromJSON)
4258−
4259−newtype NetworkInterfaceName = NetworkInterfaceName { networkInterfaceName :: Text }
4260− deriving (Eq, Ord, Generic, Show, Typeable, FromJSON)
4261−
4262−data NodeNetworkInterface = NodeNetworkInterface {
4263− nodeNetIfaceMacAddress :: MacAddress
4264− , nodeNetIfaceName :: NetworkInterfaceName
4265− , nodeNetIfaceAddress :: Server
4266− } deriving (Eq, Show, Generic, Typeable)
4267−
4268−data NodeThreadPoolsInfo = NodeThreadPoolsInfo {
4269− nodeThreadPoolsRefresh :: NodeThreadPoolInfo
4270− , nodeThreadPoolsManagement :: NodeThreadPoolInfo
4271− , nodeThreadPoolsPercolate :: Maybe NodeThreadPoolInfo
4272− , nodeThreadPoolsListener :: Maybe NodeThreadPoolInfo
4273− , nodeThreadPoolsFetchShardStarted :: Maybe NodeThreadPoolInfo
4274− , nodeThreadPoolsSearch :: NodeThreadPoolInfo
4275− , nodeThreadPoolsFlush :: NodeThreadPoolInfo
4276− , nodeThreadPoolsWarmer :: NodeThreadPoolInfo
4277− , nodeThreadPoolsOptimize :: Maybe NodeThreadPoolInfo
4278− , nodeThreadPoolsBulk :: NodeThreadPoolInfo
4279− , nodeThreadPoolsSuggest :: Maybe NodeThreadPoolInfo
4280− , nodeThreadPoolsMerge :: NodeThreadPoolInfo
4281− , nodeThreadPoolsSnapshot :: NodeThreadPoolInfo
4282− , nodeThreadPoolsGet :: NodeThreadPoolInfo
4283− , nodeThreadPoolsFetchShardStore :: Maybe NodeThreadPoolInfo
4284− , nodeThreadPoolsIndex :: NodeThreadPoolInfo
4285− , nodeThreadPoolsGeneric :: NodeThreadPoolInfo
4286− } deriving (Eq, Show, Generic, Typeable)
4287−
4288−data NodeThreadPoolInfo = NodeThreadPoolInfo {
4289− nodeThreadPoolQueueSize :: ThreadPoolSize
4290− , nodeThreadPoolKeepalive :: Maybe NominalDiffTime
4291− , nodeThreadPoolMin :: Maybe Int
4292− , nodeThreadPoolMax :: Maybe Int
4293− , nodeThreadPoolType :: ThreadPoolType
4294− } deriving (Eq, Show, Generic, Typeable)
4295−
4296−data ThreadPoolSize = ThreadPoolBounded Int
4297− | ThreadPoolUnbounded
4298− deriving (Eq, Show, Generic, Typeable)
4299−
4300−data ThreadPoolType = ThreadPoolScaling
4301− | ThreadPoolFixed
4302− | ThreadPoolCached
4303− deriving (Eq, Show, Generic, Typeable)
4304−
4305−data NodeJVMInfo = NodeJVMInfo {
4306− nodeJVMInfoMemoryPools :: [JVMMemoryPool]
4307− , nodeJVMInfoMemoryPoolsGCCollectors :: [JVMGCCollector]
4308− , nodeJVMInfoMemoryInfo :: JVMMemoryInfo
4309− , nodeJVMInfoStartTime :: UTCTime
4310− , nodeJVMInfoVMVendor :: Text
4311− , nodeJVMVMVersion :: VersionNumber
4312− -- ^ JVM doesn't seme to follow normal version conventions
4313− , nodeJVMVMName :: Text
4314− , nodeJVMVersion :: VersionNumber
4315− , nodeJVMPID :: PID
4316− } deriving (Eq, Show, Generic, Typeable)
4317−
4318−-- | Handles quirks in the way JVM versions are rendered (1.7.0_101 -> 1.7.0.101)
4319−newtype JVMVersion = JVMVersion { unJVMVersion :: VersionNumber }
4320−
4321−data JVMMemoryInfo = JVMMemoryInfo {
4322− jvmMemoryInfoDirectMax :: Bytes
4323− , jvmMemoryInfoNonHeapMax :: Bytes
4324− , jvmMemoryInfoNonHeapInit :: Bytes
4325− , jvmMemoryInfoHeapMax :: Bytes
4326− , jvmMemoryInfoHeapInit :: Bytes
4327− } deriving (Eq, Show, Generic, Typeable)
4328−
4329−newtype JVMMemoryPool = JVMMemoryPool {
4330− jvmMemoryPool :: Text
4331− } deriving (Eq, Show, Generic, Typeable, FromJSON)
4332−
4333−newtype JVMGCCollector = JVMGCCollector {
4334− jvmGCCollector :: Text
4335− } deriving (Eq, Show, Generic, Typeable, FromJSON)
4336−
4337−newtype PID = PID {
4338− pid :: Int
4339− } deriving (Eq, Show, Generic, Typeable, FromJSON)
4340−
4341−data NodeOSInfo = NodeOSInfo {
4342− nodeOSRefreshInterval :: NominalDiffTime
4343− , nodeOSName :: Text
4344− , nodeOSArch :: Text
4345− , nodeOSVersion :: VersionNumber
4346− , nodeOSAvailableProcessors :: Int
4347− , nodeOSAllocatedProcessors :: Int
4348− } deriving (Eq, Show, Generic, Typeable)
4349−
4350−data CPUInfo = CPUInfo {
4351− cpuCacheSize :: Bytes
4352− , cpuCoresPerSocket :: Int
4353− , cpuTotalSockets :: Int
4354− , cpuTotalCores :: Int
4355− , cpuMHZ :: Int
4356− , cpuModel :: Text
4357− , cpuVendor :: Text
4358− } deriving (Eq, Show, Generic, Typeable)
4359−
4360−data NodeProcessInfo = NodeProcessInfo {
4361− nodeProcessMLockAll :: Bool
4362− -- ^ See <https://www.elastic.co/guide/en/elasticsearch/reference/current/setup-configuration.html>
4363− , nodeProcessMaxFileDescriptors :: Maybe Int
4364− , nodeProcessId :: PID
4365− , nodeProcessRefreshInterval :: NominalDiffTime
4366− } deriving (Eq, Show, Generic, Typeable)
4367−
4368−data SnapshotRepoUpdateSettings = SnapshotRepoUpdateSettings {
4369− repoUpdateVerify :: Bool
4370− -- ^ After creation/update, synchronously check that nodes can
4371− -- write to this repo. Defaults to True. You may use False if you
4372− -- need a faster response and plan on verifying manually later
4373− -- with 'verifySnapshotRepo'.
4374− } deriving (Eq, Show, Generic, Typeable)
4375−
4376−
4377−-- | Reasonable defaults for repo creation/update
4378−--
4379−-- * repoUpdateVerify True
4380−defaultSnapshotRepoUpdateSettings :: SnapshotRepoUpdateSettings
4381−defaultSnapshotRepoUpdateSettings = SnapshotRepoUpdateSettings True
4382−
4383−
4384−-- | A filesystem-based snapshot repo that ships with
4385−-- ElasticSearch. This is an instance of 'SnapshotRepo' so it can be
4386−-- used with 'updateSnapshotRepo'
4387−data FsSnapshotRepo = FsSnapshotRepo {
4388− fsrName :: SnapshotRepoName
4389− , fsrLocation :: FilePath
4390− , fsrCompressMetadata :: Bool
4391− , fsrChunkSize :: Maybe Bytes
4392− -- ^ Size by which to split large files during snapshotting.
4393− , fsrMaxRestoreBytesPerSec :: Maybe Bytes
4394− -- ^ Throttle node restore rate. If not supplied, defaults to 40mb/sec
4395− , fsrMaxSnapshotBytesPerSec :: Maybe Bytes
4396− -- ^ Throttle node snapshot rate. If not supplied, defaults to 40mb/sec
4397− } deriving (Eq, Generic, Show, Typeable)
4398−
4399−
4400−instance SnapshotRepo FsSnapshotRepo where
4401− toGSnapshotRepo FsSnapshotRepo {..} =
4402− GenericSnapshotRepo fsrName fsRepoType (GenericSnapshotRepoSettings settings)
4403− where
4404− Object settings = object $ [ "location" .= fsrLocation
4405− , "compress" .= fsrCompressMetadata
4406− ] ++ optionalPairs
4407− optionalPairs = catMaybes [ ("chunk_size" .=) <$> fsrChunkSize
4408− , ("max_restore_bytes_per_sec" .=) <$> fsrMaxRestoreBytesPerSec
4409− , ("max_snapshot_bytes_per_sec" .=) <$> fsrMaxSnapshotBytesPerSec
4410− ]
4411− fromGSnapshotRepo GenericSnapshotRepo {..}
4412− | gSnapshotRepoType == fsRepoType = do
4413− let o = gSnapshotRepoSettingsObject gSnapshotRepoSettings
4414− parseRepo $ do
4415− FsSnapshotRepo gSnapshotRepoName <$> o .: "location"
4416− <*> o .:? "compress" .!= False
4417− <*> o .:? "chunk_size"
4418− <*> o .:? "max_restore_bytes_per_sec"
4419− <*> o .:? "max_snapshot_bytes_per_sec"
4420− | otherwise = Left (RepoTypeMismatch fsRepoType gSnapshotRepoType)
4421−
4422−
4423−parseRepo :: Parser a -> Either SnapshotRepoConversionError a
4424−parseRepo parser = case parseEither (const parser) () of
4425− Left e -> Left (OtherRepoConversionError (T.pack e))
4426− Right a -> Right a
4427−
4428−
4429−fsRepoType :: SnapshotRepoType
4430−fsRepoType = SnapshotRepoType "fs"
4431−
4432−-- | Law: fromGSnapshotRepo (toGSnapshotRepo r) == Right r
4433−class SnapshotRepo r where
4434− toGSnapshotRepo :: r -> GenericSnapshotRepo
4435− fromGSnapshotRepo :: GenericSnapshotRepo -> Either SnapshotRepoConversionError r
4436−
4437−
4438−data SnapshotRepoConversionError = RepoTypeMismatch SnapshotRepoType SnapshotRepoType
4439− -- ^ Expected type and actual type
4440− | OtherRepoConversionError Text
4441− deriving (Show, Eq, Generic, Typeable)
4442−
4443−
4444−instance Exception SnapshotRepoConversionError
4445−
4446−
4447−data SnapshotCreateSettings = SnapshotCreateSettings {
4448− snapWaitForCompletion :: Bool
4449− -- ^ Should the API call return immediately after initializing
4450− -- the snapshot or wait until completed? Note that if this is
4451− -- enabled it could wait a long time, so you should adjust your
4452− -- 'ManagerSettings' accordingly to set long timeouts or
4453− -- explicitly handle timeouts.
4454− , snapIndices :: Maybe IndexSelection
4455− -- ^ Nothing will snapshot all indices. Just [] is permissable and
4456− -- will essentially be a no-op snapshot.
4457− , snapIgnoreUnavailable :: Bool
4458− -- ^ If set to True, any matched indices that don't exist will be
4459− -- ignored. Otherwise it will be an error and fail.
4460− , snapIncludeGlobalState :: Bool
4461− , snapPartial :: Bool
4462− -- ^ If some indices failed to snapshot (e.g. if not all primary
4463− -- shards are available), should the process proceed?
4464− } deriving (Eq, Generic, Show, Typeable)
4465−
4466−
4467−-- | Reasonable defaults for snapshot creation
4468−--
4469−-- * snapWaitForCompletion False
4470−-- * snapIndices Nothing
4471−-- * snapIgnoreUnavailable False
4472−-- * snapIncludeGlobalState True
4473−-- * snapPartial False
4474−defaultSnapshotCreateSettings :: SnapshotCreateSettings
4475−defaultSnapshotCreateSettings = SnapshotCreateSettings {
4476− snapWaitForCompletion = False
4477− , snapIndices = Nothing
4478− , snapIgnoreUnavailable = False
4479− , snapIncludeGlobalState = True
4480− , snapPartial = False
4481− }
4482−
4483−
4484−data SnapshotSelection = SnapshotList (NonEmpty SnapshotPattern)
4485− | AllSnapshots deriving (Eq, Generic, Show, Typeable)
4486−
4487−
4488−-- | Either specifies an exact snapshot name or one with globs in it,
4489−-- e.g. @SnapPattern "foo*"@ __NOTE__: Patterns are not supported on
4490−-- ES < 1.7
4491−data SnapshotPattern = ExactSnap SnapshotName
4492− | SnapPattern Text
4493− deriving (Eq, Generic, Show, Typeable)
4494−
4495−
4496−-- | General information about the state of a snapshot. Has some
4497−-- redundancies with 'SnapshotStatus'
4498−data SnapshotInfo = SnapshotInfo {
4499− snapInfoShards :: ShardResult
4500− , snapInfoFailures :: [SnapshotShardFailure]
4501− , snapInfoDuration :: NominalDiffTime
4502− , snapInfoEndTime :: UTCTime
4503− , snapInfoStartTime :: UTCTime
4504− , snapInfoState :: SnapshotState
4505− , snapInfoIndices :: [IndexName]
4506− , snapInfoName :: SnapshotName
4507− } deriving (Eq, Generic, Show, Typeable)
4508−
4509−
4510−instance FromJSON SnapshotInfo where
4511− parseJSON = withObject "SnapshotInfo" parse
4512− where
4513− parse o = SnapshotInfo <$> o .: "shards"
4514− <*> o .: "failures"
4515− <*> (unMS <$> o .: "duration_in_millis")
4516− <*> (posixMS <$> o .: "end_time_in_millis")
4517− <*> (posixMS <$> o .: "start_time_in_millis")
4518− <*> o .: "state"
4519− <*> o .: "indices"
4520− <*> o .: "snapshot"
4521−
4522−data SnapshotShardFailure = SnapshotShardFailure {
4523− snapShardFailureIndex :: IndexName
4524− , snapShardFailureNodeId :: Maybe NodeName -- I'm not 100% sure this isn't actually 'FullNodeId'
4525− , snapShardFailureReason :: Text
4526− , snapShardFailureShardId :: ShardId
4527− } deriving (Eq, Show, Generic, Typeable)
4528−
4529−
4530−instance FromJSON SnapshotShardFailure where
4531− parseJSON = withObject "SnapshotShardFailure" parse
4532− where
4533− parse o = SnapshotShardFailure <$> o .: "index"
4534− <*> o .:? "node_id"
4535− <*> o .: "reason"
4536− <*> o .: "shard_id"
4537−
4538−
4539−newtype ShardId = ShardId { shardId :: Int }
4540− deriving (Eq, Show, Generic, Typeable, FromJSON)
4541−
4542−-- | Milliseconds
4543−newtype MS = MS NominalDiffTime
4544−
4545−
4546−-- keeps the unexported constructor warnings at bay
4547−unMS :: MS -> NominalDiffTime
4548−unMS (MS t) = t
4549−
4550−
4551−instance FromJSON MS where
4552− parseJSON = withScientific "MS" (return . MS . parse)
4553− where
4554− parse n = fromInteger ((truncate n) * 1000)
4555−
4556−
4557−data SnapshotState = SnapshotInit
4558− | SnapshotStarted
4559− | SnapshotSuccess
4560− | SnapshotFailed
4561− | SnapshotAborted
4562− | SnapshotMissing
4563− | SnapshotWaiting
4564− deriving (Show, Eq, Generic, Typeable)
4565−
4566−instance FromJSON SnapshotState where
4567− parseJSON = withText "SnapshotState" parse
4568− where
4569− parse "INIT" = return SnapshotInit
4570− parse "STARTED" = return SnapshotStarted
4571− parse "SUCCESS" = return SnapshotSuccess
4572− parse "FAILED" = return SnapshotFailed
4573− parse "ABORTED" = return SnapshotAborted
4574− parse "MISSING" = return SnapshotMissing
4575− parse "WAITING" = return SnapshotWaiting
4576− parse t = fail ("Invalid snapshot state " <> T.unpack t)
4577−
4578−
4579−newtype SnapshotName = SnapshotName { snapshotName :: Text }
4580− deriving (Show, Eq, Ord, Generic, Typeable, ToJSON, FromJSON)
4581−
4582−
4583−data SnapshotRestoreSettings = SnapshotRestoreSettings {
4584− snapRestoreWaitForCompletion :: Bool
4585− -- ^ Should the API call return immediately after initializing
4586− -- the restore or wait until completed? Note that if this is
4587− -- enabled, it could wait a long time, so you should adjust your
4588− -- 'ManagerSettings' accordingly to set long timeouts or
4589− -- explicitly handle timeouts.
4590− , snapRestoreIndices :: Maybe IndexSelection
4591− -- ^ Nothing will restore all indices in the snapshot. Just [] is
4592− -- permissable and will essentially be a no-op restore.
4593− , snapRestoreIgnoreUnavailable :: Bool
4594− -- ^ If set to True, any indices that do not exist will be ignored
4595− -- during snapshot rather than failing the restore.
4596− , snapRestoreIncludeGlobalState :: Bool
4597− -- ^ If set to false, will ignore any global state in the snapshot
4598− -- and will not restore it.
4599− , snapRestoreRenamePattern :: Maybe RestoreRenamePattern
4600− -- ^ A regex pattern for matching indices. Used with
4601− -- 'snapRestoreRenameReplacement', the restore can reference the
4602− -- matched index and create a new index name upon restore.
4603− , snapRestoreRenameReplacement :: Maybe (NonEmpty RestoreRenameToken)
4604− -- ^ Expression of how index renames should be constructed.
4605− , snapRestorePartial :: Bool
4606− -- ^ If some indices fail to restore, should the process proceed?
4607− , snapRestoreIncludeAliases :: Bool
4608− -- ^ Should the restore also restore the aliases captured in the
4609− -- snapshot.
4610− , snapRestoreIndexSettingsOverrides :: Maybe RestoreIndexSettings
4611− -- ^ Settings to apply during the restore process. __NOTE:__ This
4612− -- option is not supported in ES < 1.5 and should be set to
4613− -- Nothing in that case.
4614− , snapRestoreIgnoreIndexSettings :: Maybe (NonEmpty Text)
4615− -- ^ This type could be more rich but it isn't clear which
4616− -- settings are allowed to be ignored during restore, so we're
4617− -- going with including this feature in a basic form rather than
4618− -- omitting it. One example here would be
4619− -- "index.refresh_interval". Any setting specified here will
4620− -- revert back to the server default during the restore process.
4621− } deriving (Eq, Generic, Show, Typeable)
4622−
4623−-- | Regex-stype pattern, e.g. "index_(.+)" to match index names
4624−newtype RestoreRenamePattern = RestoreRenamePattern { rrPattern :: Text }
4625− deriving (Show, Eq, Generic, Typeable, Ord, ToJSON)
4626−
4627−
4628−-- | A single token in a index renaming scheme for a restore. These
4629−-- are concatenated into a string before being sent to
4630−-- ElasticSearch. Check out these Java
4631−-- <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.
4632−data RestoreRenameToken = RRTLit Text
4633− -- ^ Just a literal string of characters
4634− | RRSubWholeMatch
4635− -- ^ Equivalent to $0. The entire matched pattern, not any subgroup
4636− | RRSubGroup RRGroupRefNum
4637− -- ^ A specific reference to a group number
4638− deriving (Show, Eq, Generic, Typeable)
4639−
4640−
4641−-- | A group number for regex matching. Only values from 1-9 are
4642−-- supported. Construct with 'mkRRGroupRefNum'
4643−newtype RRGroupRefNum = RRGroupRefNum { rrGroupRefNum :: Int }
4644− deriving (Show, Eq, Generic, Typeable, Ord)
4645−
4646−instance Bounded RRGroupRefNum where
4647− minBound = RRGroupRefNum 1
4648− maxBound = RRGroupRefNum 9
4649−
4650−
4651−-- | Only allows valid group number references (1-9).
4652−mkRRGroupRefNum :: Int -> Maybe RRGroupRefNum
4653−mkRRGroupRefNum i
4654− | i >= (rrGroupRefNum minBound) && i <= (rrGroupRefNum maxBound) =
4655− Just $ RRGroupRefNum i
4656− | otherwise = Nothing
4657−
4658−
4659−-- | Reasonable defaults for snapshot restores
4660−--
4661−-- * snapRestoreWaitForCompletion False
4662−-- * snapRestoreIndices Nothing
4663−-- * snapRestoreIgnoreUnavailable False
4664−-- * snapRestoreIncludeGlobalState True
4665−-- * snapRestoreRenamePattern Nothing
4666−-- * snapRestoreRenameReplacement Nothing
4667−-- * snapRestorePartial False
4668−-- * snapRestoreIncludeAliases True
4669−-- * snapRestoreIndexSettingsOverrides Nothing
4670−-- * snapRestoreIgnoreIndexSettings Nothing
4671−defaultSnapshotRestoreSettings :: SnapshotRestoreSettings
4672−defaultSnapshotRestoreSettings = SnapshotRestoreSettings {
4673− snapRestoreWaitForCompletion = False
4674− , snapRestoreIndices = Nothing
4675− , snapRestoreIgnoreUnavailable = False
4676− , snapRestoreIncludeGlobalState = True
4677− , snapRestoreRenamePattern = Nothing
4678− , snapRestoreRenameReplacement = Nothing
4679− , snapRestorePartial = False
4680− , snapRestoreIncludeAliases = True
4681− , snapRestoreIndexSettingsOverrides = Nothing
4682− , snapRestoreIgnoreIndexSettings = Nothing
4683− }
4684−
4685−
4686−-- | Index settings that can be overridden. The docs only mention you
4687−-- can update number of replicas, but there may be more. You
4688−-- definitely cannot override shard count.
4689−data RestoreIndexSettings = RestoreIndexSettings {
4690− restoreOverrideReplicas :: Maybe ReplicaCount
4691− } deriving (Show, Eq, Generic, Typeable)
4692−
4693−
4694−instance ToJSON RestoreIndexSettings where
4695− toJSON RestoreIndexSettings {..} = object prs
4696− where
4697− prs = catMaybes [("index.number_of_replicas" .=) <$> restoreOverrideReplicas]
4698−
4699−
4700−instance FromJSON NodesInfo where
4701− parseJSON = withObject "NodesInfo" parse
4702− where
4703− parse o = do
4704− nodes <- o .: "nodes"
4705− infos <- forM (HM.toList nodes) $ \(fullNID, v) -> do
4706− node <- parseJSON v
4707− parseNodeInfo (FullNodeId fullNID) node
4708− cn <- o .: "cluster_name"
4709− return (NodesInfo infos cn)
4710−
4711−instance FromJSON NodesStats where
4712− parseJSON = withObject "NodesStats" parse
4713− where
4714− parse o = do
4715− nodes <- o .: "nodes"
4716− stats <- forM (HM.toList nodes) $ \(fullNID, v) -> do
4717− node <- parseJSON v
4718− parseNodeStats (FullNodeId fullNID) node
4719− cn <- o .: "cluster_name"
4720− return (NodesStats stats cn)
4721−
4722−instance FromJSON NodeBreakerStats where
4723− parseJSON = withObject "NodeBreakerStats" parse
4724− where
4725− parse o = NodeBreakerStats <$> o .: "tripped"
4726− <*> o .: "overhead"
4727− <*> o .: "estimated_size_in_bytes"
4728− <*> o .: "limit_size_in_bytes"
4729−
4730−instance FromJSON NodeHTTPStats where
4731− parseJSON = withObject "NodeHTTPStats" parse
4732− where
4733− parse o = NodeHTTPStats <$> o .: "total_opened"
4734− <*> o .: "current_open"
4735−
4736−instance FromJSON NodeTransportStats where
4737− parseJSON = withObject "NodeTransportStats" parse
4738− where
4739− parse o = NodeTransportStats <$> o .: "tx_size_in_bytes"
4740− <*> o .: "tx_count"
4741− <*> o .: "rx_size_in_bytes"
4742− <*> o .: "rx_count"
4743− <*> o .: "server_open"
4744−
4745−instance FromJSON NodeFSStats where
4746− parseJSON = withObject "NodeFSStats" parse
4747− where
4748− parse o = NodeFSStats <$> o .: "data"
4749− <*> o .: "total"
4750− <*> (posixMS <$> o .: "timestamp")
4751−
4752−instance FromJSON NodeDataPathStats where
4753− parseJSON = withObject "NodeDataPathStats" parse
4754− where
4755− parse o =
4756− NodeDataPathStats <$> (fmap unStringlyTypedDouble <$> o .:? "disk_service_time")
4757− <*> (fmap unStringlyTypedDouble <$> o .:? "disk_queue")
4758− <*> o .:? "disk_io_size_in_bytes"
4759− <*> o .:? "disk_write_size_in_bytes"
4760− <*> o .:? "disk_read_size_in_bytes"
4761− <*> o .:? "disk_io_op"
4762− <*> o .:? "disk_writes"
4763− <*> o .:? "disk_reads"
4764− <*> o .: "available_in_bytes"
4765− <*> o .: "free_in_bytes"
4766− <*> o .: "total_in_bytes"
4767− <*> o .:? "type"
4768− <*> o .:? "dev"
4769− <*> o .: "mount"
4770− <*> o .: "path"
4771−
4772−newtype StringlyTypedDouble = StringlyTypedDouble { unStringlyTypedDouble :: Double }
4773−
4774−instance FromJSON StringlyTypedDouble where
4775− parseJSON = fmap StringlyTypedDouble . parseJSON . unStringlyTypeJSON
4776−
4777−newtype StringlyTypedInt = StringlyTypedInt { unStringlyTypedInt :: Int }
4778−
4779−instance FromJSON StringlyTypedInt where
4780− parseJSON = fmap StringlyTypedInt . parseJSON . unStringlyTypeJSON
4781−
4782−instance FromJSON NodeFSTotalStats where
4783− parseJSON = withObject "NodeFSTotalStats" parse
4784− where
4785− parse o = NodeFSTotalStats <$> (fmap unStringlyTypedDouble <$> o .:? "disk_service_time")
4786− <*> (fmap unStringlyTypedDouble <$> o .:? "disk_queue")
4787− <*> o .:? "disk_io_size_in_bytes"
4788− <*> o .:? "disk_write_size_in_bytes"
4789− <*> o .:? "disk_read_size_in_bytes"
4790− <*> o .:? "disk_io_op"
4791− <*> o .:? "disk_writes"
4792− <*> o .:? "disk_reads"
4793− <*> o .: "available_in_bytes"
4794− <*> o .: "free_in_bytes"
4795− <*> o .: "total_in_bytes"
4796−
4797−instance FromJSON NodeNetworkStats where
4798− parseJSON = withObject "NodeNetworkStats" parse
4799− where
4800− parse o = do
4801− tcp <- o .: "tcp"
4802− NodeNetworkStats <$> tcp .: "out_rsts"
4803− <*> tcp .: "in_errs"
4804− <*> tcp .: "attempt_fails"
4805− <*> tcp .: "estab_resets"
4806− <*> tcp .: "retrans_segs"
4807− <*> tcp .: "out_segs"
4808− <*> tcp .: "in_segs"
4809− <*> tcp .: "curr_estab"
4810− <*> tcp .: "passive_opens"
4811− <*> tcp .: "active_opens"
4812−
4813−instance FromJSON NodeThreadPoolsStats where
4814− parseJSON = withObject "NodeThreadPoolsStats" parse
4815− where
4816− parse o = NodeThreadPoolsStats <$> o .: "snapshot"
4817− <*> o .: "bulk"
4818− <*> o .: "force_merge"
4819− <*> o .: "get"
4820− <*> o .: "management"
4821− <*> o .:? "fetch_shard_store"
4822− <*> o .:? "optimize"
4823− <*> o .: "flush"
4824− <*> o .: "search"
4825− <*> o .: "warmer"
4826− <*> o .: "generic"
4827− <*> o .:? "suggest"
4828− <*> o .: "refresh"
4829− <*> o .: "index"
4830− <*> o .:? "listener"
4831− <*> o .:? "fetch_shard_started"
4832− <*> o .:? "percolate"
4833−instance FromJSON NodeThreadPoolStats where
4834− parseJSON = withObject "NodeThreadPoolStats" parse
4835− where
4836− parse o = NodeThreadPoolStats <$> o .: "completed"
4837− <*> o .: "largest"
4838− <*> o .: "rejected"
4839− <*> o .: "active"
4840− <*> o .: "queue"
4841− <*> o .: "threads"
4842−
4843−instance FromJSON NodeJVMStats where
4844− parseJSON = withObject "NodeJVMStats" parse
4845− where
4846− parse o = do
4847− bufferPools <- o .: "buffer_pools"
4848− mapped <- bufferPools .: "mapped"
4849− direct <- bufferPools .: "direct"
4850− gc <- o .: "gc"
4851− collectors <- gc .: "collectors"
4852− oldC <- collectors .: "old"
4853− youngC <- collectors .: "young"
4854− threads <- o .: "threads"
4855− mem <- o .: "mem"
4856− pools <- mem .: "pools"
4857− oldM <- pools .: "old"
4858− survivorM <- pools .: "survivor"
4859− youngM <- pools .: "young"
4860− NodeJVMStats <$> pure mapped
4861− <*> pure direct
4862− <*> pure oldC
4863− <*> pure youngC
4864− <*> threads .: "peak_count"
4865− <*> threads .: "count"
4866− <*> pure oldM
4867− <*> pure survivorM
4868− <*> pure youngM
4869− <*> mem .: "non_heap_committed_in_bytes"
4870− <*> mem .: "non_heap_used_in_bytes"
4871− <*> mem .: "heap_max_in_bytes"
4872− <*> mem .: "heap_committed_in_bytes"
4873− <*> mem .: "heap_used_percent"
4874− <*> mem .: "heap_used_in_bytes"
4875− <*> (unMS <$> o .: "uptime_in_millis")
4876− <*> (posixMS <$> o .: "timestamp")
4877−
4878−instance FromJSON JVMBufferPoolStats where
4879− parseJSON = withObject "JVMBufferPoolStats" parse
4880− where
4881− parse o = JVMBufferPoolStats <$> o .: "total_capacity_in_bytes"
4882− <*> o .: "used_in_bytes"
4883− <*> o .: "count"
4884−
4885−instance FromJSON JVMGCStats where
4886− parseJSON = withObject "JVMGCStats" parse
4887− where
4888− parse o = JVMGCStats <$> (unMS <$> o .: "collection_time_in_millis")
4889− <*> o .: "collection_count"
4890−
4891−instance FromJSON JVMPoolStats where
4892− parseJSON = withObject "JVMPoolStats" parse
4893− where
4894− parse o = JVMPoolStats <$> o .: "peak_max_in_bytes"
4895− <*> o .: "peak_used_in_bytes"
4896− <*> o .: "max_in_bytes"
4897− <*> o .: "used_in_bytes"
4898−
4899−instance FromJSON NodeProcessStats where
4900− parseJSON = withObject "NodeProcessStats" parse
4901− where
4902− parse o = do
4903− mem <- o .: "mem"
4904− cpu <- o .: "cpu"
4905− NodeProcessStats <$> (posixMS <$> o .: "timestamp")
4906− <*> o .: "open_file_descriptors"
4907− <*> o .: "max_file_descriptors"
4908− <*> cpu .: "percent"
4909− <*> (unMS <$> cpu .: "total_in_millis")
4910− <*> mem .: "total_virtual_in_bytes"
4911−
4912−instance FromJSON NodeOSStats where
4913− parseJSON = withObject "NodeOSStats" parse
4914− where
4915− parse o = do
4916− swap <- o .: "swap"
4917− mem <- o .: "mem"
4918− cpu <- o .: "cpu"
4919− load <- o .:? "load_average"
4920− NodeOSStats <$> (posixMS <$> o .: "timestamp")
4921− <*> cpu .: "percent"
4922− <*> pure load
4923− <*> mem .: "total_in_bytes"
4924− <*> mem .: "free_in_bytes"
4925− <*> mem .: "free_percent"
4926− <*> mem .: "used_in_bytes"
4927− <*> mem .: "used_percent"
4928− <*> swap .: "total_in_bytes"
4929− <*> swap .: "free_in_bytes"
4930− <*> swap .: "used_in_bytes"
4931−
4932−instance FromJSON LoadAvgs where
4933− parseJSON = withArray "LoadAvgs" parse
4934− where
4935− parse v = case V.toList v of
4936− [one, five, fifteen] -> LoadAvgs <$> parseJSON one
4937− <*> parseJSON five
4938− <*> parseJSON fifteen
4939− _ -> fail "Expecting a triple of Doubles"
4940−
4941−instance FromJSON NodeIndicesStats where
4942− parseJSON = withObject "NodeIndicesStats" parse
4943− where
4944− parse o = do
4945− let (.::) mv k = case mv of
4946− Just v -> Just <$> v .: k
4947− Nothing -> pure Nothing
4948− mRecovery <- o .:? "recovery"
4949− mQueryCache <- o .:? "query_cache"
4950− mSuggest <- o .:? "suggest"
4951− translog <- o .: "translog"
4952− segments <- o .: "segments"
4953− completion <- o .: "completion"
4954− mPercolate <- o .:? "percolate"
4955− fielddata <- o .: "fielddata"
4956− warmer <- o .: "warmer"
4957− flush <- o .: "flush"
4958− refresh <- o .: "refresh"
4959− merges <- o .: "merges"
4960− search <- o .: "search"
4961− getStats <- o .: "get"
4962− indexing <- o .: "indexing"
4963− store <- o .: "store"
4964− docs <- o .: "docs"
4965− NodeIndicesStats <$> (fmap unMS <$> mRecovery .:: "throttle_time_in_millis")
4966− <*> mRecovery .:: "current_as_target"
4967− <*> mRecovery .:: "current_as_source"
4968− <*> mQueryCache .:: "miss_count"
4969− <*> mQueryCache .:: "hit_count"
4970− <*> mQueryCache .:: "evictions"
4971− <*> mQueryCache .:: "memory_size_in_bytes"
4972− <*> mSuggest .:: "current"
4973− <*> (fmap unMS <$> mSuggest .:: "time_in_millis")
4974− <*> mSuggest .:: "total"
4975− <*> translog .: "size_in_bytes"
4976− <*> translog .: "operations"
4977− <*> segments .:? "fixed_bit_set_memory_in_bytes"
4978− <*> segments .: "version_map_memory_in_bytes"
4979− <*> segments .:? "index_writer_max_memory_in_bytes"
4980− <*> segments .: "index_writer_memory_in_bytes"
4981− <*> segments .: "memory_in_bytes"
4982− <*> segments .: "count"
4983− <*> completion .: "size_in_bytes"
4984− <*> mPercolate .:: "queries"
4985− <*> mPercolate .:: "memory_size_in_bytes"
4986− <*> mPercolate .:: "current"
4987− <*> (fmap unMS <$> mPercolate .:: "time_in_millis")
4988− <*> mPercolate .:: "total"
4989− <*> fielddata .: "evictions"
4990− <*> fielddata .: "memory_size_in_bytes"
4991− <*> (unMS <$> warmer .: "total_time_in_millis")
4992− <*> warmer .: "total"
4993− <*> warmer .: "current"
4994− <*> (unMS <$> flush .: "total_time_in_millis")
4995− <*> flush .: "total"
4996− <*> (unMS <$> refresh .: "total_time_in_millis")
4997− <*> refresh .: "total"
4998− <*> merges .: "total_size_in_bytes"
4999− <*> merges .: "total_docs"
5000− <*> (unMS <$> merges .: "total_time_in_millis")
5001− <*> merges .: "total"
5002− <*> merges .: "current_size_in_bytes"
5003− <*> merges .: "current_docs"
5004− <*> merges .: "current"
5005− <*> search .: "fetch_current"
5006− <*> (unMS <$> search .: "fetch_time_in_millis")
5007− <*> search .: "fetch_total"
5008− <*> search .: "query_current"
5009− <*> (unMS <$> search .: "query_time_in_millis")
5010− <*> search .: "query_total"
5011− <*> search .: "open_contexts"
5012− <*> getStats .: "current"
5013− <*> (unMS <$> getStats .: "missing_time_in_millis")
5014− <*> getStats .: "missing_total"
5015− <*> (unMS <$> getStats .: "exists_time_in_millis")
5016− <*> getStats .: "exists_total"
5017− <*> (unMS <$> getStats .: "time_in_millis")
5018− <*> getStats .: "total"
5019− <*> (fmap unMS <$> indexing .:? "throttle_time_in_millis")
5020− <*> indexing .:? "is_throttled"
5021− <*> indexing .:? "noop_update_total"
5022− <*> indexing .: "delete_current"
5023− <*> (unMS <$> indexing .: "delete_time_in_millis")
5024− <*> indexing .: "delete_total"
5025− <*> indexing .: "index_current"
5026− <*> (unMS <$> indexing .: "index_time_in_millis")
5027− <*> indexing .: "index_total"
5028− <*> (unMS <$> store .: "throttle_time_in_millis")
5029− <*> store .: "size_in_bytes"
5030− <*> docs .: "deleted"
5031− <*> docs .: "count"
5032−
5033−instance FromJSON NodeBreakersStats where
5034− parseJSON = withObject "NodeBreakersStats" parse
5035− where
5036− parse o = NodeBreakersStats <$> o .: "parent"
5037− <*> o .: "request"
5038− <*> o .: "fielddata"
5039−
5040−parseNodeStats :: FullNodeId -> Object -> Parser NodeStats
5041−parseNodeStats fnid o = do
5042− NodeStats <$> o .: "name"
5043− <*> pure fnid
5044− <*> o .:? "breakers"
5045− <*> o .: "http"
5046− <*> o .: "transport"
5047− <*> o .: "fs"
5048− <*> o .:? "network"
5049− <*> o .: "thread_pool"
5050− <*> o .: "jvm"
5051− <*> o .: "process"
5052− <*> o .: "os"
5053− <*> o .: "indices"
5054−
5055−parseNodeInfo :: FullNodeId -> Object -> Parser NodeInfo
5056−parseNodeInfo nid o =
5057− NodeInfo <$> o .:? "http_address"
5058− <*> o .: "build_hash"
5059− <*> o .: "version"
5060− <*> o .: "ip"
5061− <*> o .: "host"
5062− <*> o .: "transport_address"
5063− <*> o .: "name"
5064− <*> pure nid
5065− <*> o .: "plugins"
5066− <*> o .: "http"
5067− <*> o .: "transport"
5068− <*> o .:? "network"
5069− <*> o .: "thread_pool"
5070− <*> o .: "jvm"
5071− <*> o .: "process"
5072− <*> o .: "os"
5073− <*> o .: "settings"
5074−
5075−instance FromJSON NodePluginInfo where
5076− parseJSON = withObject "NodePluginInfo" parse
5077− where
5078− parse o = NodePluginInfo <$> o .:? "site"
5079− <*> o .:? "jvm"
5080− <*> o .: "description"
5081− <*> o .: "version"
5082− <*> o .: "name"
5083−
5084−instance FromJSON NodeHTTPInfo where
5085− parseJSON = withObject "NodeHTTPInfo" parse
5086− where
5087− parse o = NodeHTTPInfo <$> o .: "max_content_length_in_bytes"
5088− <*> parseJSON (Object o)
5089−
5090−instance FromJSON BoundTransportAddress where
5091− parseJSON = withObject "BoundTransportAddress" parse
5092− where
5093− parse o = BoundTransportAddress <$> o .: "publish_address"
5094− <*> o .: "bound_address"
5095−
5096−instance FromJSON NodeOSInfo where
5097− parseJSON = withObject "NodeOSInfo" parse
5098− where
5099− parse o = do
5100− NodeOSInfo <$> (unMS <$> o .: "refresh_interval_in_millis")
5101− <*> o .: "name"
5102− <*> o .: "arch"
5103− <*> o .: "version"
5104− <*> o .: "available_processors"
5105− <*> o .: "allocated_processors"
5106−
5107−
5108−instance FromJSON CPUInfo where
5109− parseJSON = withObject "CPUInfo" parse
5110− where
5111− parse o = CPUInfo <$> o .: "cache_size_in_bytes"
5112− <*> o .: "cores_per_socket"
5113− <*> o .: "total_sockets"
5114− <*> o .: "total_cores"
5115− <*> o .: "mhz"
5116− <*> o .: "model"
5117− <*> o .: "vendor"
5118−
5119−instance FromJSON NodeProcessInfo where
5120− parseJSON = withObject "NodeProcessInfo" parse
5121− where
5122− parse o = NodeProcessInfo <$> o .: "mlockall"
5123− <*> o .:? "max_file_descriptors"
5124− <*> o .: "id"
5125− <*> (unMS <$> o .: "refresh_interval_in_millis")
5126−
5127−instance FromJSON NodeJVMInfo where
5128− parseJSON = withObject "NodeJVMInfo" parse
5129− where
5130− parse o = NodeJVMInfo <$> o .: "memory_pools"
5131− <*> o .: "gc_collectors"
5132− <*> o .: "mem"
5133− <*> (posixMS <$> o .: "start_time_in_millis")
5134− <*> o .: "vm_vendor"
5135− <*> o .: "vm_version"
5136− <*> o .: "vm_name"
5137− <*> (unJVMVersion <$> o .: "version")
5138− <*> o .: "pid"
5139−
5140−instance FromJSON JVMVersion where
5141− parseJSON (String t) =
5142− JVMVersion <$> parseJSON (String (T.replace "_" "." t))
5143− parseJSON v = JVMVersion <$> parseJSON v
5144−
5145−instance FromJSON JVMMemoryInfo where
5146− parseJSON = withObject "JVMMemoryInfo" parse
5147− where
5148− parse o = JVMMemoryInfo <$> o .: "direct_max_in_bytes"
5149− <*> o .: "non_heap_max_in_bytes"
5150− <*> o .: "non_heap_init_in_bytes"
5151− <*> o .: "heap_max_in_bytes"
5152− <*> o .: "heap_init_in_bytes"
5153−
5154−instance FromJSON NodeThreadPoolsInfo where
5155− parseJSON = withObject "NodeThreadPoolsInfo" parse
5156− where
5157− parse o = NodeThreadPoolsInfo <$> o .: "refresh"
5158− <*> o .: "management"
5159− <*> o .:? "percolate"
5160− <*> o .:? "listener"
5161− <*> o .:? "fetch_shard_started"
5162− <*> o .: "search"
5163− <*> o .: "flush"
5164− <*> o .: "warmer"
5165− <*> o .:? "optimize"
5166− <*> o .: "bulk"
5167− <*> o .:? "suggest"
5168− <*> o .: "force_merge"
5169− <*> o .: "snapshot"
5170− <*> o .: "get"
5171− <*> o .:? "fetch_shard_store"
5172− <*> o .: "index"
5173− <*> o .: "generic"
5174−
5175−instance FromJSON NodeThreadPoolInfo where
5176− parseJSON = withObject "NodeThreadPoolInfo" parse
5177− where
5178− parse o = do
5179− ka <- maybe (return Nothing) (fmap Just . parseStringInterval) =<< o .:? "keep_alive"
5180− NodeThreadPoolInfo <$> (parseJSON . unStringlyTypeJSON =<< o .: "queue_size")
5181− <*> pure ka
5182− <*> o .:? "min"
5183− <*> o .:? "max"
5184− <*> o .: "type"
5185−
5186−parseStringInterval :: (Monad m) => String -> m NominalDiffTime
5187−parseStringInterval s = case span isNumber s of
5188− ("", _) -> fail "Invalid interval"
5189− (nS, unitS) -> case (readMay nS, readMay unitS) of
5190− (Just n, Just unit) -> return (fromInteger (n * unitNDT unit))
5191− (Nothing, _) -> fail "Invalid interval number"
5192− (_, Nothing) -> fail "Invalid interval unit"
5193− where
5194− unitNDT Seconds = 1
5195− unitNDT Minutes = 60
5196− unitNDT Hours = 60 * 60
5197− unitNDT Days = 24 * 60 * 60
5198− unitNDT Weeks = 7 * 24 * 60 * 60
5199−
5200−instance FromJSON ThreadPoolSize where
5201− parseJSON v = parseAsNumber v <|> parseAsString v
5202− where
5203− parseAsNumber = parseAsInt <=< parseJSON
5204− parseAsInt (-1) = return ThreadPoolUnbounded
5205− parseAsInt n
5206− | n >= 0 = return (ThreadPoolBounded n)
5207− | otherwise = fail "Thread pool size must be >= -1."
5208− parseAsString = withText "ThreadPoolSize" $ \t ->
5209− case first (readMay . T.unpack) (T.span isNumber t) of
5210− (Just n, "k") -> return (ThreadPoolBounded (n * 1000))
5211− (Just n, "") -> return (ThreadPoolBounded n)
5212− _ -> fail ("Invalid thread pool size " <> T.unpack t)
5213−
5214−instance FromJSON ThreadPoolType where
5215− parseJSON = withText "ThreadPoolType" parse
5216− where
5217− parse "scaling" = return ThreadPoolScaling
5218− parse "fixed" = return ThreadPoolFixed
5219− parse "cached" = return ThreadPoolCached
5220− parse e = fail ("Unexpected thread pool type" <> T.unpack e)
5221−
5222−instance FromJSON NodeTransportInfo where
5223− parseJSON = withObject "NodeTransportInfo" parse
5224− where
5225− parse o = NodeTransportInfo <$> (maybe (return mempty) parseProfiles =<< o .:? "profiles")
5226− <*> parseJSON (Object o)
5227− parseProfiles (Object o) | HM.null o = return []
5228− parseProfiles v@(Array _) = parseJSON v
5229− parseProfiles Null = return []
5230− parseProfiles _ = fail "Could not parse profiles"
5231−
5232−instance FromJSON NodeNetworkInfo where
5233− parseJSON = withObject "NodeNetworkInfo" parse
5234− where
5235− parse o = NodeNetworkInfo <$> o .: "primary_interface"
5236− <*> (unMS <$> o .: "refresh_interval_in_millis")
5237−
5238−
5239−instance FromJSON NodeNetworkInterface where
5240− parseJSON = withObject "NodeNetworkInterface" parse
5241− where
5242− parse o = NodeNetworkInterface <$> o .: "mac_address"
5243− <*> o .: "name"
5244− <*> o .: "address"
5245−
5246−newtype MaybeNA a = MaybeNA { unMaybeNA :: Maybe a }
5247− deriving (Show, Eq)
5248−
5249−instance FromJSON a => FromJSON (MaybeNA a) where
5250− parseJSON (String "NA") = pure $ MaybeNA Nothing
5251− parseJSON o = MaybeNA . Just <$> parseJSON o
5252−
5253−data Suggest = Suggest { suggestText :: Text
5254− , suggestName :: Text
5255− , suggestType :: SuggestType
5256− }
5257− deriving (Show, Generic, Eq, Read)
5258−
5259−instance ToJSON Suggest where
5260− toJSON Suggest{..} = object [ "text" .= suggestText
5261− , suggestName .= suggestType
5262− ]
5263−
5264−instance FromJSON Suggest where
5265− parseJSON (Object o) = do
5266− suggestText' <- o .: "text"
5267− let dropTextList = HM.toList $ HM.filterWithKey (\x _ -> x /= "text") o
5268− suggestName' <- case dropTextList of
5269− [(x, _)] -> return x
5270− _ -> fail "error parsing Suggest field name"
5271− suggestType' <- o .: suggestName'
5272− return $ Suggest suggestText' suggestName' suggestType'
5273− parseJSON x = typeMismatch "Suggest" x
5274−
5275−data SuggestType = SuggestTypePhraseSuggester PhraseSuggester
5276− deriving (Show, Generic, Eq, Read)
5277−
5278−instance ToJSON SuggestType where
5279− toJSON (SuggestTypePhraseSuggester x) = object ["phrase" .= x]
5280−
5281−instance FromJSON SuggestType where
5282− parseJSON = withObject "SuggestType" parse
5283− where parse o = phraseSuggester `taggedWith` "phrase"
5284− where taggedWith parser k = parser =<< o .: k
5285− phraseSuggester = pure . SuggestTypePhraseSuggester
5286−
5287−data PhraseSuggester =
5288− PhraseSuggester { phraseSuggesterField :: FieldName
5289− , phraseSuggesterGramSize :: Maybe Int
5290− , phraseSuggesterRealWordErrorLikelihood :: Maybe Int
5291− , phraseSuggesterConfidence :: Maybe Int
5292− , phraseSuggesterMaxErrors :: Maybe Int
5293− , phraseSuggesterSeparator :: Maybe Text
5294− , phraseSuggesterSize :: Maybe Size
5295− , phraseSuggesterAnalyzer :: Maybe Analyzer
5296− , phraseSuggesterShardSize :: Maybe Int
5297− , phraseSuggesterHighlight :: Maybe PhraseSuggesterHighlighter
5298− , phraseSuggesterCollate :: Maybe PhraseSuggesterCollate
5299− , phraseSuggesterCandidateGenerators :: [DirectGenerators]
5300− }
5301− deriving (Show, Generic, Eq, Read)
5302−
5303−instance ToJSON PhraseSuggester where
5304− toJSON PhraseSuggester{..} = omitNulls [ "field" .= phraseSuggesterField
5305− , "gram_size" .= phraseSuggesterGramSize
5306− , "real_word_error_likelihood" .= phraseSuggesterRealWordErrorLikelihood
5307− , "confidence" .= phraseSuggesterConfidence
5308− , "max_errors" .= phraseSuggesterMaxErrors
5309− , "separator" .= phraseSuggesterSeparator
5310− , "size" .= phraseSuggesterSize
5311− , "analyzer" .= phraseSuggesterAnalyzer
5312− , "shard_size" .= phraseSuggesterShardSize
5313− , "highlight" .= phraseSuggesterHighlight
5314− , "collate" .= phraseSuggesterCollate
5315− , "direct_generator" .= phraseSuggesterCandidateGenerators
5316− ]
5317−
5318−instance FromJSON PhraseSuggester where
5319− parseJSON = withObject "PhraseSuggester" parse
5320− where parse o = PhraseSuggester
5321− <$> o .: "field"
5322− <*> o .:? "gram_size"
5323− <*> o .:? "real_word_error_likelihood"
5324− <*> o .:? "confidence"
5325− <*> o .:? "max_errors"
5326− <*> o .:? "separator"
5327− <*> o .:? "size"
5328− <*> o .:? "analyzer"
5329− <*> o .:? "shard_size"
5330− <*> o .:? "highlight"
5331− <*> o .:? "collate"
5332− <*> o .:? "direct_generator" .!= []
5333−
5334−mkPhraseSuggester :: FieldName -> PhraseSuggester
5335−mkPhraseSuggester fName =
5336− PhraseSuggester fName Nothing Nothing Nothing Nothing Nothing Nothing
5337− Nothing Nothing Nothing Nothing []
5338−
5339−data PhraseSuggesterHighlighter =
5340− PhraseSuggesterHighlighter { phraseSuggesterHighlighterPreTag :: Text
5341− , phraseSuggesterHighlighterPostTag :: Text
5342− }
5343− deriving (Show, Generic, Eq, Read)
5344−
5345−instance ToJSON PhraseSuggesterHighlighter where
5346− toJSON PhraseSuggesterHighlighter{..} =
5347− object [ "pre_tag" .= phraseSuggesterHighlighterPreTag
5348− , "post_tag" .= phraseSuggesterHighlighterPostTag
5349− ]
5350−
5351−instance FromJSON PhraseSuggesterHighlighter where
5352− parseJSON = withObject "PhraseSuggesterHighlighter" parse
5353− where parse o = PhraseSuggesterHighlighter
5354− <$> o .: "pre_tag"
5355− <*> o .: "post_tag"
5356−
5357−data PhraseSuggesterCollate =
5358− PhraseSuggesterCollate { phraseSuggesterCollateTemplateQuery :: TemplateQueryInline
5359− , phraseSuggesterCollatePrune :: Bool
5360− }
5361− deriving (Show, Generic, Eq, Read)
5362−
5363−instance ToJSON PhraseSuggesterCollate where
5364− toJSON PhraseSuggesterCollate{..} = object [ "query" .= object
5365− [ "inline" .= (inline phraseSuggesterCollateTemplateQuery)
5366− ]
5367− , "params" .= (params phraseSuggesterCollateTemplateQuery)
5368− , "prune" .= phraseSuggesterCollatePrune
5369− ]
5370−
5371−instance FromJSON PhraseSuggesterCollate where
5372− parseJSON (Object o) = do
5373− query' <- o .: "query"
5374− inline' <- query' .: "inline"
5375− params' <- o .: "params"
5376− prune' <- o .:? "prune" .!= False
5377− return $ PhraseSuggesterCollate (TemplateQueryInline inline' params') prune'
5378− parseJSON x = typeMismatch "PhraseSuggesterCollate" x
5379−
5380−data SuggestOptions =
5381− SuggestOptions { suggestOptionsText :: Text
5382− , suggestOptionsScore :: Double
5383− , suggestOptionsFreq :: Maybe Int
5384− , suggestOptionsHighlighted :: Maybe Text
5385− }
5386− deriving (Eq, Read, Show)
5387−
5388−instance FromJSON SuggestOptions where
5389− parseJSON = withObject "SuggestOptions" parse
5390− where parse o = SuggestOptions
5391− <$> o .: "text"
5392− <*> o .: "score"
5393− <*> o .:? "freq"
5394− <*> o .:? "highlighted"
5395−
5396−data SuggestResponse =
5397− SuggestResponse { suggestResponseText :: Text
5398− , suggestResponseOffset :: Int
5399− , suggestResponseLength :: Int
5400− , suggestResponseOptions :: [SuggestOptions]
5401− }
5402− deriving (Eq, Read, Show)
5403−
5404−instance FromJSON SuggestResponse where
5405− parseJSON = withObject "SuggestResponse" parse
5406− where parse o = SuggestResponse
5407− <$> o .: "text"
5408− <*> o .: "offset"
5409− <*> o .: "length"
5410− <*> o .: "options"
5411−
5412−data NamedSuggestionResponse =
5413− NamedSuggestionResponse { nsrName :: Text
5414− , nsrResponses :: [SuggestResponse]
5415− }
5416− deriving (Eq, Read, Show)
5417−
5418−instance FromJSON NamedSuggestionResponse where
5419− parseJSON (Object o) = do
5420− suggestionName' <- case HM.toList o of
5421− [(x, _)] -> return x
5422− _ -> fail "error parsing NamedSuggestionResponse name"
5423− suggestionResponses' <- o .: suggestionName'
5424− return $ NamedSuggestionResponse suggestionName' suggestionResponses'
5425−
5426− parseJSON x = typeMismatch "NamedSuggestionResponse" x
5427−
5428−data DirectGeneratorSuggestModeTypes = DirectGeneratorSuggestModeMissing
5429− | DirectGeneratorSuggestModePopular
5430− | DirectGeneratorSuggestModeAlways
5431− deriving (Show, Eq, Read, Generic)
5432−
5433−instance ToJSON DirectGeneratorSuggestModeTypes where
5434− toJSON DirectGeneratorSuggestModeMissing = "missing"
5435− toJSON DirectGeneratorSuggestModePopular = "popular"
5436− toJSON DirectGeneratorSuggestModeAlways = "always"
5437−
5438−instance FromJSON DirectGeneratorSuggestModeTypes where
5439− parseJSON = withText "DirectGeneratorSuggestModeTypes" parse
5440− where parse "missing" = pure DirectGeneratorSuggestModeMissing
5441− parse "popular" = pure DirectGeneratorSuggestModePopular
5442− parse "always" = pure DirectGeneratorSuggestModeAlways
5443− parse f = fail ("Unexpected DirectGeneratorSuggestModeTypes: " <> show f)
5444−
5445−data DirectGenerators = DirectGenerators
5446− { directGeneratorsField :: FieldName
5447− , directGeneratorsSize :: Maybe Int
5448− , directGeneratorSuggestMode :: DirectGeneratorSuggestModeTypes
5449− , directGeneratorMaxEdits :: Maybe Double
5450− , directGeneratorPrefixLength :: Maybe Int
5451− , directGeneratorMinWordLength :: Maybe Int
5452− , directGeneratorMaxInspections :: Maybe Int
5453− , directGeneratorMinDocFreq :: Maybe Double
5454− , directGeneratorMaxTermFreq :: Maybe Double
5455− , directGeneratorPreFilter :: Maybe Text
5456− , directGeneratorPostFilter :: Maybe Text
5457− }
5458− deriving (Show, Eq, Read, Generic)
5459−
5460−
5461−instance ToJSON DirectGenerators where
5462− toJSON DirectGenerators{..} = omitNulls [ "field" .= directGeneratorsField
5463− , "size" .= directGeneratorsSize
5464− , "suggest_mode" .= directGeneratorSuggestMode
5465− , "max_edits" .= directGeneratorMaxEdits
5466− , "prefix_length" .= directGeneratorPrefixLength
5467− , "min_word_length" .= directGeneratorMinWordLength
5468− , "max_inspections" .= directGeneratorMaxInspections
5469− , "min_doc_freq" .= directGeneratorMinDocFreq
5470− , "max_term_freq" .= directGeneratorMaxTermFreq
5471− , "pre_filter" .= directGeneratorPreFilter
5472− , "post_filter" .= directGeneratorPostFilter
5473− ]
5474−
5475−instance FromJSON DirectGenerators where
5476− parseJSON = withObject "DirectGenerators" parse
5477− where parse o = DirectGenerators
5478− <$> o .: "field"
5479− <*> o .:? "size"
5480− <*> o .: "suggest_mode"
5481− <*> o .:? "max_edits"
5482− <*> o .:? "prefix_length"
5483− <*> o .:? "min_word_length"
5484− <*> o .:? "max_inspections"
5485− <*> o .:? "min_doc_freq"
5486− <*> o .:? "max_term_freq"
5487− <*> o .:? "pre_filter"
5488− <*> o .:? "post_filter"
5489−
5490−mkDirectGenerators :: FieldName -> DirectGenerators
5491−mkDirectGenerators fn = DirectGenerators fn Nothing DirectGeneratorSuggestModeMissing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing
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+1
@@ -7,5 +7,6 @@ packages:
77- './examples'
88extra-deps:
99 - quickcheck-properties-0.1
10+ - quickcheck-arbitrary-template-0.2.0.0
1011
1112resolver: lts-8.14
stack-8.2.yaml+5−2
@@ -7,6 +7,9 @@ packages:
77 - './examples'
88
99extra-deps:
10−- quickcheck-properties-0.1
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
1114
12−resolver: lts-10.0
15+resolver: lts-11.6
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.yaml+1−1
@@ -1 +1 @@
1−stack-8.2.yaml
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

This diff is too big to show here.

tests/Test/ApproxEq.hsnew file+63

This diff is too big to show here.

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−1966

This diff is too big to show here.

tests/V5/tests.hsdeleted−1827

This diff is too big to show here.

tests/tests.hsnew file+136

This diff is too big to show here.