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

The content is the same.

tests/V5/Test/Common.hs → tests/Test/Common.hsrenamed+21−21
@@ -6,7 +6,7 @@ module Test.Common where
66import Test.Import
77
88import qualified Data.Map as M
9−import qualified Data.Version as Vers
9+import qualified Data.SemVer as SemVer
1010import qualified Network.HTTP.Types.Status as NHTS
1111
1212testServer :: Server
@@ -50,31 +50,31 @@ instance ToJSON ParentMapping where
5050 , "extra" .= object ["type" .= ("keyword" :: Text)]
5151 ]]
5252
53−es13 :: Vers.Version
54−es13 = Vers.Version [1, 3, 0] []
53+es11 :: SemVer.Version
54+es11 = SemVer.version 1 1 0 [] []
5555
56−es12 :: Vers.Version
57−es12 = Vers.Version [1, 2, 0] []
56+es13 :: SemVer.Version
57+es13 = SemVer.version 1 3 0 [] []
5858
59−es11 :: Vers.Version
60−es11 = Vers.Version [1, 1, 0] []
59+es12 :: SemVer.Version
60+es12 = SemVer.version 1 2 0 [] []
6161
62−es14 :: Vers.Version
63−es14 = Vers.Version [1, 4, 0] []
62+es14 :: SemVer.Version
63+es14 = SemVer.version 1 4 0 [] []
6464
65−es15 :: Vers.Version
66−es15 = Vers.Version [1, 5, 0] []
65+es15 :: SemVer.Version
66+es15 = SemVer.version 1 5 0 [] []
6767
68−es16 :: Vers.Version
69−es16 = Vers.Version [1, 6, 0] []
68+es16 :: SemVer.Version
69+es16 = SemVer.version 1 6 0 [] []
7070
71−es20 :: Vers.Version
72−es20 = Vers.Version [2, 0, 0] []
71+es20 :: SemVer.Version
72+es20 = SemVer.version 2 0 0 [] []
7373
74−es50 :: Vers.Version
75−es50 = Vers.Version [5, 0, 0] []
74+es50 :: SemVer.Version
75+es50 = SemVer.version 5 0 0 [] []
7676
77−getServerVersion :: IO (Maybe Vers.Version)
77+getServerVersion :: IO (Maybe SemVer.Version)
7878getServerVersion = fmap extractVersion <$> withTestEnv getStatus
7979 where
8080 extractVersion = versionNumber . number . version
@@ -282,11 +282,11 @@ searchExpectSource src expected = do
282282 liftIO $
283283 value `shouldBe` expected
284284
285−atleast :: Vers.Version -> IO Bool
285+atleast :: SemVer.Version -> IO Bool
286286atleast v = getServerVersion >>= \x -> return $ x >= Just v
287287
288−atmost :: Vers.Version -> IO Bool
288+atmost :: SemVer.Version -> IO Bool
289289atmost v = getServerVersion >>= \x -> return $ x <= Just v
290290
291−is :: Vers.Version -> IO Bool
291+is :: SemVer.Version -> IO Bool
292292is v = getServerVersion >>= \x -> return $ x == Just v
tests/V5/Test/Documents.hs → tests/Test/Documents.hsrenamed

The content is the same.

tests/V5/Test/Generators.hs → tests/Test/Generators.hsrenamed+38−11
@@ -5,7 +5,7 @@
55
66module Test.Generators where
77
8−import Database.V5.Bloodhound
8+import Database.Bloodhound
99
1010import Test.Import
1111
@@ -14,7 +14,7 @@ import qualified Data.List as L
1414import qualified Data.List.NonEmpty as NE
1515import qualified Data.Map as M
1616import qualified Data.Text as T
17−import qualified Data.Version as Vers
17+import qualified Data.SemVer as SemVer
1818import Test.QuickCheck.TH.Generators
1919
2020import Test.ApproxEq
@@ -55,6 +55,7 @@ instance (Arbitrary a, Typeable a) => Arbitrary (Hit a) where
5555 <*> arbitrary
5656 <*> arbitraryScore
5757 <*> arbitrary
58+ <*> return Nothing
5859 <*> arbitrary
5960 <*> arbitrary
6061
@@ -183,7 +184,7 @@ instance Arbitrary Query where
183184
184185instance Arbitrary Filter where
185186 arbitrary =
186− Filter <$> arbitrary
187+ Filter <$> arbitrary
187188 shrink (Filter q) =
188189 Filter <$> shrink q
189190
@@ -210,14 +211,22 @@ instance Arbitrary NodeAttrName where
210211instance Arbitrary NodeAttrFilter where
211212 arbitrary = do
212213 n <- arbitrary
213− s:ss <- listOf1 (listOf1 arbitraryAlphaNum)
214− let ts = T.pack <$> s :| ss
214+ xs <- listOf1 (listOf1 arbitraryAlphaNum)
215+ let (s, ss) = unpackConsPartial xs
216+ ts = T.pack <$> s :| ss
215217 return (NodeAttrFilter n ts)
218+ where -- listOf1 means this shouldn't blow up.
219+ unpackConsPartial (x : xs) = (x, xs)
220+ unpackConsPartial _ = error "unpackConsPartial failed but shouldn't have"
216221
217222instance Arbitrary VersionNumber where
218− arbitrary = mk . fmap getPositive . getNonEmpty <$> arbitrary
223+ arbitrary = do
224+ major <- posInt
225+ minor <- posInt
226+ patch <- posInt
227+ return $ VersionNumber $ SemVer.version major minor patch [] []
219228 where
220− mk versions = VersionNumber (Vers.Version versions [])
229+ posInt = getPositive <$> arbitrary
221230
222231instance Arbitrary TemplateQueryKeyValuePairs where
223232 arbitrary = TemplateQueryKeyValuePairs . HM.fromList <$> arbitrary
@@ -435,15 +444,29 @@ makeArbitrary ''Language
435444instance Arbitrary Language where arbitrary = arbitraryLanguage
436445makeArbitrary ''Shingle
437446instance Arbitrary Shingle where arbitrary = arbitraryShingle
447+
448+makeArbitrary ''CharFilter
449+instance Arbitrary CharFilter where arbitrary = arbitraryCharFilter
438450makeArbitrary ''AnalyzerDefinition
439451instance Arbitrary AnalyzerDefinition where arbitrary = arbitraryAnalyzerDefinition
452+
453+-- TODO: This should have a proper generator that doesn't
454+-- create garbage that has to be filtered out.
455+instance Arbitrary CharFilterDefinition where
456+ arbitrary =
457+ oneof [ CharFilterDefinitionMapping
458+ . chomp <$> arbitrary
459+ , CharFilterDefinitionPatternReplace
460+ <$> arbitrary <*> arbitrary <*> arbitrary
461+ ]
462+ where chomp =
463+ M.map T.strip
464+ . M.mapKeys (T.replace "=>" "" . T.strip)
465+
440466makeArbitrary ''Analysis
441467instance Arbitrary Analysis where arbitrary = arbitraryAnalysis
442468makeArbitrary ''Tokenizer
443469instance Arbitrary Tokenizer where arbitrary = arbitraryTokenizer
444−makeArbitrary ''UpdatableIndexSetting
445−instance Arbitrary UpdatableIndexSetting where
446− arbitrary = arbitraryUpdatableIndexSetting
447470makeArbitrary ''Compression
448471instance Arbitrary Compression where arbitrary = arbitraryCompression
449472makeArbitrary ''Bytes
@@ -513,6 +536,10 @@ instance Arbitrary FactorMissingFieldValue where arbitrary = arbitraryFactorMiss
513536makeArbitrary ''FactorModifier
514537instance Arbitrary FactorModifier where arbitrary = arbitraryFactorModifier
515538
539+makeArbitrary ''UpdatableIndexSetting
540+instance Arbitrary UpdatableIndexSetting where
541+ arbitrary = resize 10 arbitraryUpdatableIndexSetting
542+
516543newtype UpdatableIndexSetting' =
517544 UpdatableIndexSetting' UpdatableIndexSetting
518545 deriving (Show, Eq, ToJSON, FromJSON, ApproxEq, Typeable)
@@ -533,4 +560,4 @@ instance Arbitrary UpdatableIndexSetting' where
533560 NE.fromList . L.nubBy sameAttrName . NE.toList
534561 sameAttrName a b =
535562 nodeAttrFilterName a == nodeAttrFilterName b
536− -- shrink (UpdatableIndexSetting' x) = map UpdatableIndexSetting' (shrink x)
563+ shrink (UpdatableIndexSetting' x) = map UpdatableIndexSetting' (shrink x)
tests/V5/Test/Highlights.hs → tests/Test/Highlights.hsrenamed

The content is the same.

tests/V5/Test/Import.hs → tests/Test/Import.hsrenamed+2−2
@@ -23,7 +23,7 @@ import Data.Text as X (Text)
2323import Data.Time.Calendar as X (Day(..), fromGregorian)
2424import Data.Time.Clock as X
2525import Data.Typeable as X
26−import Database.V5.Bloodhound as X hiding (key)
26+import Database.Bloodhound as X hiding (key)
2727import Lens.Micro as X
2828import Lens.Micro.Aeson as X
2929import Network.HTTP.Client as X hiding (Proxy, fileSize)
@@ -31,7 +31,7 @@ import System.IO.Temp as X
3131import System.PosixCompat.Files as X
3232import Test.Hspec as X
3333import Test.Hspec.QuickCheck as X (prop)
34−import Test.QuickCheck as X hiding (Result, Success)
34+import Test.QuickCheck as X hiding (Result, Success, isSuccess)
3535import Test.QuickCheck.Property.Monoid as X (T (..), eq, prop_Monoid)
3636import Text.Pretty.Simple as X (pPrint)
3737
tests/V5/Test/Indices.hs → tests/Test/Indices.hsrenamed+22−1
@@ -99,6 +99,9 @@ spec = do
9999 , "ex_filter_shingle"
100100 ]
101101 )
102+ (map CharFilter
103+ ["html_strip", "ex_mapping", "ex_pattern_replace"]
104+ )
102105 )
103106 )
104107 (M.singleton "ex_tokenizer"
@@ -113,7 +116,18 @@ spec = do
113116 , ("ex_filter_reverse",TokenFilterDefinitionReverse)
114117 , ("ex_filter_snowball",TokenFilterDefinitionSnowball English)
115118 , ("ex_filter_shingle",TokenFilterDefinitionShingle (Shingle 3 3 True False " " "_"))
116− ]
119+ , ("ex_filter_stemmer",TokenFilterDefinitionStemmer German)
120+ , ("ex_filter_stop1", TokenFilterDefinitionStop (Left French))
121+ , ("ex_filter_stop2",
122+ TokenFilterDefinitionStop
123+ (Right
124+ $ map StopWord ["a", "is", "the"]))
125+ ]
126+ )
127+ (M.fromList
128+ [ ("ex_mapping", CharFilterDefinitionMapping (M.singleton "١" "1"))
129+ , ("ex_pattern_replace", CharFilterDefinitionPatternReplace "(\\d+)-(?=\\d)" "$1_" Nothing)
130+ ]
117131 )
118132 updates = [AnalysisSetting analysis]
119133 createResp <- createIndexWith (updates ++ [NumberOfReplicas (ReplicaCount 0)]) 1 testIndex
@@ -150,3 +164,10 @@ spec = do
150164 _ <- createExampleIndex
151165 resp <- forceMergeIndex (IndexList (testIndex :| [])) defaultForceMergeIndexSettings
152166 liftIO $ validateStatus resp 200
167+
168+
169+ describe "Index flushing" $ do
170+ it "returns a successful response upon flushing" $ withTestEnv $ do
171+ _ <- createExampleIndex
172+ resp <- flushIndex testIndex
173+ liftIO $ validateStatus resp 200
tests/V5/Test/JSON.hs → tests/Test/JSON.hsrenamed

The content is the same.

tests/V5/Test/Query.hs → tests/Test/Query.hsrenamed+17
@@ -46,6 +46,15 @@ spec =
4646 liftIO $
4747 myTweet `shouldBe` Right exampleTweet
4848
49+ it "returns document for match query with fuzziness" $ withTestEnv $ do
50+ _ <- insertData
51+ let match = mkMatchQuery (FieldName "user") (QueryString "bidemyapp")
52+ let query = QueryMatchQuery $ match { matchQueryFuzziness = Just FuzzinessAuto }
53+ let search = mkSearch (Just query) Nothing
54+ myTweet <- searchTweet search
55+ liftIO $
56+ myTweet `shouldBe` Right exampleTweet
57+
4958 it "returns document for multi-match query" $ withTestEnv $ do
5059 _ <- insertData
5160 let flds = [FieldName "user", FieldName "message"]
@@ -113,3 +122,11 @@ spec =
113122 search = mkSearch (Just templateQuery) Nothing
114123 myTweet <- searchTweet search
115124 liftIO $ myTweet `shouldBe` Right exampleTweet
125+
126+ it "returns document for wildcard query" $ withTestEnv $ do
127+ _ <- insertData
128+ let query = QueryWildcardQuery $ WildcardQuery (FieldName "user") "bitemy*" (Nothing)
129+ let search = mkSearch (Just query) Nothing
130+ myTweet <- searchTweet search
131+ liftIO $
132+ myTweet `shouldBe` Right exampleTweet
tests/V5/Test/Script.hs → tests/Test/Script.hsrenamed

The content is the same.

tests/V5/Test/Snapshots.hs → tests/Test/Snapshots.hsrenamed

The content is the same.

tests/V5/Test/Sorting.hs → tests/Test/Sorting.hsrenamed+1−1
@@ -14,7 +14,7 @@ spec =
1414 let sortSpec = DefaultSortSpec $ mkSort (FieldName "age") Ascending
1515 let search = Search Nothing
1616 Nothing (Just [sortSpec]) Nothing Nothing
17− False (From 0) (Size 10) SearchTypeQueryThenFetch Nothing Nothing
17+ False (From 0) (Size 10) SearchTypeQueryThenFetch Nothing Nothing Nothing
1818 Nothing Nothing
1919 result <- searchTweets search
2020 let myTweet = grabFirst result
tests/V5/Test/SourceFiltering.hs → tests/Test/SourceFiltering.hsrenamed

The content is the same.

tests/V5/Test/Suggest.hs → tests/Test/Suggest.hsrenamed

The content is the same.

tests/V5/Test/Templates.hs → tests/Test/Templates.hsrenamed

The content is the same.

tests/V1/tests.hsdeleted−1967
@@ -1,1967 +0,0 @@
1−{-# LANGUAGE CPP #-}
2−{-# LANGUAGE DefaultSignatures #-}
3−{-# LANGUAGE DeriveDataTypeable #-}
4−{-# LANGUAGE DeriveGeneric #-}
5−{-# LANGUAGE FlexibleContexts #-}
6−{-# LANGUAGE GeneralizedNewtypeDeriving #-}
7−{-# LANGUAGE OverloadedStrings #-}
8−{-# LANGUAGE RecordWildCards #-}
9−{-# LANGUAGE ScopedTypeVariables #-}
10−{-# LANGUAGE TypeOperators #-}
11−{-# OPTIONS_GHC -fno-warn-orphans #-}
12−#if __GLASGOW_HASKELL__ < 800
13−{-# OPTIONS_GHC -fcontext-stack=100 #-}
14−#endif
15−#if __GLASGOW_HASKELL__ >= 802
16−{-# LANGUAGE MonoLocalBinds #-}
17−#endif
18−
19−module Main where
20−
21−import Control.Applicative
22−import Control.Error
23−import Control.Exception (evaluate)
24−import Control.Monad
25−import Control.Monad.Catch
26−import Control.Monad.Reader
27−import Data.Aeson
28−import Data.Aeson.Types (parseEither)
29−import qualified Data.ByteString.Lazy.Char8 as BL8
30−import qualified Data.HashMap.Strict as HM
31−import Data.List (nub)
32−import qualified Data.List as L
33−import Data.List.NonEmpty (NonEmpty (..))
34−import qualified Data.List.NonEmpty as NE
35−import qualified Data.Map.Strict as M
36−import Data.Monoid
37−import Data.Ord (comparing)
38−import Data.Proxy
39−import Data.Text (Text)
40−import qualified Data.Text as T
41−import Data.Time.Calendar (Day (..), fromGregorian)
42−import Data.Time.Clock (NominalDiffTime, UTCTime (..),
43− secondsToDiffTime)
44−import Data.Typeable
45−import qualified Data.Vector as V
46−import qualified Data.Version as Vers
47−import Database.V1.Bloodhound
48−import GHC.Generics as G
49−import Network.HTTP.Client hiding (Proxy)
50−import qualified Network.HTTP.Types.Method as NHTM
51−import qualified Network.HTTP.Types.Status as NHTS
52−import qualified Network.URI as URI
53−import Prelude hiding (filter)
54−import System.IO.Temp
55−import System.PosixCompat.Files
56−import Test.Hspec
57−import Test.QuickCheck.Property.Monoid (T (..), eq, prop_Monoid)
58−
59−import Test.Hspec.QuickCheck (prop)
60−import Test.QuickCheck
61−
62−import qualified Generics.SOP as SOP
63−import qualified Generics.SOP.GGP as SOP
64−
65−testServer :: Server
66−testServer = Server "http://localhost:9200"
67−testIndex :: IndexName
68−testIndex = IndexName "bloodhound-tests-twitter-1"
69−testMapping :: MappingName
70−testMapping = MappingName "tweet"
71−
72−withTestEnv :: BH IO a -> IO a
73−withTestEnv = withBH defaultManagerSettings testServer
74−
75−validateStatus :: Show body => Response body -> Int -> Expectation
76−validateStatus resp expected =
77− if actual == expected
78− then return ()
79− else expectationFailure ("Expected " <> show expected <> " but got " <> show actual <> ": " <> show body)
80− where
81− actual = NHTS.statusCode (responseStatus resp)
82− body = responseBody resp
83−
84−createExampleIndex :: (MonadBH m) => m Reply
85−createExampleIndex = createIndex (IndexSettings (ShardCount 1) (ReplicaCount 0)) testIndex
86−deleteExampleIndex :: (MonadBH m) => m Reply
87−deleteExampleIndex = deleteIndex testIndex
88−
89−es13 :: Vers.Version
90−es13 = Vers.Version [1, 3, 0] []
91−
92−es12 :: Vers.Version
93−es12 = Vers.Version [1, 2, 0] []
94−
95−es11 :: Vers.Version
96−es11 = Vers.Version [1, 1, 0] []
97−
98−es14 :: Vers.Version
99−es14 = Vers.Version [1, 4, 0] []
100−
101−es15 :: Vers.Version
102−es15 = Vers.Version [1, 5, 0] []
103−
104−es16 :: Vers.Version
105−es16 = Vers.Version [1, 6, 0] []
106−
107−es20 :: Vers.Version
108−es20 = Vers.Version [2, 0, 0] []
109−
110−getServerVersion :: IO (Maybe Vers.Version)
111−getServerVersion = fmap extractVersion <$> withTestEnv getStatus
112− where
113− extractVersion = versionNumber . number . version
114−
115−-- | Get configured repo paths for snapshotting. Note that by default
116−-- this is not enabled and if we are over es 1.5, we won't be able to
117−-- test snapshotting. Note that this can and should be part of the
118−-- client functionality in a much less ad-hoc incarnation.
119−getRepoPaths :: IO [FilePath]
120−getRepoPaths = withTestEnv $ do
121− bhe <- getBHEnv
122− let Server s = bhServer bhe
123− let tUrl = s <> "/" <> "_nodes"
124− initReq <- parseRequest (URI.escapeURIString URI.isAllowedInURI (T.unpack tUrl))
125− let req = setRequestIgnoreStatus $ initReq { method = NHTM.methodGet }
126− Right (Object o) <- parseEsResponse =<< liftIO (httpLbs req (bhManager bhe))
127− return $ fromMaybe mempty $ do
128− Object nodes <- HM.lookup "nodes" o
129− Object firstNode <- snd <$> headMay (HM.toList nodes)
130− Object settings <- HM.lookup "settings" firstNode
131− Object path <- HM.lookup "path" settings
132− Array repo <- HM.lookup "repo" path
133− return [ T.unpack t | String t <- V.toList repo]
134−
135−-- | 1.5 and earlier don't care about repo paths
136−canSnapshot :: IO Bool
137−canSnapshot = do
138− caresAboutRepos <- atleast es16
139− repoPaths <- getRepoPaths
140− return (not caresAboutRepos || not (null (repoPaths)))
141−
142−atleast :: Vers.Version -> IO Bool
143−atleast v = getServerVersion >>= \x -> return $ x >= Just v
144−
145−atmost :: Vers.Version -> IO Bool
146−atmost v = getServerVersion >>= \x -> return $ x <= Just v
147−
148−is :: Vers.Version -> IO Bool
149−is v = getServerVersion >>= \x -> return $ x == Just v
150−
151−when' :: Monad m => m Bool -> m () -> m ()
152−when' b f = b >>= \x -> when x f
153−
154−(==~) :: (ApproxEq a) => a -> a -> Property
155−a ==~ b = counterexample (showApproxEq a ++ " !=~ " ++ showApproxEq b) (a =~ b)
156−
157−propJSON :: forall a. (Arbitrary a, ToJSON a, FromJSON a, Show a, ApproxEq a, Typeable a) => Proxy a -> Spec
158−propJSON _ = prop testName $ \(a :: a) ->
159− let jsonStr = "via " <> BL8.unpack (encode a)
160− in counterexample jsonStr (parseEither parseJSON (toJSON a) ==~ Right a)
161− where testName = show ty <> " FromJSON/ToJSON roundtrips"
162− ty = typeOf (undefined :: a)
163−
164−data Location = Location { lat :: Double
165− , lon :: Double } deriving (Eq, Generic, Show)
166−
167−data Tweet = Tweet { user :: Text
168− , postDate :: UTCTime
169− , message :: Text
170− , age :: Int
171− , location :: Location
172− , extra :: Maybe Text }
173− deriving (Eq, Generic, Show)
174−
175−instance ToJSON Tweet where
176− toJSON = genericToJSON defaultOptions
177−instance FromJSON Tweet where
178− parseJSON = genericParseJSON defaultOptions
179−instance ToJSON Location where
180− toJSON = genericToJSON defaultOptions
181−instance FromJSON Location where
182− parseJSON = genericParseJSON defaultOptions
183−
184−data ParentMapping = ParentMapping deriving (Eq, Show)
185−
186−instance ToJSON ParentMapping where
187− toJSON ParentMapping =
188− object ["properties" .=
189− object [ "user" .= object ["type" .= ("string" :: Text)]
190− -- Serializing the date as a date is breaking other tests, mysteriously.
191− -- , "postDate" .= object [ "type" .= ("date" :: Text)
192− -- , "format" .= ("YYYY-MM-dd`T`HH:mm:ss.SSSZZ" :: Text)]
193− , "message" .= object ["type" .= ("string" :: Text)]
194− , "age" .= object ["type" .= ("integer" :: Text)]
195− , "location" .= object ["type" .= ("geo_point" :: Text)]
196− ]]
197−
198−data ChildMapping = ChildMapping deriving (Eq, Show)
199−
200−instance ToJSON ChildMapping where
201− toJSON ChildMapping =
202− object ["_parent" .= object ["type" .= ("parent" :: Text)]
203− , "properties" .=
204− object [ "user" .= object ["type" .= ("string" :: Text)]
205− -- Serializing the date as a date is breaking other tests, mysteriously.
206− -- , "postDate" .= object [ "type" .= ("date" :: Text)
207− -- , "format" .= ("YYYY-MM-dd`T`HH:mm:ss.SSSZZ" :: Text)]
208− , "message" .= object ["type" .= ("string" :: Text)]
209− , "age" .= object ["type" .= ("integer" :: Text)]
210− , "location" .= object ["type" .= ("geo_point" :: Text)]
211− ]]
212−
213−data TweetMapping = TweetMapping deriving (Eq, Show)
214−
215−instance ToJSON TweetMapping where
216− toJSON TweetMapping =
217− object ["properties" .=
218− object [ "user" .= object ["type" .= ("string" :: Text)]
219− -- Serializing the date as a date is breaking other tests, mysteriously.
220− -- , "postDate" .= object [ "type" .= ("date" :: Text)
221− -- , "format" .= ("YYYY-MM-dd`T`HH:mm:ss.SSSZZ" :: Text)]
222− , "message" .= object ["type" .= ("string" :: Text)]
223− , "age" .= object ["type" .= ("integer" :: Text)]
224− , "location" .= object ["type" .= ("geo_point" :: Text)]
225− ]]
226−
227−exampleTweet :: Tweet
228−exampleTweet = Tweet { user = "bitemyapp"
229− , postDate = UTCTime
230− (ModifiedJulianDay 55000)
231− (secondsToDiffTime 10)
232− , message = "Use haskell!"
233− , age = 10000
234− , location = Location 40.12 (-71.34)
235− , extra = Nothing }
236−
237−tweetWithExtra :: Tweet
238−tweetWithExtra = Tweet { user = "bitemyapp"
239− , postDate = UTCTime
240− (ModifiedJulianDay 55000)
241− (secondsToDiffTime 10)
242− , message = "Use haskell!"
243− , age = 10000
244− , location = Location 40.12 (-71.34)
245− , extra = Just "blah blah" }
246−
247−newAge :: Int
248−newAge = 31337
249−
250−newUser :: Text
251−newUser = "someotherapp"
252−
253−tweetPatch :: Value
254−tweetPatch =
255− object [ "age" .= newAge
256− , "user" .= newUser
257− ]
258−
259−patchedTweet :: Tweet
260−patchedTweet = exampleTweet{age = newAge, user = newUser}
261−
262−otherTweet :: Tweet
263−otherTweet = Tweet { user = "notmyapp"
264− , postDate = UTCTime
265− (ModifiedJulianDay 55000)
266− (secondsToDiffTime 11)
267− , message = "Use haskell!"
268− , age = 1000
269− , location = Location 40.12 (-71.34)
270− , extra = Nothing }
271−
272−resetIndex :: BH IO ()
273−resetIndex = do
274− _ <- deleteExampleIndex
275− _ <- createExampleIndex
276− _ <- putMapping testIndex testMapping TweetMapping
277− return ()
278−
279−insertData :: BH IO Reply
280−insertData = do
281− resetIndex
282− insertData' defaultIndexDocumentSettings
283−
284−insertData' :: IndexDocumentSettings -> BH IO Reply
285−insertData' ids = do
286− r <- indexDocument testIndex testMapping ids exampleTweet (DocId "1")
287− _ <- refreshIndex testIndex
288− return r
289−
290−updateData :: BH IO Reply
291−updateData = do
292− r <- updateDocument testIndex testMapping defaultIndexDocumentSettings tweetPatch (DocId "1")
293− _ <- refreshIndex testIndex
294− return r
295−
296−insertOther :: BH IO ()
297−insertOther = do
298− _ <- indexDocument testIndex testMapping defaultIndexDocumentSettings otherTweet (DocId "2")
299− _ <- refreshIndex testIndex
300− return ()
301−
302−insertExtra :: BH IO ()
303−insertExtra = do
304− _ <- indexDocument testIndex testMapping defaultIndexDocumentSettings tweetWithExtra (DocId "4")
305− _ <- refreshIndex testIndex
306− return ()
307−
308−insertWithSpaceInId :: BH IO ()
309−insertWithSpaceInId = do
310− _ <- indexDocument testIndex testMapping defaultIndexDocumentSettings exampleTweet (DocId "Hello World")
311− _ <- refreshIndex testIndex
312− return ()
313−
314−searchTweet :: Search -> BH IO (Either EsError Tweet)
315−searchTweet search = do
316− result <- searchTweets search
317− let myTweet :: Either EsError Tweet
318− myTweet = grabFirst result
319− return myTweet
320−
321−searchTweets :: Search -> BH IO (Either EsError (SearchResult Tweet))
322−searchTweets search = parseEsResponse =<< searchByIndex testIndex search
323−
324−searchExpectNoResults :: Search -> BH IO ()
325−searchExpectNoResults search = do
326− result <- searchTweets search
327− let emptyHits = fmap (hits . searchHits) result
328− liftIO $
329− emptyHits `shouldBe` Right []
330−
331−searchExpectAggs :: Search -> BH IO ()
332−searchExpectAggs search = do
333− reply <- searchByIndex testIndex search
334− let isEmpty x = return (M.null x)
335− let result = decode (responseBody reply) :: Maybe (SearchResult Tweet)
336− liftIO $
337− (result >>= aggregations >>= isEmpty) `shouldBe` Just False
338−
339−searchValidBucketAgg :: (BucketAggregation a, FromJSON a, Show a) =>
340− Search -> Text -> (Text -> AggregationResults -> Maybe (Bucket a)) -> BH IO ()
341−searchValidBucketAgg search aggKey extractor = do
342− reply <- searchByIndex testIndex search
343− let bucketDocs = docCount . head . buckets
344− let result = decode (responseBody reply) :: Maybe (SearchResult Tweet)
345− let count = result >>= aggregations >>= extractor aggKey >>= \x -> return (bucketDocs x)
346− liftIO $
347− count `shouldBe` Just 1
348−
349−searchTermsAggHint :: [ExecutionHint] -> BH IO ()
350−searchTermsAggHint hints = do
351− let terms hint = TermsAgg $ (mkTermsAggregation "user") { termExecutionHint = Just hint }
352− let search hint = mkAggregateSearch Nothing $ mkAggregations "users" $ terms hint
353− forM_ hints $ searchExpectAggs . search
354− forM_ hints (\x -> searchValidBucketAgg (search x) "users" toTerms)
355−
356−searchTweetHighlight :: Search -> BH IO (Either EsError (Maybe HitHighlight))
357−searchTweetHighlight search = do
358− result <- searchTweets search
359− let myHighlight = fmap (hitHighlight . head . hits . searchHits) result
360− return myHighlight
361−
362−searchExpectSource :: Source -> Either EsError Value -> BH IO ()
363−searchExpectSource src expected = do
364− _ <- insertData
365− let query = QueryMatchQuery $ mkMatchQuery (FieldName "_all") (QueryString "haskell")
366− let search = (mkSearch (Just query) Nothing) { source = Just src }
367− reply <- searchByIndex testIndex search
368− result <- parseEsResponse reply
369− let value = grabFirst result
370− liftIO $
371− value `shouldBe` expected
372−
373−withSnapshotRepo
374− :: ( MonadMask m
375− , MonadBH m
376− )
377− => SnapshotRepoName
378− -> (GenericSnapshotRepo -> m a)
379− -> m a
380−withSnapshotRepo srn@(SnapshotRepoName n) f = do
381− repoPaths <- liftIO getRepoPaths
382− -- we'll use the first repo path if available, otherwise system temp
383− -- dir. Note that this will fail on ES > 1.6, so be sure you use
384− -- @when' canSnapshot@.
385− case repoPaths of
386− (firstRepoPath:_) -> withTempDirectory firstRepoPath (T.unpack n) $ \dir -> bracket (alloc dir) free f
387− [] -> withSystemTempDirectory (T.unpack n) $ \dir -> bracket (alloc dir) free f
388− where
389− alloc dir = do
390− liftIO (setFileMode dir mode)
391− let repo = FsSnapshotRepo srn "bloodhound-tests-backups" True Nothing Nothing Nothing
392− resp <- updateSnapshotRepo defaultSnapshotRepoUpdateSettings repo
393− liftIO (validateStatus resp 200)
394− return (toGSnapshotRepo repo)
395− mode = ownerModes `unionFileModes` groupModes `unionFileModes` otherModes
396− free GenericSnapshotRepo {..} = do
397− resp <- deleteSnapshotRepo gSnapshotRepoName
398− liftIO (validateStatus resp 200)
399−
400−
401−withSnapshot
402− :: ( MonadMask m
403− , MonadBH m
404− )
405− => SnapshotRepoName
406− -> SnapshotName
407− -> m a
408− -> m a
409−withSnapshot srn sn = bracket_ alloc free
410− where
411− alloc = do
412− resp <- createSnapshot srn sn createSettings
413− liftIO (validateStatus resp 200)
414− -- We'll make this synchronous for testing purposes
415− createSettings = defaultSnapshotCreateSettings { snapWaitForCompletion = True
416− , snapIndices = Just (IndexList (testIndex :| []))
417− -- We don't actually need to back up any data
418− }
419− free = do
420− deleteSnapshot srn sn
421−
422−
423−
424−data BulkTest = BulkTest { name :: Text } deriving (Eq, Generic, Show)
425−instance FromJSON BulkTest where
426− parseJSON = genericParseJSON defaultOptions
427−instance ToJSON BulkTest where
428− toJSON = genericToJSON defaultOptions
429−
430−class GApproxEq f where
431− gApproxEq :: f a -> f a -> Bool
432−
433−-- | Unit type
434−instance GApproxEq U1 where
435− gApproxEq U1 U1 = True
436−
437−-- | Sum type, ensure same constructors, recurse
438−instance (GApproxEq a, GApproxEq b) => GApproxEq (a :+: b) where
439− gApproxEq (L1 a) (L1 b) = gApproxEq a b
440− gApproxEq (R1 a) (R1 b) = gApproxEq a b
441− gApproxEq _ _ = False
442−
443−-- | Product type, ensure each field is approx eq
444−instance (GApproxEq a, GApproxEq b) => GApproxEq (a :*: b) where
445− gApproxEq (a1 :*: b1) (a2 :*: b2) = gApproxEq a1 a2 && gApproxEq b1 b2
446−
447−-- | Value type, actually check the values for approx equality
448−instance (ApproxEq a) => GApproxEq (K1 i a) where
449− gApproxEq (K1 a) (K1 b) = a =~ b
450−
451−instance (GApproxEq f) => GApproxEq (M1 i t f) where
452− gApproxEq (M1 a) (M1 b) = gApproxEq a b
453−
454−-- | Typeclass for "equal where it matters". Use this to specify
455−-- less-strict equivalence for things such as lists that can wind up
456−-- in an unpredictable order
457−class ApproxEq a where
458− (=~) :: a -> a -> Bool
459− default (=~) :: (Generic a, GApproxEq (Rep a)) => a -> a -> Bool
460− a =~ b = gApproxEq (G.from a) (G.from b)
461−
462− showApproxEq :: a -> String
463− default showApproxEq :: (Show a) => a -> String
464− showApproxEq = show
465−
466−instance ApproxEq NominalDiffTime where (=~) = (==)
467−instance ApproxEq UTCTime where (=~) = (==)
468−instance ApproxEq Text where (=~) = (==)
469−instance ApproxEq Bool where (=~) = (==)
470−instance ApproxEq Int where (=~) = (==)
471−instance ApproxEq Double where (=~) = (==)
472−instance (ApproxEq a, Show a) => ApproxEq (NonEmpty a)
473−instance (ApproxEq a, Show a) => ApproxEq (Maybe a)
474−instance ApproxEq GeoPoint
475−instance ApproxEq Regexp
476−instance ApproxEq RangeValue
477−instance ApproxEq LessThan
478−instance ApproxEq LessThanEq
479−instance ApproxEq LessThanD
480−instance ApproxEq LessThanEqD
481−instance ApproxEq GreaterThan
482−instance ApproxEq GreaterThanEq
483−instance ApproxEq GreaterThanD
484−instance ApproxEq GreaterThanEqD
485−instance ApproxEq MinimumMatchHighLow
486−instance ApproxEq RegexpFlag
487−instance ApproxEq RegexpFlags
488−instance ApproxEq NullValue
489−instance ApproxEq Version
490−instance ApproxEq VersionNumber
491−instance ApproxEq DistanceRange
492−instance ApproxEq IndexName
493−instance ApproxEq MappingName
494−instance ApproxEq DocId
495−instance ApproxEq IndexAliasRouting
496−instance ApproxEq RoutingValue
497−instance ApproxEq ShardCount
498−instance ApproxEq ReplicaCount
499−instance ApproxEq TemplateName
500−instance ApproxEq TemplatePattern
501−instance ApproxEq QueryString
502−instance ApproxEq FieldName
503−instance ApproxEq CacheName
504−instance ApproxEq CacheKey
505−instance ApproxEq Existence
506−instance ApproxEq CutoffFrequency
507−instance ApproxEq Analyzer
508−instance ApproxEq Lenient
509−instance ApproxEq Tiebreaker
510−instance ApproxEq Boost
511−instance ApproxEq BoostTerms
512−instance ApproxEq MaxExpansions
513−instance ApproxEq MinimumMatch
514−instance ApproxEq DisableCoord
515−instance ApproxEq IgnoreTermFrequency
516−instance ApproxEq MinimumTermFrequency
517−instance ApproxEq MaxQueryTerms
518−instance ApproxEq Fuzziness
519−instance ApproxEq PrefixLength
520−instance ApproxEq TypeName
521−instance ApproxEq PercentMatch
522−instance ApproxEq StopWord
523−instance ApproxEq QueryPath
524−instance ApproxEq AllowLeadingWildcard
525−instance ApproxEq LowercaseExpanded
526−instance ApproxEq EnablePositionIncrements
527−instance ApproxEq AnalyzeWildcard
528−instance ApproxEq GeneratePhraseQueries
529−instance ApproxEq Locale
530−instance ApproxEq MaxWordLength
531−instance ApproxEq MinWordLength
532−instance ApproxEq PhraseSlop
533−instance ApproxEq MinDocFrequency
534−instance ApproxEq MaxDocFrequency
535−instance ApproxEq Filter
536−instance ApproxEq Query
537−instance ApproxEq SimpleQueryStringQuery
538−instance ApproxEq FieldOrFields
539−instance ApproxEq SimpleQueryFlag
540−instance ApproxEq RegexpQuery
541−instance ApproxEq QueryStringQuery
542−instance ApproxEq RangeQuery
543−instance ApproxEq PrefixQuery
544−instance ApproxEq NestedQuery
545−instance ApproxEq MoreLikeThisFieldQuery
546−instance ApproxEq MoreLikeThisQuery
547−instance ApproxEq IndicesQuery
548−instance ApproxEq HasParentQuery
549−instance ApproxEq HasChildQuery
550−instance ApproxEq FuzzyQuery
551−instance ApproxEq FuzzyLikeFieldQuery
552−instance ApproxEq FuzzyLikeThisQuery
553−instance ApproxEq FilteredQuery
554−instance ApproxEq DisMaxQuery
555−instance ApproxEq CommonTermsQuery
556−instance ApproxEq CommonMinimumMatch
557−instance ApproxEq BoostingQuery
558−instance ApproxEq BoolQuery
559−instance ApproxEq MatchQuery
560−instance ApproxEq MultiMatchQueryType
561−instance ApproxEq BooleanOperator
562−instance ApproxEq ZeroTermsQuery
563−instance ApproxEq MatchQueryType
564−instance ApproxEq AliasRouting
565−instance ApproxEq IndexAliasCreate
566−instance ApproxEq SearchAliasRouting
567−instance ApproxEq ScoreType
568−instance ApproxEq Distance
569−instance ApproxEq DistanceUnit
570−instance ApproxEq DistanceType
571−instance ApproxEq OptimizeBbox
572−instance ApproxEq GeoBoundingBoxConstraint
573−instance ApproxEq GeoFilterType
574−instance ApproxEq GeoBoundingBox
575−instance ApproxEq LatLon
576−instance ApproxEq RangeExecution
577−instance ApproxEq FSType
578−instance ApproxEq CompoundFormat
579−instance ApproxEq InitialShardCount
580−instance ApproxEq Bytes
581−instance ApproxEq ReplicaBounds
582−instance ApproxEq Term
583−instance ApproxEq BoolMatch
584−instance ApproxEq MultiMatchQuery
585−instance ApproxEq IndexSettings
586−instance ApproxEq AllocationPolicy
587−instance ApproxEq Char where
588− (=~) = (==)
589−instance ApproxEq Vers.Version where
590− (=~) = (==)
591−instance (ApproxEq a, Show a) => ApproxEq [a] where
592− as =~ bs = and (zipWith (=~) as bs)
593−instance (ApproxEq l, ApproxEq r) => ApproxEq (Either l r) where
594− Left a =~ Left b = a =~ b
595− Right a =~ Right b = a =~ b
596− _ =~ _ = False
597− showApproxEq (Left x) = "Left " <> showApproxEq x
598− showApproxEq (Right x) = "Right " <> showApproxEq x
599−instance ApproxEq NodeAttrFilter
600−instance ApproxEq NodeAttrName
601−instance ApproxEq BuildHash
602−instance ApproxEq TemplateQueryKeyValuePairs where
603− (=~) = (==)
604−instance ApproxEq TemplateQueryInline
605−instance ApproxEq Size
606−instance ApproxEq PhraseSuggesterHighlighter
607−instance ApproxEq PhraseSuggesterCollate
608−instance ApproxEq PhraseSuggester
609−instance ApproxEq SuggestType
610−instance ApproxEq Suggest
611−instance ApproxEq DirectGenerators
612−instance ApproxEq DirectGeneratorSuggestModeTypes
613−
614−-- | Due to the way nodeattrfilters get serialized here, they may come
615−-- out in a different order, but they are morally equivalent
616−instance ApproxEq UpdatableIndexSetting where
617− RoutingAllocationInclude a =~ RoutingAllocationInclude b =
618− NE.sort a =~ NE.sort b
619− RoutingAllocationExclude a =~ RoutingAllocationExclude b =
620− NE.sort a =~ NE.sort b
621− RoutingAllocationRequire a =~ RoutingAllocationRequire b =
622− NE.sort a =~ NE.sort b
623− a =~ b = a == b
624− showApproxEq (RoutingAllocationInclude xs) = show (RoutingAllocationInclude (NE.sort xs))
625− showApproxEq (RoutingAllocationExclude xs) = show (RoutingAllocationExclude (NE.sort xs))
626− showApproxEq (RoutingAllocationRequire xs) = show (RoutingAllocationRequire (NE.sort xs))
627− showApproxEq x = show x
628−
629−
630−noDuplicates :: Eq a => [a] -> Bool
631−noDuplicates xs = nub xs == xs
632−
633−instance Arbitrary NominalDiffTime where
634− arbitrary = fromInteger <$> arbitrary
635−
636−#if !MIN_VERSION_QuickCheck(2,8,0)
637−instance (Arbitrary k, Ord k, Arbitrary v) => Arbitrary (M.Map k v) where
638− arbitrary = M.fromList <$> arbitrary
639−#endif
640−
641−instance Arbitrary Text where
642− arbitrary = T.pack <$> arbitrary
643−
644−instance Arbitrary UTCTime where
645− arbitrary = UTCTime
646− <$> arbitrary
647− <*> (fromRational . toRational <$> choose (0::Double, 86400))
648−
649−instance Arbitrary Day where
650− arbitrary = ModifiedJulianDay <$> (2000 +) <$> arbitrary
651− shrink = (ModifiedJulianDay <$>) . shrink . toModifiedJulianDay
652−
653−#if !MIN_VERSION_QuickCheck(2,9,0)
654−instance Arbitrary a => Arbitrary (NonEmpty a) where
655− arbitrary = liftA2 (:|) arbitrary arbitrary
656−#endif
657−
658−arbitraryScore :: Gen Score
659−arbitraryScore = fmap getPositive <$> arbitrary
660−
661−instance (Arbitrary a, Typeable a) => Arbitrary (Hit a) where
662− arbitrary = Hit <$> arbitrary
663− <*> arbitrary
664− <*> arbitrary
665− <*> arbitraryScore
666− <*> arbitrary
667− <*> arbitrary
668− shrink = genericShrink
669−
670−
671−instance (Arbitrary a, Typeable a) => Arbitrary (SearchHits a) where
672− arbitrary = reduceSize $ do
673− tot <- getPositive <$> arbitrary
674− score <- arbitraryScore
675− hs <- arbitrary
676− return $ SearchHits tot score hs
677− shrink = genericShrink
678−
679−reduceSize :: Gen a -> Gen a
680−reduceSize f = sized $ \n -> resize (n `div` 2) f
681−
682−getSource :: EsResult a -> Maybe a
683−getSource = fmap _source . foundResult
684−
685−grabFirst :: Either EsError (SearchResult a) -> Either EsError a
686−grabFirst r =
687− case fmap (hitSource . head . hits . searchHits) r of
688− (Left e) -> Left e
689− (Right Nothing) -> Left (EsError 500 "Source was missing")
690− (Right (Just x)) -> Right x
691−
692−-------------------------------------------------------------------------------
693−arbitraryAlphaNum :: Gen Char
694−arbitraryAlphaNum = oneof [choose ('a', 'z')
695− ,choose ('A','Z')
696− , choose ('0', '9')]
697−
698−instance Arbitrary RoutingValue where
699− arbitrary = RoutingValue . T.pack <$> listOf1 arbitraryAlphaNum
700−
701−instance Arbitrary AliasRouting where
702− arbitrary = oneof [allAlias
703− ,one
704− ,theOther
705− ,both]
706− where one = GranularAliasRouting
707− <$> (Just <$> arbitrary)
708− <*> pure Nothing
709− theOther = GranularAliasRouting Nothing
710− <$> (Just <$> arbitrary)
711− both = GranularAliasRouting
712− <$> (Just <$> arbitrary)
713− <*> (Just <$> arbitrary)
714− allAlias = AllAliasRouting <$> arbitrary
715− shrink = genericShrink
716−
717−
718−instance Arbitrary FieldName where
719− arbitrary = FieldName . T.pack <$> listOf1 arbitraryAlphaNum
720− shrink = genericShrink
721−
722−
723−#if MIN_VERSION_base(4,10,0)
724−-- Test.QuickCheck.Modifiers
725−
726−qcNonEmptyToNonEmpty :: NonEmptyList a -> NonEmpty a
727−qcNonEmptyToNonEmpty (NonEmpty (a : xs)) = (a :| xs)
728−qcNonEmptyToNonEmpty (NonEmpty []) = error "NonEmpty was empty!"
729−
730−instance Arbitrary a => Arbitrary (NonEmpty a) where
731− arbitrary = qcNonEmptyToNonEmpty <$> arbitrary
732−#endif
733−
734−instance Arbitrary RegexpFlags where
735− arbitrary = oneof [ pure AllRegexpFlags
736− , pure NoRegexpFlags
737− , SomeRegexpFlags <$> genUniqueFlags
738− ]
739− where genUniqueFlags = NE.fromList . nub <$> listOf1 arbitrary
740− shrink = genericShrink
741−
742−
743−instance Arbitrary IndexAliasCreate where
744− arbitrary = IndexAliasCreate <$> arbitrary <*> reduceSize arbitrary
745− shrink = genericShrink
746−
747−instance Arbitrary Query where
748− arbitrary = reduceSize $ oneof [ TermQuery <$> arbitrary <*> arbitrary
749− , TermsQuery <$> arbitrary <*> arbitrary
750− , QueryMatchQuery <$> arbitrary
751− , QueryMultiMatchQuery <$> arbitrary
752− , QueryBoolQuery <$> arbitrary
753− , QueryBoostingQuery <$> arbitrary
754− , QueryCommonTermsQuery <$> arbitrary
755− , ConstantScoreFilter <$> arbitrary <*> arbitrary
756− , ConstantScoreQuery <$> arbitrary <*> arbitrary
757− , QueryDisMaxQuery <$> arbitrary
758− , QueryFilteredQuery <$> arbitrary
759− , QueryFuzzyLikeThisQuery <$> arbitrary
760− , QueryFuzzyLikeFieldQuery <$> arbitrary
761− , QueryFuzzyQuery <$> arbitrary
762− , QueryHasChildQuery <$> arbitrary
763− , QueryHasParentQuery <$> arbitrary
764− , IdsQuery <$> arbitrary <*> arbitrary
765− , QueryIndicesQuery <$> arbitrary
766− , MatchAllQuery <$> arbitrary
767− , QueryMoreLikeThisQuery <$> arbitrary
768− , QueryMoreLikeThisFieldQuery <$> arbitrary
769− , QueryNestedQuery <$> arbitrary
770− , QueryPrefixQuery <$> arbitrary
771− , QueryQueryStringQuery <$> arbitrary
772− , QuerySimpleQueryStringQuery <$> arbitrary
773− , QueryRangeQuery <$> arbitrary
774− , QueryRegexpQuery <$> arbitrary
775− , QueryTemplateQueryInline <$> arbitrary
776− ]
777− shrink = genericShrink
778−
779−instance Arbitrary Filter where
780− arbitrary = reduceSize $ oneof [ AndFilter <$> arbitrary <*> arbitrary
781− , OrFilter <$> arbitrary <*> arbitrary
782− , NotFilter <$> arbitrary <*> arbitrary
783− , pure IdentityFilter
784− , BoolFilter <$> arbitrary
785− , ExistsFilter <$> arbitrary
786− , GeoBoundingBoxFilter <$> arbitrary
787− , GeoDistanceFilter <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
788− , GeoDistanceRangeFilter <$> arbitrary <*> arbitrary
789− , GeoPolygonFilter <$> arbitrary <*> arbitrary
790− , IdsFilter <$> arbitrary <*> arbitrary
791− , LimitFilter <$> arbitrary
792− , MissingFilter <$> arbitrary <*> arbitrary <*> arbitrary
793− , PrefixFilter <$> arbitrary <*> arbitrary <*> arbitrary
794− , QueryFilter <$> arbitrary <*> arbitrary
795− , RangeFilter <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
796− , RegexpFilter <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
797− , TermFilter <$> arbitrary <*> arbitrary]
798− shrink = genericShrink
799−
800−instance Arbitrary ReplicaBounds where
801− arbitrary = oneof [ replicasBounded
802− , replicasLowerBounded
803− , pure ReplicasUnbounded
804− ]
805− where replicasBounded = do Positive a <- arbitrary
806− Positive b <- arbitrary
807− return (ReplicasBounded a b)
808− replicasLowerBounded = do Positive a <- arbitrary
809− return (ReplicasLowerBounded a)
810−
811−instance Arbitrary NodeAttrName where
812− arbitrary = NodeAttrName . T.pack <$> listOf1 arbitraryAlphaNum
813−
814−
815−instance Arbitrary NodeAttrFilter where
816− arbitrary = do
817− n <- arbitrary
818− s:ss <- listOf1 (listOf1 arbitraryAlphaNum)
819− let ts = T.pack <$> s :| ss
820− return (NodeAttrFilter n ts)
821− shrink = genericShrink
822−
823−instance Arbitrary VersionNumber where
824− arbitrary = mk . fmap getPositive . getNonEmpty <$> arbitrary
825− where
826− mk versions = VersionNumber (Vers.Version versions [])
827−
828−instance Arbitrary TemplateQueryKeyValuePairs where
829− arbitrary = TemplateQueryKeyValuePairs . HM.fromList <$> arbitrary
830− shrink (TemplateQueryKeyValuePairs x) = map (TemplateQueryKeyValuePairs . HM.fromList) . shrink $ HM.toList x
831−
832−instance Arbitrary IndexName where arbitrary = sopArbitrary; shrink = genericShrink
833−instance Arbitrary MappingName where arbitrary = sopArbitrary; shrink = genericShrink
834−instance Arbitrary DocId where arbitrary = sopArbitrary; shrink = genericShrink
835−instance Arbitrary Version where arbitrary = sopArbitrary; shrink = genericShrink
836−instance Arbitrary BuildHash where arbitrary = sopArbitrary; shrink = genericShrink
837−instance Arbitrary IndexAliasRouting where arbitrary = sopArbitrary; shrink = genericShrink
838−instance Arbitrary ShardCount where arbitrary = sopArbitrary; shrink = genericShrink
839−instance Arbitrary ReplicaCount where arbitrary = sopArbitrary; shrink = genericShrink
840−instance Arbitrary TemplateName where arbitrary = sopArbitrary; shrink = genericShrink
841−instance Arbitrary TemplatePattern where arbitrary = sopArbitrary; shrink = genericShrink
842−instance Arbitrary QueryString where arbitrary = sopArbitrary; shrink = genericShrink
843−instance Arbitrary CacheName where arbitrary = sopArbitrary; shrink = genericShrink
844−instance Arbitrary CacheKey where arbitrary = sopArbitrary; shrink = genericShrink
845−instance Arbitrary Existence where arbitrary = sopArbitrary; shrink = genericShrink
846−instance Arbitrary CutoffFrequency where arbitrary = sopArbitrary; shrink = genericShrink
847−instance Arbitrary Analyzer where arbitrary = sopArbitrary; shrink = genericShrink
848−instance Arbitrary MaxExpansions where arbitrary = sopArbitrary; shrink = genericShrink
849−instance Arbitrary Lenient where arbitrary = sopArbitrary; shrink = genericShrink
850−instance Arbitrary Tiebreaker where arbitrary = sopArbitrary; shrink = genericShrink
851−instance Arbitrary Boost where arbitrary = sopArbitrary; shrink = genericShrink
852−instance Arbitrary BoostTerms where arbitrary = sopArbitrary; shrink = genericShrink
853−instance Arbitrary MinimumMatch where arbitrary = sopArbitrary; shrink = genericShrink
854−instance Arbitrary DisableCoord where arbitrary = sopArbitrary; shrink = genericShrink
855−instance Arbitrary IgnoreTermFrequency where arbitrary = sopArbitrary; shrink = genericShrink
856−instance Arbitrary MinimumTermFrequency where arbitrary = sopArbitrary; shrink = genericShrink
857−instance Arbitrary MaxQueryTerms where arbitrary = sopArbitrary; shrink = genericShrink
858−instance Arbitrary Fuzziness where arbitrary = sopArbitrary; shrink = genericShrink
859−instance Arbitrary PrefixLength where arbitrary = sopArbitrary; shrink = genericShrink
860−instance Arbitrary TypeName where arbitrary = sopArbitrary; shrink = genericShrink
861−instance Arbitrary PercentMatch where arbitrary = sopArbitrary; shrink = genericShrink
862−instance Arbitrary StopWord where arbitrary = sopArbitrary; shrink = genericShrink
863−instance Arbitrary QueryPath where arbitrary = sopArbitrary; shrink = genericShrink
864−instance Arbitrary AllowLeadingWildcard where arbitrary = sopArbitrary; shrink = genericShrink
865−instance Arbitrary LowercaseExpanded where arbitrary = sopArbitrary; shrink = genericShrink
866−instance Arbitrary EnablePositionIncrements where arbitrary = sopArbitrary; shrink = genericShrink
867−instance Arbitrary AnalyzeWildcard where arbitrary = sopArbitrary; shrink = genericShrink
868−instance Arbitrary GeneratePhraseQueries where arbitrary = sopArbitrary; shrink = genericShrink
869−instance Arbitrary Locale where arbitrary = sopArbitrary; shrink = genericShrink
870−instance Arbitrary MaxWordLength where arbitrary = sopArbitrary; shrink = genericShrink
871−instance Arbitrary MinWordLength where arbitrary = sopArbitrary; shrink = genericShrink
872−instance Arbitrary PhraseSlop where arbitrary = sopArbitrary; shrink = genericShrink
873−instance Arbitrary MinDocFrequency where arbitrary = sopArbitrary; shrink = genericShrink
874−instance Arbitrary MaxDocFrequency where arbitrary = sopArbitrary; shrink = genericShrink
875−instance Arbitrary Regexp where arbitrary = sopArbitrary; shrink = genericShrink
876−instance Arbitrary SimpleQueryStringQuery where arbitrary = sopArbitrary; shrink = genericShrink
877−instance Arbitrary FieldOrFields where arbitrary = sopArbitrary; shrink = genericShrink
878−instance Arbitrary SimpleQueryFlag where arbitrary = sopArbitrary; shrink = genericShrink
879−instance Arbitrary RegexpQuery where arbitrary = sopArbitrary; shrink = genericShrink
880−instance Arbitrary QueryStringQuery where arbitrary = sopArbitrary; shrink = genericShrink
881−instance Arbitrary RangeQuery where arbitrary = sopArbitrary; shrink = genericShrink
882−instance Arbitrary RangeValue where arbitrary = sopArbitrary; shrink = genericShrink
883−instance Arbitrary PrefixQuery where arbitrary = sopArbitrary; shrink = genericShrink
884−instance Arbitrary NestedQuery where arbitrary = sopArbitrary; shrink = genericShrink
885−instance Arbitrary MoreLikeThisFieldQuery where arbitrary = sopArbitrary; shrink = genericShrink
886−instance Arbitrary MoreLikeThisQuery where arbitrary = sopArbitrary; shrink = genericShrink
887−instance Arbitrary IndicesQuery where arbitrary = sopArbitrary; shrink = genericShrink
888−instance Arbitrary HasParentQuery where arbitrary = sopArbitrary; shrink = genericShrink
889−instance Arbitrary HasChildQuery where arbitrary = sopArbitrary; shrink = genericShrink
890−instance Arbitrary FuzzyQuery where arbitrary = sopArbitrary; shrink = genericShrink
891−instance Arbitrary FuzzyLikeFieldQuery where arbitrary = sopArbitrary; shrink = genericShrink
892−instance Arbitrary FuzzyLikeThisQuery where arbitrary = sopArbitrary; shrink = genericShrink
893−instance Arbitrary FilteredQuery where arbitrary = sopArbitrary; shrink = genericShrink
894−instance Arbitrary DisMaxQuery where arbitrary = sopArbitrary; shrink = genericShrink
895−instance Arbitrary CommonTermsQuery where arbitrary = sopArbitrary; shrink = genericShrink
896−instance Arbitrary DistanceRange where arbitrary = sopArbitrary; shrink = genericShrink
897−instance Arbitrary MultiMatchQuery where arbitrary = sopArbitrary; shrink = genericShrink
898−instance Arbitrary LessThanD where arbitrary = sopArbitrary; shrink = genericShrink
899−instance Arbitrary LessThanEqD where arbitrary = sopArbitrary; shrink = genericShrink
900−instance Arbitrary GreaterThanD where arbitrary = sopArbitrary; shrink = genericShrink
901−instance Arbitrary GreaterThanEqD where arbitrary = sopArbitrary; shrink = genericShrink
902−instance Arbitrary LessThan where arbitrary = sopArbitrary; shrink = genericShrink
903−instance Arbitrary LessThanEq where arbitrary = sopArbitrary; shrink = genericShrink
904−instance Arbitrary GreaterThan where arbitrary = sopArbitrary; shrink = genericShrink
905−instance Arbitrary GreaterThanEq where arbitrary = sopArbitrary; shrink = genericShrink
906−instance Arbitrary GeoPoint where
907− arbitrary = GeoPoint <$> (arbitrary `suchThat` reasonableFieldName) <*> arbitrary
908− where
909− -- These are problematic for geopoint for obvious reasons
910− reasonableFieldName (FieldName "from") = False
911− reasonableFieldName (FieldName "to") = False
912− reasonableFieldName _ = True
913− shrink = genericShrink
914−instance Arbitrary NullValue where arbitrary = sopArbitrary; shrink = genericShrink
915−instance Arbitrary MinimumMatchHighLow where arbitrary = sopArbitrary; shrink = genericShrink
916−instance Arbitrary CommonMinimumMatch where arbitrary = sopArbitrary; shrink = genericShrink
917−instance Arbitrary BoostingQuery where arbitrary = sopArbitrary; shrink = genericShrink
918−instance Arbitrary BoolQuery where arbitrary = sopArbitrary; shrink = genericShrink
919−instance Arbitrary MatchQuery where arbitrary = sopArbitrary; shrink = genericShrink
920−instance Arbitrary MultiMatchQueryType where arbitrary = sopArbitrary; shrink = genericShrink
921−instance Arbitrary BooleanOperator where arbitrary = sopArbitrary; shrink = genericShrink
922−instance Arbitrary ZeroTermsQuery where arbitrary = sopArbitrary; shrink = genericShrink
923−instance Arbitrary MatchQueryType where arbitrary = sopArbitrary; shrink = genericShrink
924−instance Arbitrary SearchAliasRouting where arbitrary = sopArbitrary; shrink = genericShrink
925−instance Arbitrary ScoreType where arbitrary = sopArbitrary; shrink = genericShrink
926−instance Arbitrary Distance where arbitrary = sopArbitrary; shrink = genericShrink
927−instance Arbitrary DistanceUnit where arbitrary = sopArbitrary; shrink = genericShrink
928−instance Arbitrary DistanceType where arbitrary = sopArbitrary; shrink = genericShrink
929−instance Arbitrary OptimizeBbox where arbitrary = sopArbitrary; shrink = genericShrink
930−instance Arbitrary GeoBoundingBoxConstraint where arbitrary = sopArbitrary; shrink = genericShrink
931−instance Arbitrary GeoFilterType where arbitrary = sopArbitrary; shrink = genericShrink
932−instance Arbitrary GeoBoundingBox where arbitrary = sopArbitrary; shrink = genericShrink
933−instance Arbitrary LatLon where arbitrary = sopArbitrary; shrink = genericShrink
934−instance Arbitrary RangeExecution where arbitrary = sopArbitrary; shrink = genericShrink
935−instance Arbitrary RegexpFlag where arbitrary = sopArbitrary; shrink = genericShrink
936−instance Arbitrary BoolMatch where arbitrary = sopArbitrary; shrink = genericShrink
937−instance Arbitrary Term where arbitrary = sopArbitrary; shrink = genericShrink
938−instance Arbitrary IndexSettings where arbitrary = sopArbitrary; shrink = genericShrink
939−instance Arbitrary UpdatableIndexSetting where arbitrary = sopArbitrary; shrink = genericShrink
940−instance Arbitrary Bytes where arbitrary = sopArbitrary; shrink = genericShrink
941−instance Arbitrary AllocationPolicy where arbitrary = sopArbitrary; shrink = genericShrink
942−instance Arbitrary InitialShardCount where arbitrary = sopArbitrary; shrink = genericShrink
943−instance Arbitrary FSType where arbitrary = sopArbitrary; shrink = genericShrink
944−instance Arbitrary CompoundFormat where arbitrary = sopArbitrary; shrink = genericShrink
945−instance Arbitrary FsSnapshotRepo where arbitrary = sopArbitrary; shrink = genericShrink
946−instance Arbitrary SnapshotRepoName where arbitrary = sopArbitrary; shrink = genericShrink
947−instance Arbitrary TemplateQueryInline where arbitrary = sopArbitrary; shrink = genericShrink
948−instance Arbitrary PhraseSuggesterCollate where arbitrary = sopArbitrary; shrink = genericShrink
949−instance Arbitrary PhraseSuggesterHighlighter where arbitrary = sopArbitrary; shrink = genericShrink
950−instance Arbitrary Size where arbitrary = sopArbitrary; shrink = genericShrink
951−instance Arbitrary PhraseSuggester where arbitrary = sopArbitrary; shrink = genericShrink
952−instance Arbitrary SuggestType where arbitrary = sopArbitrary; shrink = genericShrink
953−instance Arbitrary Suggest where arbitrary = sopArbitrary; shrink = genericShrink
954−instance Arbitrary DirectGenerators where arbitrary = sopArbitrary; shrink = genericShrink
955−instance Arbitrary DirectGeneratorSuggestModeTypes where arbitrary = sopArbitrary; shrink = genericShrink
956−
957−newtype UpdatableIndexSetting' = UpdatableIndexSetting' UpdatableIndexSetting
958− deriving (Show, Eq, ToJSON, FromJSON, ApproxEq, Typeable)
959−
960−instance Arbitrary UpdatableIndexSetting' where
961− arbitrary = do
962− settings <- arbitrary
963− return $ UpdatableIndexSetting' $ case settings of
964− RoutingAllocationInclude xs -> RoutingAllocationInclude (dropDuplicateAttrNames xs)
965− RoutingAllocationExclude xs -> RoutingAllocationExclude (dropDuplicateAttrNames xs)
966− RoutingAllocationRequire xs -> RoutingAllocationRequire (dropDuplicateAttrNames xs)
967− x -> x
968− where
969− dropDuplicateAttrNames = NE.fromList . L.nubBy sameAttrName . NE.toList
970− sameAttrName a b = nodeAttrFilterName a == nodeAttrFilterName b
971−
972−main :: IO ()
973−main = hspec $ do
974−
975− describe "index create/delete API" $ do
976− it "creates and then deletes the requested index" $ withTestEnv $ do
977− -- priming state.
978− _ <- deleteExampleIndex
979− resp <- createExampleIndex
980− deleteResp <- deleteExampleIndex
981− liftIO $ do
982− validateStatus resp 200
983− validateStatus deleteResp 200
984−
985− describe "error parsing" $ do
986− it "can parse EsErrors for < 2.0" $ when' (atmost es16) $ withTestEnv $ do
987− res <- getDocument (IndexName "bogus") (MappingName "also_bogus") (DocId "bogus_as_well")
988− let errorResp = eitherDecode (responseBody res)
989− liftIO (errorResp `shouldBe` Right (EsError 404 "IndexMissingException[[bogus] missing]"))
990−
991− it "can parse EsErrors for >= 2.0" $ when' (atleast es20) $ withTestEnv $ do
992− res <- getDocument (IndexName "bogus") (MappingName "also_bogus") (DocId "bogus_as_well")
993− let errorResp = eitherDecode (responseBody res)
994− liftIO (errorResp `shouldBe` Right (EsError 404 "no such index"))
995−
996− describe "document API" $ do
997− it "indexes, updates, gets, and then deletes the generated document" $ withTestEnv $ do
998− _ <- insertData
999− _ <- updateData
1000− docInserted <- getDocument testIndex testMapping (DocId "1")
1001− let newTweet = eitherDecode
1002− (responseBody docInserted) :: Either String (EsResult Tweet)
1003− liftIO $ (fmap getSource newTweet `shouldBe` Right (Just patchedTweet))
1004−
1005− it "indexes, gets, and then deletes the generated document with a DocId containing a space" $ withTestEnv $ do
1006− _ <- insertWithSpaceInId
1007− docInserted <- getDocument testIndex testMapping (DocId "Hello World")
1008− let newTweet = eitherDecode
1009− (responseBody docInserted) :: Either String (EsResult Tweet)
1010− liftIO $ (fmap getSource newTweet `shouldBe` Right (Just exampleTweet))
1011−
1012− it "produces a parseable result when looking up a bogus document" $ withTestEnv $ do
1013− doc <- getDocument testIndex testMapping (DocId "bogus")
1014− let noTweet = eitherDecode
1015− (responseBody doc) :: Either String (EsResult Tweet)
1016− liftIO $ fmap foundResult noTweet `shouldBe` Right Nothing
1017−
1018− it "can use optimistic concurrency control" $ withTestEnv $ do
1019− let ev = ExternalDocVersion minBound
1020− let cfg = defaultIndexDocumentSettings { idsVersionControl = ExternalGT ev }
1021− resetIndex
1022− res <- insertData' cfg
1023− liftIO $ isCreated res `shouldBe` True
1024− res' <- insertData' cfg
1025− liftIO $ isVersionConflict res' `shouldBe` True
1026−
1027− it "indexes two documents in a parent/child relationship and checks that the child exists" $ withTestEnv $ do
1028− resetIndex
1029− _ <- putMapping testIndex (MappingName "child") ChildMapping
1030− _ <- putMapping testIndex (MappingName "parent") ParentMapping
1031− _ <- indexDocument testIndex (MappingName "parent") defaultIndexDocumentSettings exampleTweet (DocId "1")
1032− let parent = (Just . DocumentParent . DocId) "1"
1033− ids = IndexDocumentSettings NoVersionControl parent
1034− _ <- indexDocument testIndex (MappingName "child") ids otherTweet (DocId "2")
1035− _ <- refreshIndex testIndex
1036− exists <- documentExists testIndex (MappingName "child") parent (DocId "2")
1037− liftIO $ exists `shouldBe` True
1038−
1039− describe "template API" $ do
1040− it "can create a template" $ withTestEnv $ do
1041− let idxTpl = IndexTemplate (TemplatePattern "tweet-*") (Just (IndexSettings (ShardCount 1) (ReplicaCount 1))) [toJSON TweetMapping]
1042− resp <- putTemplate idxTpl (TemplateName "tweet-tpl")
1043− liftIO $ validateStatus resp 200
1044−
1045− it "can detect if a template exists" $ withTestEnv $ do
1046− exists <- templateExists (TemplateName "tweet-tpl")
1047− liftIO $ exists `shouldBe` True
1048−
1049− it "can delete a template" $ withTestEnv $ do
1050− resp <- deleteTemplate (TemplateName "tweet-tpl")
1051− liftIO $ validateStatus resp 200
1052−
1053− it "can detect if a template doesn't exist" $ withTestEnv $ do
1054− exists <- templateExists (TemplateName "tweet-tpl")
1055− liftIO $ exists `shouldBe` False
1056−
1057− describe "bulk API" $ do
1058− it "inserts all documents we request" $ withTestEnv $ do
1059− _ <- insertData
1060− let firstTest = BulkTest "blah"
1061− let secondTest = BulkTest "bloo"
1062− let firstDoc = BulkIndex testIndex
1063− testMapping (DocId "2") (toJSON firstTest)
1064− let secondDoc = BulkCreate testIndex
1065− testMapping (DocId "3") (toJSON secondTest)
1066− let stream = V.fromList [firstDoc, secondDoc]
1067− _ <- bulk stream
1068− _ <- refreshIndex testIndex
1069− fDoc <- getDocument testIndex testMapping (DocId "2")
1070− sDoc <- getDocument testIndex testMapping (DocId "3")
1071− let maybeFirst = eitherDecode $ responseBody fDoc :: Either String (EsResult BulkTest)
1072− let maybeSecond = eitherDecode $ responseBody sDoc :: Either String (EsResult BulkTest)
1073− liftIO $ do
1074− fmap getSource maybeFirst `shouldBe` Right (Just firstTest)
1075− fmap getSource maybeSecond `shouldBe` Right (Just secondTest)
1076−
1077−
1078− describe "query API" $ do
1079− it "returns document for term query and identity filter" $ withTestEnv $ do
1080− _ <- insertData
1081− let query = TermQuery (Term "user" "bitemyapp") Nothing
1082− let filter = IdentityFilter <&&> IdentityFilter
1083− let search = mkSearch (Just query) (Just filter)
1084− myTweet <- searchTweet search
1085− liftIO $
1086− myTweet `shouldBe` Right exampleTweet
1087−
1088− it "handles constant score queries" $ withTestEnv $ do
1089− _ <- insertData
1090− let query = TermsQuery "user" ("bitemyapp" :| [])
1091− let cfQuery = ConstantScoreQuery query (Boost 1.0)
1092− let filter = IdentityFilter
1093− let search = mkSearch (Just cfQuery) (Just filter)
1094− myTweet <- searchTweet search
1095− liftIO $
1096− myTweet `shouldBe` Right exampleTweet
1097− it "handles constant score filters" $ withTestEnv $ do
1098− _ <- insertData
1099− let query = TermsQuery "user" ("bitemyapp" :| [])
1100− let cfFilter = ConstantScoreFilter IdentityFilter (Boost 1.0)
1101− let boolQuery = mkBoolQuery [query, cfFilter] [] []
1102− let search = mkSearch (Just (QueryBoolQuery boolQuery)) Nothing
1103− myTweet <- searchTweet search
1104− liftIO $
1105− myTweet `shouldBe` Right exampleTweet
1106−
1107−
1108− it "returns document for terms query and identity filter" $ withTestEnv $ do
1109− _ <- insertData
1110− let query = TermsQuery "user" ("bitemyapp" :| [])
1111− let filter = IdentityFilter <&&> IdentityFilter
1112− let search = mkSearch (Just query) (Just filter)
1113− myTweet <- searchTweet search
1114− liftIO $
1115− myTweet `shouldBe` Right exampleTweet
1116−
1117− it "returns document for match query" $ withTestEnv $ do
1118− _ <- insertData
1119− let query = QueryMatchQuery $ mkMatchQuery (FieldName "user") (QueryString "bitemyapp")
1120− let search = mkSearch (Just query) Nothing
1121− myTweet <- searchTweet search
1122− liftIO $
1123− myTweet `shouldBe` Right exampleTweet
1124−
1125− it "returns document for multi-match query" $ withTestEnv $ do
1126− _ <- insertData
1127− let flds = [FieldName "user", FieldName "message"]
1128− let query = QueryMultiMatchQuery $ mkMultiMatchQuery flds (QueryString "bitemyapp")
1129− let search = mkSearch (Just query) Nothing
1130− myTweet <- searchTweet search
1131− liftIO $
1132− myTweet `shouldBe` Right exampleTweet
1133−
1134− it "returns document for multi-match query with a custom tiebreaker" $ withTestEnv $ do
1135− _ <- insertData
1136− let tiebreaker = Just $ Tiebreaker 0.3
1137− flds = [FieldName "user", FieldName "message"]
1138− multiQuery' = mkMultiMatchQuery flds (QueryString "bitemyapp")
1139− query = QueryMultiMatchQuery $ multiQuery' { multiMatchQueryTiebreaker = tiebreaker }
1140− search = mkSearch (Just query) Nothing
1141− myTweet <- searchTweet search
1142− liftIO $
1143− myTweet `shouldBe` Right exampleTweet
1144−
1145− it "returns document for bool query" $ withTestEnv $ do
1146− _ <- insertData
1147− let innerQuery = QueryMatchQuery $
1148− mkMatchQuery (FieldName "user") (QueryString "bitemyapp")
1149− let query = QueryBoolQuery $
1150− mkBoolQuery [innerQuery] [] []
1151− let search = mkSearch (Just query) Nothing
1152− myTweet <- searchTweet search
1153− liftIO $
1154− myTweet `shouldBe` Right exampleTweet
1155−
1156− it "returns document for boosting query" $ withTestEnv $ do
1157− _ <- insertData
1158− let posQuery = QueryMatchQuery $ mkMatchQuery (FieldName "user") (QueryString "bitemyapp")
1159− let negQuery = QueryMatchQuery $ mkMatchQuery (FieldName "user") (QueryString "notmyapp")
1160− let query = QueryBoostingQuery $ BoostingQuery posQuery negQuery (Boost 0.2)
1161− let search = mkSearch (Just query) Nothing
1162− myTweet <- searchTweet search
1163− liftIO $
1164− myTweet `shouldBe` Right exampleTweet
1165−
1166− it "returns document for common terms query" $ withTestEnv $ do
1167− _ <- insertData
1168− let query = QueryCommonTermsQuery $
1169− CommonTermsQuery (FieldName "user")
1170− (QueryString "bitemyapp")
1171− (CutoffFrequency 0.0001)
1172− Or Or Nothing Nothing Nothing Nothing
1173− let search = mkSearch (Just query) Nothing
1174− myTweet <- searchTweet search
1175− liftIO $
1176− myTweet `shouldBe` Right exampleTweet
1177−
1178− it "returns document for for inline template query" $ withTestEnv $ do
1179− _ <- insertData
1180− let innerQuery = QueryMatchQuery $
1181− mkMatchQuery (FieldName "{{userKey}}")
1182− (QueryString "{{bitemyappKey}}")
1183− templateParams = TemplateQueryKeyValuePairs $ HM.fromList
1184− [ ("userKey", "user")
1185− , ("bitemyappKey", "bitemyapp")
1186− ]
1187− templateQuery = QueryTemplateQueryInline $
1188− TemplateQueryInline innerQuery templateParams
1189− search = mkSearch (Just templateQuery) Nothing
1190− myTweet <- searchTweet search
1191− liftIO $ myTweet `shouldBe` Right exampleTweet
1192−
1193−
1194− describe "sorting" $ do
1195− it "returns documents in the right order" $ withTestEnv $ do
1196− _ <- insertData
1197− _ <- insertOther
1198− let sortSpec = DefaultSortSpec $ mkSort (FieldName "age") Ascending
1199− let search = Search Nothing
1200− (Just IdentityFilter) (Just [sortSpec]) Nothing Nothing
1201− False (From 0) (Size 10) SearchTypeQueryThenFetch Nothing Nothing
1202− Nothing
1203− result <- searchTweets search
1204− let myTweet = grabFirst result
1205− liftIO $
1206− myTweet `shouldBe` Right otherTweet
1207−
1208−
1209− describe "filtering API" $ do
1210− it "returns document for composed boolmatch and identity" $ withTestEnv $ do
1211− _ <- insertData
1212− let queryFilter = BoolFilter (MustMatch (Term "user" "bitemyapp") False)
1213− <&&> IdentityFilter
1214− let search = mkSearch Nothing (Just queryFilter)
1215− myTweet <- searchTweet search
1216− liftIO $
1217− myTweet `shouldBe` Right exampleTweet
1218−
1219− it "returns document for term filter" $ withTestEnv $ do
1220− _ <- insertData
1221− let termFilter = TermFilter (Term "user" "bitemyapp") False
1222− let search = mkSearch Nothing (Just termFilter)
1223− myTweet <- searchTweet search
1224− liftIO $
1225− myTweet `shouldBe` Right exampleTweet
1226−
1227− it "returns document for existential filter" $ withTestEnv $ do
1228− _ <- insertData
1229− let search = mkSearch Nothing (Just (ExistsFilter (FieldName "user")))
1230− myTweet <- searchTweet search
1231− liftIO $
1232− myTweet `shouldBe` Right exampleTweet
1233−
1234− it "returns document for geo boundingbox filter" $ withTestEnv $ do
1235− _ <- insertData
1236− let box = GeoBoundingBox (LatLon 40.73 (-74.1)) (LatLon 40.10 (-71.12))
1237− let bbConstraint = GeoBoundingBoxConstraint (FieldName "tweet.location") box False GeoFilterMemory
1238− let geoFilter = GeoBoundingBoxFilter bbConstraint
1239− let search = mkSearch Nothing (Just geoFilter)
1240− myTweet <- searchTweet search
1241− liftIO $
1242− myTweet `shouldBe` Right exampleTweet
1243−
1244− it "doesn't return document for nonsensical boundingbox filter" $ withTestEnv $ do
1245− _ <- insertData
1246− let box = GeoBoundingBox (LatLon 0.73 (-4.1)) (LatLon 0.10 (-1.12))
1247− let bbConstraint = GeoBoundingBoxConstraint (FieldName "tweet.location") box False GeoFilterMemory
1248− let geoFilter = GeoBoundingBoxFilter bbConstraint
1249− let search = mkSearch Nothing (Just geoFilter)
1250− searchExpectNoResults search
1251−
1252− it "returns document for geo distance filter" $ withTestEnv $ do
1253− _ <- insertData
1254− let geoPoint = GeoPoint (FieldName "tweet.location") (LatLon 40.12 (-71.34))
1255− let distance = Distance 10.0 Miles
1256− let optimizeBbox = OptimizeGeoFilterType GeoFilterMemory
1257− let geoFilter = GeoDistanceFilter geoPoint distance SloppyArc optimizeBbox False
1258− let search = mkSearch Nothing (Just geoFilter)
1259− myTweet <- searchTweet search
1260− liftIO $
1261− myTweet `shouldBe` Right exampleTweet
1262−
1263− it "returns document for geo distance range filter" $ withTestEnv $ do
1264− _ <- insertData
1265− let geoPoint = GeoPoint (FieldName "tweet.location") (LatLon 40.12 (-71.34))
1266− let distanceRange = DistanceRange (Distance 0.0 Miles) (Distance 10.0 Miles)
1267− let geoFilter = GeoDistanceRangeFilter geoPoint distanceRange
1268− let search = mkSearch Nothing (Just geoFilter)
1269− myTweet <- searchTweet search
1270− liftIO $
1271− myTweet `shouldBe` Right exampleTweet
1272−
1273− it "doesn't return document for wild geo distance range filter" $ withTestEnv $ do
1274− _ <- insertData
1275− let geoPoint = GeoPoint (FieldName "tweet.location") (LatLon 40.12 (-71.34))
1276− let distanceRange = DistanceRange (Distance 100.0 Miles) (Distance 1000.0 Miles)
1277− let geoFilter = GeoDistanceRangeFilter geoPoint distanceRange
1278− let search = mkSearch Nothing (Just geoFilter)
1279− searchExpectNoResults search
1280−
1281− it "returns document for geo polygon filter" $ withTestEnv $ do
1282− _ <- insertData
1283− let points = [LatLon 40.0 (-70.00),
1284− LatLon 40.0 (-72.00),
1285− LatLon 41.0 (-70.00),
1286− LatLon 41.0 (-72.00)]
1287− let geoFilter = GeoPolygonFilter (FieldName "tweet.location") points
1288− let search = mkSearch Nothing (Just geoFilter)
1289− myTweet <- searchTweet search
1290− liftIO $
1291− myTweet `shouldBe` Right exampleTweet
1292−
1293− it "doesn't return document for bad geo polygon filter" $ withTestEnv $ do
1294− _ <- insertData
1295− let points = [LatLon 40.0 (-70.00),
1296− LatLon 40.0 (-71.00),
1297− LatLon 41.0 (-70.00),
1298− LatLon 41.0 (-71.00)]
1299− let geoFilter = GeoPolygonFilter (FieldName "tweet.location") points
1300− let search = mkSearch Nothing (Just geoFilter)
1301− searchExpectNoResults search
1302−
1303− it "returns document for ids filter" $ withTestEnv $ do
1304− _ <- insertData
1305− let filter = IdsFilter (MappingName "tweet") [DocId "1"]
1306− let search = mkSearch Nothing (Just filter)
1307− myTweet <- searchTweet search
1308− liftIO $
1309− myTweet `shouldBe` Right exampleTweet
1310−
1311− it "returns document for Double range filter" $ withTestEnv $ do
1312− _ <- insertData
1313− let filter = RangeFilter (FieldName "age")
1314− (RangeDoubleGtLt (GreaterThan 1000.0) (LessThan 100000.0))
1315− RangeExecutionIndex False
1316− let search = mkSearch Nothing (Just filter)
1317− myTweet <- searchTweet search
1318− liftIO $
1319− myTweet `shouldBe` Right exampleTweet
1320−
1321− it "returns document for UTCTime date filter" $ withTestEnv $ do
1322− _ <- insertData
1323− let filter = RangeFilter (FieldName "postDate")
1324− (RangeDateGtLt
1325− (GreaterThanD (UTCTime
1326− (ModifiedJulianDay 54000)
1327− (secondsToDiffTime 0)))
1328− (LessThanD (UTCTime
1329− (ModifiedJulianDay 55000)
1330− (secondsToDiffTime 11))))
1331− RangeExecutionIndex False
1332− let search = mkSearch Nothing (Just filter)
1333− myTweet <- searchTweet search
1334− liftIO $
1335− myTweet `shouldBe` Right exampleTweet
1336−
1337− it "returns document for regexp filter" $ withTestEnv $ do
1338− _ <- insertData
1339− let filter = RegexpFilter (FieldName "user") (Regexp "bite.*app")
1340− AllRegexpFlags (CacheName "test") False (CacheKey "key")
1341− let search = mkSearch Nothing (Just filter)
1342− myTweet <- searchTweet search
1343− liftIO $
1344− myTweet `shouldBe` Right exampleTweet
1345−
1346− it "doesn't return document for non-matching regexp filter" $ withTestEnv $ do
1347− _ <- insertData
1348− let filter = RegexpFilter (FieldName "user")
1349− (Regexp "boy") AllRegexpFlags
1350− (CacheName "test") False (CacheKey "key")
1351− let search = mkSearch Nothing (Just filter)
1352− searchExpectNoResults search
1353−
1354− it "returns document for query filter, uncached" $ withTestEnv $ do
1355− _ <- insertData
1356− let filter = QueryFilter (TermQuery (Term "user" "bitemyapp") Nothing) True
1357− search = mkSearch Nothing (Just filter)
1358− myTweet <- searchTweet search
1359− liftIO $ myTweet `shouldBe` Right exampleTweet
1360−
1361− it "returns document for query filter, cached" $ withTestEnv $ do
1362− _ <- insertData
1363− let filter = QueryFilter (TermQuery (Term "user" "bitemyapp") Nothing) False
1364− search = mkSearch Nothing (Just filter)
1365− myTweet <- searchTweet search
1366− liftIO $ myTweet `shouldBe` Right exampleTweet
1367−
1368− describe "Aggregation API" $ do
1369− it "returns term aggregation results" $ withTestEnv $ do
1370− _ <- insertData
1371− let terms = TermsAgg $ mkTermsAggregation "user"
1372− let search = mkAggregateSearch Nothing $ mkAggregations "users" terms
1373− searchExpectAggs search
1374− searchValidBucketAgg search "users" toTerms
1375−
1376− it "return sub-aggregation results" $ withTestEnv $ do
1377− _ <- insertData
1378− let subaggs = mkAggregations "age_agg" . TermsAgg $ mkTermsAggregation "age"
1379− agg = TermsAgg $ (mkTermsAggregation "user") { termAggs = Just subaggs}
1380− search = mkAggregateSearch Nothing $ mkAggregations "users" agg
1381− reply <- searchByIndex testIndex search
1382− let result = decode (responseBody reply) :: Maybe (SearchResult Tweet)
1383− usersAggResults = result >>= aggregations >>= toTerms "users"
1384− subAggResults = usersAggResults >>= (listToMaybe . buckets) >>= termsAggs >>= toTerms "age_agg"
1385− subAddResultsExists = isJust subAggResults
1386− liftIO $ (subAddResultsExists) `shouldBe` True
1387−
1388− it "returns cardinality aggregation results" $ withTestEnv $ do
1389− _ <- insertData
1390− let cardinality = CardinalityAgg $ mkCardinalityAggregation $ FieldName "user"
1391− let search = mkAggregateSearch Nothing $ mkAggregations "users" cardinality
1392− let search' = search { Database.V1.Bloodhound.from = From 0, size = Size 0 }
1393− searchExpectAggs search'
1394− let docCountPair k n = (k, object ["value" .= Number n])
1395− res <- searchTweets search'
1396− liftIO $
1397− fmap aggregations res `shouldBe` Right (Just (M.fromList [ docCountPair "users" 1]))
1398−
1399− it "can give collection hint parameters to term aggregations" $ when' (atleast es13) $ withTestEnv $ do
1400− _ <- insertData
1401− let terms = TermsAgg $ (mkTermsAggregation "user") { termCollectMode = Just BreadthFirst }
1402− let search = mkAggregateSearch Nothing $ mkAggregations "users" terms
1403− searchExpectAggs search
1404− searchValidBucketAgg search "users" toTerms
1405−
1406− -- One of these fails with 1.7.3
1407− it "can give execution hint parameters to term aggregations" $ when' (atmost es11) $ withTestEnv $ do
1408− _ <- insertData
1409− searchTermsAggHint [Map, Ordinals]
1410−
1411− it "can give execution hint parameters to term aggregations" $ when' (is es12) $ withTestEnv $ do
1412− _ <- insertData
1413− searchTermsAggHint [GlobalOrdinals, GlobalOrdinalsHash, GlobalOrdinalsLowCardinality, Map, Ordinals]
1414−
1415− it "can give execution hint parameters to term aggregations" $ when' (atleast es12) $ withTestEnv $ do
1416− _ <- insertData
1417− searchTermsAggHint [GlobalOrdinals, GlobalOrdinalsHash, GlobalOrdinalsLowCardinality, Map]
1418− -- One of the above.
1419−
1420− it "can execute value_count aggregations" $ withTestEnv $ do
1421− _ <- insertData
1422− _ <- insertOther
1423− let ags = mkAggregations "user_count" (ValueCountAgg (FieldValueCount (FieldName "user"))) <>
1424− mkAggregations "bogus_count" (ValueCountAgg (FieldValueCount (FieldName "bogus")))
1425− let search = mkAggregateSearch Nothing ags
1426− let docCountPair k n = (k, object ["value" .= Number n])
1427− res <- searchTweets search
1428− liftIO $
1429− fmap aggregations res `shouldBe` Right (Just (M.fromList [ docCountPair "user_count" 2
1430− , docCountPair "bogus_count" 0
1431− ]))
1432−
1433− it "can execute filter aggregations" $ withTestEnv $ do
1434− _ <- insertData
1435− _ <- insertOther
1436− let ags = mkAggregations "bitemyapps" (FilterAgg (FilterAggregation (TermFilter (Term "user" "bitemyapp") defaultCache) Nothing)) <>
1437− mkAggregations "notmyapps" (FilterAgg (FilterAggregation (TermFilter (Term "user" "notmyapp") defaultCache) Nothing))
1438− let search = mkAggregateSearch Nothing ags
1439− let docCountPair k n = (k, object ["doc_count" .= Number n])
1440− res <- searchTweets search
1441− liftIO $
1442− fmap aggregations res `shouldBe` Right (Just (M.fromList [ docCountPair "bitemyapps" 1
1443− , docCountPair "notmyapps" 1
1444− ]))
1445− it "can execute date_range aggregations" $ withTestEnv $ do
1446− let now = fromGregorian 2015 3 14
1447− let ltAMonthAgo = UTCTime (fromGregorian 2015 3 1) 0
1448− let ltAWeekAgo = UTCTime (fromGregorian 2015 3 10) 0
1449− let oldDoc = exampleTweet { postDate = ltAMonthAgo }
1450− let newDoc = exampleTweet { postDate = ltAWeekAgo }
1451− _ <- indexDocument testIndex testMapping defaultIndexDocumentSettings oldDoc (DocId "1")
1452− _ <- indexDocument testIndex testMapping defaultIndexDocumentSettings newDoc (DocId "2")
1453− _ <- refreshIndex testIndex
1454− let thisMonth = DateRangeFrom (DateMathExpr (DMDate now) [SubtractTime 1 DMMonth])
1455− let thisWeek = DateRangeFrom (DateMathExpr (DMDate now) [SubtractTime 1 DMWeek])
1456− let agg = DateRangeAggregation (FieldName "postDate") Nothing (thisMonth :| [thisWeek])
1457− let ags = mkAggregations "date_ranges" (DateRangeAgg agg)
1458− let search = mkAggregateSearch Nothing ags
1459− res <- searchTweets search
1460− liftIO $ hitsTotal . searchHits <$> res `shouldBe` Right 2
1461− let bucks = do magrs <- fmapL show (aggregations <$> res)
1462− agrs <- note "no aggregations returned" magrs
1463− rawBucks <- note "no date_ranges aggregation" $ M.lookup "date_ranges" agrs
1464− parseEither parseJSON rawBucks
1465− let fromMonthT = UTCTime (fromGregorian 2015 2 14) 0
1466− let fromWeekT = UTCTime (fromGregorian 2015 3 7) 0
1467− liftIO $ buckets <$> bucks `shouldBe` Right [ DateRangeResult "2015-02-14T00:00:00.000Z-*"
1468− (Just fromMonthT)
1469− (Just "2015-02-14T00:00:00.000Z")
1470− Nothing
1471− Nothing
1472− 2
1473− Nothing
1474− , DateRangeResult "2015-03-07T00:00:00.000Z-*"
1475− (Just fromWeekT)
1476− (Just "2015-03-07T00:00:00.000Z")
1477− Nothing
1478− Nothing
1479− 1
1480− Nothing
1481− ]
1482−
1483− it "returns date histogram aggregation results" $ withTestEnv $ do
1484− _ <- insertData
1485− let histogram = DateHistogramAgg $ mkDateHistogram (FieldName "postDate") Minute
1486− let search = mkAggregateSearch Nothing (mkAggregations "byDate" histogram)
1487− searchExpectAggs search
1488− searchValidBucketAgg search "byDate" toDateHistogram
1489−
1490− it "returns date histogram using fractional date" $ withTestEnv $ do
1491− _ <- insertData
1492− let periods = [Year, Quarter, Month, Week, Day, Hour, Minute, Second]
1493− let fractionals = map (FractionalInterval 1.5) [Weeks, Days, Hours, Minutes, Seconds]
1494− let intervals = periods ++ fractionals
1495− let histogram = mkDateHistogram (FieldName "postDate")
1496− let search interval = mkAggregateSearch Nothing $ mkAggregations "byDate" $ DateHistogramAgg (histogram interval)
1497− let expect interval = searchExpectAggs (search interval)
1498− let valid interval = searchValidBucketAgg (search interval) "byDate" toDateHistogram
1499− forM_ intervals expect
1500− forM_ intervals valid
1501−
1502− it "can execute missing aggregations" $ withTestEnv $ do
1503− _ <- insertData
1504− _ <- insertExtra
1505− let ags = mkAggregations "missing_agg" (MissingAgg (MissingAggregation "extra"))
1506− let search = mkAggregateSearch Nothing ags
1507− let docCountPair k n = (k, object ["doc_count" .= Number n])
1508− res <- searchTweets search
1509− liftIO $
1510− fmap aggregations res `shouldBe` Right (Just (M.fromList [docCountPair "missing_agg" 1]))
1511−
1512− describe "Highlights API" $ do
1513−
1514− it "returns highlight from query when there should be one" $ withTestEnv $ do
1515− _ <- insertData
1516− _ <- insertOther
1517− let query = QueryMatchQuery $ mkMatchQuery (FieldName "_all") (QueryString "haskell")
1518− let testHighlight = Highlights Nothing [FieldHighlight (FieldName "message") Nothing]
1519−
1520− let search = mkHighlightSearch (Just query) testHighlight
1521− myHighlight <- searchTweetHighlight search
1522− liftIO $
1523− myHighlight `shouldBe` Right (Just (M.fromList [("message",["Use <em>haskell</em>!"])]))
1524−
1525− it "doesn't return highlight from a query when it shouldn't" $ withTestEnv $ do
1526− _ <- insertData
1527− _ <- insertOther
1528− let query = QueryMatchQuery $ mkMatchQuery (FieldName "_all") (QueryString "haskell")
1529− let testHighlight = Highlights Nothing [FieldHighlight (FieldName "user") Nothing]
1530−
1531− let search = mkHighlightSearch (Just query) testHighlight
1532− myHighlight <- searchTweetHighlight search
1533− liftIO $
1534− myHighlight `shouldBe` Right Nothing
1535−
1536− describe "Source filtering" $ do
1537−
1538− it "doesn't include source when sources are disabled" $ withTestEnv $ do
1539− searchExpectSource
1540− NoSource
1541− (Left (EsError 500 "Source was missing"))
1542−
1543− it "includes a source" $ withTestEnv $ do
1544− searchExpectSource
1545− (SourcePatterns (PopPattern (Pattern "message")))
1546− (Right (Object (HM.fromList [("message", String "Use haskell!")])))
1547−
1548− it "includes sources" $ withTestEnv $ do
1549− searchExpectSource
1550− (SourcePatterns (PopPatterns [Pattern "user", Pattern "message"]))
1551− (Right (Object (HM.fromList [("user",String "bitemyapp"),("message", String "Use haskell!")])))
1552−
1553− it "includes source patterns" $ withTestEnv $ do
1554− searchExpectSource
1555− (SourcePatterns (PopPattern (Pattern "*ge")))
1556− (Right (Object (HM.fromList [("age", Number 10000),("message", String "Use haskell!")])))
1557−
1558− it "excludes source patterns" $ withTestEnv $ do
1559− searchExpectSource
1560− (SourceIncludeExclude (Include [])
1561− (Exclude [Pattern "l*", Pattern "*ge", Pattern "postDate", Pattern "extra"]))
1562− (Right (Object (HM.fromList [("user",String "bitemyapp")])))
1563−
1564− describe "ToJSON RegexpFlags" $ do
1565− it "generates the correct JSON for AllRegexpFlags" $
1566− toJSON AllRegexpFlags `shouldBe` String "ALL"
1567−
1568− it "generates the correct JSON for NoRegexpFlags" $
1569− toJSON NoRegexpFlags `shouldBe` String "NONE"
1570−
1571− it "generates the correct JSON for SomeRegexpFlags" $
1572− let flags = AnyString :| [ Automaton
1573− , Complement
1574− , Empty
1575− , Intersection
1576− , Interval ]
1577− in toJSON (SomeRegexpFlags flags) `shouldBe` String "ANYSTRING|AUTOMATON|COMPLEMENT|EMPTY|INTERSECTION|INTERVAL"
1578−
1579− prop "removes duplicates from flags" $ \(flags :: RegexpFlags) ->
1580− let String str = toJSON flags
1581− flagStrs = T.splitOn "|" str
1582− in noDuplicates flagStrs
1583−
1584− describe "omitNulls" $ do
1585− it "checks that omitNulls drops list elements when it should" $
1586− let dropped = omitNulls $ [ "test1" .= (toJSON ([] :: [Int]))
1587− , "test2" .= (toJSON ("some value" :: Text))]
1588− in dropped `shouldBe` Object (HM.fromList [("test2", String "some value")])
1589−
1590− it "checks that omitNulls doesn't drop list elements when it shouldn't" $
1591− let notDropped = omitNulls $ [ "test1" .= (toJSON ([1] :: [Int]))
1592− , "test2" .= (toJSON ("some value" :: Text))]
1593− in notDropped `shouldBe` Object (HM.fromList [ ("test1", Array (V.fromList [Number 1.0]))
1594− , ("test2", String "some value")])
1595− it "checks that omitNulls drops non list elements when it should" $
1596− let dropped = omitNulls $ [ "test1" .= (toJSON Null)
1597− , "test2" .= (toJSON ("some value" :: Text))]
1598− in dropped `shouldBe` Object (HM.fromList [("test2", String "some value")])
1599− it "checks that omitNulls doesn't drop non list elements when it shouldn't" $
1600− let notDropped = omitNulls $ [ "test1" .= (toJSON (1 :: Int))
1601− , "test2" .= (toJSON ("some value" :: Text))]
1602− in notDropped `shouldBe` Object (HM.fromList [ ("test1", Number 1.0)
1603− , ("test2", String "some value")])
1604− describe "Monoid (SearchHits a)" $ do
1605− prop "abides the monoid laws" $ eq $
1606− prop_Monoid (T :: T (SearchHits ()))
1607−
1608− describe "mkDocVersion" $ do
1609− prop "can never construct an out of range docVersion" $ \i ->
1610− let res = mkDocVersion i
1611− in case res of
1612− Nothing -> property True
1613− Just dv -> (dv >= minBound) .&&.
1614− (dv <= maxBound) .&&.
1615− docVersionNumber dv === i
1616−
1617− describe "FsSnapshotRepo" $ do
1618− prop "SnapshotRepo laws" $ \fsr ->
1619− fromGSnapshotRepo (toGSnapshotRepo fsr) === Right (fsr :: FsSnapshotRepo)
1620−
1621− describe "snapshot repos" $ do
1622− it "always parses all snapshot repos API" $ when' canSnapshot $ withTestEnv $ do
1623− res <- getSnapshotRepos AllSnapshotRepos
1624− liftIO $ case res of
1625− Left e -> expectationFailure ("Expected a right but got Left " <> show e)
1626− Right _ -> return ()
1627−
1628− it "finds an existing list of repos" $ when' canSnapshot $ withTestEnv $ do
1629− let r1n = SnapshotRepoName "bloodhound-repo1"
1630− let r2n = SnapshotRepoName "bloodhound-repo2"
1631− withSnapshotRepo r1n $ \r1 ->
1632− withSnapshotRepo r2n $ \r2 -> do
1633− repos <- getSnapshotRepos (SnapshotRepoList (ExactRepo r1n :| [ExactRepo r2n]))
1634− liftIO $ case repos of
1635− Right xs -> do
1636− let srt = L.sortBy (comparing gSnapshotRepoName)
1637− srt xs `shouldBe` srt [r1, r2]
1638− Left e -> expectationFailure (show e)
1639−
1640− it "creates and updates with updateSnapshotRepo" $ when' canSnapshot $ withTestEnv $ do
1641− let r1n = SnapshotRepoName "bloodhound-repo1"
1642− withSnapshotRepo r1n $ \r1 -> do
1643− let Just (String dir) = HM.lookup "location" (gSnapshotRepoSettingsObject (gSnapshotRepoSettings r1))
1644− let noCompression = FsSnapshotRepo r1n (T.unpack dir) False Nothing Nothing Nothing
1645− resp <- updateSnapshotRepo defaultSnapshotRepoUpdateSettings noCompression
1646− liftIO (validateStatus resp 200)
1647− Right [roundtrippedNoCompression] <- getSnapshotRepos (SnapshotRepoList (ExactRepo r1n :| []))
1648− liftIO (roundtrippedNoCompression `shouldBe` toGSnapshotRepo noCompression)
1649−
1650− -- verify came around in 1.4 it seems
1651− it "can verify existing repos" $ when' canSnapshot $ when' (atleast es14) $ withTestEnv $ do
1652− let r1n = SnapshotRepoName "bloodhound-repo1"
1653− withSnapshotRepo r1n $ \_ -> do
1654− res <- verifySnapshotRepo r1n
1655− liftIO $ case res of
1656− Right (SnapshotVerification vs)
1657− | null vs -> expectationFailure "Expected nonempty set of verifying nodes"
1658− | otherwise -> return ()
1659− Left e -> expectationFailure (show e)
1660−
1661− describe "snapshots" $ do
1662− it "always parses all snapshots API" $ when' canSnapshot $ withTestEnv $ do
1663− let r1n = SnapshotRepoName "bloodhound-repo1"
1664− withSnapshotRepo r1n $ \_ -> do
1665− res <- getSnapshots r1n AllSnapshots
1666− liftIO $ case res of
1667− Left e -> expectationFailure ("Expected a right but got Left " <> show e)
1668− Right _ -> return ()
1669−
1670− it "can parse a snapshot that it created" $ when' canSnapshot $ withTestEnv $ do
1671− let r1n = SnapshotRepoName "bloodhound-repo1"
1672− withSnapshotRepo r1n $ \_ -> do
1673− let s1n = SnapshotName "example-snapshot"
1674− withSnapshot r1n s1n $ do
1675− res <- getSnapshots r1n (SnapshotList (ExactSnap s1n :| []))
1676− liftIO $ case res of
1677− Right [snap]
1678− | snapInfoState snap == SnapshotSuccess &&
1679− snapInfoName snap == s1n -> return ()
1680− | otherwise -> expectationFailure (show snap)
1681− Right [] -> expectationFailure "There were no snapshots"
1682− Right snaps -> expectationFailure ("Expected 1 snapshot but got" <> show (length snaps))
1683− Left e -> expectationFailure (show e)
1684−
1685− describe "snapshot restore" $ do
1686− it "can restore a snapshot that we create" $ when' canSnapshot $ withTestEnv $ do
1687− let r1n = SnapshotRepoName "bloodhound-repo1"
1688− withSnapshotRepo r1n $ \_ -> do
1689− let s1n = SnapshotName "example-snapshot"
1690− withSnapshot r1n s1n $ do
1691− let settings = defaultSnapshotRestoreSettings { snapRestoreWaitForCompletion = True }
1692− -- have to close an index to restore it
1693− resp1 <- closeIndex testIndex
1694− liftIO (validateStatus resp1 200)
1695− resp2 <- restoreSnapshot r1n s1n settings
1696− liftIO (validateStatus resp2 200)
1697−
1698− it "can restore and rename" $ when' canSnapshot $ withTestEnv $ do
1699− let r1n = SnapshotRepoName "bloodhound-repo1"
1700− withSnapshotRepo r1n $ \_ -> do
1701− let s1n = SnapshotName "example-snapshot"
1702− withSnapshot r1n s1n $ do
1703− let pat = RestoreRenamePattern "bloodhound-tests-twitter-(\\d+)"
1704− let replace = RRTLit "restored-" :| [RRSubWholeMatch]
1705− let expectedIndex = IndexName "restored-bloodhound-tests-twitter-1"
1706− oldEnoughForOverrides <- liftIO (atleast es15)
1707− let overrides = RestoreIndexSettings { restoreOverrideReplicas = Just (ReplicaCount 0) }
1708− let settings = defaultSnapshotRestoreSettings { snapRestoreWaitForCompletion = True
1709− , snapRestoreRenamePattern = Just pat
1710− , snapRestoreRenameReplacement = Just replace
1711− , snapRestoreIndexSettingsOverrides = if oldEnoughForOverrides
1712− then Just overrides
1713− else Nothing
1714− }
1715− -- have to close an index to restore it
1716− let go = do
1717− resp <- restoreSnapshot r1n s1n settings
1718− liftIO (validateStatus resp 200)
1719− exists <- indexExists expectedIndex
1720− liftIO (exists `shouldBe` True)
1721− go `finally` deleteIndex expectedIndex
1722−
1723− describe "getNodesInfo" $ do
1724− it "fetches the responding node when LocalNode is used" $ withTestEnv $ do
1725− res <- getNodesInfo LocalNode
1726− liftIO $ case res of
1727− -- This is really just a smoke test for response
1728− -- parsing. Node info is so variable, there's not much I can
1729− -- assert here.
1730− Right NodesInfo {..} -> length nodesInfo `shouldBe` 1
1731− Left e -> expectationFailure ("Expected NodesInfo but got " <> show e)
1732−
1733− describe "getNodesStats" $ do
1734− it "fetches the responding node when LocalNode is used" $ withTestEnv $ do
1735− res <- getNodesStats LocalNode
1736− liftIO $ case res of
1737− -- This is really just a smoke test for response
1738− -- parsing. Node stats is so variable, there's not much I can
1739− -- assert here.
1740− Right NodesStats {..} -> length nodesStats `shouldBe` 1
1741− Left e -> expectationFailure ("Expected NodesStats but got " <> show e)
1742−
1743− describe "Enum DocVersion" $ do
1744− it "follows the laws of Enum, Bounded" $ do
1745− evaluate (succ maxBound :: DocVersion) `shouldThrow` anyErrorCall
1746− evaluate (pred minBound :: DocVersion) `shouldThrow` anyErrorCall
1747− evaluate (toEnum 0 :: DocVersion) `shouldThrow` anyErrorCall
1748− evaluate (toEnum 9200000000000000001 :: DocVersion) `shouldThrow` anyErrorCall
1749− enumFrom (pred maxBound :: DocVersion) `shouldBe` [pred maxBound, maxBound]
1750− enumFrom (pred maxBound :: DocVersion) `shouldBe` [pred maxBound, maxBound]
1751− enumFromThen minBound (pred maxBound :: DocVersion) `shouldBe` [minBound, pred maxBound]
1752−
1753− describe "scan&scroll API" $ do
1754− it "returns documents using the scan&scroll API" $ withTestEnv $ do
1755− _ <- insertData
1756− _ <- insertOther
1757− let search = (mkSearch (Just $ MatchAllQuery Nothing) Nothing) { size = (Size 1) }
1758− regular_search <- searchTweet search
1759− scan_search' <- scanSearch testIndex testMapping search :: BH IO [Hit Tweet]
1760− let scan_search = map hitSource scan_search'
1761− liftIO $
1762− regular_search `shouldBe` Right exampleTweet -- Check that the size restrtiction is being honored
1763− liftIO $
1764− scan_search `shouldMatchList` [Just exampleTweet, Just otherTweet]
1765−
1766− describe "index aliases" $ do
1767− it "handles the simple case of aliasing an existing index" $ do
1768− let alias = IndexAlias (testIndex) (IndexAliasName (IndexName "bloodhound-tests-twitter-1-alias"))
1769− let create = IndexAliasCreate Nothing Nothing
1770− let action = AddAlias alias create
1771−
1772− withTestEnv $ do
1773− resetIndex
1774− resp <- updateIndexAliases (action :| [])
1775− liftIO $ validateStatus resp 200
1776− let cleanup = withTestEnv (updateIndexAliases (RemoveAlias alias :| []))
1777− (do aliases <- withTestEnv getIndexAliases
1778− let expected = IndexAliasSummary alias create
1779− case aliases of
1780− Right (IndexAliasesSummary summs) ->
1781− L.find ((== alias) . indexAliasSummaryAlias) summs `shouldBe` Just expected
1782− Left e -> expectationFailure ("Expected an IndexAliasesSummary but got " <> show e)) `finally` cleanup
1783−
1784− it "handles an alias with routing and a filter" $ do
1785− let alias = IndexAlias (testIndex) (IndexAliasName (IndexName "bloodhound-tests-twitter-1-alias"))
1786− let sar = SearchAliasRouting (RoutingValue "search val" :| [])
1787− let iar = IndexAliasRouting (RoutingValue "index val")
1788− let routing = GranularAliasRouting (Just sar) (Just iar)
1789− let filter = LimitFilter 42
1790− let create = IndexAliasCreate (Just routing) (Just filter)
1791− let action = AddAlias alias create
1792−
1793− withTestEnv $ do
1794− resetIndex
1795− resp <- updateIndexAliases (action :| [])
1796− liftIO $ validateStatus resp 200
1797− let cleanup = withTestEnv (updateIndexAliases (RemoveAlias alias :| []))
1798− (do aliases <- withTestEnv getIndexAliases
1799− let expected = IndexAliasSummary alias create
1800− case aliases of
1801− Right (IndexAliasesSummary summs) ->
1802− L.find ((== alias) . indexAliasSummaryAlias) summs `shouldBe` Just expected
1803− Left e -> expectationFailure ("Expected an IndexAliasesSummary but got " <> show e)) `finally` cleanup
1804−
1805− describe "Index Listing" $ do
1806− it "returns a list of index names" $ withTestEnv $ do
1807− _ <- createExampleIndex
1808− ixns <- listIndices
1809− liftIO (ixns `shouldContain` [testIndex])
1810−
1811− describe "Index Settings" $ do
1812− it "persists settings" $ withTestEnv $ do
1813− _ <- deleteExampleIndex
1814− _ <- createExampleIndex
1815− let updates = BlocksWrite False :| []
1816− updateResp <- updateIndexSettings updates testIndex
1817− liftIO $ validateStatus updateResp 200
1818− getResp <- getIndexSettings testIndex
1819− liftIO $
1820− getResp `shouldBe` Right (IndexSettingsSummary
1821− testIndex
1822− (IndexSettings (ShardCount 1) (ReplicaCount 0))
1823− (NE.toList updates))
1824−
1825− describe "Index Optimization" $ do
1826− it "returns a successful response upon completion" $ withTestEnv $ do
1827− _ <- createExampleIndex
1828− resp <- optimizeIndex (IndexList (testIndex :| [])) defaultIndexOptimizationSettings
1829− liftIO $ validateStatus resp 200
1830−
1831− describe "Suggest" $ do
1832− it "returns a search suggestion using the phrase suggester" $ withTestEnv $ do
1833− _ <- insertData
1834− let {- query = QueryMatchNoneQuery
1835− query = TermQuery (Term "user" "bitemyapp") Nothing -}
1836− let phraseSuggester = mkPhraseSuggester (FieldName "message")
1837− namedSuggester = Suggest "Use haskel" "suggest_name" (SuggestTypePhraseSuggester phraseSuggester)
1838− search' = mkSearch Nothing Nothing
1839− search = search' { suggestBody = Just namedSuggester }
1840− expectedText = Just "use haskell"
1841− resp <- searchByIndex testIndex search
1842− parsed <- parseEsResponse resp :: BH IO (Either EsError (SearchResult Tweet))
1843− case parsed of
1844− Left e -> liftIO $ expectationFailure ("Expected an search suggestion but got " <> show e)
1845− Right sr -> liftIO $ (suggestOptionsText . head . suggestResponseOptions . head . nsrResponses <$> suggest sr) `shouldBe` expectedText
1846−
1847− describe "JSON instances" $ do
1848− propJSON (Proxy :: Proxy Version)
1849− propJSON (Proxy :: Proxy IndexName)
1850− propJSON (Proxy :: Proxy MappingName)
1851− propJSON (Proxy :: Proxy DocId)
1852− propJSON (Proxy :: Proxy IndexAliasRouting)
1853− propJSON (Proxy :: Proxy RoutingValue)
1854− propJSON (Proxy :: Proxy ShardCount)
1855− propJSON (Proxy :: Proxy ReplicaCount)
1856− propJSON (Proxy :: Proxy TemplateName)
1857− propJSON (Proxy :: Proxy TemplatePattern)
1858− propJSON (Proxy :: Proxy QueryString)
1859− propJSON (Proxy :: Proxy FieldName)
1860− propJSON (Proxy :: Proxy CacheName)
1861− propJSON (Proxy :: Proxy CacheKey)
1862− propJSON (Proxy :: Proxy Existence)
1863− propJSON (Proxy :: Proxy CutoffFrequency)
1864− propJSON (Proxy :: Proxy Analyzer)
1865− propJSON (Proxy :: Proxy MaxExpansions)
1866− propJSON (Proxy :: Proxy Lenient)
1867− propJSON (Proxy :: Proxy Tiebreaker)
1868− propJSON (Proxy :: Proxy Boost)
1869− propJSON (Proxy :: Proxy BoostTerms)
1870− propJSON (Proxy :: Proxy MinimumMatch)
1871− propJSON (Proxy :: Proxy DisableCoord)
1872− propJSON (Proxy :: Proxy IgnoreTermFrequency)
1873− propJSON (Proxy :: Proxy MinimumTermFrequency)
1874− propJSON (Proxy :: Proxy MaxQueryTerms)
1875− propJSON (Proxy :: Proxy Fuzziness)
1876− propJSON (Proxy :: Proxy PrefixLength)
1877− propJSON (Proxy :: Proxy TypeName)
1878− propJSON (Proxy :: Proxy PercentMatch)
1879− propJSON (Proxy :: Proxy StopWord)
1880− propJSON (Proxy :: Proxy QueryPath)
1881− propJSON (Proxy :: Proxy AllowLeadingWildcard)
1882− propJSON (Proxy :: Proxy LowercaseExpanded)
1883− propJSON (Proxy :: Proxy EnablePositionIncrements)
1884− propJSON (Proxy :: Proxy AnalyzeWildcard)
1885− propJSON (Proxy :: Proxy GeneratePhraseQueries)
1886− propJSON (Proxy :: Proxy Locale)
1887− propJSON (Proxy :: Proxy MaxWordLength)
1888− propJSON (Proxy :: Proxy MinWordLength)
1889− propJSON (Proxy :: Proxy PhraseSlop)
1890− propJSON (Proxy :: Proxy MinDocFrequency)
1891− propJSON (Proxy :: Proxy MaxDocFrequency)
1892− propJSON (Proxy :: Proxy Filter)
1893− propJSON (Proxy :: Proxy Query)
1894− propJSON (Proxy :: Proxy SimpleQueryStringQuery)
1895− propJSON (Proxy :: Proxy FieldOrFields)
1896− propJSON (Proxy :: Proxy SimpleQueryFlag)
1897− propJSON (Proxy :: Proxy RegexpQuery)
1898− propJSON (Proxy :: Proxy QueryStringQuery)
1899− propJSON (Proxy :: Proxy RangeQuery)
1900− propJSON (Proxy :: Proxy PrefixQuery)
1901− propJSON (Proxy :: Proxy NestedQuery)
1902− propJSON (Proxy :: Proxy MoreLikeThisFieldQuery)
1903− propJSON (Proxy :: Proxy MoreLikeThisQuery)
1904− propJSON (Proxy :: Proxy IndicesQuery)
1905− propJSON (Proxy :: Proxy HasParentQuery)
1906− propJSON (Proxy :: Proxy HasChildQuery)
1907− propJSON (Proxy :: Proxy FuzzyQuery)
1908− propJSON (Proxy :: Proxy FuzzyLikeFieldQuery)
1909− propJSON (Proxy :: Proxy FuzzyLikeThisQuery)
1910− propJSON (Proxy :: Proxy FilteredQuery)
1911− propJSON (Proxy :: Proxy DisMaxQuery)
1912− propJSON (Proxy :: Proxy CommonTermsQuery)
1913− propJSON (Proxy :: Proxy CommonMinimumMatch)
1914− propJSON (Proxy :: Proxy BoostingQuery)
1915− propJSON (Proxy :: Proxy BoolQuery)
1916− propJSON (Proxy :: Proxy MatchQuery)
1917− propJSON (Proxy :: Proxy MultiMatchQueryType)
1918− propJSON (Proxy :: Proxy BooleanOperator)
1919− propJSON (Proxy :: Proxy ZeroTermsQuery)
1920− propJSON (Proxy :: Proxy MatchQueryType)
1921− propJSON (Proxy :: Proxy AliasRouting)
1922− propJSON (Proxy :: Proxy IndexAliasCreate)
1923− propJSON (Proxy :: Proxy SearchAliasRouting)
1924− propJSON (Proxy :: Proxy ScoreType)
1925− propJSON (Proxy :: Proxy Distance)
1926− propJSON (Proxy :: Proxy DistanceUnit)
1927− propJSON (Proxy :: Proxy DistanceType)
1928− propJSON (Proxy :: Proxy OptimizeBbox)
1929− propJSON (Proxy :: Proxy GeoBoundingBoxConstraint)
1930− propJSON (Proxy :: Proxy GeoFilterType)
1931− propJSON (Proxy :: Proxy GeoBoundingBox)
1932− propJSON (Proxy :: Proxy LatLon)
1933− propJSON (Proxy :: Proxy RangeExecution)
1934− prop "RegexpFlags FromJSON/ToJSON roundtrips, removing dups " $ \rfs ->
1935− let expected = case rfs of
1936− SomeRegexpFlags fs -> SomeRegexpFlags (NE.fromList (nub (NE.toList fs)))
1937− x -> x
1938− in parseEither parseJSON (toJSON rfs) === Right expected
1939− propJSON (Proxy :: Proxy BoolMatch)
1940− propJSON (Proxy :: Proxy Term)
1941− propJSON (Proxy :: Proxy MultiMatchQuery)
1942− propJSON (Proxy :: Proxy IndexSettings)
1943− propJSON (Proxy :: Proxy UpdatableIndexSetting')
1944− propJSON (Proxy :: Proxy ReplicaBounds)
1945− propJSON (Proxy :: Proxy Bytes)
1946− propJSON (Proxy :: Proxy AllocationPolicy)
1947− propJSON (Proxy :: Proxy InitialShardCount)
1948− propJSON (Proxy :: Proxy FSType)
1949− propJSON (Proxy :: Proxy CompoundFormat)
1950− propJSON (Proxy :: Proxy TemplateQueryInline)
1951− propJSON (Proxy :: Proxy Suggest)
1952− propJSON (Proxy :: Proxy DirectGenerators)
1953− propJSON (Proxy :: Proxy DirectGeneratorSuggestModeTypes)
1954−
1955−-- Temporary solution for lacking of generic derivation of Arbitrary
1956−-- We use generics-sop, as it's much more concise than directly using GHC.Generics
1957−--
1958−-- This will be unneeded after https://github.com/nick8325/quickcheck/pull/112
1959−-- is merged and released
1960−sopArbitrary :: forall a. (Generic a, SOP.GTo a, SOP.All SOP.SListI (SOP.GCode a), SOP.All2 Arbitrary (SOP.GCode a)) => Gen a
1961−sopArbitrary = fmap SOP.gto sopArbitrary'
1962−
1963−sopArbitrary' :: forall xss. (SOP.All SOP.SListI xss, SOP.All2 Arbitrary xss) => Gen (SOP.SOP SOP.I xss)
1964−sopArbitrary' = SOP.hsequence =<< elements (SOP.apInjs_POP $ SOP.hcpure p arbitrary)
1965− where
1966− p :: Proxy Arbitrary
1967− p = Proxy
tests/V5/tests.hs → tests/tests.hsrenamed+17
@@ -18,6 +18,7 @@ import Test.Import
1818
1919import Prelude
2020
21+import qualified Data.Aeson as Aeson
2122import qualified Test.Aggregation as Aggregation
2223import qualified Test.BulkAPI as Bulk
2324import qualified Test.Documents as Documents
@@ -117,3 +118,19 @@ main = hspec $ do
117118 regular_search `shouldBe` Right exampleTweet -- Check that the size restrtiction is being honored
118119 liftIO $
119120 scan_search `shouldMatchList` [Just exampleTweet, Just otherTweet]
121+
122+ describe "Search After API" $
123+ it "returns document for search after query" $ withTestEnv $ do
124+ _ <- insertData
125+ _ <- insertOther
126+ let
127+ sortSpec = DefaultSortSpec $ mkSort (FieldName "user") Ascending
128+ searchAfterKey = [Aeson.toJSON ("bitemyapp" :: String)]
129+ search = Search Nothing
130+ Nothing (Just [sortSpec]) Nothing Nothing
131+ False (From 0) (Size 10) SearchTypeQueryThenFetch (Just searchAfterKey)
132+ Nothing Nothing Nothing Nothing
133+ result <- searchTweets search
134+ let myTweet = grabFirst result
135+ liftIO $
136+ myTweet `shouldBe` Right otherTweet