git.iko.soy/typeable/bloodhound
on master help sign in
75 files changed+9867−16206
since splitsnapshots
unifiedsplit
.gitignore+4 .hlint.yaml+66 .travis.yml+18−27 DSL.org+1−1 Makefile+117−14 README.md+17−837 bloodhound.cabal−117 changelog.md+107 docker-compose.yml+35 elasticsearch/Dockerfile+3 elasticsearch/config/elasticsearch.yml+3 examples/LICENSE+12 examples/Makefile+5 examples/README.md+6 examples/Setup.hs+2 examples/Tweet.hs+108 examples/package.yaml+37 examples/stack.yaml+20 package.yaml+74 src/Bloodhound/Import.hs+85 src/Database/Bloodhound.hs+10 src/Database/V5/Bloodhound/Client.hs → src/Database/Bloodhound/Client.hs+165−57 src/Database/Bloodhound/Common/Script.hs+220 src/Database/Bloodhound/Internal/Aggregation.hs+479 src/Database/Bloodhound/Internal/Analysis.hs+379 src/Database/Bloodhound/Internal/Client.hs+2431 src/Database/Bloodhound/Internal/Highlight.hs+164 src/Database/Bloodhound/Internal/Newtypes.hs+237 src/Database/Bloodhound/Internal/Query.hs+1640 src/Database/Bloodhound/Internal/Sort.hs+107 src/Database/Bloodhound/Internal/StringlyTyped.hs+51 src/Database/Bloodhound/Internal/Suggest.hs+270 src/Database/Bloodhound/Types.hs+542 src/Database/V1/Bloodhound.hs−10 src/Database/V1/Bloodhound/Client.hs−1097 src/Database/V1/Bloodhound/Types.hs−5271 src/Database/V1/Bloodhound/Types/Class.hs−17 src/Database/V1/Bloodhound/Types/Internal.hs−57 src/Database/V5/Bloodhound.hs−10 src/Database/V5/Bloodhound/Types.hs−5028 src/Database/V5/Bloodhound/Types/Class.hs−17 src/Database/V5/Bloodhound/Types/Internal.hs−57 stack-7.10.yaml−15 stack-7.8.yaml−19 stack-8.0.yaml+9−12 stack-8.2.yaml+15 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−6 stack.yaml.lock+12 tests/Test/Aggregation.hs+147 tests/Test/ApproxEq.hs+63 tests/Test/BulkAPI.hs+95 tests/Test/Common.hs+292 tests/Test/Documents.hs+51 tests/Test/Generators.hs+563 tests/Test/Highlights.hs+32 tests/Test/Import.hs+58 tests/Test/Indices.hs+173 tests/Test/JSON.hs+213 tests/Test/Query.hs+132 tests/Test/Script.hs+36 tests/Test/Snapshots.hs+201 tests/Test/Sorting.hs+22 tests/Test/SourceFiltering.hs+38 tests/Test/Suggest.hs+23 tests/Test/Templates.hs+26 tests/V1/doctests.hs−4 tests/V1/tests.hs−1880 tests/V5/doctests.hs−4 tests/V5/tests.hs−1649 tests/tests.hs+136
.gitignore+4
@@ -16,3 +16,7 @@ bloodhound.iml
1616.hg/00changelog.i
1717.hg
1818.hgignore
19+examples/bloodhound-examples.cabal
20+/.ghc.environment.*
21+.hspec-failures
22+bloodhound.cabal
.hlint.yamlnew file+66
@@ -0,0 +1,66 @@
1+# HLint configuration file
2+# https://github.com/ndmitchell/hlint
3+##########################
4+
5+# This file contains a template configuration file, which is typically
6+# placed as .hlint.yaml in the root of your project
7+
8+
9+# Specify additional command line arguments
10+#
11+# - arguments: [--color, --cpp-simple, -XQuasiQuotes]
12+
13+
14+# Control which extensions/flags/modules/functions can be used
15+#
16+# - extensions:
17+# - default: false # all extension are banned by default
18+# - name: [PatternGuards, ViewPatterns] # only these listed extensions can be used
19+# - {name: CPP, within: CrossPlatform} # CPP can only be used in a given module
20+#
21+# - flags:
22+# - {name: -w, within: []} # -w is allowed nowhere
23+#
24+# - modules:
25+# - {name: [Data.Set, Data.HashSet], as: Set} # if you import Data.Set qualified, it must be as 'Set'
26+# - {name: Control.Arrow, within: []} # Certain modules are banned entirely
27+#
28+# - functions:
29+# - {name: unsafePerformIO, within: []} # unsafePerformIO can only appear in no modules
30+
31+
32+# Add custom hints for this project
33+#
34+# Will suggest replacing "wibbleMany [myvar]" with "wibbleOne myvar"
35+# - error: {lhs: "wibbleMany [x]", rhs: wibbleOne x}
36+
37+
38+# Turn on hints that are off by default
39+#
40+# Ban "module X(module X) where", to require a real export list
41+# - warn: {name: Use explicit module export list}
42+#
43+# Replace a $ b $ c with a . b $ c
44+# - group: {name: dollar, enabled: true}
45+#
46+# Generalise map to fmap, ++ to <>
47+# - group: {name: generalise, enabled: true}
48+
49+
50+# Ignore some builtin hints
51+- ignore: {name: "Use <$>"}
52+- ignore: {name: "Use lambda-case"}
53+# When we don't use camelCase it's to match ES.
54+# Possibly this is a mistake.
55+- ignore: {name: "Use camelCase"}
56+- ignore: {name: "Eta reduce"}
57+# - ignore: {name: Use let}
58+# - ignore: {name: Use const, within: SpecialModule} # Only within certain modules
59+
60+
61+# Define some custom infix operators
62+# - fixity: infixr 3 ~^#^~
63+
64+
65+# To generate a suitable file for HLint do:
66+# $ hlint --default > .hlint.yaml
.travis.yml+18−27
@@ -1,38 +1,24 @@
11sudo: false
2+language: generic
3+
4+jdk:
5+ - oraclejdk11
26
37addons:
48 apt:
59 packages:
610 - libgmp-dev
7− - oracle-java8-installer
811
912env:
10− global:
11− - JAVA_HOME=/usr/lib/jvm/java-8-oracle
12− matrix:
13− - GHCVER=7.8 ESVER=1.3.6 ESFLAG=ES1 DLINK=https://download.elastic.co/elasticsearch/elasticsearch/elasticsearch
14− - GHCVER=7.8 ESVER=1.4.1 ESFLAG=ES1 DLINK=https://download.elastic.co/elasticsearch/elasticsearch/elasticsearch
15− - GHCVER=7.10 ESVER=1.5.2 ESFLAG=ES1 DLINK=https://download.elastic.co/elasticsearch/elasticsearch/elasticsearch
16− - GHCVER=7.10 ESVER=1.6.0 ESFLAG=ES1 DLINK=https://download.elastic.co/elasticsearch/elasticsearch/elasticsearch
17− - GHCVER=7.10 ESVER=1.7.2 ESFLAG=ES1 DLINK=https://download.elastic.co/elasticsearch/elasticsearch/elasticsearch
18− - GHCVER=8.0 ESVER=1.7.2 ESFLAG=ES1 DLINK=https://download.elastic.co/elasticsearch/elasticsearch/elasticsearch
19− # - GHCVER=8.0 ESVER=2.4.2 ESFLAG=ES1 DLINK=https://download.elastic.co/elasticsearch/release/org/elasticsearch/distribution/tar/elasticsearch/2.4.2/elasticsearch
20− # - GHCVER=8.0 ESVER=2.4.2 ESFLAG=ES5 DLINK=https://download.elastic.co/elasticsearch/release/org/elasticsearch/distribution/tar/elasticsearch/2.4.2/elasticsearch
21− - GHCVER=8.0 ESVER=5.0.2 ESFLAG=ES5 DLINK=https://artifacts.elastic.co/downloads/elasticsearch/elasticsearch ES_JAVA_OPTS="-Xms500m -Xmx750m"
22−
23−# matrix:
24−# allow_failures:
25−# - env: GHCVER=8.0 ESVER=2.4.2 ESFLAG=ES1 DLINK=https://download.elastic.co/elasticsearch/release/org/elasticsearch/distribution/tar/elasticsearch/2.4.2/elasticsearch
26−# - env: GHCVER=8.0 ESVER=2.4.2 ESFLAG=ES5 DLINK=https://download.elastic.co/elasticsearch/release/org/elasticsearch/distribution/tar/elasticsearch/2.4.2/elasticsearch
13+ matrix:
14+ - GHCVER=8.6 ESVER=5.6.0 STACK_YAML=stack.yaml DLINK=https://artifacts.elastic.co/downloads/elasticsearch/elasticsearch ES_JAVA_OPTS="-Xms500m -Xmx750m"
2715
2816install:
2917 # stack
30− - export STACK_YAML=stack-$GHCVER.yaml
3118 - mkdir -p ~/.local/bin
32− - travis_retry curl -L https://github.com/commercialhaskell/stack/releases/download/v1.2.0/stack-1.2.0-linux-x86_64.tar.gz | tar xz --wildcards --strip-components=1 -C ~/.local/bin '*/stack'
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'
3320 - export PATH=~/.local/bin:$PATH
34− - stack --version
35−
21+ - stack --no-terminal --version
3622 # elasticsearch
3723 - wget --no-check-certificate $DLINK-$ESVER.tar.gz
3824 - tar xzf elasticsearch-$ESVER.tar.gz
@@ -41,12 +27,17 @@ install:
4127 - ./elasticsearch-$ESVER/bin/elasticsearch &
4228
4329script:
44− - stack setup
45− - stack update
46− - stack build -j1
47− - stack test bloodhound:doctests --flag bloodhound:$ESFLAG
48− - stack test bloodhound:tests --test-arguments="--qc-max-success 500" --flag bloodhound:$ESFLAG
30+ - stack setup --no-terminal
31+ - stack update --no-terminal
32+ - stack build -j2 --fast --no-terminal
33+ - travis_wait 60 sleep 1800 &
34+ - stack test --fast --no-terminal bloodhound:bloodhound-tests --test-arguments="--qc-max-success 500"
4935
5036cache:
37+ timeout: 1500
5138 directories:
39+ - $HOME/.cabal
40+ - $HOME/.ghc
5241 - $HOME/.stack
42+ - .stack-work/
43+ apt: true
DSL.org+1−1
@@ -1,4 +1,4 @@
1−* ElasticSearch DSL
1+* Elasticsearch DSL
22
33** Grouping
44
Makefile+117−14
@@ -1,26 +1,129 @@
1+.PHONY : build build-validate ghci test test-rerun test-ghci ghcid ghcid-validate \
2+ weeder hlint hlint-watch mod-build
3+
4+.DEFAULT_GOAL = help
5+
6+stack = STACK_YAML='stack.yaml' stack
7+ghc_perf_options = --ghc-options '+RTS -A128M -RTS'
8+build = build $(ghc_perf_options)
9+ghci = ghci $(ghc_perf_options)
10+test = test $(ghc_perf_options)
11+stack-8.0 = STACK_YAML="stack-8.0.yaml" stack
12+stack-8.2 = STACK_YAML="stack-8.2.yaml" stack
13+stack-8.4 = STACK_YAML="stack-8.4.yaml" stack
14+stack-8.6 = STACK_YAML="stack-8.6.yaml" stack
15+elasticsearch_directory = elasticsearch
16+
17+# stack build --ghc-options '+RTS -A128M -RTS'
18+
19+## run build
120build:
2− stack build
21+ $(stack) $(build)
322
4−echo-warn:
5− echo "Make certain you have an elasticsearch instance on localhost:9200 !"
23+## build with validation options (Wall, Werror)
24+build-validate:
25+ $(stack) build --fast --ghc-options '-Wall -Werror +RTS -A128M -RTS'
26+
27+## run ghci
28+ghci:
29+ $(stack) $(ghci)
630
31+## run tests
732test: echo-warn
8− stack test
33+ $(stack) $(test)
934
10−7.8-build:
11− STACK_YAML="stack-7.8.yaml" stack build
35+## run tests with forced re-run via "-r"
36+test-rerun: echo-warn
37+ $(stack) $(test) --test-arguments "-r"
1238
13−7.8-test: echo-warn
14− STACK_YAML="stack-7.8.yaml" stack test
39+## run ghci with test stanza
40+test-ghci:
41+ $(stack) $(ghci) bloodhound:test:bloodhound-tests
1542
16−8.0-build:
17− STACK_YAML="stack-8.0.yaml" stack build
43+## run ghcid
44+ghcid:
45+ ghcid -c "$(stack) ghci bloodhound:lib --test --ghci-options='-fobject-code -fno-warn-unused-do-bind' --main-is bloodhound:test:bloodhound-tests"
1846
19−8.0-test: echo-warn
20− STACK_YAML="stack-8.0.yaml" stack test
47+## run ghcid with validate options (Werror, etc.)
48+ghcid-validate:
49+ ghcid -c "$(stack) ghci bloodhound:lib --test --ghci-options='-Werror -fobject-code -fno-warn-unused-do-bind' --main-is bloodhound:test:bloodhound-tests"
2150
22−ghci:
23− stack ghci
51+## run weeder
52+weeder:
53+ weeder . --build
54+
55+## run hlint
56+hlint:
57+ hlint .
58+
59+## hlint watch with `sos`
60+hlint-watch:
61+ sos src/ -c "hlint ." -p "src/(.*)\.hs"
62+
63+# mod-build:
64+# stack build --ghc-options '+RTS -A128M -RTS'
65+
66+echo-warn:
67+ @echo "Make certain you have an elasticsearch instance on localhost:9200 !"
2468
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"
72+
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"
76+
77+## Build with the GHC 8.0 Stack YAML
78+build-8.0:
79+ $(stack-8.0) $(build)
80+
81+## Build with the GHC 8.2 Stack YAML
82+build-8.2:
83+ $(stack-8.2) $(build)
84+
85+## Build with the GHC 8.4 Stack YAML
86+build-8.4:
87+ $(stack-8.4) $(build)
88+
89+## Build with the GHC 8.6 Stack YAML
90+build-8.6:
91+ $(stack-8.6) $(build)
92+
93+## Upload the package to Hackage
2594upload:
2695 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+17−837
@@ -21,9 +21,19 @@ Endorsements
2121Version compatibility
2222---------------------
2323
24−Elasticsearch \>=1.0 && \<2.0 is recommended. Bloodhound mostly works with 0.9.x, but I don't recommend it if you expect everything to work. As of Bloodhound 0.3 all \>=1.0 && \<2.0 versions of Elasticsearch work. Some (or even most?) features will work with versions \>=2.0, but it is not officially supported yet.
24+As 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
26+for your use case. If you would like to add support for another major
27+version, open a ticket expressing your intend and follow the pattern
28+used for other versions. We weighed the idea of sharing code between
29+versions but it just got too messy, especially considering the
30+instability of the Elasticsearch API. We switched to a model which
31+would allow the persons responsible for a particular protocol version
32+to maintain that version while avoiding conflict with other versions.
33+
34+See our [TravisCI](https://travis-ci.org/bitemyapp/bloodhound) for a
35+listing of Elasticsearch version we test against.
2536
26−Current versions we test against are 1.2.4, 1.3.6, 1.4.1, 1.5.2, 1.6.0, and 1.7.2. We also check that GHC 7.6 and 7.8 both build and pass tests. See our [TravisCI](https://travis-ci.org/bitemyapp/bloodhound) to learn more.
2737
2838Stability
2939---------
@@ -33,15 +43,15 @@ Bloodhound is stable for production use. I will strive to avoid breaking API com
3343Testing
3444---------
3545
36−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.
3747
3848Steps to run the tests locally:
39− 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.
4050 2. Install [Stack] (http://docs.haskellstack.org/en/stable/README.html#how-to-install)
4151 3. In your local Bloodhound directory, run `stack setup && stack build`
42− 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.
4353 5. Run `stack test` in your local Bloodhound directory.
44− 6. The unit tests will pass if you re-execute `stack test`, but some of the doctests might fail due to existing data in ElasticSearch. 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`.
4555
4656
4757Hackage page and Haddock documentation
@@ -57,837 +67,7 @@ It's not using Bloodhound, but if you need an introduction to or overview of Ela
5767Examples
5868========
5969
60−Index Operations
61−----------------
62−
63−### Create Index
64−
65−``` {.haskell}
66−
67−-- Formatted for use in ghci, so there are "let"s in front of the decls.
68−
69−-- if you see :{ and :}, they're so you can copy-paste
70−-- the multi-line examples into your ghci REPL.
71−
72−:set -XDeriveGeneric
73−:set -XOverloadedStrings
74−:{
75−import Control.Applicative
76−import Database.Bloodhound
77−import Data.Aeson
78−import Data.Either (Either(..))
79−import Data.Maybe (fromJust)
80−import Data.Time.Calendar (Day(..))
81−import Data.Time.Clock (secondsToDiffTime, UTCTime(..))
82−import Data.Text (Text)
83−import GHC.Generics (Generic)
84−import Network.HTTP.Client
85−import qualified Network.HTTP.Types.Status as NHTS
86−
87−-- no trailing slashes in servers, library handles building the path.
88−let testServer = (Server "http://localhost:9200")
89−let testIndex = IndexName "twitter"
90−let testMapping = MappingName "tweet"
91−let withBH' = withBH defaultManagerSettings testServer
92−
93−-- defaultIndexSettings is exported by Database.Bloodhound as well
94−let defaultIndexSettings = IndexSettings (ShardCount 3) (ReplicaCount 2)
95−
96−-- createIndex returns MonadBH m => m Reply. You can use withBH for
97−-- one-off commands or you can use runBH to group together commands
98−-- and to pass in your own HTTP manager for pipelining.
99−
100−-- response :: Reply, Reply is a synonym for Network.HTTP.Conduit.Response
101−response <- withBH' $ createIndex defaultIndexSettings testIndex
102−:}
103−
104−```
105−
106−### Delete Index
107−
108−#### Code
109−
110−``` {.haskell}
111−
112−-- response :: Reply
113−response <- withBH' $ deleteIndex testIndex
114−
115−```
116−
117−#### Example Response
118−
119−``` {.haskell}
120−
121−-- print response if it was a success
122−Response {responseStatus = Status {statusCode = 200, statusMessage = "OK"}
123− , responseVersion = HTTP/1.1
124− , responseHeaders = [("Content-Type", "application/json; charset=UTF-8")
125− , ("Content-Length", "21")]
126− , responseBody = "{\"acknowledged\":true}"
127− , responseCookieJar = CJ {expose = []}
128− , responseClose' = ResponseClose}
129−
130−-- if the index to be deleted didn't exist anyway
131−Response {responseStatus = Status {statusCode = 404, statusMessage = "Not Found"}
132− , responseVersion = HTTP/1.1
133− , responseHeaders = [("Content-Type", "application/json; charset=UTF-8")
134− , ("Content-Length","65")]
135− , responseBody = "{\"error\":\"IndexMissingException[[twitter] missing]\",\"status\":404}"
136− , responseCookieJar = CJ {expose = []}
137− , responseClose' = ResponseClose}
138−
139−```
140−
141−### Refresh Index
142−
143−#### Note, you **have** to do this if you expect to read what you just wrote
144−
145−``` {.haskell}
146−
147−resp <- withBH' $ refreshIndex testIndex
148−
149−```
150−
151−#### Example Response
152−
153−``` {.haskell}
154−
155−-- print resp on success
156−Response {responseStatus = Status {statusCode = 200, statusMessage = "OK"}
157− , responseVersion = HTTP/1.1
158− , responseHeaders = [("Content-Type", "application/json; charset=UTF-8")
159− , ("Content-Length","50")]
160− , responseBody = "{\"_shards\":{\"total\":10,\"successful\":5,\"failed\":0}}"
161− , responseCookieJar = CJ {expose = []}
162− , responseClose' = ResponseClose}
163−
164−```
165−
166−Mapping Operations
167−------------------
168−
169−### Create Mapping
170−
171−``` {.haskell}
172−
173−-- don't forget imports and the like at the top.
174−
175−data TweetMapping = TweetMapping deriving (Eq, Show)
176−
177−-- I know writing the JSON manually sucks.
178−-- I don't have a proper data type for Mappings yet.
179−-- Let me know if this is something you need.
180−
181−:{
182−instance ToJSON TweetMapping where
183− toJSON TweetMapping =
184− object ["properties" .=
185− object ["location" .=
186− object ["type" .= ("geo_point" :: Text)]]]
187−:}
188−
189−resp <- withBH' $ putMapping testIndex testMapping TweetMapping
190−
191−```
192−
193−### Delete Mapping
194−
195−``` {.haskell}
196−
197−resp <- withBH' $ deleteMapping testIndex testMapping
198−
199−```
200−
201−Document Operations
202−-------------------
203−
204−### Indexing Documents
205−
206−``` {.haskell}
207−
208−-- don't forget the imports and derive generic setting for ghci
209−-- at the beginning of the examples.
210−
211−:{
212−data Location = Location { lat :: Double
213− , lon :: Double } deriving (Eq, Generic, Show)
214−
215−data Tweet = Tweet { user :: Text
216− , postDate :: UTCTime
217− , message :: Text
218− , age :: Int
219− , location :: Location } deriving (Eq, Generic, Show)
220−
221−exampleTweet = Tweet { user = "bitemyapp"
222− , postDate = UTCTime
223− (ModifiedJulianDay 55000)
224− (secondsToDiffTime 10)
225− , message = "Use haskell!"
226− , age = 10000
227− , location = Location 40.12 (-71.34) }
228−
229−-- automagic (generic) derivation of instances because we're lazy.
230−instance ToJSON Tweet
231−instance FromJSON Tweet
232−instance ToJSON Location
233−instance FromJSON Location
234−:}
235−
236−-- Should be able to toJSON and encode the data structures like this:
237−-- λ> toJSON $ Location 10.0 10.0
238−-- Object fromList [("lat",Number 10.0),("lon",Number 10.0)]
239−-- λ> encode $ Location 10.0 10.0
240−-- "{\"lat\":10,\"lon\":10}"
241−
242−resp <- withBH' $ indexDocument testIndex testMapping defaultIndexDocumentSettings exampleTweet (DocId "1")
243−
244−```
245−
246−#### Example Response
247−
248−``` {.haskell}
249−
250−Response {responseStatus =
251− Status {statusCode = 200, statusMessage = "OK"}
252− , responseVersion = HTTP/1.1, responseHeaders =
253− [("Content-Type","application/json; charset=UTF-8"),
254− ("Content-Length","75")]
255− , responseBody = "{\"_index\":\"twitter\",\"_type\":\"tweet\",\"_id\":\"1\",\"_version\":2,\"created\":false}"
256− , responseCookieJar = CJ {expose = []}, responseClose' = ResponseClose}
257−
258−```
259−
260−### Deleting Documents
261−
262−``` {.haskell}
263−
264−resp <- withBH' $ deleteDocument testIndex testMapping (DocId "1")
265−
266−```
267−
268−### Getting Documents
269−
270−``` {.haskell}
271−
272−-- n.b., you'll need the earlier imports. responseBody is from http-conduit
273−
274−resp <- withBH' $ getDocument testIndex testMapping (DocId "1")
275−
276−-- responseBody :: Response body -> body
277−let body = responseBody resp
278−
279−-- you have two options, you use decode and just get Maybe (EsResult Tweet)
280−-- or you can use eitherDecode and get Either String (EsResult Tweet)
281−
282−let maybeResult = decode body :: Maybe (EsResult Tweet)
283−-- the explicit typing is so Aeson knows how to parse the JSON.
284−
285−-- use either if you want to know why something failed to parse.
286−-- (string errors, sadly)
287−let eitherResult = eitherDecode body :: Either String (EsResult Tweet)
288−
289−-- print eitherResult should look like:
290−Right (EsResult {_index = "twitter"
291− , _type = "tweet"
292− , _id = "1"
293− , foundResult = Just (EsResultFound { _version = 2
294− , _source = Tweet {user = "bitemyapp"
295− , postDate = 2009-06-18 00:00:10 UTC
296− , message = "Use haskell!"
297− , age = 10000
298− , location = Location {lat = 40.12, lon = -71.34}}})})
299−
300−-- _source in EsResultFound is parametric, we dispatch the type by passing in what we expect (Tweet) as a parameter to EsResult.
301−
302−-- use the _source record accessor to get at your document
303−fmap (fmap _source . foundResult) eitherResult
304−Right (Just (Tweet {user = "bitemyapp"
305− , postDate = 2009-06-18 00:00:10 UTC
306− , message = "Use haskell!"
307− , age = 10000
308− , location = Location {lat = 40.12, lon = -71.34}}))
309−
310−```
311−
312−Bulk Operations
313−---------------
314−
315−### Bulk create, index
316−
317−``` {.haskell}
318−
319−-- don't forget the imports and derive generic setting for ghci
320−-- at the beginning of the examples.
321−
322−:{
323−-- Using the earlier Tweet datatype and exampleTweet data
324−
325−-- just changing up the data a bit.
326−let bulkTest = exampleTweet { user = "blah" }
327−let bulkTestTwo = exampleTweet { message = "woohoo!" }
328−
329−-- create only bulk operation
330−-- BulkCreate :: IndexName -> MappingName -> DocId -> Value -> BulkOperation
331−let firstOp = BulkCreate testIndex
332− testMapping (DocId "3") (toJSON bulkTest)
333−
334−-- index operation "create or update"
335−let sndOp = BulkIndex testIndex
336− testMapping (DocId "4") (toJSON bulkTestTwo)
337−
338−-- Some explanation, the final "Value" type that BulkIndex,
339−-- BulkCreate, and BulkUpdate accept is the actual document
340−-- data that your operation applies to. BulkDelete doesn't
341−-- take a value because it's just deleting whatever DocId
342−-- you pass.
343−
344−-- list of bulk operations
345−let stream = [firstDoc, secondDoc]
346−
347−-- Fire off the actual bulk request
348−-- bulk :: Vector BulkOperation -> IO Reply
349−resp <- withBH' $ bulk stream
350−:}
351−
352−```
353−
354−### Encoding individual bulk API operations
355−
356−``` {.haskell}
357−-- the following functions are exported in Bloodhound so
358−-- you can build up bulk operations yourself
359−encodeBulkOperations :: V.Vector BulkOperation -> L.ByteString
360−encodeBulkOperation :: BulkOperation -> L.ByteString
361−
362−-- How to use the above:
363−data BulkTest = BulkTest { name :: Text } deriving (Eq, Generic, Show)
364−instance FromJSON BulkTest
365−instance ToJSON BulkTest
366−
367−_ <- insertData
368−let firstTest = BulkTest "blah"
369−let secondTest = BulkTest "bloo"
370−let firstDoc = BulkIndex testIndex
371− testMapping (DocId "2") (toJSON firstTest)
372−let secondDoc = BulkCreate testIndex
373− testMapping (DocId "3") (toJSON secondTest)
374−let stream = V.fromList [firstDoc, secondDoc] :: V.Vector BulkOperation
375−
376−-- to encode yourself
377−let firstDocEncoded = encode firstDoc :: L.ByteString
378−
379−-- to encode a vector of bulk operations
380−let encodedOperations = encodeBulkOperations stream
381−
382−-- to insert into a particular server
383−-- bulk :: V.Vector BulkOperation -> IO Reply
384−_ <- withBH' $ bulk streamp
385−
386−```
387−
388−Search
389−------
390−
391−### Querying
392−
393−#### Term Query
394−
395−``` {.haskell}
396−
397−-- exported by the Client module, just defaults some stuff.
398−-- mkSearch :: Maybe Query -> Maybe Filter -> Search
399−-- mkSearch query filter = Search query filter Nothing False (From 0) (Size 10) Nothing
400−
401−let query = TermQuery (Term "user" "bitemyapp") Nothing
402−
403−-- AND'ing identity filter with itself and then tacking it onto a query
404−-- search should be a null-operation. I include it for the sake of example.
405−-- <||> (or/plus) should make it into a search that returns everything.
406−
407−let filter = IdentityFilter <&&> IdentityFilter
408−
409−-- constructing the search object the searchByIndex function dispatches on.
410−let search = mkSearch (Just query) (Just filter)
411−
412−-- you can also searchByType and specify the mapping name.
413−reply <- withBH' $ searchByIndex testIndex search
414−
415−let result = eitherDecode (responseBody reply) :: Either String (SearchResult Tweet)
416−
417−λ> fmap (hits . searchHits) result
418−Right [Hit {hitIndex = IndexName "twitter"
419− , hitType = MappingName "tweet"
420− , hitDocId = DocId "1"
421− , hitScore = 0.30685282
422− , hitSource = Tweet {user = "bitemyapp"
423− , postDate = 2009-06-18 00:00:10 UTC
424− , message = "Use haskell!"
425− , age = 10000
426− , location = Location {lat = 40.12, lon = -71.34}}}]
427−
428−```
429−
430−#### Match Query
431−
432−``` {.haskell}
433−
434−let query = QueryMatchQuery $ mkMatchQuery (FieldName "user") (QueryString "bitemyapp")
435−let search = mkSearch (Just query) Nothing
436−
437−```
438−
439−#### Multi-Match Query
440−
441−``` {.haskell}
442−
443−let fields = [FieldName "user", FieldName "message"]
444−let query = QueryMultiMatchQuery $ mkMultiMatchQuery fields (QueryString "bitemyapp")
445−let search = mkSearch (Just query) Nothing
446−
447−```
448−
449−#### Bool Query
450−
451−``` {.haskell}
452−
453−let innerQuery = QueryMatchQuery $
454− mkMatchQuery (FieldName "user") (QueryString "bitemyapp")
455−let query = QueryBoolQuery $
456− mkBoolQuery [innerQuery] [] []
457−let search = mkSearch (Just query) Nothing
458−
459−```
460−
461−#### Boosting Query
462−
463−``` {.haskell}
464−
465−let posQuery = QueryMatchQuery $
466− mkMatchQuery (FieldName "user") (QueryString "bitemyapp")
467−let negQuery = QueryMatchQuery $
468− mkMatchQuery (FieldName "user") (QueryString "notmyapp")
469−let query = QueryBoostingQuery $
470− BoostingQuery posQuery negQuery (Boost 0.2)
471−
472−```
473−
474−#### Rest of the query/filter types
475−
476−Just follow the pattern you've seen here and check the Hackage API documentation.
477−
478−### Sorting
479−
480−``` {.haskell}
481−
482−let sortSpec = DefaultSortSpec $ mkSort (FieldName "age") Ascending
483−
484−-- mkSort is a shortcut function that takes a FieldName and a SortOrder
485−-- to generate a vanilla DefaultSort.
486−-- checkt the DefaultSort type for the full list of customizable options.
487−
488−-- From and size are integers for pagination.
489−
490−-- When sorting on a field, scores are not computed. By setting TrackSortScores to true, scores will still be computed and tracked.
491−
492−-- type Sort = [SortSpec]
493−-- type TrackSortScores = Bool
494−-- type From = Int
495−-- type Size = Int
496−
497−-- Search takes Maybe Query
498−-- -> Maybe Filter
499−-- -> Maybe Sort
500−-- -> TrackSortScores
501−-- -> From -> Size
502−-- -> Maybe [FieldName]
503−
504−-- just add more sortspecs to the list if you want tie-breakers.
505−let search = Search Nothing (Just IdentityFilter) (Just [sortSpec]) False (From 0) (Size 10) Nothing
506−
507−```
508−
509−### Field selection
510−
511−If you only want certain fields from the source document returned, you can
512−set the "fields" field of the Search record.
513−
514−``` {.haskell}
515−
516−let search' = mkSearch (Just (MatchAllQuery Nothing)) Nothing
517− search = search' { fields = Just [FieldName "updated"] }
518−
519−```
520−
521−### Filtering
522−
523−#### And, Not, and Or filters
524−
525−Filters form a monoid and seminearring.
526−
527−``` {.haskell}
528−
529−instance Monoid Filter where
530− mempty = IdentityFilter
531− mappend a b = AndFilter [a, b] defaultCache
532−
533−instance Seminearring Filter where
534− a <||> b = OrFilter [a, b] defaultCache
535−
536−-- AndFilter and OrFilter take [Filter] as an argument.
537−
538−-- This will return anything, because IdentityFilter returns everything
539−OrFilter [IdentityFilter, someOtherFilter] False
540−
541−-- This will return exactly what someOtherFilter returns
542−AndFilter [IdentityFilter, someOtherFilter] False
543−
544−-- Thanks to the seminearring and monoid, the above can be expressed as:
545−
546−-- "and"
547−IdentityFilter <&&> someOtherFilter
548−
549−-- "or"
550−IdentityFilter <||> someOtherFilter
551−
552−-- Also there is a NotFilter, it only accepts a single filter, not a list.
553−
554−NotFilter someOtherFilter False
555−
556−```
557−
558−#### Identity Filter
559−
560−``` {.haskell}
561−
562−-- And'ing two Identity
563−let queryFilter = IdentityFilter <&&> IdentityFilter
564−
565−let search = mkSearch Nothing (Just queryFilter)
566−
567−reply <- withBH' $ searchByType testIndex testMapping search
568−
569−```
570−
571−#### Boolean Filter
572−
573−Similar to boolean queries.
574−
575−``` {.haskell}
576−
577−-- Will return only items whose "user" field contains the term "bitemyapp"
578−let queryFilter = BoolFilter (MustMatch (Term "user" "bitemyapp") False)
579−
580−-- Will return only items whose "user" field does not contain the term "bitemyapp"
581−let queryFilter = BoolFilter (MustNotMatch (Term "user" "bitemyapp") False)
582−
583−-- The clause (query) should appear in the matching document.
584−-- In a boolean query with no must clauses, one or more should
585−-- clauses must match a document. The minimum number of should
586−-- clauses to match can be set using the minimum_should_match parameter.
587−let queryFilter = BoolFilter (ShouldMatch [(Term "user" "bitemyapp")] False)
588−
589−```
590−
591−#### Exists Filter
592−
593−``` {.haskell}
594−
595−-- Will filter for documents that have the field "user"
596−let existsFilter = ExistsFilter (FieldName "user")
597−
598−```
599−
600−#### Geo BoundingBox Filter
601−
602−``` {.haskell}
603−
604−-- topLeft and bottomRight
605−let box = GeoBoundingBox (LatLon 40.73 (-74.1)) (LatLon 40.10 (-71.12))
606−
607−let constraint = GeoBoundingBoxConstraint (FieldName "tweet.location") box False GeoFilterMemory
608−
609−```
610−
611−#### Geo Distance Filter
612−
613−``` {.haskell}
614−
615−let geoPoint = GeoPoint (FieldName "tweet.location") (LatLon 40.12 (-71.34))
616−
617−-- coefficient and units
618−let distance = Distance 10.0 Miles
619−
620−-- GeoFilterType or NoOptimizeBbox
621−let optimizeBbox = OptimizeGeoFilterType GeoFilterMemory
622−
623−-- SloppyArc is the usual/default optimization in Elasticsearch today
624−-- but pre-1.0 versions will need to pick Arc or Plane.
625−
626−let geoFilter = GeoDistanceFilter geoPoint distance SloppyArc optimizeBbox False
627−
628−```
629−
630−#### Geo Distance Range Filter
631−
632−Think of a donut and you won't be far off.
633−
634−``` {.haskell}
635−
636−let geoPoint = GeoPoint (FieldName "tweet.location") (LatLon 40.12 (-71.34))
637−
638−let distanceRange = DistanceRange (Distance 0.0 Miles) (Distance 10.0 Miles)
639−
640−let geoFilter = GeoDistanceRangeFilter geoPoint distanceRange
641−
642−```
643−
644−#### Geo Polygon Filter
645−
646−``` {.haskell}
647−
648−-- I think I drew a square here.
649−let points = [LatLon 40.0 (-70.00),
650− LatLon 40.0 (-72.00),
651− LatLon 41.0 (-70.00),
652− LatLon 41.0 (-72.00)]
653−
654−let geoFilter = GeoPolygonFilter (FieldName "tweet.location") points
655−
656−```
657−
658−#### Document IDs filter
659−
660−``` {.haskell}
661−
662−-- takes a mapping name and a list of DocIds
663−IdsFilter (MappingName "tweet") [DocId "1"]
664−
665−```
666−
667−#### Range Filter
668−
669−``` {.haskell}
670−
671−-- RangeFilter :: FieldName
672−-- -> RangeValue
673−-- -> RangeExecution
674−-- -> Cache -> Filter
675−
676−let filter = RangeFilter (FieldName "age")
677− (RangeGtLt (GreaterThan 1000.0) (LessThan 100000.0))
678− RangeExecutionIndex False
679−
680−```
681−
682−``` {.haskell}
683−
684−let filter = RangeFilter (FieldName "age")
685− (RangeLte (LessThanEq 100000.0))
686− RangeExecutionIndex False
687−
688−```
689−
690−##### Date Ranges
691−
692−Date ranges are expressed in UTCTime. Date ranges use the same range bound constructors as numerics, except that they end in "D".
693−
694−Note that compatibility with ES is tested only down to seconds.
695−
696−``` {.haskell}
697−
698−let filter = RangeFilter (FieldName "postDate")
699− (RangeDateGtLte
700− (GreaterThanD (UTCTime
701− (ModifiedJulianDay 55000)
702− (secondsToDiffTime 9)))
703− (LessThanEqD (UTCTime
704− (ModifiedJulianDay 55000)
705− (secondsToDiffTime 11))))
706− RangeExecutionIndex False
707−```
708−
709−#### Regexp Filter
710−
711−``` {.haskell}
712−
713−-- RegexpFilter
714−-- :: FieldName
715−-- -> Regexp
716−-- -> RegexpFlags
717−-- -> CacheName
718−-- -> Cache
719−-- -> CacheKey
720−-- -> Filter
721−let filter = RegexpFilter (FieldName "user") (Regexp "bite.*app")
722− AllRegexpFlags (CacheName "test") False (CacheKey "key")
723−
724−-- n.b.
725−-- data RegexpFlags = AllRegexpFlags
726−-- | NoRegexpFlags
727−-- | SomeRegexpFlags (NonEmpty RegexpFlag) deriving (Eq, Show)
728−
729−-- data RegexpFlag = AnyString
730−-- | Automaton
731−-- | Complement
732−-- | Empty
733−-- | Intersection
734−-- | Interval deriving (Eq, Show)
735−
736−```
737−
738−### Aggregations
739−
740−#### Adding aggregations to search
741−
742−Aggregations can now be added to search queries, or made on their own.
743−
744−``` {.haskell}
745−type Aggregations = M.Map Text Aggregation
746−data Aggregation
747− = TermsAgg TermsAggregation
748− | DateHistogramAgg DateHistogramAggregation
749−```
750−
751−For convenience, \`\`\`mkAggregations\`\`\` exists, that will create an \`\`\`Aggregations\`\`\` with the aggregation provided.
752−
753−For example:
754−
755−``` {.haskell}
756− let a = mkAggregations "users" $ TermsAgg $ mkTermsAggregation "user"
757− let search = mkAggregateSearch Nothing a
758−```
759−
760−Aggregations can be added to an existing search, using the \`\`\`aggBody\`\`\` field
761−
762−``` {.haskell}
763− let search = mkSearch (Just (MatchAllQuery Nothing)) Nothing
764− let search' = search {aggBody = Just a}
765−```
766−
767−Since the \`\`\`Aggregations\`\`\` structure is just a Map Text Aggregation, M.insert can be used to add additional aggregations.
768−
769−``` {.haskell}
770− let a' = M.insert "age" (TermsAgg $ mkTermsAggregation "age") a
771−```
772−
773−#### Extracting aggregations from results
774−
775−Aggregations are part of the reply structure of every search, in the
776−form of `Maybe AggregationResults`
777−
778−``` {.haskell}
779−-- Lift decode and response body to be in the IO monad.
780−let decode' = liftM decode
781−let responseBody' = liftM responseBody
782−let reply = withBH' $ searchByIndex testIndex search
783−let response = decode' $ responseBody' reply :: IO (Maybe (SearchResult Tweet))
784−
785−-- Now that we have our response, we can extract our terms aggregation result -- which is a list of buckets.
786−
787−let terms = do { response' <- response; return $ response' >>= aggregations >>= toTerms "users" }
788−terms
789−Just (Bucket {buckets = [TermsResult {termKey = "bitemyapp", termsDocCount = 1, termsAggs = Nothing}]})
790−```
791−
792−Note that bucket aggregation results, such as the TermsResult is a member of the type class `BucketAggregation`:
793−
794−``` {.haskell}
795−class BucketAggregation a where
796− key :: a -> Text
797− docCount :: a -> Int
798− aggs :: a -> Maybe AggregationResults
799−```
800−
801−You can use the `aggs` function to get any nested results, if there
802−were any. For example, if there were a nested terms aggregation keyed
803−to "age" in a TermsResult named `termresult` , you would call `aggs
804−termresult >>= toTerms "age"`
805−
806−#### Terms Aggregation
807−
808−``` {.haskell}
809−data TermsAggregation
810− = TermsAggregation {term :: Either Text Text,
811− termInclude :: Maybe TermInclusion,
812− termExclude :: Maybe TermInclusion,
813− termOrder :: Maybe TermOrder,
814− termMinDocCount :: Maybe Int,
815− termSize :: Maybe Int,
816− termShardSize :: Maybe Int,
817− termCollectMode :: Maybe CollectionMode,
818− termExecutionHint :: Maybe ExecutionHint,
819− termAggs :: Maybe Aggregations}
820−```
821−
822−Term Aggregations have two factory functions, `mkTermsAggregation`, and
823−`mkTermsScriptAggregation`, and can be used as follows:
824−
825−``` {.haskell}
826−let ta = TermsAgg $ mkTermsAggregation "user"
827−```
828−
829−There are of course other options that can be added to a Terms Aggregation, such as the collection mode:
830−
831−``` {.haskell}
832−let ta = mkTermsAggregation "user"
833−let ta' = ta { termCollectMode = Just BreadthFirst }
834−let ta'' = TermsAgg ta'
835−```
836−
837−For more documentation on how the Terms Aggregation works, see <https://www.elastic.co/guide/en/elasticsearch/reference/current/search-aggregations-bucket-terms-aggregation.html>
838−
839−#### Date Histogram Aggregation
840−
841−``` {.haskell}
842−data DateHistogramAggregation
843− = DateHistogramAggregation {dateField :: FieldName,
844− dateInterval :: Interval,
845− dateFormat :: Maybe Text,
846− datePreZone :: Maybe Text,
847− datePostZone :: Maybe Text,
848− datePreOffset :: Maybe Text,
849− datePostOffset :: Maybe Text,
850− dateAggs :: Maybe Aggregations}
851−```
852−
853−The Date Histogram Aggregation works much the same as the Terms Aggregation.
854−
855−Relevant functions include `mkDateHistogram`, and `toDateHistogram`
856−
857−``` {.haskell}
858−let dh = DateHistogramAgg (mkDateHistogram (FieldName "postDate") Minute)
859−```
860−
861−Date histograms also accept a `FractionalInterval`:
862−
863−``` {.haskell}
864−FractionalInterval :: Float -> TimeInterval -> Interval
865−-- TimeInterval is the following:
866−data TimeInterval = Weeks | Days | Hours | Minutes | Seconds
867−```
868−
869−It can be used as follows:
870−
871−``` {.haskell}
872−let dh = DateHistogramAgg (mkDateHistogram (FieldName "postDate") (FractionalInterval 1.5 Minutes))
873−```
874−
875−The `DateHistogramResult` is defined as:
876−
877−``` {.haskell}
878−data DateHistogramResult
879− = DateHistogramResult {dateKey :: Int,
880− dateKeyStr :: Maybe Text,
881− dateDocCount :: Int,
882− dateHistogramAggs :: Maybe AggregationResults}
883−```
884−
885−It is an instance of `BucketAggregation`, and can have nested aggregations in each bucket.
886−
887−Buckets can be extracted from an `AggregationResult` using
888−`toDateHistogram name`
889−
890−For more information on the Date Histogram Aggregation, see: <https://www.elastic.co/guide/en/elasticsearch/reference/current/search-aggregations-bucket-datehistogram-aggregation.html>
70+See the [examples](htts://github.com/bitemyapp/bloodhound/tree/master/examples) directory for example code.
89171
89272
89373Contributors
bloodhound.cabaldeleted−117
@@ -1,117 +0,0 @@
1−name: bloodhound
2−version: 0.13.0.0
3−synopsis: ElasticSearch client library for Haskell
4−description: ElasticSearch made awesome for Haskell hackers
5−homepage: https://github.com/bitemyapp/bloodhound
6−license: BSD3
7−license-file: LICENSE
8−author: Chris Allen
9−maintainer: cma@bitemyapp.com
10−copyright: 2015, Chris Allen
11−category: Database, Search
12−build-type: Simple
13−cabal-version: >=1.10
14−
15−extra-source-files:
16− README.md
17− changelog.md
18−
19−source-repository head
20− type: git
21− location: https://github.com/bitemyapp/bloodhound.git
22−
23−Flag ES1
24− Description: Run the test suite against an Elasticsearch 1.x server
25− Default: True
26−
27−Flag ES5
28− Description: Run the test suite against an Elasticsearch 5.x server
29− Default: False
30−
31−library
32− ghc-options: -Wall
33− exposed-modules: Database.V1.Bloodhound
34− Database.V1.Bloodhound.Client
35− Database.V1.Bloodhound.Types
36− Database.V1.Bloodhound.Types.Class
37− Database.V1.Bloodhound.Types.Internal
38− Database.V5.Bloodhound
39− Database.V5.Bloodhound.Client
40− Database.V5.Bloodhound.Types
41− Database.V5.Bloodhound.Types.Class
42− Database.V5.Bloodhound.Types.Internal
43− hs-source-dirs: src
44− build-depends: base >= 4.3 && <5,
45− bytestring >= 0.10.0 && <0.11,
46− containers >= 0.5.0.0 && <0.6,
47− aeson >= 0.11.1 && <1.2,
48− http-client >= 0.4.30 && <0.6,
49− network-uri >= 2.6 && <2.7,
50− semigroups >= 0.15 && <0.19,
51− time >= 1.4 && <1.7,
52− text >= 0.11 && <1.3,
53− mtl >= 1.0 && <2.3,
54− transformers >= 0.2 && <0.6,
55− http-types >= 0.8 && <0.10,
56− vector >= 0.10.9 && <0.12,
57− scientific >= 0.3.0.0 && <0.4.0.0,
58− exceptions,
59− data-default-class,
60− blaze-builder,
61− unordered-containers,
62− mtl-compat,
63− hashable
64− default-language: Haskell2010
65−
66−test-suite tests
67− ghc-options: -Wall -fno-warn-orphans
68− type: exitcode-stdio-1.0
69− main-is: tests.hs
70− if flag(ES5)
71− hs-source-dirs: tests/V5
72− else
73− hs-source-dirs: tests/V1
74−
75− build-depends: base,
76− bloodhound,
77− bytestring,
78− http-client,
79− http-types,
80− containers,
81− hspec >= 1.8 && <2.4,
82− text,
83− time,
84− aeson,
85− semigroups,
86− QuickCheck,
87− vector,
88− unordered-containers >= 0.2.5.0 && <0.3,
89− mtl,
90− quickcheck-properties,
91− generics-sop >=0.2 && <0.3,
92− errors,
93− exceptions,
94− temporary,
95− unix-compat,
96− network-uri
97− default-language: Haskell2010
98−
99−test-suite doctests
100− ghc-options: -threaded -Wall
101− default-language: Haskell2010
102− type: exitcode-stdio-1.0
103− main-is: doctests.hs
104− hs-source-dirs: src
105− if flag(ES5)
106− hs-source-dirs: tests/V5
107− else
108− hs-source-dirs: tests/V1
109− if impl(ghc >= 7.8)
110− build-depends: base,
111− aeson,
112− bloodhound,
113− directory,
114− doctest >= 0.10.1,
115− filepath
116− else
117− buildable: False
changelog.md+107
@@ -1,3 +1,110 @@
1+0.17.0.0
2+========
3+- @bitemyapp
4+ - Removed V1 modules and support.
5+ - Removed the cabal file, replaced with an Hpack `package.yaml`.
6+- @JoseD92
7+ - Removed the disused `Seminearring` class.
8+ - Added Docker Compose support.
9+
10+0.16.0.0
11+========
12+- @bitemyapp
13+ - Reorganized V5 modules internally, ripped out Generic,
14+ rewrote part of the test suite.
15+ - Added message field to EsProtocolException
16+ - Switch from Data.Version to Data.SemVer to support parsing broader version format.
17+ - Drop support for GHC < 8.0
18+ - Remove upper bound on aeson.
19+- @mxavier
20+ - Reorganized V1 modules, mirroring the work done on V5.
21+- @andrewthad
22+ - Added support for autogenerated elasticsearch ids in the bulk API
23+ - Added support for token filters
24+ - Added action for searching multiple indices
25+- @lunaris
26+ - Added support for scripts fields and function score queries
27+- @bermanjosh
28+ - Added support for direct generators
29+- @rvl
30+ - Add [character filters][] to the `AnalyzerDefinition` type.
31+ - Add the "stemmer" and "stop" [token filters][] to `TokenFilterDefinition`.
32+- @ahodgen
33+ - Add support for wildcard queries
34+- @ashutoshrishi
35+ - Added [fuzziness][] option to a Match Query
36+ - Added support for "AUTO" Fuzziness alongside a numeric value.
37+
38+[Character Filters]: https://www.elastic.co/guide/en/elasticsearch/reference/5.6/analysis-charfilters.html
39+[Token Filters]: https://www.elastic.co/guide/en/elasticsearch/reference/5.6/analysis-tokenfilters.html
40+[Fuzziness]: https://www.elastic.co/guide/en/elasticsearch/reference/current/common-options.html#fuzziness
41+
42+0.15.0.2
43+========
44+- @michaelxavier
45+ - Allow http-types 0.12
46+
47+0.15.0.1
48+========
49+- @bitemyapp
50+ - Allow http-types 0.11
51+ - Removed unused `oPath` function
52+
53+0.15.0.0
54+===================
55+
56+- @jagare
57+ - #204 Fix bug where Location was used instad of LatLon
58+ - #207 Add instructions on how to run example code
59+
60+- @andrewthad
61+ - #200 Add function for deleting alias
62+ - #201 Add BulkCreateEncoding, which allows use of aeson's Encoding for faster bulk creates
63+ - #203 Add support for total fields limit
64+
65+- @chrissound
66+ - #196 Add missing import to example
67+
68+- @tmcgilchrist
69+ - #186 Fix warnings and drop redundant constraints
70+
71+- @23Skidoo
72+ - #183 Bump dependencies to support GHC 8.2
73+
74+- @bermanjosh
75+ - #182 Support for Suggesters and Template Queries
76+
77+- @dawei-dev
78+ - #181 Fix typo
79+
80+
81+0.14.0.0
82+===================
83+
84+- @bitemyapp
85+ - Aeson 1.2
86+
87+- @shmish111
88+ - #177 Added stats aggregation
89+
90+- @justinwhite
91+ - #176 Fixed typo
92+
93+- @WraithM
94+ - #175 Sorted version of getInitialScroll for V5 client
95+
96+0.13.0.0
97+===================
98+
99+- @michaelxavier
100+ - #174 doctests are bad
101+ - #171 Added Semigroup instances
102+ - #165 Aeson 1.1
103+
104+- @bermanjosh
105+ - #168 Sub-aggregation support
106+ - #167 Limit QuickCheck to 500 checks
107+
11080.12.1.0
2109===================
3110* @michaelxavier
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/LICENSEnew file+12
@@ -0,0 +1,12 @@
1+Copyright (c) 2014, Chris Allen
2+All rights reserved.
3+
4+Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met:
5+
6+1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer.
7+
8+2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution.
9+
10+3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission.
11+
12+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
examples/Makefilenew file+5
@@ -0,0 +1,5 @@
1+build:
2+ stack build
3+
4+ghci:
5+ stack ghci
examples/README.mdnew file+6
@@ -0,0 +1,6 @@
1+# Bloodhound Examples
2+
3+These examples can be built via `stack build`.
4+To run them start an Elasticsearch 5.x server at `localhost:9200`
5+
6+Run with `stack exec tweet-example`
examples/Setup.hsnew file+2
@@ -0,0 +1,2 @@
1+import Distribution.Simple
2+main = defaultMain
examples/Tweet.hsnew file+108
@@ -0,0 +1,108 @@
1+{-# LANGUAGE DeriveGeneric #-}
2+{-# LANGUAGE OverloadedStrings #-}
3+module Main
4+ ( main
5+ ) where
6+
7+
8+import Control.Monad.IO.Class (liftIO)
9+import Data.Aeson (FromJSON (..), defaultOptions,
10+ genericParseJSON, genericToJSON,
11+ object, (.=))
12+import Data.List.NonEmpty (NonEmpty (..))
13+import Data.Text (Text)
14+import Data.Time.Calendar (Day (..))
15+import Data.Time.Clock (UTCTime (..), secondsToDiffTime)
16+import qualified Data.Vector as V
17+import Database.Bloodhound
18+import GHC.Generics (Generic)
19+import Network.HTTP.Client (defaultManagerSettings)
20+
21+
22+data TweetMapping = TweetMapping deriving (Eq, Show)
23+
24+instance ToJSON TweetMapping where
25+ toJSON TweetMapping =
26+ object
27+ [ "properties" .=
28+ object ["location" .= object ["type" .= ("geo_point" :: Text)]]
29+ ]
30+
31+data Tweet = Tweet
32+ { user :: Text
33+ , postDate :: UTCTime
34+ , message :: Text
35+ , age :: Int
36+ , location :: LatLon
37+ } deriving (Eq, Generic, Show)
38+
39+
40+exampleTweet :: Tweet
41+exampleTweet =
42+ Tweet
43+ { user = "bitemyapp"
44+ , postDate = UTCTime (ModifiedJulianDay 55000) (secondsToDiffTime 10)
45+ , message = "Use haskell!"
46+ , age = 10000
47+ , location = loc
48+ }
49+ where
50+ loc = LatLon {lat = 40.12, lon = -71.3}
51+
52+instance ToJSON Tweet where
53+ toJSON = genericToJSON defaultOptions
54+instance FromJSON Tweet where
55+ parseJSON = genericParseJSON defaultOptions
56+
57+
58+main :: IO ()
59+main = runBH' $ do
60+ -- set up index
61+ _ <- createIndex indexSettings testIndex
62+ True <- indexExists testIndex
63+ _ <- putMapping testIndex testMapping TweetMapping
64+
65+ -- create a tweet
66+ resp <- indexDocument testIndex testMapping defaultIndexDocumentSettings exampleTweet (DocId "1")
67+ liftIO (print resp)
68+ -- Response {responseStatus = Status {statusCode = 201, statusMessage = "Created"}, responseVersion = HTTP/1.1, responseHeaders = [("Content-Type","application/json; charset=UTF-8"),("Content-Length","74")], responseBody = "{\"_index\":\"twitter\",\"_type\":\"tweet\",\"_id\":\"1\",\"_version\":1,\"created\":true}", responseCookieJar = CJ {expose = []}, responseClose' = ResponseClose}
69+
70+ -- bulk load
71+ let stream = V.fromList [BulkIndex testIndex testMapping (DocId "2") (toJSON exampleTweet)]
72+ _ <- bulk stream
73+ -- Bulk loads require an index refresh before new data is loaded.
74+ _ <- refreshIndex testIndex
75+
76+ -- set up some aliases
77+ let aliasName = IndexName "twitter-alias"
78+ let iAlias = IndexAlias testIndex (IndexAliasName aliasName)
79+ let aliasRouting = Nothing
80+ let aliasFiltering = Nothing
81+ let aliasCreate = IndexAliasCreate aliasRouting aliasFiltering
82+ _ <- updateIndexAliases (AddAlias iAlias aliasCreate :| [])
83+ True <- indexExists aliasName
84+
85+ -- create a template so that if we just write into an index named tweet-2017-01-02, for instance, the index will be automatically created with the given mapping. This is a great idea for any ongoing indices because it makes them much easier to manage and rotate.
86+ let idxTpl = IndexTemplate (TemplatePattern "tweet-*") (Just (IndexSettings (ShardCount 1) (ReplicaCount 1))) [object ["tweet" .= toJSON TweetMapping]]
87+ let templateName = TemplateName "tweet-tpl"
88+ _ <- putTemplate idxTpl templateName
89+ True <- templateExists templateName
90+
91+ -- do a search
92+ let boost = Nothing
93+ let query = TermQuery (Term "user" "bitemyapp") boost
94+ let search = mkSearch (Just query) boost
95+ _ <- searchByType testIndex testMapping search
96+
97+ -- clean up
98+ _ <- deleteTemplate templateName
99+ _ <- deleteIndex testIndex
100+ False <- indexExists testIndex
101+
102+ return ()
103+ where
104+ testServer = Server "http://localhost:9200"
105+ runBH' = withBH defaultManagerSettings testServer
106+ testIndex = IndexName "twitter"
107+ testMapping = MappingName "tweet"
108+ indexSettings = IndexSettings (ShardCount 1) (ReplicaCount 0)
examples/package.yamlnew file+37
@@ -0,0 +1,37 @@
1+name: bloodhound-examples
2+version: '0.0.0.0'
3+category: Web
4+author: Chris Allen
5+maintainer: cma@bitemyapp.com
6+copyright: 2017, Chris Allen
7+license: BSD3
8+github: bitemyapp/bloodhound
9+extra-source-files:
10+- README.md
11+dependencies:
12+- base
13+- bloodhound
14+- time
15+- aeson
16+- text
17+- http-client
18+- vector
19+- semigroups
20+ghc-options:
21+- -Wall
22+- -threaded
23+- -rtsopts
24+- -with-rtsopts=-N
25+when:
26+- condition: flag(werror)
27+ ghc-options: -Werror
28+
29+executables:
30+ tweet-example:
31+ main: Tweet.hs
32+
33+flags:
34+ werror:
35+ description: "Treat warnings as errors"
36+ manual: true
37+ default: false
examples/stack.yamlnew file+20
@@ -0,0 +1,20 @@
1+flags:
2+ bloodhound-examples:
3+ werror: false
4+
5+packages:
6+- '.'
7+- '..'
8+# extra-deps:
9+# - http-client-0.5.0
10+# - aeson-1.2.0.0
11+# - fail-4.9.0.0
12+# - http-types-0.9
13+# - attoparsec-0.13.0.1
14+# - quickcheck-properties-0.1
15+# - semigroups-0.18.3
16+# - uri-bytestring-0.1.9
17+# - temporary-resourcet-0.1.0.0
18+# - transformers-compat-0.5.1.4
19+
20+resolver: lts-8.14
package.yamlnew file+74
@@ -0,0 +1,74 @@
1+name: bloodhound
2+version: '0.17.0.0'
3+synopsis: Elasticsearch client library for Haskell
4+description: Elasticsearch made awesome for Haskell hackers
5+category: Database, Search
6+author: Chris Allen
7+maintainer: cma@bitemyapp.com
8+copyright: 2018 Chris Allen
9+license: BSD3
10+github: bitemyapp/bloodhound.git
11+
12+extra-source-files:
13+ - README.md
14+ - changelog.md
15+ - tests/tests.hs
16+
17+dependencies:
18+ - aeson >=0.11.1
19+ - base >=4.3 && <5
20+ - blaze-builder
21+ - bytestring >=0.10.0
22+ - containers >=0.5.0.0
23+ - exceptions
24+ - hashable
25+ - http-client >=0.4.30
26+ - http-types >=0.8
27+ - mtl >=1.0
28+ - network-uri >=2.6
29+ - scientific >=0.3.0.0
30+ - semigroups >=0.15
31+ - semver
32+ - text >=0.11
33+ - time >=1.4
34+ - transformers >=0.2
35+ - unordered-containers
36+ - vector >=0.10.9
37+
38+library:
39+ source-dirs: src
40+ ghc-options: -Wall
41+ exposed-modules:
42+ - Database.Bloodhound
43+ - Database.Bloodhound.Client
44+ - Database.Bloodhound.Types
45+ - Database.Bloodhound.Internal.Aggregation
46+ - Database.Bloodhound.Internal.Analysis
47+ - Database.Bloodhound.Internal.Client
48+ - Database.Bloodhound.Internal.Highlight
49+ - Database.Bloodhound.Internal.Newtypes
50+ - Database.Bloodhound.Internal.Query
51+ - Database.Bloodhound.Internal.Sort
52+ - Database.Bloodhound.Internal.StringlyTyped
53+ - Database.Bloodhound.Internal.Suggest
54+
55+tests:
56+ bloodhound-tests:
57+ source-dirs: tests
58+ main: tests.hs
59+ ghc-options:
60+ - -Wall
61+ - -fno-warn-orphans
62+ dependencies:
63+ - QuickCheck
64+ - base
65+ - bloodhound
66+ - errors
67+ - hspec >=1.8
68+ - microlens
69+ - microlens-aeson
70+ - pretty-simple
71+ - quickcheck-arbitrary-template
72+ - quickcheck-properties
73+ - temporary
74+ - unix-compat
src/Bloodhound/Import.hsnew file+85
@@ -0,0 +1,85 @@
1+module Bloodhound.Import
2+ ( module X
3+ , LByteString
4+ , Method
5+ , omitNulls
6+ , parseNEJSON
7+ , parseReadText
8+ , readMay
9+ , showText
10+ , deleteSeveral
11+ , oPath
12+ , tshow
13+ ) where
14+
15+import Control.Applicative as X (Alternative (..), optional)
16+import Control.Exception as X (Exception)
17+import Control.Monad as X (MonadPlus (..), forM, (<=<))
18+import Control.Monad.Catch as X (MonadCatch, MonadMask,
19+ MonadThrow)
20+import Control.Monad.Except as X (MonadError)
21+import Control.Monad.Fix as X (MonadFix)
22+import Control.Monad.IO.Class as X (MonadIO (..))
23+import Control.Monad.Reader as X (MonadReader (..),
24+ MonadTrans (..), ReaderT (..))
25+import Control.Monad.State as X (MonadState)
26+import Control.Monad.Writer as X (MonadWriter)
27+import Data.Aeson as X
28+import Data.Aeson.Types as X (Pair, Parser, emptyObject,
29+ parseEither, parseMaybe,
30+ typeMismatch)
31+import Data.Bifunctor as X (first)
32+import Data.Char as X (isNumber)
33+import Data.Hashable as X (Hashable)
34+import qualified Data.HashMap.Strict as HM
35+import Data.List as X (foldl', intercalate, nub)
36+import Data.List.NonEmpty as X (NonEmpty (..), toList)
37+import Data.Maybe as X (catMaybes, fromMaybe,
38+ isNothing, maybeToList)
39+import Data.Scientific as X (Scientific)
40+import Data.Semigroup as X (Semigroup (..))
41+import Data.Text as X (Text)
42+import Data.Time.Calendar as X (Day (..), showGregorian)
43+import Data.Time.Clock as X (NominalDiffTime, UTCTime)
44+import Data.Time.Clock.POSIX as X
45+
46+import qualified Data.ByteString.Lazy as BL
47+import qualified Data.Text as T
48+import qualified Data.Traversable as DT
49+import qualified Data.Vector as V
50+import qualified Network.HTTP.Types.Method as NHTM
51+
52+type LByteString = BL.ByteString
53+
54+type Method = NHTM.Method
55+
56+readMay :: Read a => String -> Maybe a
57+readMay s = case reads s of
58+ (a, ""):_ -> Just a
59+ _ -> Nothing
60+
61+parseReadText :: Read a => Text -> Parser a
62+parseReadText = maybe mzero return . readMay . T.unpack
63+
64+showText :: Show a => a -> Text
65+showText = T.pack . show
66+
67+omitNulls :: [(Text, Value)] -> Value
68+omitNulls = object . filter notNull where
69+ notNull (_, Null) = False
70+ notNull (_, Array a) = (not . V.null) a
71+ notNull _ = True
72+
73+parseNEJSON :: (FromJSON a) => [Value] -> Parser (NonEmpty a)
74+parseNEJSON [] = fail "Expected non-empty list"
75+parseNEJSON (x:xs) = DT.mapM parseJSON (x :| xs)
76+
77+deleteSeveral :: (Eq k, Hashable k) => [k] -> HM.HashMap k v -> HM.HashMap k v
78+deleteSeveral ks hm = foldr HM.delete hm ks
79+
80+oPath :: ToJSON a => NonEmpty Text -> a -> Value
81+oPath (k :| []) v = object [k .= v]
82+oPath (k:| (h:t)) v = object [k .= oPath (h :| t) v]
83+
84+tshow :: Show a => a -> Text
85+tshow = T.pack . show
src/Database/Bloodhound.hsnew file+10
@@ -0,0 +1,10 @@
1+module Database.Bloodhound
2+ ( -- module Data.Aeson.Types
3+ -- ,
4+ module Database.Bloodhound.Client
5+ , module Database.Bloodhound.Types
6+ ) where
7+
8+-- import Data.Aeson.Types
9+import Database.Bloodhound.Client
10+import Database.Bloodhound.Types
src/Database/V5/Bloodhound/Client.hs → src/Database/Bloodhound/Client.hsrenamed+165−57
@@ -5,9 +5,9 @@
55-------------------------------------------------------------------------------
66-- |
77-- Module : Database.Bloodhound.Client
8−-- Copyright : (C) 2014 Chris Allen
8+-- Copyright : (C) 2014, 2018 Chris Allen
99-- License : BSD-style (see the file LICENSE)
10−-- Maintainer : Chris Allen <cma@bitemyapp.com
10+-- Maintainer : Chris Allen <cma@bitemyapp.com>
1111-- Stability : provisional
1212-- Portability : OverloadedStrings
1313--
@@ -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
@@ -25,6 +25,8 @@ module Database.V5.Bloodhound.Client
2525 withBH
2626 -- ** Indices
2727 , createIndex
28+ , createIndexWith
29+ , flushIndex
2830 , deleteIndex
2931 , updateIndexSettings
3032 , getIndexSettings
@@ -37,6 +39,7 @@ module Database.V5.Bloodhound.Client
3739 -- *** Index Aliases
3840 , updateIndexAliases
3941 , getIndexAliases
42+ , deleteIndexAlias
4043 -- *** Index Templates
4144 , putTemplate
4245 , templateExists
@@ -52,9 +55,11 @@ module Database.V5.Bloodhound.Client
5255 -- ** Searching
5356 , searchAll
5457 , searchByIndex
58+ , searchByIndices
5559 , searchByType
5660 , scanSearch
5761 , getInitialScroll
62+ , getInitialSortedScroll
5863 , advanceScroll
5964 , refreshIndex
6065 , mkSearch
@@ -120,12 +125,13 @@ import qualified Network.HTTP.Types.URI as NHTU
120125import qualified Network.URI as URI
121126import Prelude hiding (filter, head)
122127
123−import Database.V5.Bloodhound.Types
128+import Database.Bloodhound.Types
124129
125130-- $setup
126131-- >>> :set -XOverloadedStrings
127132-- >>> :set -XDeriveGeneric
128−-- >>> import Database.V5.Bloodhound
133+-- >>> import Database.Bloodhound
134+-- >>> import Network.HTTP.Client
129135-- >>> let testServer = (Server "http://localhost:9200")
130136-- >>> let runBH' = withBH defaultManagerSettings testServer
131137-- >>> let testIndex = IndexName "twitter"
@@ -206,8 +212,16 @@ dispatch dMethod url body = do
206212 initReq <- liftIO $ parseUrl' url
207213 reqHook <- bhRequestHook A.<$> getBHEnv
208214 let reqBody = RequestBodyLBS $ fromMaybe emptyBody body
209− req <- liftIO $ reqHook $ setRequestIgnoreStatus $ initReq { method = dMethod
210− , requestBody = reqBody }
215+ req <- liftIO
216+ $ reqHook
217+ $ setRequestIgnoreStatus
218+ $ initReq { method = dMethod
219+ , requestHeaders =
220+ -- "application/x-ndjson" for bulk
221+ ("Content-Type", "application/json") : requestHeaders initReq
222+ , requestBody = reqBody }
223+ -- req <- liftIO $ reqHook $ setRequestIgnoreStatus $ initReq { method = dMethod
224+ -- , requestBody = reqBody }
211225 mgr <- bhManager <$> getBHEnv
212226 liftIO $ httpLbs req mgr
213227
@@ -304,7 +318,7 @@ instance FromJSON GSRs where
304318 parseJSON = withObject "Collection of GenericSnapshotRepo" parse
305319 where
306320 parse = fmap GSRs . mapM (uncurry go) . HM.toList
307− go rawName = withObject "GenericSnapshotRepo" $ \o -> do
321+ go rawName = withObject "GenericSnapshotRepo" $ \o ->
308322 GenericSnapshotRepo (SnapshotRepoName rawName) <$> o .: "type"
309323 <*> o .: "settings"
310324
@@ -333,7 +347,7 @@ updateSnapshotRepo SnapshotRepoUpdateSettings {..} repo =
333347
334348
335349-- | Verify if a snapshot repo is working. __NOTE:__ this API did not
336−-- 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,
337351-- you will get an error here.
338352verifySnapshotRepo
339353 :: ( MonadBH m
@@ -502,8 +516,32 @@ createIndex indexSettings (IndexName indexName) =
502516 where url = joinPath [indexName]
503517 body = Just $ encode indexSettings
504518
505−
506−-- | 'deleteIndex' will delete an index given a 'Server', and an 'IndexName'.
519+-- | Create an index, providing it with any number of settings. This
520+-- is more expressive than 'createIndex' but makes is more verbose
521+-- for the common case of configuring only the shard count and
522+-- replica count.
523+createIndexWith :: MonadBH m
524+ => [UpdatableIndexSetting]
525+ -> Int -- ^ shard count
526+ -> IndexName
527+ -> m Reply
528+createIndexWith updates shards (IndexName indexName) =
529+ bindM2 put url (return (Just body))
530+ where url = joinPath [indexName]
531+ body = encode $ object
532+ ["settings" .= deepMerge
533+ ( HM.singleton "index.number_of_shards" (toJSON shards) :
534+ [u | Object u <- toJSON <$> updates]
535+ )
536+ ]
537+
538+-- | 'flushIndex' will flush an index given a 'Server' and an 'IndexName'.
539+flushIndex :: MonadBH m => IndexName -> m Reply
540+flushIndex (IndexName indexName) = do
541+ path <- joinPath [indexName, "_flush"]
542+ post path Nothing
543+
544+-- | 'deleteIndex' will delete an index given a 'Server' and an 'IndexName'.
507545--
508546-- >>> _ <- runBH' $ createIndex defaultIndexSettings (IndexName "didimakeanindex")
509547-- >>> response <- runBH' $ deleteIndex (IndexName "didimakeanindex")
@@ -524,20 +562,21 @@ deleteIndex (IndexName indexName) =
524562updateIndexSettings :: MonadBH m => NonEmpty UpdatableIndexSetting -> IndexName -> m Reply
525563updateIndexSettings updates (IndexName indexName) =
526564 bindM2 put url (return body)
527− where url = joinPath [indexName, "_settings"]
528− body = Just (encode jsonBody)
529− jsonBody = Object (deepMerge [u | Object u <- toJSON <$> toList updates])
565+ where
566+ url = joinPath [indexName, "_settings"]
567+ body = Just (encode jsonBody)
568+ jsonBody = Object (deepMerge [u | Object u <- toJSON <$> toList updates])
530569
531570
532571getIndexSettings :: (MonadBH m, MonadThrow m) => IndexName
533572 -> m (Either EsError IndexSettingsSummary)
534−getIndexSettings (IndexName indexName) = do
573+getIndexSettings (IndexName indexName) =
535574 parseEsResponse =<< get =<< url
536− where url = joinPath [indexName, "_settings"]
537−
575+ where
576+ url = joinPath [indexName, "_settings"]
538577
539−-- | 'forceMergeIndex'
540−--
578+-- | 'forceMergeIndex'
579+--
541580-- The force merge API allows to force merging of one or more indices through
542581-- an API. The merge relates to the number of segments a Lucene index holds
543582-- within each shard. The force merge operation allows to reduce the number of
@@ -599,20 +638,25 @@ existentialQuery url = do
599638-- responses from elasticsearch should fall into these two
600639-- categories. If they don't, a 'EsProtocolException' will be
601640-- thrown. If you encounter this, please report the full body it
602−-- reports along with your ElasticSearch verison.
603−parseEsResponse :: (MonadThrow m, FromJSON a) => Reply
641+-- reports along with your Elasticsearch verison.
642+parseEsResponse :: ( MonadThrow m
643+ , FromJSON a
644+ )
645+ => Reply
604646 -> m (Either EsError a)
605647parseEsResponse reply
606648 | respIsTwoHunna reply = case eitherDecode body of
607649 Right a -> return (Right a)
608− Left _ -> tryParseError
609− | otherwise = tryParseError
650+ Left err ->
651+ tryParseError err
652+ | otherwise = tryParseError "Non-200 status code"
610653 where body = responseBody reply
611− tryParseError = case eitherDecode body of
612− Right e -> return (Left e)
613− -- this case should not be possible
614− Left _ -> explode
615− 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)
616660
617661-- | 'indexExists' enables you to check if an index exists. Returns 'Bool'
618662-- in IO
@@ -671,14 +715,16 @@ listIndices :: (MonadThrow m, MonadBH m) => m [IndexName]
671715listIndices =
672716 parse . responseBody =<< get =<< url
673717 where
674− url = joinPath ["_cat/indices?v"]
675− -- parses the tabular format the indices api provides
676− parse body = case T.lines (T.decodeUtf8 (L.toStrict body)) of
677− (hdr:rows) -> let ks = T.words hdr
678− keyedRows = [ HM.fromList (zip ks (T.words row)) | row <- rows ]
679− names = catMaybes (HM.lookup "index" <$> keyedRows)
680− in return (IndexName <$> names)
681− [] -> throwM (EsProtocolException body)
718+ url = joinPath ["_cat/indices?format=json"]
719+ parse body = either (\msg -> (throwM (EsProtocolException (T.pack msg) body))) return $ do
720+ vals <- eitherDecode body
721+ forM vals $ \val ->
722+ case val of
723+ Object obj ->
724+ case HM.lookup "index" obj of
725+ (Just (String txt)) -> Right (IndexName txt)
726+ v -> Left $ "indexVal in listIndices failed on non-string, was: " <> show v
727+ v -> Left $ "One of the values parsed in listIndices wasn't an object, it was: " <> show v
682728
683729-- | 'updateIndexAliases' updates the server's index alias
684730-- table. Operations are atomic. Explained in further detail at
@@ -709,6 +755,12 @@ getIndexAliases :: (MonadBH m, MonadThrow m)
709755getIndexAliases = parseEsResponse =<< get =<< url
710756 where url = joinPath ["_aliases"]
711757
758+-- | Delete a single alias, removing it from all indices it
759+-- is currently associated with.
760+deleteIndexAlias :: MonadBH m => IndexAliasName -> m Reply
761+deleteIndexAlias (IndexAliasName (IndexName name)) = delete =<< url
762+ where url = joinPath ["_all","_alias",name]
763+
712764-- | 'putTemplate' creates a template given an 'IndexTemplate' and a 'TemplateName'.
713765-- Explained in further detail at
714766-- <https://www.elastic.co/guide/en/elasticsearch/reference/1.7/indices-templates.html>
@@ -771,7 +823,10 @@ versionCtlParams cfg =
771823-- | 'indexDocument' is the primary way to save a single document in
772824-- Elasticsearch. The document itself is simply something we can
773825-- convert into a JSON 'Value'. The 'DocId' will function as the
774−-- primary key for the document.
826+-- primary key for the document. You are encouraged to generate
827+-- your own id's and not rely on Elasticsearch's automatic id
828+-- generation. Read more about it here:
829+-- https://github.com/bitemyapp/bloodhound/issues/107
775830--
776831-- >>> resp <- runBH' $ indexDocument testIndex testMapping defaultIndexDocumentSettings exampleTweet (DocId "1")
777832-- >>> print resp
@@ -819,9 +874,11 @@ deleteDocument (IndexName indexName)
819874-- >>> _ <- runBH' $ bulk stream
820875-- >>> _ <- runBH' $ refreshIndex testIndex
821876bulk :: MonadBH m => V.Vector BulkOperation -> m Reply
822−bulk bulkOps = bindM2 post url (return body)
823− where url = joinPath ["_bulk"]
824− body = Just $ encodeBulkOperations bulkOps
877+bulk bulkOps =
878+ bindM2 post url (return body)
879+ where
880+ url = joinPath ["_bulk"]
881+ body = Just $ encodeBulkOperations bulkOps
825882
826883-- | 'encodeBulkOperations' is a convenience function for dumping a vector of 'BulkOperation'
827884-- into an 'L.ByteString'
@@ -831,12 +888,15 @@ bulk bulkOps = bindM2 post url (return body)
831888-- "\n{\"index\":{\"_type\":\"tweet\",\"_id\":\"2\",\"_index\":\"twitter\"}}\n{\"name\":\"blah\"}\n"
832889encodeBulkOperations :: V.Vector BulkOperation -> L.ByteString
833890encodeBulkOperations stream = collapsed where
834− blobs = fmap encodeBulkOperation stream
835− mashedTaters = mash (mempty :: Builder) blobs
836− collapsed = toLazyByteString $ mappend mashedTaters (byteString "\n")
891+ blobs =
892+ fmap encodeBulkOperation stream
893+ mashedTaters =
894+ mash (mempty :: Builder) blobs
895+ collapsed =
896+ toLazyByteString $ mappend mashedTaters (byteString "\n")
837897
838898mash :: Builder -> V.Vector L.ByteString -> Builder
839−mash = V.foldl' (\b x -> b `mappend` (byteString "\n") `mappend` (lazyByteString x))
899+mash = V.foldl' (\b x -> b <> byteString "\n" <> lazyByteString x)
840900
841901mkBulkStreamValue :: Text -> Text -> Text -> Text -> Value
842902mkBulkStreamValue operation indexName mappingName docId =
@@ -845,6 +905,12 @@ mkBulkStreamValue operation indexName mappingName docId =
845905 , "_type" .= mappingName
846906 , "_id" .= docId]]
847907
908+mkBulkStreamValueAuto :: Text -> Text -> Text -> Value
909+mkBulkStreamValueAuto operation indexName mappingName =
910+ object [operation .=
911+ object [ "_index" .= indexName
912+ , "_type" .= mappingName]]
913+
848914-- | 'encodeBulkOperation' is a convenience function for dumping a single 'BulkOperation'
849915-- into an 'L.ByteString'
850916--
@@ -858,6 +924,18 @@ encodeBulkOperation (BulkIndex (IndexName indexName)
858924 where metadata = mkBulkStreamValue "index" indexName mappingName docId
859925 blob = encode metadata `mappend` "\n" `mappend` encode value
860926
927+encodeBulkOperation (BulkIndexAuto (IndexName indexName)
928+ (MappingName mappingName)
929+ value) = blob
930+ where metadata = mkBulkStreamValueAuto "index" indexName mappingName
931+ blob = encode metadata `mappend` "\n" `mappend` encode value
932+
933+encodeBulkOperation (BulkIndexEncodingAuto (IndexName indexName)
934+ (MappingName mappingName)
935+ encoding) = toLazyByteString blob
936+ where metadata = toEncoding (mkBulkStreamValueAuto "index" indexName mappingName)
937+ blob = fromEncoding metadata <> "\n" <> fromEncoding encoding
938+
861939encodeBulkOperation (BulkCreate (IndexName indexName)
862940 (MappingName mappingName)
863941 (DocId docId) value) = blob
@@ -877,6 +955,12 @@ encodeBulkOperation (BulkUpdate (IndexName indexName)
877955 doc = object ["doc" .= value]
878956 blob = encode metadata `mappend` "\n" `mappend` encode doc
879957
958+encodeBulkOperation (BulkCreateEncoding (IndexName indexName)
959+ (MappingName mappingName)
960+ (DocId docId) encoding) = toLazyByteString blob
961+ where metadata = toEncoding (mkBulkStreamValue "create" indexName mappingName docId)
962+ blob = fromEncoding metadata <> "\n" <> fromEncoding encoding
963+
880964-- | 'getDocument' is a straight-forward way to fetch a single document from
881965-- Elasticsearch using a 'Server', 'IndexName', 'MappingName', and a 'DocId'.
882966-- The 'DocId' is the primary key for your Elasticsearch document.
@@ -926,6 +1010,15 @@ searchByIndex :: MonadBH m => IndexName -> Search -> m Reply
9261010searchByIndex (IndexName indexName) = bindM2 dispatchSearch url . return
9271011 where url = joinPath [indexName, "_search"]
9281012
1013+-- | 'searchByIndices' is a variant of 'searchByIndex' that executes a
1014+-- 'Search' over many indices. This is much faster than using
1015+-- 'mapM' to 'searchByIndex' over a collection since it only
1016+-- causes a single HTTP request to be emitted.
1017+searchByIndices :: MonadBH m => NonEmpty IndexName -> Search -> m Reply
1018+searchByIndices ixs = bindM2 dispatchSearch url . return
1019+ where url = joinPath [renderedIxs, "_search"]
1020+ renderedIxs = T.intercalate (T.singleton ',') (map (\(IndexName t) -> t) (toList ixs))
1021+
9291022-- | 'searchByType', given a 'Search', 'IndexName', and 'MappingName', will perform that
9301023-- search against a specific mapping within an index on an Elasticsearch server.
9311024--
@@ -938,14 +1031,14 @@ searchByType (IndexName indexName)
9381031 (MappingName mappingName) = bindM2 dispatchSearch url . return
9391032 where url = joinPath [indexName, mappingName, "_search"]
9401033
941−-- | For a given scearch, request a scroll for efficient streaming of
1034+-- | For a given search, request a scroll for efficient streaming of
9421035-- search results. Note that the search is put into 'SearchTypeScan'
9431036-- mode and thus results will not be sorted. Combine this with
9441037-- 'advanceScroll' to efficiently stream through the full result set
945−getInitialScroll ::
946− (FromJSON a, MonadThrow m, MonadBH m) => IndexName ->
947− MappingName ->
948− Search ->
1038+getInitialScroll ::
1039+ (FromJSON a, MonadThrow m, MonadBH m) => IndexName ->
1040+ MappingName ->
1041+ Search ->
9491042 m (Either EsError (SearchResult a))
9501043getInitialScroll (IndexName indexName) (MappingName mappingName) search' = do
9511044 let url = addQuery params <$> joinPath [indexName, mappingName, "_search"]
@@ -955,7 +1048,22 @@ getInitialScroll (IndexName indexName) (MappingName mappingName) search' = do
9551048 resp' <- bindM2 dispatchSearch url (return search)
9561049 parseEsResponse resp'
9571050
958−scroll' :: (FromJSON a, MonadBH m, MonadThrow m) => Maybe ScrollId ->
1051+-- | For a given search, request a scroll for efficient streaming of
1052+-- search results. Combine this with 'advanceScroll' to efficiently
1053+-- stream through the full result set. Note that this search respects
1054+-- sorting and may be less efficient than 'getInitialScroll'.
1055+getInitialSortedScroll ::
1056+ (FromJSON a, MonadThrow m, MonadBH m) => IndexName ->
1057+ MappingName ->
1058+ Search ->
1059+ m (Either EsError (SearchResult a))
1060+getInitialSortedScroll (IndexName indexName) (MappingName mappingName) search = do
1061+ let url = addQuery params <$> joinPath [indexName, mappingName, "_search"]
1062+ params = [("scroll", Just "1m")]
1063+ resp' <- bindM2 dispatchSearch url (return search)
1064+ parseEsResponse resp'
1065+
1066+scroll' :: (FromJSON a, MonadBH m, MonadThrow m) => Maybe ScrollId ->
9591067 m ([Hit a], Maybe ScrollId)
9601068scroll' Nothing = return ([], Nothing)
9611069scroll' (Just sid) = do
@@ -982,13 +1090,13 @@ advanceScroll (ScrollId sid) scroll = do
9821090 where scrollTime = showText secs <> "s"
9831091 secs :: Integer
9841092 secs = round scroll
985−
1093+
9861094 scrollObject = object [ "scroll" .= scrollTime
9871095 , "scroll_id" .= sid
9881096 ]
9891097
990−simpleAccumulator ::
991− (FromJSON a, MonadBH m, MonadThrow m) =>
1098+simpleAccumulator ::
1099+ (FromJSON a, MonadBH m, MonadThrow m) =>
9921100 [Hit a] ->
9931101 ([Hit a], Maybe ScrollId) ->
9941102 m ([Hit a], Maybe ScrollId)
@@ -1026,9 +1134,9 @@ scanSearch indexName mappingName search = do
10261134--
10271135-- >>> let query = TermQuery (Term "user" "bitemyapp") Nothing
10281136-- >>> mkSearch (Just query) Nothing
1029−-- 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}
10301138mkSearch :: Maybe Query -> Maybe Filter -> Search
1031−mkSearch query filter = Search query filter Nothing Nothing Nothing False (From 0) (Size 10) SearchTypeQueryThenFetch Nothing Nothing
1139+mkSearch query filter = Search query filter Nothing Nothing Nothing False (From 0) (Size 10) SearchTypeQueryThenFetch Nothing Nothing Nothing Nothing Nothing
10321140
10331141-- | 'mkAggregateSearch' is a helper function that defaults everything in a 'Search' except for
10341142-- the 'Query' and the 'Aggregation'.
@@ -1038,7 +1146,7 @@ mkSearch query filter = Search query filter Nothing Nothing Nothing False (From
10381146-- TermsAgg (TermsAggregation {term = Left "user", termInclude = Nothing, termExclude = Nothing, termOrder = Nothing, termMinDocCount = Nothing, termSize = Nothing, termShardSize = Nothing, termCollectMode = Just BreadthFirst, termExecutionHint = Nothing, termAggs = Nothing})
10391147-- >>> let myAggregation = mkAggregateSearch Nothing $ mkAggregations "users" terms
10401148mkAggregateSearch :: Maybe Query -> Aggregations -> Search
1041−mkAggregateSearch query mkSearchAggs = Search query Nothing Nothing (Just mkSearchAggs) Nothing False (From 0) (Size 0) SearchTypeQueryThenFetch Nothing Nothing
1149+mkAggregateSearch query mkSearchAggs = Search query Nothing Nothing (Just mkSearchAggs) Nothing False (From 0) (Size 0) SearchTypeQueryThenFetch Nothing Nothing Nothing Nothing Nothing
10421150
10431151-- | 'mkHighlightSearch' is a helper function that defaults everything in a 'Search' except for
10441152-- the 'Query' and the 'Aggregation'.
@@ -1047,7 +1155,7 @@ mkAggregateSearch query mkSearchAggs = Search query Nothing Nothing (Just mkSear
10471155-- >>> let testHighlight = Highlights Nothing [FieldHighlight (FieldName "message") Nothing]
10481156-- >>> let search = mkHighlightSearch (Just query) testHighlight
10491157mkHighlightSearch :: Maybe Query -> Highlights -> Search
1050−mkHighlightSearch query searchHighlights = Search query Nothing Nothing Nothing (Just searchHighlights) False (From 0) (Size 10) SearchTypeQueryThenFetch Nothing Nothing
1158+mkHighlightSearch query searchHighlights = Search query Nothing Nothing Nothing (Just searchHighlights) False (From 0) (Size 10) SearchTypeQueryThenFetch Nothing Nothing Nothing Nothing Nothing
10511159
10521160-- | 'pageSearch' is a helper function that takes a search and assigns the from
10531161-- and size fields for the search. The from parameter defines the offset
src/Database/Bloodhound/Common/Script.hsnew file+220
@@ -0,0 +1,220 @@
1+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
2+{-# LANGUAGE OverloadedStrings #-}
3+
4+module Database.Bloodhound.Common.Script where
5+
6+import Bloodhound.Import
7+
8+import qualified Data.HashMap.Strict as HM
9+
10+import Database.Bloodhound.Internal.Newtypes
11+
12+newtype ScriptFields =
13+ ScriptFields (HM.HashMap ScriptFieldName ScriptFieldValue)
14+ deriving (Eq, Show)
15+
16+type ScriptFieldName = Text
17+type ScriptFieldValue = Value
18+
19+data Script =
20+ Script { scriptLanguage :: Maybe ScriptLanguage
21+ , scriptInline :: Maybe ScriptInline
22+ , scriptStored :: Maybe ScriptId
23+ , scriptParams :: Maybe ScriptParams
24+ } deriving (Eq, Show)
25+
26+newtype ScriptLanguage =
27+ ScriptLanguage Text deriving (Eq, Show, FromJSON, ToJSON)
28+
29+newtype ScriptInline =
30+ ScriptInline Text deriving (Eq, Show, FromJSON, ToJSON)
31+
32+newtype ScriptId =
33+ ScriptId Text deriving (Eq, Show, FromJSON, ToJSON)
34+
35+newtype ScriptParams =
36+ ScriptParams (HM.HashMap ScriptParamName ScriptParamValue)
37+ deriving (Eq, Show)
38+
39+type ScriptParamName = Text
40+type ScriptParamValue = Value
41+
42+data BoostMode =
43+ BoostModeMultiply
44+ | BoostModeReplace
45+ | BoostModeSum
46+ | BoostModeAvg
47+ | BoostModeMax
48+ | BoostModeMin deriving (Eq, Show)
49+
50+data ScoreMode =
51+ ScoreModeMultiply
52+ | ScoreModeSum
53+ | ScoreModeAvg
54+ | ScoreModeFirst
55+ | ScoreModeMax
56+ | ScoreModeMin deriving (Eq, Show)
57+
58+data FunctionScoreFunction =
59+ FunctionScoreFunctionScript Script
60+ | FunctionScoreFunctionRandom Seed
61+ | FunctionScoreFunctionFieldValueFactor FieldValueFactor
62+ deriving (Eq, Show)
63+
64+newtype Weight =
65+ Weight Float deriving (Eq, Show, FromJSON, ToJSON)
66+
67+newtype Seed =
68+ Seed Float deriving (Eq, Show, FromJSON, ToJSON)
69+
70+data FieldValueFactor =
71+ FieldValueFactor { fieldValueFactorField :: FieldName
72+ , fieldValueFactor :: Maybe Factor
73+ , fieldValueFactorModifier :: Maybe FactorModifier
74+ , fieldValueFactorMissing :: Maybe FactorMissingFieldValue
75+ } deriving (Eq, Show)
76+
77+newtype Factor =
78+ Factor Float deriving (Eq, Show, FromJSON, ToJSON)
79+
80+data FactorModifier =
81+ FactorModifierNone
82+ | FactorModifierLog
83+ | FactorModifierLog1p
84+ | FactorModifierLog2p
85+ | FactorModifierLn
86+ | FactorModifierLn1p
87+ | FactorModifierLn2p
88+ | FactorModifierSquare
89+ | FactorModifierSqrt
90+ | FactorModifierReciprocal deriving (Eq, Show)
91+
92+newtype FactorMissingFieldValue =
93+ FactorMissingFieldValue Float deriving (Eq, Show, FromJSON, ToJSON)
94+
95+instance ToJSON BoostMode where
96+ toJSON BoostModeMultiply = "multiply"
97+ toJSON BoostModeReplace = "replace"
98+ toJSON BoostModeSum = "sum"
99+ toJSON BoostModeAvg = "avg"
100+ toJSON BoostModeMax = "max"
101+ toJSON BoostModeMin = "min"
102+
103+instance FromJSON BoostMode where
104+ parseJSON = withText "BoostMode" parse
105+ where parse "multiply" = pure BoostModeMultiply
106+ parse "replace" = pure BoostModeReplace
107+ parse "sum" = pure BoostModeSum
108+ parse "avg" = pure BoostModeAvg
109+ parse "max" = pure BoostModeMax
110+ parse "min" = pure BoostModeMin
111+ parse bm = fail ("Unexpected BoostMode: " <> show bm)
112+
113+instance ToJSON ScoreMode where
114+ toJSON ScoreModeMultiply = "multiply"
115+ toJSON ScoreModeSum = "sum"
116+ toJSON ScoreModeFirst = "first"
117+ toJSON ScoreModeAvg = "avg"
118+ toJSON ScoreModeMax = "max"
119+ toJSON ScoreModeMin = "min"
120+
121+instance FromJSON ScoreMode where
122+ parseJSON = withText "ScoreMode" parse
123+ where parse "multiply" = pure ScoreModeMultiply
124+ parse "sum" = pure ScoreModeSum
125+ parse "first" = pure ScoreModeFirst
126+ parse "avg" = pure ScoreModeAvg
127+ parse "max" = pure ScoreModeMax
128+ parse "min" = pure ScoreModeMin
129+ parse sm = fail ("Unexpected ScoreMode: " <> show sm)
130+
131+functionScoreFunctionPair :: FunctionScoreFunction -> (Text, Value)
132+functionScoreFunctionPair (FunctionScoreFunctionScript functionScoreScript) =
133+ ("script_score", toJSON functionScoreScript)
134+functionScoreFunctionPair (FunctionScoreFunctionRandom seed) =
135+ ("random_score", omitNulls [ "seed" .= seed ])
136+functionScoreFunctionPair (FunctionScoreFunctionFieldValueFactor fvf) =
137+ ("field_value_factor", toJSON fvf)
138+
139+parseFunctionScoreFunction :: Object -> Parser FunctionScoreFunction
140+parseFunctionScoreFunction o =
141+ singleScript `taggedWith` "script_score"
142+ <|> singleRandom `taggedWith` "random_score"
143+ <|> singleFieldValueFactor `taggedWith` "field_value_factor"
144+ where taggedWith parser k = parser =<< o .: k
145+ singleScript = pure . FunctionScoreFunctionScript
146+ singleRandom o' = FunctionScoreFunctionRandom <$> o' .: "seed"
147+ singleFieldValueFactor = pure . FunctionScoreFunctionFieldValueFactor
148+
149+instance ToJSON ScriptFields where
150+ toJSON (ScriptFields x) = Object x
151+
152+instance FromJSON ScriptFields where
153+ parseJSON (Object o) = pure (ScriptFields o)
154+ parseJSON _ = fail "error parsing ScriptFields"
155+
156+instance ToJSON Script where
157+ toJSON (Script lang inline stored params) =
158+ object [ "script" .= omitNulls base ]
159+ where base = [ "lang" .= lang
160+ , "inline" .= inline
161+ , "stored" .= stored
162+ , "params" .= params ]
163+
164+instance FromJSON Script where
165+ parseJSON = withObject "Script" parse
166+ where parse o = o .: "script" >>= \o' ->
167+ Script
168+ <$> o' .:? "lang"
169+ <*> o' .:? "inline"
170+ <*> o' .:? "stored"
171+ <*> o' .:? "params"
172+
173+instance ToJSON ScriptParams where
174+ toJSON (ScriptParams x) = Object x
175+
176+instance FromJSON ScriptParams where
177+ parseJSON (Object o) = pure (ScriptParams o)
178+ parseJSON _ = fail "error parsing ScriptParams"
179+
180+instance ToJSON FieldValueFactor where
181+ toJSON (FieldValueFactor field factor modifier missing) =
182+ omitNulls base
183+ where base = [ "field" .= field
184+ , "factor" .= factor
185+ , "modifier" .= modifier
186+ , "missing" .= missing ]
187+
188+instance FromJSON FieldValueFactor where
189+ parseJSON = withObject "FieldValueFactor" parse
190+ where parse o = FieldValueFactor
191+ <$> o .: "field"
192+ <*> o .:? "factor"
193+ <*> o .:? "modifier"
194+ <*> o .:? "missing"
195+
196+instance ToJSON FactorModifier where
197+ toJSON FactorModifierNone = "none"
198+ toJSON FactorModifierLog = "log"
199+ toJSON FactorModifierLog1p = "log1p"
200+ toJSON FactorModifierLog2p = "log2p"
201+ toJSON FactorModifierLn = "ln"
202+ toJSON FactorModifierLn1p = "ln1p"
203+ toJSON FactorModifierLn2p = "ln2p"
204+ toJSON FactorModifierSquare = "square"
205+ toJSON FactorModifierSqrt = "sqrt"
206+ toJSON FactorModifierReciprocal = "reciprocal"
207+
208+instance FromJSON FactorModifier where
209+ parseJSON = withText "FactorModifier" parse
210+ where parse "none" = pure FactorModifierNone
211+ parse "log" = pure FactorModifierLog
212+ parse "log1p" = pure FactorModifierLog1p
213+ parse "log2p" = pure FactorModifierLog2p
214+ parse "ln" = pure FactorModifierLn
215+ parse "ln1p" = pure FactorModifierLn1p
216+ parse "ln2p" = pure FactorModifierLn2p
217+ parse "square" = pure FactorModifierSquare
218+ parse "sqrt" = pure FactorModifierSqrt
219+ parse "reciprocal" = pure FactorModifierReciprocal
220+ parse fm = fail ("Unexpected FactorModifier: " <> show fm)
src/Database/Bloodhound/Internal/Aggregation.hsnew file+479
@@ -0,0 +1,479 @@
1+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
2+{-# LANGUAGE OverloadedStrings #-}
3+{-# LANGUAGE RecordWildCards #-}
4+
5+module Database.Bloodhound.Internal.Aggregation where
6+
7+import Bloodhound.Import
8+
9+import qualified Data.Aeson as Aeson
10+import qualified Data.HashMap.Strict as HM
11+import qualified Data.Map.Strict as M
12+import qualified Data.Text as T
13+
14+import Database.Bloodhound.Internal.Client
15+import Database.Bloodhound.Internal.Highlight (HitHighlight)
16+import Database.Bloodhound.Internal.Newtypes
17+import Database.Bloodhound.Internal.Query
18+import Database.Bloodhound.Internal.Sort
19+
20+type Aggregations = M.Map Text Aggregation
21+
22+emptyAggregations :: Aggregations
23+emptyAggregations = M.empty
24+
25+mkAggregations :: Text -> Aggregation -> Aggregations
26+mkAggregations name aggregation = M.insert name aggregation emptyAggregations
27+
28+data Aggregation = TermsAgg TermsAggregation
29+ | CardinalityAgg CardinalityAggregation
30+ | MaxAgg MaxAggregation
31+ | DateHistogramAgg DateHistogramAggregation
32+ | ValueCountAgg ValueCountAggregation
33+ | FilterAgg FilterAggregation
34+ | DateRangeAgg DateRangeAggregation
35+ | MissingAgg MissingAggregation
36+ | TopHitsAgg TopHitsAggregation
37+ | StatsAgg StatisticsAggregation
38+ deriving (Eq, Show)
39+
40+instance ToJSON Aggregation where
41+ toJSON (TermsAgg (TermsAggregation term include exclude order minDocCount size shardSize collectMode executionHint termAggs)) =
42+ omitNulls ["terms" .= omitNulls [ toJSON' term,
43+ "include" .= include,
44+ "exclude" .= exclude,
45+ "order" .= order,
46+ "min_doc_count" .= minDocCount,
47+ "size" .= size,
48+ "shard_size" .= shardSize,
49+ "collect_mode" .= collectMode,
50+ "execution_hint" .= executionHint
51+ ],
52+ "aggs" .= termAggs ]
53+ where
54+ toJSON' x = case x of { Left y -> "field" .= y; Right y -> "script" .= y }
55+
56+ toJSON (CardinalityAgg (CardinalityAggregation field precisionThreshold)) =
57+ object ["cardinality" .= omitNulls [ "field" .= field,
58+ "precisionThreshold" .= precisionThreshold
59+ ]
60+ ]
61+
62+ toJSON (MaxAgg (MaxAggregation field)) =
63+ object ["max" .= omitNulls [ "field" .= field ]]
64+
65+ toJSON (DateHistogramAgg
66+ (DateHistogramAggregation field interval format
67+ preZone postZone preOffset postOffset dateHistoAggs)) =
68+ omitNulls ["date_histogram" .= omitNulls [ "field" .= field,
69+ "interval" .= interval,
70+ "format" .= format,
71+ "pre_zone" .= preZone,
72+ "post_zone" .= postZone,
73+ "pre_offset" .= preOffset,
74+ "post_offset" .= postOffset
75+ ],
76+ "aggs" .= dateHistoAggs ]
77+ toJSON (ValueCountAgg a) = object ["value_count" .= v]
78+ where v = case a of
79+ (FieldValueCount (FieldName n)) ->
80+ object ["field" .= n]
81+ (ScriptValueCount s) ->
82+ object ["script" .= s]
83+ toJSON (FilterAgg (FilterAggregation filt ags)) =
84+ omitNulls [ "filter" .= filt
85+ , "aggs" .= ags]
86+ toJSON (DateRangeAgg a) = object [ "date_range" .= a
87+ ]
88+ toJSON (MissingAgg (MissingAggregation{..})) =
89+ object ["missing" .= object ["field" .= maField]]
90+
91+ toJSON (TopHitsAgg (TopHitsAggregation mfrom msize msort)) =
92+ omitNulls ["top_hits" .= omitNulls [ "size" .= msize
93+ , "from" .= mfrom
94+ , "sort" .= msort
95+ ]
96+ ]
97+
98+ toJSON (StatsAgg (StatisticsAggregation typ field)) =
99+ object [stType .= omitNulls [ "field" .= field ]]
100+ where
101+ stType | typ == Basic = "stats"
102+ | otherwise = "extended_stats"
103+
104+data TopHitsAggregation = TopHitsAggregation
105+ { taFrom :: Maybe From
106+ , taSize :: Maybe Size
107+ , taSort :: Maybe Sort
108+ } deriving (Eq, Show)
109+
110+data MissingAggregation = MissingAggregation
111+ { maField :: Text
112+ } deriving (Eq, Show)
113+
114+data TermsAggregation = TermsAggregation
115+ { term :: Either Text Text
116+ , termInclude :: Maybe TermInclusion
117+ , termExclude :: Maybe TermInclusion
118+ , termOrder :: Maybe TermOrder
119+ , termMinDocCount :: Maybe Int
120+ , termSize :: Maybe Int
121+ , termShardSize :: Maybe Int
122+ , termCollectMode :: Maybe CollectionMode
123+ , termExecutionHint :: Maybe ExecutionHint
124+ , termAggs :: Maybe Aggregations
125+ } deriving (Eq, Show)
126+
127+data CardinalityAggregation = CardinalityAggregation
128+ { cardinalityField :: FieldName,
129+ precisionThreshold :: Maybe Int
130+ } deriving (Eq, Show)
131+
132+data MaxAggregation = MaxAggregation
133+ { maxField :: FieldName
134+ } deriving (Eq, Show)
135+
136+data DateHistogramAggregation = DateHistogramAggregation
137+ { dateField :: FieldName
138+ , dateInterval :: Interval
139+ , dateFormat :: Maybe Text
140+ -- pre and post deprecated in 1.5
141+ , datePreZone :: Maybe Text
142+ , datePostZone :: Maybe Text
143+ , datePreOffset :: Maybe Text
144+ , datePostOffset :: Maybe Text
145+ , dateAggs :: Maybe Aggregations
146+ } deriving (Eq, Show)
147+
148+data DateRangeAggregation = DateRangeAggregation
149+ { draField :: FieldName
150+ , draFormat :: Maybe Text
151+ , draRanges :: NonEmpty DateRangeAggRange
152+ } deriving (Eq, Show)
153+
154+instance ToJSON DateRangeAggregation where
155+ toJSON DateRangeAggregation {..} =
156+ omitNulls [ "field" .= draField
157+ , "format" .= draFormat
158+ , "ranges" .= toList draRanges
159+ ]
160+
161+data DateRangeAggRange =
162+ DateRangeFrom DateMathExpr
163+ | DateRangeTo DateMathExpr
164+ | DateRangeFromAndTo DateMathExpr DateMathExpr
165+ deriving (Eq, Show)
166+
167+instance ToJSON DateRangeAggRange where
168+ toJSON (DateRangeFrom e) = object [ "from" .= e ]
169+ toJSON (DateRangeTo e) = object [ "to" .= e ]
170+ toJSON (DateRangeFromAndTo f t) = object [ "from" .= f, "to" .= t ]
171+
172+-- | See <https://www.elastic.co/guide/en/elasticsearch/reference/current/search-aggregations-metrics-valuecount-aggregation.html> for more information.
173+data ValueCountAggregation =
174+ FieldValueCount FieldName
175+ | ScriptValueCount Script
176+ deriving (Eq, Show)
177+
178+-- | Single-bucket filter aggregations. See <https://www.elastic.co/guide/en/elasticsearch/reference/current/search-aggregations-bucket-filter-aggregation.html#search-aggregations-bucket-filter-aggregation> for more information.
179+data FilterAggregation = FilterAggregation
180+ { faFilter :: Filter
181+ , faAggs :: Maybe Aggregations }
182+ deriving (Eq, Show)
183+
184+data StatisticsAggregation = StatisticsAggregation
185+ { statsType :: StatsType
186+ , statsField :: FieldName }
187+ deriving (Eq, Show)
188+
189+data StatsType
190+ = Basic
191+ | Extended
192+ deriving (Eq, Show)
193+
194+mkTermsAggregation :: Text -> TermsAggregation
195+mkTermsAggregation t =
196+ TermsAggregation (Left t)
197+ Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing
198+
199+mkTermsScriptAggregation :: Text -> TermsAggregation
200+mkTermsScriptAggregation t = TermsAggregation (Right t) Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing
201+
202+mkDateHistogram :: FieldName -> Interval -> DateHistogramAggregation
203+mkDateHistogram t i = DateHistogramAggregation t i Nothing Nothing Nothing Nothing Nothing Nothing
204+
205+mkCardinalityAggregation :: FieldName -> CardinalityAggregation
206+mkCardinalityAggregation t = CardinalityAggregation t Nothing
207+
208+mkStatsAggregation :: FieldName -> StatisticsAggregation
209+mkStatsAggregation = StatisticsAggregation Basic
210+
211+mkExtendedStatsAggregation :: FieldName -> StatisticsAggregation
212+mkExtendedStatsAggregation = StatisticsAggregation Extended
213+
214+type AggregationResults = M.Map Text Value
215+
216+class BucketAggregation a where
217+ key :: a -> BucketValue
218+ docCount :: a -> Int
219+ aggs :: a -> Maybe AggregationResults
220+
221+data Bucket a = Bucket
222+ { buckets :: [a]
223+ } deriving (Read, Show)
224+
225+instance (FromJSON a) => FromJSON (Bucket a) where
226+ parseJSON (Object v) = Bucket <$>
227+ v .: "buckets"
228+ parseJSON _ = mempty
229+
230+data BucketValue = TextValue Text
231+ | ScientificValue Scientific
232+ | BoolValue Bool deriving (Read, Show)
233+
234+instance FromJSON BucketValue where
235+ parseJSON (String t) = return $ TextValue t
236+ parseJSON (Number s) = return $ ScientificValue s
237+ parseJSON (Bool b) = return $ BoolValue b
238+ parseJSON _ = mempty
239+
240+data TermInclusion = TermInclusion Text
241+ | TermPattern Text Text deriving (Eq, Show)
242+
243+instance ToJSON TermInclusion where
244+ toJSON (TermInclusion x) = toJSON x
245+ toJSON (TermPattern pattern flags) =
246+ omitNulls [ "pattern" .= pattern
247+ , "flags" .= flags]
248+
249+data TermOrder = TermOrder
250+ { termSortField :: Text
251+ , termSortOrder :: SortOrder } deriving (Eq, Show)
252+
253+instance ToJSON TermOrder where
254+ toJSON (TermOrder termSortField termSortOrder) =
255+ object [termSortField .= termSortOrder]
256+
257+data CollectionMode = BreadthFirst
258+ | DepthFirst deriving (Eq, Show)
259+
260+instance ToJSON CollectionMode where
261+ toJSON BreadthFirst = "breadth_first"
262+ toJSON DepthFirst = "depth_first"
263+
264+data ExecutionHint = Ordinals
265+ | GlobalOrdinals
266+ | GlobalOrdinalsHash
267+ | GlobalOrdinalsLowCardinality
268+ | Map deriving (Eq, Show)
269+
270+instance ToJSON ExecutionHint where
271+ toJSON Ordinals = "ordinals"
272+ toJSON GlobalOrdinals = "global_ordinals"
273+ toJSON GlobalOrdinalsHash = "global_ordinals_hash"
274+ toJSON GlobalOrdinalsLowCardinality = "global_ordinals_low_cardinality"
275+ toJSON Map = "map"
276+
277+-- | See <https://www.elastic.co/guide/en/elasticsearch/reference/current/common-options.html#date-math> for more information.
278+data DateMathExpr =
279+ DateMathExpr DateMathAnchor [DateMathModifier]
280+ deriving (Eq, Show)
281+
282+instance ToJSON DateMathExpr where
283+ toJSON (DateMathExpr a mods) = String (fmtA a <> mconcat (fmtMod <$> mods))
284+ where fmtA DMNow = "now"
285+ fmtA (DMDate date) = (T.pack $ showGregorian date) <> "||"
286+ fmtMod (AddTime n u) = "+" <> showText n <> fmtU u
287+ fmtMod (SubtractTime n u) = "-" <> showText n <> fmtU u
288+ fmtMod (RoundDownTo u) = "/" <> fmtU u
289+ fmtU DMYear = "y"
290+ fmtU DMMonth = "M"
291+ fmtU DMWeek = "w"
292+ fmtU DMDay = "d"
293+ fmtU DMHour = "h"
294+ fmtU DMMinute = "m"
295+ fmtU DMSecond = "s"
296+
297+-- | Starting point for a date range. This along with the 'DateMathModifiers' gets you the date ES will start from.
298+data DateMathAnchor =
299+ DMNow
300+ | DMDate Day
301+ deriving (Eq, Show)
302+
303+data DateMathModifier =
304+ AddTime Int DateMathUnit
305+ | SubtractTime Int DateMathUnit
306+ | RoundDownTo DateMathUnit
307+ deriving (Eq, Show)
308+
309+data DateMathUnit =
310+ DMYear
311+ | DMMonth
312+ | DMWeek
313+ | DMDay
314+ | DMHour
315+ | DMMinute
316+ | DMSecond
317+ deriving (Eq, Show)
318+
319+data TermsResult = TermsResult
320+ { termKey :: BucketValue
321+ , termsDocCount :: Int
322+ , termsAggs :: Maybe AggregationResults
323+ } deriving (Read, Show)
324+
325+instance FromJSON TermsResult where
326+ parseJSON (Object v) = TermsResult <$>
327+ v .: "key" <*>
328+ v .: "doc_count" <*>
329+ (pure $ getNamedSubAgg v ["key", "doc_count"])
330+ parseJSON _ = mempty
331+
332+instance BucketAggregation TermsResult where
333+ key = termKey
334+ docCount = termsDocCount
335+ aggs = termsAggs
336+
337+data DateHistogramResult = DateHistogramResult
338+ { dateKey :: Int
339+ , dateKeyStr :: Maybe Text
340+ , dateDocCount :: Int
341+ , dateHistogramAggs :: Maybe AggregationResults
342+ } deriving (Show)
343+
344+instance FromJSON DateHistogramResult where
345+ parseJSON (Object v) = DateHistogramResult <$>
346+ v .: "key" <*>
347+ v .:? "key_as_string" <*>
348+ v .: "doc_count" <*>
349+ (pure $ getNamedSubAgg v [ "key"
350+ , "doc_count"
351+ , "key_as_string"
352+ ]
353+ )
354+ parseJSON _ = mempty
355+
356+instance BucketAggregation DateHistogramResult where
357+ key = TextValue . showText . dateKey
358+ docCount = dateDocCount
359+ aggs = dateHistogramAggs
360+
361+data DateRangeResult = DateRangeResult
362+ { dateRangeKey :: Text
363+ , dateRangeFrom :: Maybe UTCTime
364+ , dateRangeFromAsString :: Maybe Text
365+ , dateRangeTo :: Maybe UTCTime
366+ , dateRangeToAsString :: Maybe Text
367+ , dateRangeDocCount :: Int
368+ , dateRangeAggs :: Maybe AggregationResults
369+ } deriving (Eq, Show)
370+
371+instance FromJSON DateRangeResult where
372+ parseJSON = withObject "DateRangeResult" parse
373+ where parse v = DateRangeResult <$>
374+ v .: "key" <*>
375+ (fmap posixMS <$> v .:? "from") <*>
376+ v .:? "from_as_string" <*>
377+ (fmap posixMS <$> v .:? "to") <*>
378+ v .:? "to_as_string" <*>
379+ v .: "doc_count" <*>
380+ (pure $ getNamedSubAgg v [ "key"
381+ , "from"
382+ , "from_as_string"
383+ , "to"
384+ , "to_as_string"
385+ , "doc_count"
386+ ]
387+ )
388+
389+instance BucketAggregation DateRangeResult where
390+ key = TextValue . dateRangeKey
391+ docCount = dateRangeDocCount
392+ aggs = dateRangeAggs
393+
394+toTerms :: Text -> AggregationResults -> Maybe (Bucket TermsResult)
395+toTerms = toAggResult
396+
397+toDateHistogram :: Text -> AggregationResults -> Maybe (Bucket DateHistogramResult)
398+toDateHistogram = toAggResult
399+
400+toMissing :: Text -> AggregationResults -> Maybe MissingResult
401+toMissing = toAggResult
402+
403+toTopHits :: (FromJSON a) => Text -> AggregationResults -> Maybe (TopHitResult a)
404+toTopHits = toAggResult
405+
406+toAggResult :: (FromJSON a) => Text -> AggregationResults -> Maybe a
407+toAggResult t a = M.lookup t a >>= deserialize
408+ where deserialize = parseMaybe parseJSON
409+
410+-- Try to get an AggregationResults when we don't know the
411+-- field name. We filter out the known keys to try to minimize the noise.
412+getNamedSubAgg :: Object -> [Text] -> Maybe AggregationResults
413+getNamedSubAgg o knownKeys = maggRes
414+ where unknownKeys = HM.filterWithKey (\k _ -> k `notElem` knownKeys) o
415+ maggRes
416+ | HM.null unknownKeys = Nothing
417+ | otherwise = Just . M.fromList $ HM.toList unknownKeys
418+
419+data MissingResult = MissingResult
420+ { missingDocCount :: Int
421+ } deriving (Show)
422+
423+instance FromJSON MissingResult where
424+ parseJSON = withObject "MissingResult" parse
425+ where parse v = MissingResult <$> v .: "doc_count"
426+
427+data TopHitResult a = TopHitResult
428+ { tarHits :: (SearchHits a)
429+ } deriving Show
430+
431+instance (FromJSON a) => FromJSON (TopHitResult a) where
432+ parseJSON (Object v) = TopHitResult <$>
433+ v .: "hits"
434+ parseJSON _ = fail "Failure in FromJSON (TopHitResult a)"
435+
436+data SearchHits a =
437+ SearchHits { hitsTotal :: Int
438+ , maxScore :: Score
439+ , hits :: [Hit a] } deriving (Eq, Show)
440+
441+
442+instance (FromJSON a) => FromJSON (SearchHits a) where
443+ parseJSON (Object v) = SearchHits <$>
444+ v .: "total" <*>
445+ v .: "max_score" <*>
446+ v .: "hits"
447+ parseJSON _ = empty
448+
449+instance Semigroup (SearchHits a) where
450+ (SearchHits ta ma ha) <> (SearchHits tb mb hb) =
451+ SearchHits (ta + tb) (max ma mb) (ha <> hb)
452+
453+instance Monoid (SearchHits a) where
454+ mempty = SearchHits 0 Nothing mempty
455+ mappend = (<>)
456+
457+type SearchAfterKey = [Aeson.Value]
458+
459+data Hit a =
460+ Hit { hitIndex :: IndexName
461+ , hitType :: MappingName
462+ , hitDocId :: DocId
463+ , hitScore :: Score
464+ , hitSource :: Maybe a
465+ , hitSort :: Maybe SearchAfterKey
466+ , hitFields :: Maybe HitFields
467+ , hitHighlight :: Maybe HitHighlight } deriving (Eq, Show)
468+
469+instance (FromJSON a) => FromJSON (Hit a) where
470+ parseJSON (Object v) = Hit <$>
471+ v .: "_index" <*>
472+ v .: "_type" <*>
473+ v .: "_id" <*>
474+ v .: "_score" <*>
475+ v .:? "_source" <*>
476+ v .:? "sort" <*>
477+ v .:? "fields" <*>
478+ v .:? "highlight"
479+ parseJSON _ = empty
src/Database/Bloodhound/Internal/Analysis.hsnew file+379
@@ -0,0 +1,379 @@
1+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
2+{-# LANGUAGE OverloadedStrings #-}
3+
4+module Database.Bloodhound.Internal.Analysis where
5+
6+import Bloodhound.Import
7+
8+import qualified Data.Map.Strict as M
9+import qualified Data.Text as T
10+
11+import Database.Bloodhound.Internal.Newtypes
12+import Database.Bloodhound.Internal.StringlyTyped
13+
14+data Analysis = Analysis
15+ { analysisAnalyzer :: M.Map Text AnalyzerDefinition
16+ , analysisTokenizer :: M.Map Text TokenizerDefinition
17+ , analysisTokenFilter :: M.Map Text TokenFilterDefinition
18+ , analysisCharFilter :: M.Map Text CharFilterDefinition
19+ } deriving (Eq, Show)
20+
21+instance ToJSON Analysis where
22+ toJSON (Analysis analyzer tokenizer tokenFilter charFilter) = object
23+ [ "analyzer" .= analyzer
24+ , "tokenizer" .= tokenizer
25+ , "filter" .= tokenFilter
26+ , "char_filter" .= charFilter
27+ ]
28+
29+instance FromJSON Analysis where
30+ parseJSON = withObject "Analysis" $ \m -> Analysis
31+ <$> m .: "analyzer"
32+ <*> m .:? "tokenizer" .!= M.empty
33+ <*> m .:? "filter" .!= M.empty
34+ <*> m .:? "char_filter" .!= M.empty
35+
36+newtype Tokenizer =
37+ Tokenizer Text
38+ deriving (Eq, Show, ToJSON, FromJSON)
39+
40+data AnalyzerDefinition = AnalyzerDefinition
41+ { analyzerDefinitionTokenizer :: Maybe Tokenizer
42+ , analyzerDefinitionFilter :: [TokenFilter]
43+ , analyzerDefinitionCharFilter :: [CharFilter]
44+ } deriving (Eq,Show)
45+
46+instance ToJSON AnalyzerDefinition where
47+ toJSON (AnalyzerDefinition tokenizer tokenFilter charFilter) =
48+ object $ catMaybes
49+ [ fmap ("tokenizer" .=) tokenizer
50+ , Just $ "filter" .= tokenFilter
51+ , Just $ "char_filter" .= charFilter
52+ ]
53+
54+instance FromJSON AnalyzerDefinition where
55+ parseJSON = withObject "AnalyzerDefinition" $ \m -> AnalyzerDefinition
56+ <$> m .:? "tokenizer"
57+ <*> m .:? "filter" .!= []
58+ <*> m .:? "char_filter" .!= []
59+
60+-- | Character filters are used to preprocess the stream of characters
61+-- before it is passed to the tokenizer.
62+data CharFilterDefinition
63+ = CharFilterDefinitionMapping (M.Map Text Text)
64+ | CharFilterDefinitionPatternReplace
65+ { charFilterDefinitionPatternReplacePattern :: Text
66+ , charFilterDefinitionPatternReplaceReplacement :: Text
67+ , charFilterDefinitionPatternReplaceFlags :: Maybe Text
68+ }
69+ deriving (Eq, Show)
70+
71+instance ToJSON CharFilterDefinition where
72+ toJSON (CharFilterDefinitionMapping ms) = object
73+ [ "type" .= ("mapping" :: Text)
74+ , "mappings" .= [a <> " => " <> b | (a, b) <- M.toList ms] ]
75+ toJSON (CharFilterDefinitionPatternReplace pat repl flags) = object $
76+ [ "type" .= ("pattern_replace" :: Text)
77+ , "pattern" .= pat
78+ , "replacement" .= repl
79+ ] ++ maybe [] (\f -> ["flags" .= f]) flags
80+
81+instance FromJSON CharFilterDefinition where
82+ parseJSON = withObject "CharFilterDefinition" $ \m -> do
83+ t <- m .: "type"
84+ case (t :: Text) of
85+ "mapping" -> CharFilterDefinitionMapping . M.fromList <$> ms
86+ where
87+ ms = m .: "mappings" >>= mapM parseMapping
88+ parseMapping kv = case T.splitOn "=>" kv of
89+ (k:vs) -> pure (T.strip k, T.strip $ T.concat vs)
90+ _ -> fail "mapping is not of the format key => value"
91+ "pattern_replace" -> CharFilterDefinitionPatternReplace
92+ <$> m .: "pattern" <*> m .: "replacement" <*> m .:? "flags"
93+ _ -> fail ("unrecognized character filter type: " ++ T.unpack t)
94+
95+newtype TokenizerDefinition =
96+ TokenizerDefinitionNgram Ngram
97+ deriving (Eq,Show)
98+
99+instance ToJSON TokenizerDefinition where
100+ toJSON x = case x of
101+ TokenizerDefinitionNgram (Ngram minGram maxGram tokenChars) -> object
102+ [ "type" .= ("ngram" :: Text)
103+ , "min_gram" .= minGram
104+ , "max_gram" .= maxGram
105+ , "token_chars" .= tokenChars
106+ ]
107+
108+instance FromJSON TokenizerDefinition where
109+ parseJSON = withObject "TokenizerDefinition" $ \m -> do
110+ typ <- m .: "type" :: Parser Text
111+ case typ of
112+ "ngram" -> fmap TokenizerDefinitionNgram $ Ngram
113+ <$> fmap unStringlyTypedInt (m .: "min_gram")
114+ <*> fmap unStringlyTypedInt (m .: "max_gram")
115+ <*> m .: "token_chars"
116+ _ -> fail "invalid TokenizerDefinition"
117+
118+data Ngram = Ngram
119+ { ngramMinGram :: Int
120+ , ngramMaxGram :: Int
121+ , ngramTokenChars :: [TokenChar]
122+ } deriving (Eq,Show)
123+
124+data TokenChar =
125+ TokenLetter
126+ | TokenDigit
127+ | TokenWhitespace
128+ | TokenPunctuation
129+ | TokenSymbol
130+ deriving (Eq,Show)
131+
132+instance ToJSON TokenChar where
133+ toJSON t = String $ case t of
134+ TokenLetter -> "letter"
135+ TokenDigit -> "digit"
136+ TokenWhitespace -> "whitespace"
137+ TokenPunctuation -> "punctuation"
138+ TokenSymbol -> "symbol"
139+
140+instance FromJSON TokenChar where
141+ parseJSON = withText "TokenChar" $ \t -> case t of
142+ "letter" -> return TokenLetter
143+ "digit" -> return TokenDigit
144+ "whitespace" -> return TokenWhitespace
145+ "punctuation" -> return TokenPunctuation
146+ "symbol" -> return TokenSymbol
147+ _ -> fail "invalid TokenChar"
148+
149+-- | Token filters are used to create custom analyzers.
150+data TokenFilterDefinition
151+ = TokenFilterDefinitionLowercase (Maybe Language)
152+ | TokenFilterDefinitionUppercase (Maybe Language)
153+ | TokenFilterDefinitionApostrophe
154+ | TokenFilterDefinitionReverse
155+ | TokenFilterDefinitionSnowball Language
156+ | TokenFilterDefinitionShingle Shingle
157+ | TokenFilterDefinitionStemmer Language
158+ | TokenFilterDefinitionStop (Either Language [StopWord])
159+ deriving (Eq, Show)
160+
161+instance ToJSON TokenFilterDefinition where
162+ toJSON x = case x of
163+ TokenFilterDefinitionLowercase mlang -> object $ catMaybes
164+ [ Just $ "type" .= ("lowercase" :: Text)
165+ , fmap (\lang -> "language" .= languageToText lang) mlang
166+ ]
167+ TokenFilterDefinitionUppercase mlang -> object $ catMaybes
168+ [ Just $ "type" .= ("uppercase" :: Text)
169+ , fmap (\lang -> "language" .= languageToText lang) mlang
170+ ]
171+ TokenFilterDefinitionApostrophe -> object
172+ [ "type" .= ("apostrophe" :: Text)
173+ ]
174+ TokenFilterDefinitionReverse -> object
175+ [ "type" .= ("reverse" :: Text)
176+ ]
177+ TokenFilterDefinitionSnowball lang -> object
178+ [ "type" .= ("snowball" :: Text)
179+ , "language" .= languageToText lang
180+ ]
181+ TokenFilterDefinitionShingle s -> object
182+ [ "type" .= ("shingle" :: Text)
183+ , "max_shingle_size" .= shingleMaxSize s
184+ , "min_shingle_size" .= shingleMinSize s
185+ , "output_unigrams" .= shingleOutputUnigrams s
186+ , "output_unigrams_if_no_shingles" .= shingleOutputUnigramsIfNoShingles s
187+ , "token_separator" .= shingleTokenSeparator s
188+ , "filler_token" .= shingleFillerToken s
189+ ]
190+ TokenFilterDefinitionStemmer lang -> object
191+ [ "type" .= ("stemmer" :: Text)
192+ , "language" .= languageToText lang
193+ ]
194+ TokenFilterDefinitionStop stop -> object
195+ [ "type" .= ("stop" :: Text)
196+ , "stopwords" .= case stop of
197+ Left lang -> String $ "_" <> languageToText lang <> "_"
198+ Right stops -> toJSON stops
199+ ]
200+
201+instance FromJSON TokenFilterDefinition where
202+ parseJSON = withObject "TokenFilterDefinition" $ \m -> do
203+ t <- m .: "type"
204+ case (t :: Text) of
205+ "reverse" -> return TokenFilterDefinitionReverse
206+ "apostrophe" -> return TokenFilterDefinitionApostrophe
207+ "lowercase" -> TokenFilterDefinitionLowercase
208+ <$> m .:? "language"
209+ "uppercase" -> TokenFilterDefinitionUppercase
210+ <$> m .:? "language"
211+ "snowball" -> TokenFilterDefinitionSnowball
212+ <$> m .: "language"
213+ "shingle" -> fmap TokenFilterDefinitionShingle $ Shingle
214+ <$> (fmap.fmap) unStringlyTypedInt (m .:? "max_shingle_size") .!= 2
215+ <*> (fmap.fmap) unStringlyTypedInt (m .:? "min_shingle_size") .!= 2
216+ <*> (fmap.fmap) unStringlyTypedBool (m .:? "output_unigrams") .!= True
217+ <*> (fmap.fmap) unStringlyTypedBool (m .:? "output_unigrams_if_no_shingles") .!= False
218+ <*> m .:? "token_separator" .!= " "
219+ <*> m .:? "filler_token" .!= "_"
220+ "stemmer" -> TokenFilterDefinitionStemmer
221+ <$> m .: "language"
222+ "stop" -> do
223+ stop <- m .: "stopwords"
224+ stop' <- case stop of
225+ String lang ->
226+ fmap Left
227+ . parseJSON
228+ . String
229+ . T.drop 1
230+ . T.dropEnd 1 $ lang
231+ _ -> Right <$> parseJSON stop
232+ return (TokenFilterDefinitionStop stop')
233+ _ -> fail ("unrecognized token filter type: " ++ T.unpack t)
234+
235+-- | The set of languages that can be passed to various analyzers,
236+-- filters, etc. in Elasticsearch. Most data types in this module
237+-- that have a 'Language' field are actually only actually to
238+-- handle a subset of these languages. Consult the official
239+-- Elasticsearch documentation to see what is actually supported.
240+data Language
241+ = Arabic
242+ | Armenian
243+ | Basque
244+ | Bengali
245+ | Brazilian
246+ | Bulgarian
247+ | Catalan
248+ | Cjk
249+ | Czech
250+ | Danish
251+ | Dutch
252+ | English
253+ | Finnish
254+ | French
255+ | Galician
256+ | German
257+ | German2
258+ | Greek
259+ | Hindi
260+ | Hungarian
261+ | Indonesian
262+ | Irish
263+ | Italian
264+ | Kp
265+ | Latvian
266+ | Lithuanian
267+ | Lovins
268+ | Norwegian
269+ | Persian
270+ | Porter
271+ | Portuguese
272+ | Romanian
273+ | Russian
274+ | Sorani
275+ | Spanish
276+ | Swedish
277+ | Thai
278+ | Turkish
279+ deriving (Eq, Show)
280+
281+instance ToJSON Language where
282+ toJSON = String . languageToText
283+
284+instance FromJSON Language where
285+ parseJSON = withText "Language" $ \t -> case languageFromText t of
286+ Nothing -> fail "not a supported Elasticsearch language"
287+ Just lang -> return lang
288+
289+languageToText :: Language -> Text
290+languageToText x = case x of
291+ Arabic -> "arabic"
292+ Armenian -> "armenian"
293+ Basque -> "basque"
294+ Bengali -> "bengali"
295+ Brazilian -> "brazilian"
296+ Bulgarian -> "bulgarian"
297+ Catalan -> "catalan"
298+ Cjk -> "cjk"
299+ Czech -> "czech"
300+ Danish -> "danish"
301+ Dutch -> "dutch"
302+ English -> "english"
303+ Finnish -> "finnish"
304+ French -> "french"
305+ Galician -> "galician"
306+ German -> "german"
307+ German2 -> "german2"
308+ Greek -> "greek"
309+ Hindi -> "hindi"
310+ Hungarian -> "hungarian"
311+ Indonesian -> "indonesian"
312+ Irish -> "irish"
313+ Italian -> "italian"
314+ Kp -> "kp"
315+ Latvian -> "latvian"
316+ Lithuanian -> "lithuanian"
317+ Lovins -> "lovins"
318+ Norwegian -> "norwegian"
319+ Persian -> "persian"
320+ Porter -> "porter"
321+ Portuguese -> "portuguese"
322+ Romanian -> "romanian"
323+ Russian -> "russian"
324+ Sorani -> "sorani"
325+ Spanish -> "spanish"
326+ Swedish -> "swedish"
327+ Thai -> "thai"
328+ Turkish -> "turkish"
329+
330+languageFromText :: Text -> Maybe Language
331+languageFromText x = case x of
332+ "arabic" -> Just Arabic
333+ "armenian" -> Just Armenian
334+ "basque" -> Just Basque
335+ "bengali" -> Just Bengali
336+ "brazilian" -> Just Brazilian
337+ "bulgarian" -> Just Bulgarian
338+ "catalan" -> Just Catalan
339+ "cjk" -> Just Cjk
340+ "czech" -> Just Czech
341+ "danish" -> Just Danish
342+ "dutch" -> Just Dutch
343+ "english" -> Just English
344+ "finnish" -> Just Finnish
345+ "french" -> Just French
346+ "galician" -> Just Galician
347+ "german" -> Just German
348+ "german2" -> Just German2
349+ "greek" -> Just Greek
350+ "hindi" -> Just Hindi
351+ "hungarian" -> Just Hungarian
352+ "indonesian" -> Just Indonesian
353+ "irish" -> Just Irish
354+ "italian" -> Just Italian
355+ "kp" -> Just Kp
356+ "latvian" -> Just Latvian
357+ "lithuanian" -> Just Lithuanian
358+ "lovins" -> Just Lovins
359+ "norwegian" -> Just Norwegian
360+ "persian" -> Just Persian
361+ "porter" -> Just Porter
362+ "portuguese" -> Just Portuguese
363+ "romanian" -> Just Romanian
364+ "russian" -> Just Russian
365+ "sorani" -> Just Sorani
366+ "spanish" -> Just Spanish
367+ "swedish" -> Just Swedish
368+ "thai" -> Just Thai
369+ "turkish" -> Just Turkish
370+ _ -> Nothing
371+
372+data Shingle = Shingle
373+ { shingleMaxSize :: Int
374+ , shingleMinSize :: Int
375+ , shingleOutputUnigrams :: Bool
376+ , shingleOutputUnigramsIfNoShingles :: Bool
377+ , shingleTokenSeparator :: Text
378+ , shingleFillerToken :: Text
379+ } deriving (Eq, Show)
src/Database/Bloodhound/Internal/Client.hsnew file+2431
@@ -0,0 +1,2431 @@
1+{-# LANGUAGE CPP #-}
2+{-# LANGUAGE FlexibleInstances #-}
3+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
4+{-# LANGUAGE MultiParamTypeClasses #-}
5+{-# LANGUAGE OverloadedStrings #-}
6+{-# LANGUAGE RecordWildCards #-}
7+{-# LANGUAGE UndecidableInstances #-}
8+
9+module Database.Bloodhound.Internal.Client where
10+
11+import Bloodhound.Import
12+
13+#if defined(MIN_VERSION_GLASGOW_HASKELL)
14+#if MIN_VERSION_GLASGOW_HASKELL(8,6,0,0)
15+import Control.Monad.Fail (MonadFail)
16+#endif
17+#endif
18+import qualified Data.Text as T
19+import qualified Data.Traversable as DT
20+import qualified Data.HashMap.Strict as HM
21+import qualified Data.SemVer as SemVer
22+import qualified Data.Vector as V
23+import GHC.Enum
24+import Network.HTTP.Client
25+import Text.Read (Read(..))
26+import qualified Text.Read as TR
27+
28+import Database.Bloodhound.Internal.Analysis
29+import Database.Bloodhound.Internal.Newtypes
30+import Database.Bloodhound.Internal.Query
31+import Database.Bloodhound.Internal.StringlyTyped
32+
33+{-| Common environment for Elasticsearch calls. Connections will be
34+ pipelined according to the provided HTTP connection manager.
35+-}
36+data BHEnv = BHEnv { bhServer :: Server
37+ , bhManager :: Manager
38+ , bhRequestHook :: Request -> IO Request
39+ -- ^ Low-level hook that is run before every request is sent. Used to implement custom authentication strategies. Defaults to 'return' with 'mkBHEnv'.
40+ }
41+
42+instance (Functor m, Applicative m, MonadIO m) => MonadBH (ReaderT BHEnv m) where
43+ getBHEnv = ask
44+
45+{-| 'Server' is used with the client functions to point at the ES instance
46+-}
47+newtype Server = Server Text deriving (Eq, Show, FromJSON)
48+
49+{-| All API calls to Elasticsearch operate within
50+ MonadBH
51+ . The idea is that it can be easily embedded in your
52+ own monad transformer stack. A default instance for a ReaderT and
53+ alias 'BH' is provided for the simple case.
54+-}
55+class (Functor m, Applicative m, MonadIO m) => MonadBH m where
56+ getBHEnv :: m BHEnv
57+
58+-- | Create a 'BHEnv' with all optional fields defaulted. HTTP hook
59+-- will be a noop. You can use the exported fields to customize
60+-- it further, e.g.:
61+--
62+-- >> (mkBHEnv myServer myManager) { bhRequestHook = customHook }
63+mkBHEnv :: Server -> Manager -> BHEnv
64+mkBHEnv s m = BHEnv s m return
65+
66+newtype BH m a = BH {
67+ unBH :: ReaderT BHEnv m a
68+ } deriving ( Functor
69+ , Applicative
70+ , Monad
71+ , MonadIO
72+ , MonadState s
73+ , MonadWriter w
74+ , MonadError e
75+ , Alternative
76+ , MonadPlus
77+ , MonadFix
78+ , MonadThrow
79+ , MonadCatch
80+#if defined(MIN_VERSION_GLASGOW_HASKELL)
81+#if MIN_VERSION_GLASGOW_HASKELL(8,6,0,0)
82+ , MonadFail
83+#endif
84+#endif
85+ , MonadMask)
86+
87+instance MonadTrans BH where
88+ lift = BH . lift
89+
90+instance (MonadReader r m) => MonadReader r (BH m) where
91+ ask = lift ask
92+ local f (BH (ReaderT m)) = BH $ ReaderT $ \r ->
93+ local f (m r)
94+
95+instance (Functor m, Applicative m, MonadIO m) => MonadBH (BH m) where
96+ getBHEnv = BH getBHEnv
97+
98+runBH :: BHEnv -> BH m a -> m a
99+runBH e f = runReaderT (unBH f) e
100+
101+{-| 'Version' is embedded in 'Status' -}
102+data Version = Version { number :: VersionNumber
103+ , build_hash :: BuildHash
104+ , build_date :: UTCTime
105+ , build_snapshot :: Bool
106+ , lucene_version :: VersionNumber }
107+ deriving (Eq, Show)
108+
109+-- | Traditional software versioning number
110+newtype VersionNumber = VersionNumber
111+ { versionNumber :: SemVer.Version }
112+ deriving (Eq, Ord, Show)
113+
114+{-| 'Status' is a data type for describing the JSON body returned by
115+ Elasticsearch when you query its status. This was deprecated in 1.2.0.
116+
117+ <http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/indices-status.html#indices-status>
118+-}
119+
120+data Status = Status
121+ { name :: Text
122+ , cluster_name :: Text
123+ , cluster_uuid :: Text
124+ , version :: Version
125+ , tagline :: Text }
126+ deriving (Eq, Show)
127+
128+instance FromJSON Status where
129+ parseJSON (Object v) = Status <$>
130+ v .: "name" <*>
131+ v .: "cluster_name" <*>
132+ v .: "cluster_uuid" <*>
133+ v .: "version" <*>
134+ v .: "tagline"
135+ parseJSON _ = empty
136+
137+{-| 'IndexSettings' is used to configure the shards and replicas when
138+ you create an Elasticsearch Index.
139+
140+ <http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/indices-create-index.html>
141+-}
142+
143+data IndexSettings = IndexSettings
144+ { indexShards :: ShardCount
145+ , indexReplicas :: ReplicaCount }
146+ deriving (Eq, Show)
147+
148+instance ToJSON IndexSettings where
149+ toJSON (IndexSettings s r) = object ["settings" .=
150+ object ["index" .=
151+ object ["number_of_shards" .= s, "number_of_replicas" .= r]
152+ ]
153+ ]
154+
155+instance FromJSON IndexSettings where
156+ parseJSON = withObject "IndexSettings" parse
157+ where parse o = do s <- o .: "settings"
158+ i <- s .: "index"
159+ IndexSettings <$> i .: "number_of_shards"
160+ <*> i .: "number_of_replicas"
161+
162+{-| 'defaultIndexSettings' is an 'IndexSettings' with 3 shards and
163+ 2 replicas. -}
164+defaultIndexSettings :: IndexSettings
165+defaultIndexSettings = IndexSettings (ShardCount 3) (ReplicaCount 2)
166+-- defaultIndexSettings is exported by Database.Bloodhound as well
167+-- no trailing slashes in servers, library handles building the path.
168+
169+
170+{-| 'ForceMergeIndexSettings' is used to configure index optimization. See
171+ <https://www.elastic.co/guide/en/elasticsearch/reference/current/indices-forcemerge.html>
172+ for more info.
173+-}
174+data ForceMergeIndexSettings =
175+ ForceMergeIndexSettings { maxNumSegments :: Maybe Int
176+ -- ^ Number of segments to optimize to. 1 will fully optimize the index. If omitted, the default behavior is to only optimize if the server deems it necessary.
177+ , onlyExpungeDeletes :: Bool
178+ -- ^ Should the optimize process only expunge segments with deletes in them? If the purpose of the optimization is to free disk space, this should be set to True.
179+ , flushAfterOptimize :: Bool
180+ -- ^ Should a flush be performed after the optimize.
181+ } deriving (Eq, Show)
182+
183+
184+{-| 'defaultForceMergeIndexSettings' implements the default settings that
185+ Elasticsearch uses for index optimization. 'maxNumSegments' is Nothing,
186+ 'onlyExpungeDeletes' is False, and flushAfterOptimize is True.
187+-}
188+defaultForceMergeIndexSettings :: ForceMergeIndexSettings
189+defaultForceMergeIndexSettings = ForceMergeIndexSettings Nothing False True
190+
191+{-| 'UpdatableIndexSetting' are settings which may be updated after an index is created.
192+
193+ <https://www.elastic.co/guide/en/elasticsearch/reference/current/indices-update-settings.html>
194+-}
195+data UpdatableIndexSetting = NumberOfReplicas ReplicaCount
196+ -- ^ The number of replicas each shard has.
197+ | AutoExpandReplicas ReplicaBounds
198+ | BlocksReadOnly Bool
199+ -- ^ Set to True to have the index read only. False to allow writes and metadata changes.
200+ | BlocksRead Bool
201+ -- ^ Set to True to disable read operations against the index.
202+ | BlocksWrite Bool
203+ -- ^ Set to True to disable write operations against the index.
204+ | BlocksMetaData Bool
205+ -- ^ Set to True to disable metadata operations against the index.
206+ | RefreshInterval NominalDiffTime
207+ -- ^ The async refresh interval of a shard
208+ | IndexConcurrency Int
209+ | FailOnMergeFailure Bool
210+ | TranslogFlushThresholdOps Int
211+ -- ^ When to flush on operations.
212+ | TranslogFlushThresholdSize Bytes
213+ -- ^ When to flush based on translog (bytes) size.
214+ | TranslogFlushThresholdPeriod NominalDiffTime
215+ -- ^ When to flush based on a period of not flushing.
216+ | TranslogDisableFlush Bool
217+ -- ^ Disables flushing. Note, should be set for a short interval and then enabled.
218+ | CacheFilterMaxSize (Maybe Bytes)
219+ -- ^ The maximum size of filter cache (per segment in shard).
220+ | CacheFilterExpire (Maybe NominalDiffTime)
221+ -- ^ The expire after access time for filter cache.
222+ | GatewaySnapshotInterval NominalDiffTime
223+ -- ^ The gateway snapshot interval (only applies to shared gateways).
224+ | RoutingAllocationInclude (NonEmpty NodeAttrFilter)
225+ -- ^ A node matching any rule will be allowed to host shards from the index.
226+ | RoutingAllocationExclude (NonEmpty NodeAttrFilter)
227+ -- ^ A node matching any rule will NOT be allowed to host shards from the index.
228+ | RoutingAllocationRequire (NonEmpty NodeAttrFilter)
229+ -- ^ Only nodes matching all rules will be allowed to host shards from the index.
230+ | RoutingAllocationEnable AllocationPolicy
231+ -- ^ Enables shard allocation for a specific index.
232+ | RoutingAllocationShardsPerNode ShardCount
233+ -- ^ Controls the total number of shards (replicas and primaries) allowed to be allocated on a single node.
234+ | RecoveryInitialShards InitialShardCount
235+ -- ^ When using local gateway a particular shard is recovered only if there can be allocated quorum shards in the cluster.
236+ | GCDeletes NominalDiffTime
237+ | TTLDisablePurge Bool
238+ -- ^ Disables temporarily the purge of expired docs.
239+ | TranslogFSType FSType
240+ | CompressionSetting Compression
241+ | IndexCompoundFormat CompoundFormat
242+ | IndexCompoundOnFlush Bool
243+ | WarmerEnabled Bool
244+ | MappingTotalFieldsLimit Int
245+ | AnalysisSetting Analysis
246+ -- ^ Analysis is not a dynamic setting and can only be performed on a closed index.
247+ deriving (Eq, Show)
248+
249+attrFilterJSON :: NonEmpty NodeAttrFilter -> Value
250+attrFilterJSON fs = object [ n .= T.intercalate "," (toList vs)
251+ | NodeAttrFilter (NodeAttrName n) vs <- toList fs]
252+
253+parseAttrFilter :: Value -> Parser (NonEmpty NodeAttrFilter)
254+parseAttrFilter = withObject "NonEmpty NodeAttrFilter" parse
255+ where parse o = case HM.toList o of
256+ [] -> fail "Expected non-empty list of NodeAttrFilters"
257+ x:xs -> DT.mapM (uncurry parse') (x :| xs)
258+ parse' n = withText "Text" $ \t ->
259+ case T.splitOn "," t of
260+ fv:fvs -> return (NodeAttrFilter (NodeAttrName n) (fv :| fvs))
261+ [] -> fail "Expected non-empty list of filter values"
262+
263+instance ToJSON UpdatableIndexSetting where
264+ toJSON (NumberOfReplicas x) = oPath ("index" :| ["number_of_replicas"]) x
265+ toJSON (AutoExpandReplicas x) = oPath ("index" :| ["auto_expand_replicas"]) x
266+ toJSON (RefreshInterval x) = oPath ("index" :| ["refresh_interval"]) (NominalDiffTimeJSON x)
267+ toJSON (IndexConcurrency x) = oPath ("index" :| ["concurrency"]) x
268+ toJSON (FailOnMergeFailure x) = oPath ("index" :| ["fail_on_merge_failure"]) x
269+ toJSON (TranslogFlushThresholdOps x) = oPath ("index" :| ["translog", "flush_threshold_ops"]) x
270+ toJSON (TranslogFlushThresholdSize x) = oPath ("index" :| ["translog", "flush_threshold_size"]) x
271+ toJSON (TranslogFlushThresholdPeriod x) = oPath ("index" :| ["translog", "flush_threshold_period"]) (NominalDiffTimeJSON x)
272+ toJSON (TranslogDisableFlush x) = oPath ("index" :| ["translog", "disable_flush"]) x
273+ toJSON (CacheFilterMaxSize x) = oPath ("index" :| ["cache", "filter", "max_size"]) x
274+ toJSON (CacheFilterExpire x) = oPath ("index" :| ["cache", "filter", "expire"]) (NominalDiffTimeJSON <$> x)
275+ toJSON (GatewaySnapshotInterval x) = oPath ("index" :| ["gateway", "snapshot_interval"]) (NominalDiffTimeJSON x)
276+ toJSON (RoutingAllocationInclude fs) = oPath ("index" :| ["routing", "allocation", "include"]) (attrFilterJSON fs)
277+ toJSON (RoutingAllocationExclude fs) = oPath ("index" :| ["routing", "allocation", "exclude"]) (attrFilterJSON fs)
278+ toJSON (RoutingAllocationRequire fs) = oPath ("index" :| ["routing", "allocation", "require"]) (attrFilterJSON fs)
279+ toJSON (RoutingAllocationEnable x) = oPath ("index" :| ["routing", "allocation", "enable"]) x
280+ toJSON (RoutingAllocationShardsPerNode x) = oPath ("index" :| ["routing", "allocation", "total_shards_per_node"]) x
281+ toJSON (RecoveryInitialShards x) = oPath ("index" :| ["recovery", "initial_shards"]) x
282+ toJSON (GCDeletes x) = oPath ("index" :| ["gc_deletes"]) (NominalDiffTimeJSON x)
283+ toJSON (TTLDisablePurge x) = oPath ("index" :| ["ttl", "disable_purge"]) x
284+ toJSON (TranslogFSType x) = oPath ("index" :| ["translog", "fs", "type"]) x
285+ toJSON (CompressionSetting x) = oPath ("index" :| ["codec"]) x
286+ toJSON (IndexCompoundFormat x) = oPath ("index" :| ["compound_format"]) x
287+ toJSON (IndexCompoundOnFlush x) = oPath ("index" :| ["compound_on_flush"]) x
288+ toJSON (WarmerEnabled x) = oPath ("index" :| ["warmer", "enabled"]) x
289+ toJSON (BlocksReadOnly x) = oPath ("blocks" :| ["read_only"]) x
290+ toJSON (BlocksRead x) = oPath ("blocks" :| ["read"]) x
291+ toJSON (BlocksWrite x) = oPath ("blocks" :| ["write"]) x
292+ toJSON (BlocksMetaData x) = oPath ("blocks" :| ["metadata"]) x
293+ toJSON (MappingTotalFieldsLimit x) = oPath ("index" :| ["mapping","total_fields","limit"]) x
294+ toJSON (AnalysisSetting x) = oPath ("index" :| ["analysis"]) x
295+
296+instance FromJSON UpdatableIndexSetting where
297+ parseJSON = withObject "UpdatableIndexSetting" parse
298+ where parse o = numberOfReplicas `taggedAt` ["index", "number_of_replicas"]
299+ <|> autoExpandReplicas `taggedAt` ["index", "auto_expand_replicas"]
300+ <|> refreshInterval `taggedAt` ["index", "refresh_interval"]
301+ <|> indexConcurrency `taggedAt` ["index", "concurrency"]
302+ <|> failOnMergeFailure `taggedAt` ["index", "fail_on_merge_failure"]
303+ <|> translogFlushThresholdOps `taggedAt` ["index", "translog", "flush_threshold_ops"]
304+ <|> translogFlushThresholdSize `taggedAt` ["index", "translog", "flush_threshold_size"]
305+ <|> translogFlushThresholdPeriod `taggedAt` ["index", "translog", "flush_threshold_period"]
306+ <|> translogDisableFlush `taggedAt` ["index", "translog", "disable_flush"]
307+ <|> cacheFilterMaxSize `taggedAt` ["index", "cache", "filter", "max_size"]
308+ <|> cacheFilterExpire `taggedAt` ["index", "cache", "filter", "expire"]
309+ <|> gatewaySnapshotInterval `taggedAt` ["index", "gateway", "snapshot_interval"]
310+ <|> routingAllocationInclude `taggedAt` ["index", "routing", "allocation", "include"]
311+ <|> routingAllocationExclude `taggedAt` ["index", "routing", "allocation", "exclude"]
312+ <|> routingAllocationRequire `taggedAt` ["index", "routing", "allocation", "require"]
313+ <|> routingAllocationEnable `taggedAt` ["index", "routing", "allocation", "enable"]
314+ <|> routingAllocationShardsPerNode `taggedAt` ["index", "routing", "allocation", "total_shards_per_node"]
315+ <|> recoveryInitialShards `taggedAt` ["index", "recovery", "initial_shards"]
316+ <|> gcDeletes `taggedAt` ["index", "gc_deletes"]
317+ <|> ttlDisablePurge `taggedAt` ["index", "ttl", "disable_purge"]
318+ <|> translogFSType `taggedAt` ["index", "translog", "fs", "type"]
319+ <|> compressionSetting `taggedAt` ["index", "codec"]
320+ <|> compoundFormat `taggedAt` ["index", "compound_format"]
321+ <|> compoundOnFlush `taggedAt` ["index", "compound_on_flush"]
322+ <|> warmerEnabled `taggedAt` ["index", "warmer", "enabled"]
323+ <|> blocksReadOnly `taggedAt` ["blocks", "read_only"]
324+ <|> blocksRead `taggedAt` ["blocks", "read"]
325+ <|> blocksWrite `taggedAt` ["blocks", "write"]
326+ <|> blocksMetaData `taggedAt` ["blocks", "metadata"]
327+ <|> mappingTotalFieldsLimit `taggedAt` ["index", "mapping", "total_fields", "limit"]
328+ <|> analysisSetting `taggedAt` ["index", "analysis"]
329+ where taggedAt f ks = taggedAt' f (Object o) ks
330+ taggedAt' f v [] =
331+ f =<< (parseJSON v <|> parseJSON (unStringlyTypeJSON v))
332+ taggedAt' f v (k:ks) =
333+ withObject "Object" (\o -> do v' <- o .: k
334+ taggedAt' f v' ks) v
335+ numberOfReplicas = pure . NumberOfReplicas
336+ autoExpandReplicas = pure . AutoExpandReplicas
337+ refreshInterval = pure . RefreshInterval . ndtJSON
338+ indexConcurrency = pure . IndexConcurrency
339+ failOnMergeFailure = pure . FailOnMergeFailure
340+ translogFlushThresholdOps = pure . TranslogFlushThresholdOps
341+ translogFlushThresholdSize = pure . TranslogFlushThresholdSize
342+ translogFlushThresholdPeriod = pure . TranslogFlushThresholdPeriod . ndtJSON
343+ translogDisableFlush = pure . TranslogDisableFlush
344+ cacheFilterMaxSize = pure . CacheFilterMaxSize
345+ cacheFilterExpire = pure . CacheFilterExpire . fmap ndtJSON
346+ gatewaySnapshotInterval = pure . GatewaySnapshotInterval . ndtJSON
347+ routingAllocationInclude = fmap RoutingAllocationInclude . parseAttrFilter
348+ routingAllocationExclude = fmap RoutingAllocationExclude . parseAttrFilter
349+ routingAllocationRequire = fmap RoutingAllocationRequire . parseAttrFilter
350+ routingAllocationEnable = pure . RoutingAllocationEnable
351+ routingAllocationShardsPerNode = pure . RoutingAllocationShardsPerNode
352+ recoveryInitialShards = pure . RecoveryInitialShards
353+ gcDeletes = pure . GCDeletes . ndtJSON
354+ ttlDisablePurge = pure . TTLDisablePurge
355+ translogFSType = pure . TranslogFSType
356+ compressionSetting = pure . CompressionSetting
357+ compoundFormat = pure . IndexCompoundFormat
358+ compoundOnFlush = pure . IndexCompoundOnFlush
359+ warmerEnabled = pure . WarmerEnabled
360+ blocksReadOnly = pure . BlocksReadOnly
361+ blocksRead = pure . BlocksRead
362+ blocksWrite = pure . BlocksWrite
363+ blocksMetaData = pure . BlocksMetaData
364+ mappingTotalFieldsLimit = pure . MappingTotalFieldsLimit
365+ analysisSetting = pure . AnalysisSetting
366+
367+data ReplicaBounds = ReplicasBounded Int Int
368+ | ReplicasLowerBounded Int
369+ | ReplicasUnbounded
370+ deriving (Eq, Show)
371+
372+
373+instance ToJSON ReplicaBounds where
374+ toJSON (ReplicasBounded a b) = String (showText a <> "-" <> showText b)
375+ toJSON (ReplicasLowerBounded a) = String (showText a <> "-all")
376+ toJSON ReplicasUnbounded = Bool False
377+
378+instance FromJSON ReplicaBounds where
379+ parseJSON v = withText "ReplicaBounds" parseText v
380+ <|> withBool "ReplicaBounds" parseBool v
381+ where parseText t = case T.splitOn "-" t of
382+ [a, "all"] -> ReplicasLowerBounded <$> parseReadText a
383+ [a, b] -> ReplicasBounded <$> parseReadText a
384+ <*> parseReadText b
385+ _ -> fail ("Could not parse ReplicaBounds: " <> show t)
386+ parseBool False = pure ReplicasUnbounded
387+ parseBool _ = fail "ReplicasUnbounded cannot be represented with True"
388+
389+data Compression
390+ = CompressionDefault
391+ -- ^ Compress with LZ4
392+ | CompressionBest
393+ -- ^ Compress with DEFLATE. Elastic
394+ -- <https://www.elastic.co/blog/elasticsearch-storage-the-true-story-2.0 blogs>
395+ -- that this can reduce disk use by 15%-25%.
396+ deriving (Eq,Show)
397+
398+instance ToJSON Compression where
399+ toJSON x = case x of
400+ CompressionDefault -> toJSON ("default" :: Text)
401+ CompressionBest -> toJSON ("best_compression" :: Text)
402+
403+instance FromJSON Compression where
404+ parseJSON = withText "Compression" $ \t -> case t of
405+ "default" -> return CompressionDefault
406+ "best_compression" -> return CompressionBest
407+ _ -> fail "invalid compression codec"
408+
409+-- | A measure of bytes used for various configurations. You may want
410+-- to use smart constructors like 'gigabytes' for larger values.
411+--
412+-- >>> gigabytes 9
413+-- Bytes 9000000000
414+--
415+-- >>> megabytes 9
416+-- Bytes 9000000
417+--
418+-- >>> kilobytes 9
419+-- Bytes 9000
420+newtype Bytes =
421+ Bytes Int
422+ deriving (Eq, Show, Ord, ToJSON, FromJSON)
423+
424+gigabytes :: Int -> Bytes
425+gigabytes n = megabytes (1000 * n)
426+
427+
428+megabytes :: Int -> Bytes
429+megabytes n = kilobytes (1000 * n)
430+
431+
432+kilobytes :: Int -> Bytes
433+kilobytes n = Bytes (1000 * n)
434+
435+
436+data FSType = FSSimple
437+ | FSBuffered deriving (Eq, Show)
438+
439+instance ToJSON FSType where
440+ toJSON FSSimple = "simple"
441+ toJSON FSBuffered = "buffered"
442+
443+instance FromJSON FSType where
444+ parseJSON = withText "FSType" parse
445+ where parse "simple" = pure FSSimple
446+ parse "buffered" = pure FSBuffered
447+ parse t = fail ("Invalid FSType: " <> show t)
448+
449+data InitialShardCount = QuorumShards
450+ | QuorumMinus1Shards
451+ | FullShards
452+ | FullMinus1Shards
453+ | ExplicitShards Int
454+ deriving (Eq, Show)
455+
456+instance FromJSON InitialShardCount where
457+ parseJSON v = withText "InitialShardCount" parseText v
458+ <|> ExplicitShards <$> parseJSON v
459+ where parseText "quorum" = pure QuorumShards
460+ parseText "quorum-1" = pure QuorumMinus1Shards
461+ parseText "full" = pure FullShards
462+ parseText "full-1" = pure FullMinus1Shards
463+ parseText _ = mzero
464+
465+instance ToJSON InitialShardCount where
466+ toJSON QuorumShards = String "quorum"
467+ toJSON QuorumMinus1Shards = String "quorum-1"
468+ toJSON FullShards = String "full"
469+ toJSON FullMinus1Shards = String "full-1"
470+ toJSON (ExplicitShards x) = toJSON x
471+
472+data NodeAttrFilter = NodeAttrFilter
473+ { nodeAttrFilterName :: NodeAttrName
474+ , nodeAttrFilterValues :: NonEmpty Text }
475+ deriving (Eq, Ord, Show)
476+
477+newtype NodeAttrName = NodeAttrName Text deriving (Eq, Ord, Show)
478+
479+data CompoundFormat = CompoundFileFormat Bool
480+ | MergeSegmentVsTotalIndex Double
481+ -- ^ percentage between 0 and 1 where 0 is false, 1 is true
482+ deriving (Eq, Show)
483+
484+instance ToJSON CompoundFormat where
485+ toJSON (CompoundFileFormat x) = Bool x
486+ toJSON (MergeSegmentVsTotalIndex x) = toJSON x
487+
488+instance FromJSON CompoundFormat where
489+ parseJSON v = CompoundFileFormat <$> parseJSON v
490+ <|> MergeSegmentVsTotalIndex <$> parseJSON v
491+
492+newtype NominalDiffTimeJSON =
493+ NominalDiffTimeJSON { ndtJSON :: NominalDiffTime }
494+
495+instance ToJSON NominalDiffTimeJSON where
496+ toJSON (NominalDiffTimeJSON t) = String (showText (round t :: Integer) <> "s")
497+
498+instance FromJSON NominalDiffTimeJSON where
499+ parseJSON = withText "NominalDiffTime" parse
500+ where parse t = case T.takeEnd 1 t of
501+ "s" -> NominalDiffTimeJSON . fromInteger <$> parseReadText (T.dropEnd 1 t)
502+ _ -> fail "Invalid or missing NominalDiffTime unit (expected s)"
503+
504+data IndexSettingsSummary = IndexSettingsSummary
505+ { sSummaryIndexName :: IndexName
506+ , sSummaryFixedSettings :: IndexSettings
507+ , sSummaryUpdateable :: [UpdatableIndexSetting]}
508+ deriving (Eq, Show)
509+
510+parseSettings :: Object -> Parser [UpdatableIndexSetting]
511+parseSettings o = do
512+ o' <- o .: "index"
513+ -- slice the index object into singleton hashmaps and try to parse each
514+ parses <- forM (HM.toList o') $ \(k, v) -> do
515+ -- blocks are now nested into the "index" key, which is not how they're serialized
516+ let atRoot = Object (HM.singleton k v)
517+ let atIndex = Object (HM.singleton "index" atRoot)
518+ optional (parseJSON atRoot <|> parseJSON atIndex)
519+ return (catMaybes parses)
520+
521+instance FromJSON IndexSettingsSummary where
522+ parseJSON = withObject "IndexSettingsSummary" parse
523+ where parse o = case HM.toList o of
524+ [(ixn, v@(Object o'))] -> IndexSettingsSummary (IndexName ixn)
525+ <$> parseJSON v
526+ <*> (fmap (filter (not . redundant)) . parseSettings =<< o' .: "settings")
527+ _ -> fail "Expected single-key object with index name"
528+ redundant (NumberOfReplicas _) = True
529+ redundant _ = False
530+
531+{-| 'Reply' and 'Method' are type synonyms from 'Network.HTTP.Types.Method.Method' -}
532+type Reply = Network.HTTP.Client.Response LByteString
533+
534+{-| 'OpenCloseIndex' is a sum type for opening and closing indices.
535+
536+ <http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/indices-open-close.html>
537+-}
538+data OpenCloseIndex = OpenIndex | CloseIndex deriving (Eq, Show)
539+
540+data FieldType = GeoPointType
541+ | GeoShapeType
542+ | FloatType
543+ | IntegerType
544+ | LongType
545+ | ShortType
546+ | ByteType deriving (Eq, Show)
547+
548+newtype FieldDefinition = FieldDefinition
549+ { fieldType :: FieldType
550+ } deriving (Eq, Show)
551+
552+{-| An 'IndexTemplate' defines a template that will automatically be
553+ applied to new indices created. The templates include both
554+ 'IndexSettings' and mappings, and a simple 'TemplatePattern' that
555+ controls if the template will be applied to the index created.
556+ Specify mappings as follows: @[toJSON TweetMapping, ...]@
557+
558+ https://www.elastic.co/guide/en/elasticsearch/reference/1.7/indices-templates.html
559+-}
560+data IndexTemplate =
561+ IndexTemplate { templatePattern :: TemplatePattern
562+ , templateSettings :: Maybe IndexSettings
563+ , templateMappings :: [Value]
564+ }
565+
566+instance ToJSON IndexTemplate where
567+ toJSON (IndexTemplate p s m) = merge
568+ (object [ "template" .= p
569+ , "mappings" .= foldl' merge (object []) m
570+ ])
571+ (toJSON s)
572+ where
573+ merge (Object o1) (Object o2) = toJSON $ HM.union o1 o2
574+ merge o Null = o
575+ merge _ _ = undefined
576+
577+data MappingField =
578+ MappingField { mappingFieldName :: FieldName
579+ , fieldDefinition :: FieldDefinition }
580+ deriving (Eq, Show)
581+
582+{-| Support for type reification of 'Mapping's is currently incomplete, for
583+ now the mapping API verbiage expects a 'ToJSON'able blob.
584+
585+ Indexes have mappings, mappings are schemas for the documents contained
586+ in the index. I'd recommend having only one mapping per index, always
587+ having a mapping, and keeping different kinds of documents separated
588+ if possible.
589+-}
590+data Mapping =
591+ Mapping { typeName :: TypeName
592+ , mappingFields :: [MappingField] }
593+ deriving (Eq, Show)
594+
595+data AllocationPolicy = AllocAll
596+ -- ^ Allows shard allocation for all shards.
597+ | AllocPrimaries
598+ -- ^ Allows shard allocation only for primary shards.
599+ | AllocNewPrimaries
600+ -- ^ Allows shard allocation only for primary shards for new indices.
601+ | AllocNone
602+ -- ^ No shard allocation is allowed
603+ deriving (Eq, Show)
604+
605+instance ToJSON AllocationPolicy where
606+ toJSON AllocAll = String "all"
607+ toJSON AllocPrimaries = String "primaries"
608+ toJSON AllocNewPrimaries = String "new_primaries"
609+ toJSON AllocNone = String "none"
610+
611+instance FromJSON AllocationPolicy where
612+ parseJSON = withText "AllocationPolicy" parse
613+ where parse "all" = pure AllocAll
614+ parse "primaries" = pure AllocPrimaries
615+ parse "new_primaries" = pure AllocNewPrimaries
616+ parse "none" = pure AllocNone
617+ parse t = fail ("Invlaid AllocationPolicy: " <> show t)
618+
619+{-| 'BulkOperation' is a sum type for expressing the four kinds of bulk
620+ operation index, create, delete, and update. 'BulkIndex' behaves like an
621+ "upsert", 'BulkCreate' will fail if a document already exists at the DocId.
622+ Consult the <http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/docs-bulk.html#docs-bulk Bulk API documentation>
623+ for further explanation.
624+ Warning: Bulk operations suffixed with @Auto@ rely on Elasticsearch to
625+ generate the id. Often, people use auto-generated identifiers when
626+ Elasticsearch is the only place that their data is stored. Do not let
627+ Elasticsearch be the only place your data is stored. It does not guarantee
628+ durability, and it may silently discard data.
629+ This <https://github.com/elastic/elasticsearch/issues/10708 issue> is
630+ discussed further on github.
631+-}
632+data BulkOperation =
633+ BulkIndex IndexName MappingName DocId Value
634+ -- ^ Create the document, replacing it if it already exists.
635+ | BulkIndexAuto IndexName MappingName Value
636+ -- ^ Create a document with an autogenerated id.
637+ | BulkIndexEncodingAuto IndexName MappingName Encoding
638+ -- ^ Create a document with an autogenerated id. Use fast JSON encoding.
639+ | BulkCreate IndexName MappingName DocId Value
640+ -- ^ Create a document, failing if it already exists.
641+ | BulkCreateEncoding IndexName MappingName DocId Encoding
642+ -- ^ Create a document, failing if it already exists. Use fast JSON encoding.
643+ | BulkDelete IndexName MappingName DocId
644+ -- ^ Delete the document
645+ | BulkUpdate IndexName MappingName DocId Value
646+ -- ^ Update the document, merging the new value with the existing one.
647+ deriving (Eq, Show)
648+
649+{-| 'EsResult' describes the standard wrapper JSON document that you see in
650+ successful Elasticsearch lookups or lookups that couldn't find the document.
651+-}
652+data EsResult a = EsResult { _index :: Text
653+ , _type :: Text
654+ , _id :: Text
655+ , foundResult :: Maybe (EsResultFound a)} deriving (Eq, Show)
656+
657+{-| 'EsResultFound' contains the document and its metadata inside of an
658+ 'EsResult' when the document was successfully found.
659+-}
660+data EsResultFound a =
661+ EsResultFound { _version :: DocVersion
662+ , _source :: a }
663+ deriving (Eq, Show)
664+
665+instance (FromJSON a) => FromJSON (EsResult a) where
666+ parseJSON jsonVal@(Object v) = do
667+ found <- v .:? "found" .!= False
668+ fr <- if found
669+ then parseJSON jsonVal
670+ else return Nothing
671+ EsResult <$> v .: "_index" <*>
672+ v .: "_type" <*>
673+ v .: "_id" <*>
674+ pure fr
675+ parseJSON _ = empty
676+
677+instance (FromJSON a) => FromJSON (EsResultFound a) where
678+ parseJSON (Object v) = EsResultFound <$>
679+ v .: "_version" <*>
680+ v .: "_source"
681+ parseJSON _ = empty
682+
683+{-| 'EsError' is the generic type that will be returned when there was a
684+ problem. If you can't parse the expected response, its a good idea to
685+ try parsing this.
686+-}
687+data EsError =
688+ EsError { errorStatus :: Int
689+ , errorMessage :: Text }
690+ deriving (Eq, Show)
691+
692+instance FromJSON EsError where
693+ parseJSON (Object v) = EsError <$>
694+ v .: "status" <*>
695+ (v .: "error" <|> (v .: "error" >>= (.: "reason")))
696+ parseJSON _ = empty
697+
698+{-| 'EsProtocolException' will be thrown if Bloodhound cannot parse a response
699+returned by the Elasticsearch server. If you encounter this error, please
700+verify that your domain data types and FromJSON instances are working properly
701+(for example, the 'a' of '[Hit a]' in 'SearchResult.searchHits.hits'). If you're
702+sure that your mappings are correct, then this error may be an indication of an
703+incompatibility between Bloodhound and Elasticsearch. Please open a bug report
704+and be sure to include the exception body.
705+-}
706+data EsProtocolException = EsProtocolException
707+ { esProtoExMessage :: !Text
708+ , esProtoExBody :: !LByteString
709+ } deriving (Eq, Show)
710+
711+instance Exception EsProtocolException
712+
713+data IndexAlias = IndexAlias { srcIndex :: IndexName
714+ , indexAlias :: IndexAliasName } deriving (Eq, Show)
715+
716+data IndexAliasAction =
717+ AddAlias IndexAlias IndexAliasCreate
718+ | RemoveAlias IndexAlias
719+ deriving (Eq, Show)
720+
721+data IndexAliasCreate =
722+ IndexAliasCreate { aliasCreateRouting :: Maybe AliasRouting
723+ , aliasCreateFilter :: Maybe Filter}
724+ deriving (Eq, Show)
725+
726+data AliasRouting =
727+ AllAliasRouting RoutingValue
728+ | GranularAliasRouting (Maybe SearchAliasRouting) (Maybe IndexAliasRouting)
729+ deriving (Eq, Show)
730+
731+newtype SearchAliasRouting =
732+ SearchAliasRouting (NonEmpty RoutingValue)
733+ deriving (Eq, Show)
734+
735+instance ToJSON SearchAliasRouting where
736+ toJSON (SearchAliasRouting rvs) = toJSON (T.intercalate "," (routingValue <$> toList rvs))
737+
738+instance FromJSON SearchAliasRouting where
739+ parseJSON = withText "SearchAliasRouting" parse
740+ where parse t = SearchAliasRouting <$> parseNEJSON (String <$> T.splitOn "," t)
741+
742+newtype IndexAliasRouting =
743+ IndexAliasRouting RoutingValue
744+ deriving (Eq, Show, ToJSON, FromJSON)
745+
746+newtype RoutingValue =
747+ RoutingValue { routingValue :: Text }
748+ deriving (Eq, Show, ToJSON, FromJSON)
749+
750+newtype IndexAliasesSummary =
751+ IndexAliasesSummary { indexAliasesSummary :: [IndexAliasSummary] }
752+ deriving (Eq, Show)
753+
754+instance FromJSON IndexAliasesSummary where
755+ parseJSON = withObject "IndexAliasesSummary" parse
756+ where parse o = IndexAliasesSummary . mconcat <$> mapM (uncurry go) (HM.toList o)
757+ go ixn = withObject "index aliases" $ \ia -> do
758+ aliases <- ia .:? "aliases" .!= mempty
759+ forM (HM.toList aliases) $ \(aName, v) -> do
760+ let indexAlias = IndexAlias (IndexName ixn) (IndexAliasName (IndexName aName))
761+ IndexAliasSummary indexAlias <$> parseJSON v
762+
763+
764+instance ToJSON IndexAliasAction where
765+ toJSON (AddAlias ia opts) = object ["add" .= (iaObj <> optsObj)]
766+ where Object iaObj = toJSON ia
767+ Object optsObj = toJSON opts
768+ toJSON (RemoveAlias ia) = object ["remove" .= iaObj]
769+ where Object iaObj = toJSON ia
770+
771+instance ToJSON IndexAlias where
772+ toJSON IndexAlias {..} = object ["index" .= srcIndex
773+ , "alias" .= indexAlias
774+ ]
775+
776+instance ToJSON IndexAliasCreate where
777+ toJSON IndexAliasCreate {..} = Object (filterObj <> routingObj)
778+ where filterObj = maybe mempty (HM.singleton "filter" . toJSON) aliasCreateFilter
779+ Object routingObj = maybe (Object mempty) toJSON aliasCreateRouting
780+
781+instance ToJSON AliasRouting where
782+ toJSON (AllAliasRouting v) = object ["routing" .= v]
783+ toJSON (GranularAliasRouting srch idx) = object (catMaybes prs)
784+ where prs = [("search_routing" .=) <$> srch
785+ ,("index_routing" .=) <$> idx]
786+
787+instance FromJSON AliasRouting where
788+ parseJSON = withObject "AliasRouting" parse
789+ where parse o = parseAll o <|> parseGranular o
790+ parseAll o = AllAliasRouting <$> o .: "routing"
791+ parseGranular o = do
792+ sr <- o .:? "search_routing"
793+ ir <- o .:? "index_routing"
794+ if isNothing sr && isNothing ir
795+ then fail "Both search_routing and index_routing can't be blank"
796+ else return (GranularAliasRouting sr ir)
797+
798+instance FromJSON IndexAliasCreate where
799+ parseJSON v = withObject "IndexAliasCreate" parse v
800+ where parse o = IndexAliasCreate <$> optional (parseJSON v)
801+ <*> o .:? "filter"
802+
803+{-| 'IndexAliasSummary' is a summary of an index alias configured for a server. -}
804+data IndexAliasSummary = IndexAliasSummary
805+ { indexAliasSummaryAlias :: IndexAlias
806+ , indexAliasSummaryCreate :: IndexAliasCreate }
807+ deriving (Eq, Show)
808+
809+{-| 'DocVersion' is an integer version number for a document between 1
810+and 9.2e+18 used for <<https://www.elastic.co/guide/en/elasticsearch/guide/current/optimistic-concurrency-control.html optimistic concurrency control>>.
811+-}
812+newtype DocVersion = DocVersion {
813+ docVersionNumber :: Int
814+ } deriving (Eq, Show, Ord, ToJSON)
815+
816+-- | Smart constructor for in-range doc version
817+mkDocVersion :: Int -> Maybe DocVersion
818+mkDocVersion i
819+ | i >= docVersionNumber minBound
820+ && i <= docVersionNumber maxBound =
821+ Just $ DocVersion i
822+ | otherwise = Nothing
823+
824+instance Bounded DocVersion where
825+ minBound = DocVersion 1
826+ maxBound = DocVersion 9200000000000000000 -- 9.2e+18
827+
828+instance Enum DocVersion where
829+ succ x
830+ | x /= maxBound = DocVersion (succ $ docVersionNumber x)
831+ | otherwise = succError "DocVersion"
832+ pred x
833+ | x /= minBound = DocVersion (pred $ docVersionNumber x)
834+ | otherwise = predError "DocVersion"
835+ toEnum i =
836+ fromMaybe (error $ show i ++ " out of DocVersion range") $ mkDocVersion i
837+ fromEnum = docVersionNumber
838+ enumFrom = boundedEnumFrom
839+ enumFromThen = boundedEnumFromThen
840+
841+instance FromJSON DocVersion where
842+ parseJSON v = do
843+ i <- parseJSON v
844+ maybe (fail "DocVersion out of range") return $ mkDocVersion i
845+
846+{-| 'ExternalDocVersion' is a convenience wrapper if your code uses its
847+own version numbers instead of ones from ES.
848+-}
849+newtype ExternalDocVersion = ExternalDocVersion DocVersion
850+ deriving (Eq, Show, Ord, Bounded, Enum, ToJSON)
851+
852+{-| 'VersionControl' is specified when indexing documents as a
853+optimistic concurrency control.
854+-}
855+data VersionControl = NoVersionControl
856+ -- ^ Don't send a version. This is a pure overwrite.
857+ | InternalVersion DocVersion
858+ -- ^ Use the default ES versioning scheme. Only
859+ -- index the document if the version is the same
860+ -- as the one specified. Only applicable to
861+ -- updates, as you should be getting Version from
862+ -- a search result.
863+ | ExternalGT ExternalDocVersion
864+ -- ^ Use your own version numbering. Only index
865+ -- the document if the version is strictly higher
866+ -- OR the document doesn't exist. The given
867+ -- version will be used as the new version number
868+ -- for the stored document. N.B. All updates must
869+ -- increment this number, meaning there is some
870+ -- global, external ordering of updates.
871+ | ExternalGTE ExternalDocVersion
872+ -- ^ Use your own version numbering. Only index
873+ -- the document if the version is equal or higher
874+ -- than the stored version. Will succeed if there
875+ -- is no existing document. The given version will
876+ -- be used as the new version number for the
877+ -- stored document. Use with care, as this could
878+ -- result in data loss.
879+ | ForceVersion ExternalDocVersion
880+ -- ^ The document will always be indexed and the
881+ -- given version will be the new version. This is
882+ -- typically used for correcting errors. Use with
883+ -- care, as this could result in data loss.
884+ deriving (Eq, Show, Ord)
885+
886+{-| 'DocumentParent' is used to specify a parent document.
887+-}
888+newtype DocumentParent = DocumentParent DocId
889+ deriving (Eq, Show)
890+
891+{-| 'IndexDocumentSettings' are special settings supplied when indexing
892+a document. For the best backwards compatiblity when new fields are
893+added, you should probably prefer to start with 'defaultIndexDocumentSettings'
894+-}
895+data IndexDocumentSettings =
896+ IndexDocumentSettings { idsVersionControl :: VersionControl
897+ , idsParent :: Maybe DocumentParent
898+ } deriving (Eq, Show)
899+
900+{-| Reasonable default settings. Chooses no version control and no parent.
901+-}
902+defaultIndexDocumentSettings :: IndexDocumentSettings
903+defaultIndexDocumentSettings = IndexDocumentSettings NoVersionControl Nothing
904+
905+{-| 'IndexSelection' is used for APIs which take a single index, a list of
906+ indexes, or the special @_all@ index.
907+-}
908+--TODO: this does not fully support <https://www.elastic.co/guide/en/elasticsearch/reference/1.7/multi-index.html multi-index syntax>. It wouldn't be too hard to implement but you'd have to add the optional parameters (ignore_unavailable, allow_no_indices, expand_wildcards) to any APIs using it. Also would be a breaking API.
909+data IndexSelection =
910+ IndexList (NonEmpty IndexName)
911+ | AllIndexes
912+ deriving (Eq, Show)
913+
914+{-| 'NodeSelection' is used for most cluster APIs. See <https://www.elastic.co/guide/en/elasticsearch/reference/current/cluster.html#cluster-nodes here> for more details.
915+-}
916+data NodeSelection =
917+ LocalNode
918+ -- ^ Whatever node receives this request
919+ | NodeList (NonEmpty NodeSelector)
920+ | AllNodes
921+ deriving (Eq, Show)
922+
923+
924+-- | An exact match or pattern to identify a node. Note that All of
925+-- these options support wildcarding, so your node name, server, attr
926+-- name can all contain * characters to be a fuzzy match.
927+data NodeSelector =
928+ NodeByName NodeName
929+ | NodeByFullNodeId FullNodeId
930+ | NodeByHost Server
931+ -- ^ e.g. 10.0.0.1 or even 10.0.0.*
932+ | NodeByAttribute NodeAttrName Text
933+ -- ^ NodeAttrName can be a pattern, e.g. rack*. The value can too.
934+ deriving (Eq, Show)
935+
936+{-| 'TemplateName' is used to describe which template to query/create/delete
937+-}
938+newtype TemplateName = TemplateName Text deriving (Eq, Show, ToJSON, FromJSON)
939+
940+{-| 'TemplatePattern' represents a pattern which is matched against index names
941+-}
942+newtype TemplatePattern = TemplatePattern Text deriving (Eq, Show, ToJSON, FromJSON)
943+
944+-- | Username type used for HTTP Basic authentication. See 'basicAuthHook'.
945+newtype EsUsername = EsUsername { esUsername :: Text } deriving (Read, Show, Eq)
946+
947+-- | Password type used for HTTP Basic authentication. See 'basicAuthHook'.
948+newtype EsPassword = EsPassword { esPassword :: Text } deriving (Read, Show, Eq)
949+
950+
951+data SnapshotRepoSelection =
952+ SnapshotRepoList (NonEmpty SnapshotRepoPattern)
953+ | AllSnapshotRepos
954+ deriving (Eq, Show)
955+
956+
957+-- | Either specifies an exact repo name or one with globs in it,
958+-- e.g. @RepoPattern "foo*"@ __NOTE__: Patterns are not supported on ES < 1.7
959+data SnapshotRepoPattern =
960+ ExactRepo SnapshotRepoName
961+ | RepoPattern Text
962+ deriving (Eq, Show)
963+
964+-- | The unique name of a snapshot repository.
965+newtype SnapshotRepoName =
966+ SnapshotRepoName { snapshotRepoName :: Text }
967+ deriving (Eq, Ord, Show, ToJSON, FromJSON)
968+
969+
970+-- | A generic representation of a snapshot repo. This is what gets
971+-- sent to and parsed from the server. For repo types enabled by
972+-- plugins that aren't exported by this library, consider making a
973+-- custom type which implements 'SnapshotRepo'. If it is a common repo
974+-- type, consider submitting a pull request to have it included in the
975+-- library proper
976+data GenericSnapshotRepo = GenericSnapshotRepo {
977+ gSnapshotRepoName :: SnapshotRepoName
978+ , gSnapshotRepoType :: SnapshotRepoType
979+ , gSnapshotRepoSettings :: GenericSnapshotRepoSettings
980+ } deriving (Eq, Show)
981+
982+
983+instance SnapshotRepo GenericSnapshotRepo where
984+ toGSnapshotRepo = id
985+ fromGSnapshotRepo = Right
986+
987+
988+newtype SnapshotRepoType =
989+ SnapshotRepoType { snapshotRepoType :: Text }
990+ deriving (Eq, Ord, Show, ToJSON, FromJSON)
991+
992+
993+-- | Opaque representation of snapshot repo settings. Instances of
994+-- 'SnapshotRepo' will produce this.
995+newtype GenericSnapshotRepoSettings =
996+ GenericSnapshotRepoSettings { gSnapshotRepoSettingsObject :: Object }
997+ deriving (Eq, Show, ToJSON)
998+
999+
1000+ -- Regardless of whether you send strongly typed json, my version of
1001+ -- ES sends back stringly typed json in the settings, e.g. booleans
1002+ -- as strings, so we'll try to convert them.
1003+instance FromJSON GenericSnapshotRepoSettings where
1004+ parseJSON = fmap (GenericSnapshotRepoSettings . fmap unStringlyTypeJSON). parseJSON
1005+
1006+-- | The result of running 'verifySnapshotRepo'.
1007+newtype SnapshotVerification =
1008+ SnapshotVerification {
1009+ snapshotNodeVerifications :: [SnapshotNodeVerification]
1010+ } deriving (Eq, Show)
1011+
1012+
1013+instance FromJSON SnapshotVerification where
1014+ parseJSON = withObject "SnapshotVerification" parse
1015+ where
1016+ parse o = do
1017+ o2 <- o .: "nodes"
1018+ SnapshotVerification <$> mapM (uncurry parse') (HM.toList o2)
1019+ parse' rawFullId = withObject "SnapshotNodeVerification" $ \o ->
1020+ SnapshotNodeVerification (FullNodeId rawFullId) <$> o .: "name"
1021+
1022+
1023+-- | A node that has verified a snapshot
1024+data SnapshotNodeVerification = SnapshotNodeVerification {
1025+ snvFullId :: FullNodeId
1026+ , snvNodeName :: NodeName
1027+ } deriving (Eq, Show)
1028+
1029+
1030+-- | Unique, automatically-generated name assigned to nodes that are
1031+-- usually returned in node-oriented APIs.
1032+newtype FullNodeId = FullNodeId { fullNodeId :: Text }
1033+ deriving (Eq, Ord, Show, FromJSON)
1034+
1035+
1036+-- | A human-readable node name that is supplied by the user in the
1037+-- node config or automatically generated by Elasticsearch.
1038+newtype NodeName = NodeName { nodeName :: Text }
1039+ deriving (Eq, Ord, Show, FromJSON)
1040+
1041+newtype ClusterName = ClusterName { clusterName :: Text }
1042+ deriving (Eq, Ord, Show, FromJSON)
1043+
1044+data NodesInfo = NodesInfo {
1045+ nodesInfo :: [NodeInfo]
1046+ , nodesClusterName :: ClusterName
1047+ } deriving (Eq, Show)
1048+
1049+data NodesStats = NodesStats {
1050+ nodesStats :: [NodeStats]
1051+ , nodesStatsClusterName :: ClusterName
1052+ } deriving (Eq, Show)
1053+
1054+data NodeStats = NodeStats {
1055+ nodeStatsName :: NodeName
1056+ , nodeStatsFullId :: FullNodeId
1057+ , nodeStatsBreakersStats :: Maybe NodeBreakersStats
1058+ , nodeStatsHTTP :: NodeHTTPStats
1059+ , nodeStatsTransport :: NodeTransportStats
1060+ , nodeStatsFS :: NodeFSStats
1061+ , nodeStatsNetwork :: Maybe NodeNetworkStats
1062+ , nodeStatsThreadPool :: NodeThreadPoolsStats
1063+ , nodeStatsJVM :: NodeJVMStats
1064+ , nodeStatsProcess :: NodeProcessStats
1065+ , nodeStatsOS :: NodeOSStats
1066+ , nodeStatsIndices :: NodeIndicesStats
1067+ } deriving (Eq, Show)
1068+
1069+data NodeBreakersStats = NodeBreakersStats {
1070+ nodeStatsParentBreaker :: NodeBreakerStats
1071+ , nodeStatsRequestBreaker :: NodeBreakerStats
1072+ , nodeStatsFieldDataBreaker :: NodeBreakerStats
1073+ } deriving (Eq, Show)
1074+
1075+data NodeBreakerStats = NodeBreakerStats {
1076+ nodeBreakersTripped :: Int
1077+ , nodeBreakersOverhead :: Double
1078+ , nodeBreakersEstSize :: Bytes
1079+ , nodeBreakersLimitSize :: Bytes
1080+ } deriving (Eq, Show)
1081+
1082+data NodeHTTPStats = NodeHTTPStats {
1083+ nodeHTTPTotalOpened :: Int
1084+ , nodeHTTPCurrentOpen :: Int
1085+ } deriving (Eq, Show)
1086+
1087+data NodeTransportStats = NodeTransportStats {
1088+ nodeTransportTXSize :: Bytes
1089+ , nodeTransportCount :: Int
1090+ , nodeTransportRXSize :: Bytes
1091+ , nodeTransportRXCount :: Int
1092+ , nodeTransportServerOpen :: Int
1093+ } deriving (Eq, Show)
1094+
1095+data NodeFSStats = NodeFSStats {
1096+ nodeFSDataPaths :: [NodeDataPathStats]
1097+ , nodeFSTotal :: NodeFSTotalStats
1098+ , nodeFSTimestamp :: UTCTime
1099+ } deriving (Eq, Show)
1100+
1101+data NodeDataPathStats = NodeDataPathStats {
1102+ nodeDataPathDiskServiceTime :: Maybe Double
1103+ , nodeDataPathDiskQueue :: Maybe Double
1104+ , nodeDataPathIOSize :: Maybe Bytes
1105+ , nodeDataPathWriteSize :: Maybe Bytes
1106+ , nodeDataPathReadSize :: Maybe Bytes
1107+ , nodeDataPathIOOps :: Maybe Int
1108+ , nodeDataPathWrites :: Maybe Int
1109+ , nodeDataPathReads :: Maybe Int
1110+ , nodeDataPathAvailable :: Bytes
1111+ , nodeDataPathFree :: Bytes
1112+ , nodeDataPathTotal :: Bytes
1113+ , nodeDataPathType :: Maybe Text
1114+ , nodeDataPathDevice :: Maybe Text
1115+ , nodeDataPathMount :: Text
1116+ , nodeDataPathPath :: Text
1117+ } deriving (Eq, Show)
1118+
1119+data NodeFSTotalStats = NodeFSTotalStats {
1120+ nodeFSTotalDiskServiceTime :: Maybe Double
1121+ , nodeFSTotalDiskQueue :: Maybe Double
1122+ , nodeFSTotalIOSize :: Maybe Bytes
1123+ , nodeFSTotalWriteSize :: Maybe Bytes
1124+ , nodeFSTotalReadSize :: Maybe Bytes
1125+ , nodeFSTotalIOOps :: Maybe Int
1126+ , nodeFSTotalWrites :: Maybe Int
1127+ , nodeFSTotalReads :: Maybe Int
1128+ , nodeFSTotalAvailable :: Bytes
1129+ , nodeFSTotalFree :: Bytes
1130+ , nodeFSTotalTotal :: Bytes
1131+ } deriving (Eq, Show)
1132+
1133+data NodeNetworkStats = NodeNetworkStats {
1134+ nodeNetTCPOutRSTs :: Int
1135+ , nodeNetTCPInErrs :: Int
1136+ , nodeNetTCPAttemptFails :: Int
1137+ , nodeNetTCPEstabResets :: Int
1138+ , nodeNetTCPRetransSegs :: Int
1139+ , nodeNetTCPOutSegs :: Int
1140+ , nodeNetTCPInSegs :: Int
1141+ , nodeNetTCPCurrEstab :: Int
1142+ , nodeNetTCPPassiveOpens :: Int
1143+ , nodeNetTCPActiveOpens :: Int
1144+ } deriving (Eq, Show)
1145+
1146+data NodeThreadPoolsStats = NodeThreadPoolsStats {
1147+ nodeThreadPoolsStatsSnapshot :: NodeThreadPoolStats
1148+ , nodeThreadPoolsStatsBulk :: NodeThreadPoolStats
1149+ , nodeThreadPoolsStatsMerge :: NodeThreadPoolStats
1150+ , nodeThreadPoolsStatsGet :: NodeThreadPoolStats
1151+ , nodeThreadPoolsStatsManagement :: NodeThreadPoolStats
1152+ , nodeThreadPoolsStatsFetchShardStore :: Maybe NodeThreadPoolStats
1153+ , nodeThreadPoolsStatsOptimize :: Maybe NodeThreadPoolStats
1154+ , nodeThreadPoolsStatsFlush :: NodeThreadPoolStats
1155+ , nodeThreadPoolsStatsSearch :: NodeThreadPoolStats
1156+ , nodeThreadPoolsStatsWarmer :: NodeThreadPoolStats
1157+ , nodeThreadPoolsStatsGeneric :: NodeThreadPoolStats
1158+ , nodeThreadPoolsStatsSuggest :: Maybe NodeThreadPoolStats
1159+ , nodeThreadPoolsStatsRefresh :: NodeThreadPoolStats
1160+ , nodeThreadPoolsStatsIndex :: NodeThreadPoolStats
1161+ , nodeThreadPoolsStatsListener :: Maybe NodeThreadPoolStats
1162+ , nodeThreadPoolsStatsFetchShardStarted :: Maybe NodeThreadPoolStats
1163+ , nodeThreadPoolsStatsPercolate :: Maybe NodeThreadPoolStats
1164+ } deriving (Eq, Show)
1165+
1166+data NodeThreadPoolStats = NodeThreadPoolStats {
1167+ nodeThreadPoolCompleted :: Int
1168+ , nodeThreadPoolLargest :: Int
1169+ , nodeThreadPoolRejected :: Int
1170+ , nodeThreadPoolActive :: Int
1171+ , nodeThreadPoolQueue :: Int
1172+ , nodeThreadPoolThreads :: Int
1173+ } deriving (Eq, Show)
1174+
1175+data NodeJVMStats = NodeJVMStats {
1176+ nodeJVMStatsMappedBufferPool :: JVMBufferPoolStats
1177+ , nodeJVMStatsDirectBufferPool :: JVMBufferPoolStats
1178+ , nodeJVMStatsGCOldCollector :: JVMGCStats
1179+ , nodeJVMStatsGCYoungCollector :: JVMGCStats
1180+ , nodeJVMStatsPeakThreadsCount :: Int
1181+ , nodeJVMStatsThreadsCount :: Int
1182+ , nodeJVMStatsOldPool :: JVMPoolStats
1183+ , nodeJVMStatsSurvivorPool :: JVMPoolStats
1184+ , nodeJVMStatsYoungPool :: JVMPoolStats
1185+ , nodeJVMStatsNonHeapCommitted :: Bytes
1186+ , nodeJVMStatsNonHeapUsed :: Bytes
1187+ , nodeJVMStatsHeapMax :: Bytes
1188+ , nodeJVMStatsHeapCommitted :: Bytes
1189+ , nodeJVMStatsHeapUsedPercent :: Int
1190+ , nodeJVMStatsHeapUsed :: Bytes
1191+ , nodeJVMStatsUptime :: NominalDiffTime
1192+ , nodeJVMStatsTimestamp :: UTCTime
1193+ } deriving (Eq, Show)
1194+
1195+data JVMBufferPoolStats = JVMBufferPoolStats {
1196+ jvmBufferPoolStatsTotalCapacity :: Bytes
1197+ , jvmBufferPoolStatsUsed :: Bytes
1198+ , jvmBufferPoolStatsCount :: Int
1199+ } deriving (Eq, Show)
1200+
1201+data JVMGCStats = JVMGCStats {
1202+ jvmGCStatsCollectionTime :: NominalDiffTime
1203+ , jvmGCStatsCollectionCount :: Int
1204+ } deriving (Eq, Show)
1205+
1206+data JVMPoolStats = JVMPoolStats {
1207+ jvmPoolStatsPeakMax :: Bytes
1208+ , jvmPoolStatsPeakUsed :: Bytes
1209+ , jvmPoolStatsMax :: Bytes
1210+ , jvmPoolStatsUsed :: Bytes
1211+ } deriving (Eq, Show)
1212+
1213+data NodeProcessStats = NodeProcessStats {
1214+ nodeProcessTimestamp :: UTCTime
1215+ , nodeProcessOpenFDs :: Int
1216+ , nodeProcessMaxFDs :: Int
1217+ , nodeProcessCPUPercent :: Int
1218+ , nodeProcessCPUTotal :: NominalDiffTime
1219+ , nodeProcessMemTotalVirtual :: Bytes
1220+ } deriving (Eq, Show)
1221+
1222+data NodeOSStats = NodeOSStats {
1223+ nodeOSTimestamp :: UTCTime
1224+ , nodeOSCPUPercent :: Int
1225+ , nodeOSLoad :: Maybe LoadAvgs
1226+ , nodeOSMemTotal :: Bytes
1227+ , nodeOSMemFree :: Bytes
1228+ , nodeOSMemFreePercent :: Int
1229+ , nodeOSMemUsed :: Bytes
1230+ , nodeOSMemUsedPercent :: Int
1231+ , nodeOSSwapTotal :: Bytes
1232+ , nodeOSSwapFree :: Bytes
1233+ , nodeOSSwapUsed :: Bytes
1234+ } deriving (Eq, Show)
1235+
1236+data LoadAvgs = LoadAvgs {
1237+ loadAvg1Min :: Double
1238+ , loadAvg5Min :: Double
1239+ , loadAvg15Min :: Double
1240+ } deriving (Eq, Show)
1241+
1242+data NodeIndicesStats = NodeIndicesStats {
1243+ nodeIndicesStatsRecoveryThrottleTime :: Maybe NominalDiffTime
1244+ , nodeIndicesStatsRecoveryCurrentAsTarget :: Maybe Int
1245+ , nodeIndicesStatsRecoveryCurrentAsSource :: Maybe Int
1246+ , nodeIndicesStatsQueryCacheMisses :: Maybe Int
1247+ , nodeIndicesStatsQueryCacheHits :: Maybe Int
1248+ , nodeIndicesStatsQueryCacheEvictions :: Maybe Int
1249+ , nodeIndicesStatsQueryCacheSize :: Maybe Bytes
1250+ , nodeIndicesStatsSuggestCurrent :: Maybe Int
1251+ , nodeIndicesStatsSuggestTime :: Maybe NominalDiffTime
1252+ , nodeIndicesStatsSuggestTotal :: Maybe Int
1253+ , nodeIndicesStatsTranslogSize :: Bytes
1254+ , nodeIndicesStatsTranslogOps :: Int
1255+ , nodeIndicesStatsSegFixedBitSetMemory :: Maybe Bytes
1256+ , nodeIndicesStatsSegVersionMapMemory :: Bytes
1257+ , nodeIndicesStatsSegIndexWriterMaxMemory :: Maybe Bytes
1258+ , nodeIndicesStatsSegIndexWriterMemory :: Bytes
1259+ , nodeIndicesStatsSegMemory :: Bytes
1260+ , nodeIndicesStatsSegCount :: Int
1261+ , nodeIndicesStatsCompletionSize :: Bytes
1262+ , nodeIndicesStatsPercolateQueries :: Maybe Int
1263+ , nodeIndicesStatsPercolateMemory :: Maybe Bytes
1264+ , nodeIndicesStatsPercolateCurrent :: Maybe Int
1265+ , nodeIndicesStatsPercolateTime :: Maybe NominalDiffTime
1266+ , nodeIndicesStatsPercolateTotal :: Maybe Int
1267+ , nodeIndicesStatsFieldDataEvictions :: Int
1268+ , nodeIndicesStatsFieldDataMemory :: Bytes
1269+ , nodeIndicesStatsWarmerTotalTime :: NominalDiffTime
1270+ , nodeIndicesStatsWarmerTotal :: Int
1271+ , nodeIndicesStatsWarmerCurrent :: Int
1272+ , nodeIndicesStatsFlushTotalTime :: NominalDiffTime
1273+ , nodeIndicesStatsFlushTotal :: Int
1274+ , nodeIndicesStatsRefreshTotalTime :: NominalDiffTime
1275+ , nodeIndicesStatsRefreshTotal :: Int
1276+ , nodeIndicesStatsMergesTotalSize :: Bytes
1277+ , nodeIndicesStatsMergesTotalDocs :: Int
1278+ , nodeIndicesStatsMergesTotalTime :: NominalDiffTime
1279+ , nodeIndicesStatsMergesTotal :: Int
1280+ , nodeIndicesStatsMergesCurrentSize :: Bytes
1281+ , nodeIndicesStatsMergesCurrentDocs :: Int
1282+ , nodeIndicesStatsMergesCurrent :: Int
1283+ , nodeIndicesStatsSearchFetchCurrent :: Int
1284+ , nodeIndicesStatsSearchFetchTime :: NominalDiffTime
1285+ , nodeIndicesStatsSearchFetchTotal :: Int
1286+ , nodeIndicesStatsSearchQueryCurrent :: Int
1287+ , nodeIndicesStatsSearchQueryTime :: NominalDiffTime
1288+ , nodeIndicesStatsSearchQueryTotal :: Int
1289+ , nodeIndicesStatsSearchOpenContexts :: Int
1290+ , nodeIndicesStatsGetCurrent :: Int
1291+ , nodeIndicesStatsGetMissingTime :: NominalDiffTime
1292+ , nodeIndicesStatsGetMissingTotal :: Int
1293+ , nodeIndicesStatsGetExistsTime :: NominalDiffTime
1294+ , nodeIndicesStatsGetExistsTotal :: Int
1295+ , nodeIndicesStatsGetTime :: NominalDiffTime
1296+ , nodeIndicesStatsGetTotal :: Int
1297+ , nodeIndicesStatsIndexingThrottleTime :: Maybe NominalDiffTime
1298+ , nodeIndicesStatsIndexingIsThrottled :: Maybe Bool
1299+ , nodeIndicesStatsIndexingNoopUpdateTotal :: Maybe Int
1300+ , nodeIndicesStatsIndexingDeleteCurrent :: Int
1301+ , nodeIndicesStatsIndexingDeleteTime :: NominalDiffTime
1302+ , nodeIndicesStatsIndexingDeleteTotal :: Int
1303+ , nodeIndicesStatsIndexingIndexCurrent :: Int
1304+ , nodeIndicesStatsIndexingIndexTime :: NominalDiffTime
1305+ , nodeIndicesStatsIndexingTotal :: Int
1306+ , nodeIndicesStatsStoreThrottleTime :: NominalDiffTime
1307+ , nodeIndicesStatsStoreSize :: Bytes
1308+ , nodeIndicesStatsDocsDeleted :: Int
1309+ , nodeIndicesStatsDocsCount :: Int
1310+ } deriving (Eq, Show)
1311+
1312+-- | A quirky address format used throughout Elasticsearch. An example
1313+-- would be inet[/1.1.1.1:9200]. inet may be a placeholder for a
1314+-- <https://en.wikipedia.org/wiki/Fully_qualified_domain_name FQDN>.
1315+newtype EsAddress = EsAddress { esAddress :: Text }
1316+ deriving (Eq, Ord, Show, FromJSON)
1317+
1318+-- | Typically a 7 character hex string.
1319+newtype BuildHash = BuildHash { buildHash :: Text }
1320+ deriving (Eq, Ord, Show, FromJSON, ToJSON)
1321+
1322+newtype PluginName = PluginName { pluginName :: Text }
1323+ deriving (Eq, Ord, Show, FromJSON)
1324+
1325+data NodeInfo = NodeInfo {
1326+ nodeInfoHTTPAddress :: Maybe EsAddress
1327+ , nodeInfoBuild :: BuildHash
1328+ , nodeInfoESVersion :: VersionNumber
1329+ , nodeInfoIP :: Server
1330+ , nodeInfoHost :: Server
1331+ , nodeInfoTransportAddress :: EsAddress
1332+ , nodeInfoName :: NodeName
1333+ , nodeInfoFullId :: FullNodeId
1334+ , nodeInfoPlugins :: [NodePluginInfo]
1335+ , nodeInfoHTTP :: NodeHTTPInfo
1336+ , nodeInfoTransport :: NodeTransportInfo
1337+ , nodeInfoNetwork :: Maybe NodeNetworkInfo
1338+ , nodeInfoThreadPool :: NodeThreadPoolsInfo
1339+ , nodeInfoJVM :: NodeJVMInfo
1340+ , nodeInfoProcess :: NodeProcessInfo
1341+ , nodeInfoOS :: NodeOSInfo
1342+ , nodeInfoSettings :: Object
1343+ -- ^ The members of the settings objects are not consistent,
1344+ -- dependent on plugins, etc.
1345+ } deriving (Eq, Show)
1346+
1347+data NodePluginInfo = NodePluginInfo {
1348+ nodePluginSite :: Maybe Bool
1349+ -- ^ Is this a site plugin?
1350+ , nodePluginJVM :: Maybe Bool
1351+ -- ^ Is this plugin running on the JVM
1352+ , nodePluginDescription :: Text
1353+ , nodePluginVersion :: MaybeNA VersionNumber
1354+ , nodePluginName :: PluginName
1355+ } deriving (Eq, Show)
1356+
1357+data NodeHTTPInfo = NodeHTTPInfo {
1358+ nodeHTTPMaxContentLength :: Bytes
1359+ , nodeHTTPTransportAddress :: BoundTransportAddress
1360+ } deriving (Eq, Show)
1361+
1362+data NodeTransportInfo = NodeTransportInfo {
1363+ nodeTransportProfiles :: [BoundTransportAddress]
1364+ , nodeTransportAddress :: BoundTransportAddress
1365+ } deriving (Eq, Show)
1366+
1367+data BoundTransportAddress = BoundTransportAddress {
1368+ publishAddress :: EsAddress
1369+ , boundAddress :: [EsAddress]
1370+ } deriving (Eq, Show)
1371+
1372+data NodeNetworkInfo = NodeNetworkInfo {
1373+ nodeNetworkPrimaryInterface :: NodeNetworkInterface
1374+ , nodeNetworkRefreshInterval :: NominalDiffTime
1375+ } deriving (Eq, Show)
1376+
1377+newtype MacAddress = MacAddress { macAddress :: Text }
1378+ deriving (Eq, Ord, Show, FromJSON)
1379+
1380+newtype NetworkInterfaceName = NetworkInterfaceName { networkInterfaceName :: Text }
1381+ deriving (Eq, Ord, Show, FromJSON)
1382+
1383+data NodeNetworkInterface = NodeNetworkInterface {
1384+ nodeNetIfaceMacAddress :: MacAddress
1385+ , nodeNetIfaceName :: NetworkInterfaceName
1386+ , nodeNetIfaceAddress :: Server
1387+ } deriving (Eq, Show)
1388+
1389+data NodeThreadPoolsInfo = NodeThreadPoolsInfo {
1390+ nodeThreadPoolsRefresh :: NodeThreadPoolInfo
1391+ , nodeThreadPoolsManagement :: NodeThreadPoolInfo
1392+ , nodeThreadPoolsPercolate :: Maybe NodeThreadPoolInfo
1393+ , nodeThreadPoolsListener :: Maybe NodeThreadPoolInfo
1394+ , nodeThreadPoolsFetchShardStarted :: Maybe NodeThreadPoolInfo
1395+ , nodeThreadPoolsSearch :: NodeThreadPoolInfo
1396+ , nodeThreadPoolsFlush :: NodeThreadPoolInfo
1397+ , nodeThreadPoolsWarmer :: NodeThreadPoolInfo
1398+ , nodeThreadPoolsOptimize :: Maybe NodeThreadPoolInfo
1399+ , nodeThreadPoolsBulk :: NodeThreadPoolInfo
1400+ , nodeThreadPoolsSuggest :: Maybe NodeThreadPoolInfo
1401+ , nodeThreadPoolsMerge :: NodeThreadPoolInfo
1402+ , nodeThreadPoolsSnapshot :: NodeThreadPoolInfo
1403+ , nodeThreadPoolsGet :: NodeThreadPoolInfo
1404+ , nodeThreadPoolsFetchShardStore :: Maybe NodeThreadPoolInfo
1405+ , nodeThreadPoolsIndex :: NodeThreadPoolInfo
1406+ , nodeThreadPoolsGeneric :: NodeThreadPoolInfo
1407+ } deriving (Eq, Show)
1408+
1409+data NodeThreadPoolInfo = NodeThreadPoolInfo {
1410+ nodeThreadPoolQueueSize :: ThreadPoolSize
1411+ , nodeThreadPoolKeepalive :: Maybe NominalDiffTime
1412+ , nodeThreadPoolMin :: Maybe Int
1413+ , nodeThreadPoolMax :: Maybe Int
1414+ , nodeThreadPoolType :: ThreadPoolType
1415+ } deriving (Eq, Show)
1416+
1417+data ThreadPoolSize = ThreadPoolBounded Int
1418+ | ThreadPoolUnbounded
1419+ deriving (Eq, Show)
1420+
1421+data ThreadPoolType = ThreadPoolScaling
1422+ | ThreadPoolFixed
1423+ | ThreadPoolCached
1424+ deriving (Eq, Show)
1425+
1426+data NodeJVMInfo = NodeJVMInfo {
1427+ nodeJVMInfoMemoryPools :: [JVMMemoryPool]
1428+ , nodeJVMInfoMemoryPoolsGCCollectors :: [JVMGCCollector]
1429+ , nodeJVMInfoMemoryInfo :: JVMMemoryInfo
1430+ , nodeJVMInfoStartTime :: UTCTime
1431+ , nodeJVMInfoVMVendor :: Text
1432+ , nodeJVMVMVersion :: VMVersion
1433+ -- ^ JVM doesn't seme to follow normal version conventions
1434+ , nodeJVMVMName :: Text
1435+ , nodeJVMVersion :: JVMVersion
1436+ , nodeJVMPID :: PID
1437+ } deriving (Eq, Show)
1438+
1439+-- | We cannot parse JVM version numbers and we're not going to try.
1440+newtype JVMVersion =
1441+ JVMVersion { unJVMVersion :: Text }
1442+ deriving (Eq, Show)
1443+
1444+instance FromJSON JVMVersion where
1445+ parseJSON = withText "JVMVersion" (pure . JVMVersion)
1446+
1447+data JVMMemoryInfo = JVMMemoryInfo {
1448+ jvmMemoryInfoDirectMax :: Bytes
1449+ , jvmMemoryInfoNonHeapMax :: Bytes
1450+ , jvmMemoryInfoNonHeapInit :: Bytes
1451+ , jvmMemoryInfoHeapMax :: Bytes
1452+ , jvmMemoryInfoHeapInit :: Bytes
1453+ } deriving (Eq, Show)
1454+
1455+-- VM version numbers don't appear to be SemVer
1456+-- so we're special casing this jawn.
1457+newtype VMVersion =
1458+ VMVersion { unVMVersion :: Text }
1459+ deriving (Eq, Show)
1460+
1461+instance ToJSON VMVersion where
1462+ toJSON = toJSON . unVMVersion
1463+
1464+instance FromJSON VMVersion where
1465+ parseJSON = withText "VMVersion" (pure . VMVersion)
1466+
1467+newtype JVMMemoryPool = JVMMemoryPool {
1468+ jvmMemoryPool :: Text
1469+ } deriving (Eq, Show, FromJSON)
1470+
1471+newtype JVMGCCollector = JVMGCCollector {
1472+ jvmGCCollector :: Text
1473+ } deriving (Eq, Show, FromJSON)
1474+
1475+newtype PID = PID {
1476+ pid :: Int
1477+ } deriving (Eq, Show, FromJSON)
1478+
1479+data NodeOSInfo = NodeOSInfo {
1480+ nodeOSRefreshInterval :: NominalDiffTime
1481+ , nodeOSName :: Text
1482+ , nodeOSArch :: Text
1483+ , nodeOSVersion :: VersionNumber
1484+ , nodeOSAvailableProcessors :: Int
1485+ , nodeOSAllocatedProcessors :: Int
1486+ } deriving (Eq, Show)
1487+
1488+data CPUInfo = CPUInfo {
1489+ cpuCacheSize :: Bytes
1490+ , cpuCoresPerSocket :: Int
1491+ , cpuTotalSockets :: Int
1492+ , cpuTotalCores :: Int
1493+ , cpuMHZ :: Int
1494+ , cpuModel :: Text
1495+ , cpuVendor :: Text
1496+ } deriving (Eq, Show)
1497+
1498+data NodeProcessInfo = NodeProcessInfo {
1499+ nodeProcessMLockAll :: Bool
1500+ -- ^ See <https://www.elastic.co/guide/en/elasticsearch/reference/current/setup-configuration.html>
1501+ , nodeProcessMaxFileDescriptors :: Maybe Int
1502+ , nodeProcessId :: PID
1503+ , nodeProcessRefreshInterval :: NominalDiffTime
1504+ } deriving (Eq, Show)
1505+
1506+data ShardResult =
1507+ ShardResult { shardTotal :: Int
1508+ , shardsSuccessful :: Int
1509+ , shardsFailed :: Int } deriving (Eq, Show)
1510+
1511+instance FromJSON ShardResult where
1512+ parseJSON (Object v) = ShardResult <$>
1513+ v .: "total" <*>
1514+ v .: "successful" <*>
1515+ v .: "failed"
1516+ parseJSON _ = empty
1517+
1518+data SnapshotState = SnapshotInit
1519+ | SnapshotStarted
1520+ | SnapshotSuccess
1521+ | SnapshotFailed
1522+ | SnapshotAborted
1523+ | SnapshotMissing
1524+ | SnapshotWaiting
1525+ deriving (Eq, Show)
1526+
1527+instance FromJSON SnapshotState where
1528+ parseJSON = withText "SnapshotState" parse
1529+ where
1530+ parse "INIT" = return SnapshotInit
1531+ parse "STARTED" = return SnapshotStarted
1532+ parse "SUCCESS" = return SnapshotSuccess
1533+ parse "FAILED" = return SnapshotFailed
1534+ parse "ABORTED" = return SnapshotAborted
1535+ parse "MISSING" = return SnapshotMissing
1536+ parse "WAITING" = return SnapshotWaiting
1537+ parse t = fail ("Invalid snapshot state " <> T.unpack t)
1538+
1539+
1540+data SnapshotRestoreSettings = SnapshotRestoreSettings {
1541+ snapRestoreWaitForCompletion :: Bool
1542+ -- ^ Should the API call return immediately after initializing
1543+ -- the restore or wait until completed? Note that if this is
1544+ -- enabled, it could wait a long time, so you should adjust your
1545+ -- 'ManagerSettings' accordingly to set long timeouts or
1546+ -- explicitly handle timeouts.
1547+ , snapRestoreIndices :: Maybe IndexSelection
1548+ -- ^ Nothing will restore all indices in the snapshot. Just [] is
1549+ -- permissable and will essentially be a no-op restore.
1550+ , snapRestoreIgnoreUnavailable :: Bool
1551+ -- ^ If set to True, any indices that do not exist will be ignored
1552+ -- during snapshot rather than failing the restore.
1553+ , snapRestoreIncludeGlobalState :: Bool
1554+ -- ^ If set to false, will ignore any global state in the snapshot
1555+ -- and will not restore it.
1556+ , snapRestoreRenamePattern :: Maybe RestoreRenamePattern
1557+ -- ^ A regex pattern for matching indices. Used with
1558+ -- 'snapRestoreRenameReplacement', the restore can reference the
1559+ -- matched index and create a new index name upon restore.
1560+ , snapRestoreRenameReplacement :: Maybe (NonEmpty RestoreRenameToken)
1561+ -- ^ Expression of how index renames should be constructed.
1562+ , snapRestorePartial :: Bool
1563+ -- ^ If some indices fail to restore, should the process proceed?
1564+ , snapRestoreIncludeAliases :: Bool
1565+ -- ^ Should the restore also restore the aliases captured in the
1566+ -- snapshot.
1567+ , snapRestoreIndexSettingsOverrides :: Maybe RestoreIndexSettings
1568+ -- ^ Settings to apply during the restore process. __NOTE:__ This
1569+ -- option is not supported in ES < 1.5 and should be set to
1570+ -- Nothing in that case.
1571+ , snapRestoreIgnoreIndexSettings :: Maybe (NonEmpty Text)
1572+ -- ^ This type could be more rich but it isn't clear which
1573+ -- settings are allowed to be ignored during restore, so we're
1574+ -- going with including this feature in a basic form rather than
1575+ -- omitting it. One example here would be
1576+ -- "index.refresh_interval". Any setting specified here will
1577+ -- revert back to the server default during the restore process.
1578+ } deriving (Eq, Show)
1579+
1580+newtype SnapshotRepoUpdateSettings = SnapshotRepoUpdateSettings
1581+ { repoUpdateVerify :: Bool
1582+ -- ^ After creation/update, synchronously check that nodes can
1583+ -- write to this repo. Defaults to True. You may use False if you
1584+ -- need a faster response and plan on verifying manually later
1585+ -- with 'verifySnapshotRepo'.
1586+ } deriving (Eq, Show)
1587+
1588+
1589+-- | Reasonable defaults for repo creation/update
1590+--
1591+-- * repoUpdateVerify True
1592+defaultSnapshotRepoUpdateSettings :: SnapshotRepoUpdateSettings
1593+defaultSnapshotRepoUpdateSettings = SnapshotRepoUpdateSettings True
1594+
1595+
1596+-- | A filesystem-based snapshot repo that ships with
1597+-- Elasticsearch. This is an instance of 'SnapshotRepo' so it can be
1598+-- used with 'updateSnapshotRepo'
1599+data FsSnapshotRepo = FsSnapshotRepo {
1600+ fsrName :: SnapshotRepoName
1601+ , fsrLocation :: FilePath
1602+ , fsrCompressMetadata :: Bool
1603+ , fsrChunkSize :: Maybe Bytes
1604+ -- ^ Size by which to split large files during snapshotting.
1605+ , fsrMaxRestoreBytesPerSec :: Maybe Bytes
1606+ -- ^ Throttle node restore rate. If not supplied, defaults to 40mb/sec
1607+ , fsrMaxSnapshotBytesPerSec :: Maybe Bytes
1608+ -- ^ Throttle node snapshot rate. If not supplied, defaults to 40mb/sec
1609+ } deriving (Eq, Show)
1610+
1611+
1612+instance SnapshotRepo FsSnapshotRepo where
1613+ toGSnapshotRepo FsSnapshotRepo {..} =
1614+ GenericSnapshotRepo fsrName fsRepoType (GenericSnapshotRepoSettings settings)
1615+ where
1616+ Object settings = object $ [ "location" .= fsrLocation
1617+ , "compress" .= fsrCompressMetadata
1618+ ] ++ optionalPairs
1619+ optionalPairs = catMaybes [ ("chunk_size" .=) <$> fsrChunkSize
1620+ , ("max_restore_bytes_per_sec" .=) <$> fsrMaxRestoreBytesPerSec
1621+ , ("max_snapshot_bytes_per_sec" .=) <$> fsrMaxSnapshotBytesPerSec
1622+ ]
1623+ fromGSnapshotRepo GenericSnapshotRepo {..}
1624+ | gSnapshotRepoType == fsRepoType = do
1625+ let o = gSnapshotRepoSettingsObject gSnapshotRepoSettings
1626+ parseRepo $
1627+ FsSnapshotRepo gSnapshotRepoName <$> o .: "location"
1628+ <*> o .:? "compress" .!= False
1629+ <*> o .:? "chunk_size"
1630+ <*> o .:? "max_restore_bytes_per_sec"
1631+ <*> o .:? "max_snapshot_bytes_per_sec"
1632+ | otherwise = Left (RepoTypeMismatch fsRepoType gSnapshotRepoType)
1633+
1634+
1635+parseRepo :: Parser a -> Either SnapshotRepoConversionError a
1636+parseRepo parser = case parseEither (const parser) () of
1637+ Left e -> Left (OtherRepoConversionError (T.pack e))
1638+ Right a -> Right a
1639+
1640+
1641+fsRepoType :: SnapshotRepoType
1642+fsRepoType = SnapshotRepoType "fs"
1643+
1644+-- | Law: fromGSnapshotRepo (toGSnapshotRepo r) == Right r
1645+class SnapshotRepo r where
1646+ toGSnapshotRepo :: r -> GenericSnapshotRepo
1647+ fromGSnapshotRepo :: GenericSnapshotRepo -> Either SnapshotRepoConversionError r
1648+
1649+
1650+data SnapshotRepoConversionError = RepoTypeMismatch SnapshotRepoType SnapshotRepoType
1651+ -- ^ Expected type and actual type
1652+ | OtherRepoConversionError Text
1653+ deriving (Show, Eq)
1654+
1655+
1656+instance Exception SnapshotRepoConversionError
1657+
1658+
1659+data SnapshotCreateSettings = SnapshotCreateSettings {
1660+ snapWaitForCompletion :: Bool
1661+ -- ^ Should the API call return immediately after initializing
1662+ -- the snapshot or wait until completed? Note that if this is
1663+ -- enabled it could wait a long time, so you should adjust your
1664+ -- 'ManagerSettings' accordingly to set long timeouts or
1665+ -- explicitly handle timeouts.
1666+ , snapIndices :: Maybe IndexSelection
1667+ -- ^ Nothing will snapshot all indices. Just [] is permissable and
1668+ -- will essentially be a no-op snapshot.
1669+ , snapIgnoreUnavailable :: Bool
1670+ -- ^ If set to True, any matched indices that don't exist will be
1671+ -- ignored. Otherwise it will be an error and fail.
1672+ , snapIncludeGlobalState :: Bool
1673+ , snapPartial :: Bool
1674+ -- ^ If some indices failed to snapshot (e.g. if not all primary
1675+ -- shards are available), should the process proceed?
1676+ } deriving (Eq, Show)
1677+
1678+
1679+-- | Reasonable defaults for snapshot creation
1680+--
1681+-- * snapWaitForCompletion False
1682+-- * snapIndices Nothing
1683+-- * snapIgnoreUnavailable False
1684+-- * snapIncludeGlobalState True
1685+-- * snapPartial False
1686+defaultSnapshotCreateSettings :: SnapshotCreateSettings
1687+defaultSnapshotCreateSettings = SnapshotCreateSettings {
1688+ snapWaitForCompletion = False
1689+ , snapIndices = Nothing
1690+ , snapIgnoreUnavailable = False
1691+ , snapIncludeGlobalState = True
1692+ , snapPartial = False
1693+ }
1694+
1695+
1696+data SnapshotSelection =
1697+ SnapshotList (NonEmpty SnapshotPattern)
1698+ | AllSnapshots
1699+ deriving (Eq, Show)
1700+
1701+
1702+-- | Either specifies an exact snapshot name or one with globs in it,
1703+-- e.g. @SnapPattern "foo*"@ __NOTE__: Patterns are not supported on
1704+-- ES < 1.7
1705+data SnapshotPattern =
1706+ ExactSnap SnapshotName
1707+ | SnapPattern Text
1708+ deriving (Eq, Show)
1709+
1710+
1711+-- | General information about the state of a snapshot. Has some
1712+-- redundancies with 'SnapshotStatus'
1713+data SnapshotInfo = SnapshotInfo {
1714+ snapInfoShards :: ShardResult
1715+ , snapInfoFailures :: [SnapshotShardFailure]
1716+ , snapInfoDuration :: NominalDiffTime
1717+ , snapInfoEndTime :: UTCTime
1718+ , snapInfoStartTime :: UTCTime
1719+ , snapInfoState :: SnapshotState
1720+ , snapInfoIndices :: [IndexName]
1721+ , snapInfoName :: SnapshotName
1722+ } deriving (Eq, Show)
1723+
1724+
1725+instance FromJSON SnapshotInfo where
1726+ parseJSON = withObject "SnapshotInfo" parse
1727+ where
1728+ parse o = SnapshotInfo <$> o .: "shards"
1729+ <*> o .: "failures"
1730+ <*> (unMS <$> o .: "duration_in_millis")
1731+ <*> (posixMS <$> o .: "end_time_in_millis")
1732+ <*> (posixMS <$> o .: "start_time_in_millis")
1733+ <*> o .: "state"
1734+ <*> o .: "indices"
1735+ <*> o .: "snapshot"
1736+
1737+data SnapshotShardFailure = SnapshotShardFailure {
1738+ snapShardFailureIndex :: IndexName
1739+ , snapShardFailureNodeId :: Maybe NodeName -- I'm not 100% sure this isn't actually 'FullNodeId'
1740+ , snapShardFailureReason :: Text
1741+ , snapShardFailureShardId :: ShardId
1742+ } deriving (Eq, Show)
1743+
1744+
1745+instance FromJSON SnapshotShardFailure where
1746+ parseJSON = withObject "SnapshotShardFailure" parse
1747+ where
1748+ parse o = SnapshotShardFailure <$> o .: "index"
1749+ <*> o .:? "node_id"
1750+ <*> o .: "reason"
1751+ <*> o .: "shard_id"
1752+
1753+-- | Regex-stype pattern, e.g. "index_(.+)" to match index names
1754+newtype RestoreRenamePattern =
1755+ RestoreRenamePattern { rrPattern :: Text }
1756+ deriving (Eq, Show, Ord, ToJSON)
1757+
1758+
1759+-- | A single token in a index renaming scheme for a restore. These
1760+-- are concatenated into a string before being sent to
1761+-- Elasticsearch. Check out these Java
1762+-- <https://docs.oracle.com/javase/7/docs/api/java/util/regex/Matcher.html docs> to find out more if you're into that sort of thing.
1763+data RestoreRenameToken = RRTLit Text
1764+ -- ^ Just a literal string of characters
1765+ | RRSubWholeMatch
1766+ -- ^ Equivalent to $0. The entire matched pattern, not any subgroup
1767+ | RRSubGroup RRGroupRefNum
1768+ -- ^ A specific reference to a group number
1769+ deriving (Eq, Show)
1770+
1771+
1772+-- | A group number for regex matching. Only values from 1-9 are
1773+-- supported. Construct with 'mkRRGroupRefNum'
1774+newtype RRGroupRefNum =
1775+ RRGroupRefNum { rrGroupRefNum :: Int }
1776+ deriving (Eq, Ord, Show)
1777+
1778+instance Bounded RRGroupRefNum where
1779+ minBound = RRGroupRefNum 1
1780+ maxBound = RRGroupRefNum 9
1781+
1782+
1783+-- | Only allows valid group number references (1-9).
1784+mkRRGroupRefNum :: Int -> Maybe RRGroupRefNum
1785+mkRRGroupRefNum i
1786+ | i >= rrGroupRefNum minBound
1787+ && i <= rrGroupRefNum maxBound =
1788+ Just $ RRGroupRefNum i
1789+ | otherwise = Nothing
1790+
1791+-- | Reasonable defaults for snapshot restores
1792+--
1793+-- * snapRestoreWaitForCompletion False
1794+-- * snapRestoreIndices Nothing
1795+-- * snapRestoreIgnoreUnavailable False
1796+-- * snapRestoreIncludeGlobalState True
1797+-- * snapRestoreRenamePattern Nothing
1798+-- * snapRestoreRenameReplacement Nothing
1799+-- * snapRestorePartial False
1800+-- * snapRestoreIncludeAliases True
1801+-- * snapRestoreIndexSettingsOverrides Nothing
1802+-- * snapRestoreIgnoreIndexSettings Nothing
1803+defaultSnapshotRestoreSettings :: SnapshotRestoreSettings
1804+defaultSnapshotRestoreSettings = SnapshotRestoreSettings {
1805+ snapRestoreWaitForCompletion = False
1806+ , snapRestoreIndices = Nothing
1807+ , snapRestoreIgnoreUnavailable = False
1808+ , snapRestoreIncludeGlobalState = True
1809+ , snapRestoreRenamePattern = Nothing
1810+ , snapRestoreRenameReplacement = Nothing
1811+ , snapRestorePartial = False
1812+ , snapRestoreIncludeAliases = True
1813+ , snapRestoreIndexSettingsOverrides = Nothing
1814+ , snapRestoreIgnoreIndexSettings = Nothing
1815+ }
1816+
1817+
1818+-- | Index settings that can be overridden. The docs only mention you
1819+-- can update number of replicas, but there may be more. You
1820+-- definitely cannot override shard count.
1821+newtype RestoreIndexSettings = RestoreIndexSettings
1822+ { restoreOverrideReplicas :: Maybe ReplicaCount
1823+ } deriving (Eq, Show)
1824+
1825+
1826+instance ToJSON RestoreIndexSettings where
1827+ toJSON RestoreIndexSettings {..} = object prs
1828+ where
1829+ prs = catMaybes [("index.number_of_replicas" .=) <$> restoreOverrideReplicas]
1830+
1831+
1832+instance FromJSON NodesInfo where
1833+ parseJSON = withObject "NodesInfo" parse
1834+ where
1835+ parse o = do
1836+ nodes <- o .: "nodes"
1837+ infos <- forM (HM.toList nodes) $ \(fullNID, v) -> do
1838+ node <- parseJSON v
1839+ parseNodeInfo (FullNodeId fullNID) node
1840+ cn <- o .: "cluster_name"
1841+ return (NodesInfo infos cn)
1842+
1843+instance FromJSON NodesStats where
1844+ parseJSON = withObject "NodesStats" parse
1845+ where
1846+ parse o = do
1847+ nodes <- o .: "nodes"
1848+ stats <- forM (HM.toList nodes) $ \(fullNID, v) -> do
1849+ node <- parseJSON v
1850+ parseNodeStats (FullNodeId fullNID) node
1851+ cn <- o .: "cluster_name"
1852+ return (NodesStats stats cn)
1853+
1854+instance FromJSON NodeBreakerStats where
1855+ parseJSON = withObject "NodeBreakerStats" parse
1856+ where
1857+ parse o = NodeBreakerStats <$> o .: "tripped"
1858+ <*> o .: "overhead"
1859+ <*> o .: "estimated_size_in_bytes"
1860+ <*> o .: "limit_size_in_bytes"
1861+
1862+instance FromJSON NodeHTTPStats where
1863+ parseJSON = withObject "NodeHTTPStats" parse
1864+ where
1865+ parse o = NodeHTTPStats <$> o .: "total_opened"
1866+ <*> o .: "current_open"
1867+
1868+instance FromJSON NodeTransportStats where
1869+ parseJSON = withObject "NodeTransportStats" parse
1870+ where
1871+ parse o = NodeTransportStats <$> o .: "tx_size_in_bytes"
1872+ <*> o .: "tx_count"
1873+ <*> o .: "rx_size_in_bytes"
1874+ <*> o .: "rx_count"
1875+ <*> o .: "server_open"
1876+
1877+instance FromJSON NodeFSStats where
1878+ parseJSON = withObject "NodeFSStats" parse
1879+ where
1880+ parse o = NodeFSStats <$> o .: "data"
1881+ <*> o .: "total"
1882+ <*> (posixMS <$> o .: "timestamp")
1883+
1884+instance FromJSON NodeDataPathStats where
1885+ parseJSON = withObject "NodeDataPathStats" parse
1886+ where
1887+ parse o =
1888+ NodeDataPathStats <$> (fmap unStringlyTypedDouble <$> o .:? "disk_service_time")
1889+ <*> (fmap unStringlyTypedDouble <$> o .:? "disk_queue")
1890+ <*> o .:? "disk_io_size_in_bytes"
1891+ <*> o .:? "disk_write_size_in_bytes"
1892+ <*> o .:? "disk_read_size_in_bytes"
1893+ <*> o .:? "disk_io_op"
1894+ <*> o .:? "disk_writes"
1895+ <*> o .:? "disk_reads"
1896+ <*> o .: "available_in_bytes"
1897+ <*> o .: "free_in_bytes"
1898+ <*> o .: "total_in_bytes"
1899+ <*> o .:? "type"
1900+ <*> o .:? "dev"
1901+ <*> o .: "mount"
1902+ <*> o .: "path"
1903+
1904+instance FromJSON NodeFSTotalStats where
1905+ parseJSON = withObject "NodeFSTotalStats" parse
1906+ where
1907+ parse o = NodeFSTotalStats <$> (fmap unStringlyTypedDouble <$> o .:? "disk_service_time")
1908+ <*> (fmap unStringlyTypedDouble <$> o .:? "disk_queue")
1909+ <*> o .:? "disk_io_size_in_bytes"
1910+ <*> o .:? "disk_write_size_in_bytes"
1911+ <*> o .:? "disk_read_size_in_bytes"
1912+ <*> o .:? "disk_io_op"
1913+ <*> o .:? "disk_writes"
1914+ <*> o .:? "disk_reads"
1915+ <*> o .: "available_in_bytes"
1916+ <*> o .: "free_in_bytes"
1917+ <*> o .: "total_in_bytes"
1918+
1919+instance FromJSON NodeNetworkStats where
1920+ parseJSON = withObject "NodeNetworkStats" parse
1921+ where
1922+ parse o = do
1923+ tcp <- o .: "tcp"
1924+ NodeNetworkStats <$> tcp .: "out_rsts"
1925+ <*> tcp .: "in_errs"
1926+ <*> tcp .: "attempt_fails"
1927+ <*> tcp .: "estab_resets"
1928+ <*> tcp .: "retrans_segs"
1929+ <*> tcp .: "out_segs"
1930+ <*> tcp .: "in_segs"
1931+ <*> tcp .: "curr_estab"
1932+ <*> tcp .: "passive_opens"
1933+ <*> tcp .: "active_opens"
1934+
1935+instance FromJSON NodeThreadPoolsStats where
1936+ parseJSON = withObject "NodeThreadPoolsStats" parse
1937+ where
1938+ parse o = NodeThreadPoolsStats <$> o .: "snapshot"
1939+ <*> o .: "bulk"
1940+ <*> o .: "force_merge"
1941+ <*> o .: "get"
1942+ <*> o .: "management"
1943+ <*> o .:? "fetch_shard_store"
1944+ <*> o .:? "optimize"
1945+ <*> o .: "flush"
1946+ <*> o .: "search"
1947+ <*> o .: "warmer"
1948+ <*> o .: "generic"
1949+ <*> o .:? "suggest"
1950+ <*> o .: "refresh"
1951+ <*> o .: "index"
1952+ <*> o .:? "listener"
1953+ <*> o .:? "fetch_shard_started"
1954+ <*> o .:? "percolate"
1955+instance FromJSON NodeThreadPoolStats where
1956+ parseJSON = withObject "NodeThreadPoolStats" parse
1957+ where
1958+ parse o = NodeThreadPoolStats <$> o .: "completed"
1959+ <*> o .: "largest"
1960+ <*> o .: "rejected"
1961+ <*> o .: "active"
1962+ <*> o .: "queue"
1963+ <*> o .: "threads"
1964+
1965+instance FromJSON NodeJVMStats where
1966+ parseJSON = withObject "NodeJVMStats" parse
1967+ where
1968+ parse o = do
1969+ bufferPools <- o .: "buffer_pools"
1970+ mapped <- bufferPools .: "mapped"
1971+ direct <- bufferPools .: "direct"
1972+ gc <- o .: "gc"
1973+ collectors <- gc .: "collectors"
1974+ oldC <- collectors .: "old"
1975+ youngC <- collectors .: "young"
1976+ threads <- o .: "threads"
1977+ mem <- o .: "mem"
1978+ pools <- mem .: "pools"
1979+ oldM <- pools .: "old"
1980+ survivorM <- pools .: "survivor"
1981+ youngM <- pools .: "young"
1982+ NodeJVMStats <$> pure mapped
1983+ <*> pure direct
1984+ <*> pure oldC
1985+ <*> pure youngC
1986+ <*> threads .: "peak_count"
1987+ <*> threads .: "count"
1988+ <*> pure oldM
1989+ <*> pure survivorM
1990+ <*> pure youngM
1991+ <*> mem .: "non_heap_committed_in_bytes"
1992+ <*> mem .: "non_heap_used_in_bytes"
1993+ <*> mem .: "heap_max_in_bytes"
1994+ <*> mem .: "heap_committed_in_bytes"
1995+ <*> mem .: "heap_used_percent"
1996+ <*> mem .: "heap_used_in_bytes"
1997+ <*> (unMS <$> o .: "uptime_in_millis")
1998+ <*> (posixMS <$> o .: "timestamp")
1999+
2000+instance FromJSON JVMBufferPoolStats where
2001+ parseJSON = withObject "JVMBufferPoolStats" parse
2002+ where
2003+ parse o = JVMBufferPoolStats <$> o .: "total_capacity_in_bytes"
2004+ <*> o .: "used_in_bytes"
2005+ <*> o .: "count"
2006+
2007+instance FromJSON JVMGCStats where
2008+ parseJSON = withObject "JVMGCStats" parse
2009+ where
2010+ parse o = JVMGCStats <$> (unMS <$> o .: "collection_time_in_millis")
2011+ <*> o .: "collection_count"
2012+
2013+instance FromJSON JVMPoolStats where
2014+ parseJSON = withObject "JVMPoolStats" parse
2015+ where
2016+ parse o = JVMPoolStats <$> o .: "peak_max_in_bytes"
2017+ <*> o .: "peak_used_in_bytes"
2018+ <*> o .: "max_in_bytes"
2019+ <*> o .: "used_in_bytes"
2020+
2021+instance FromJSON NodeProcessStats where
2022+ parseJSON = withObject "NodeProcessStats" parse
2023+ where
2024+ parse o = do
2025+ mem <- o .: "mem"
2026+ cpu <- o .: "cpu"
2027+ NodeProcessStats <$> (posixMS <$> o .: "timestamp")
2028+ <*> o .: "open_file_descriptors"
2029+ <*> o .: "max_file_descriptors"
2030+ <*> cpu .: "percent"
2031+ <*> (unMS <$> cpu .: "total_in_millis")
2032+ <*> mem .: "total_virtual_in_bytes"
2033+
2034+instance FromJSON NodeOSStats where
2035+ parseJSON = withObject "NodeOSStats" parse
2036+ where
2037+ parse o = do
2038+ swap <- o .: "swap"
2039+ mem <- o .: "mem"
2040+ cpu <- o .: "cpu"
2041+ load <- o .:? "load_average"
2042+ NodeOSStats <$> (posixMS <$> o .: "timestamp")
2043+ <*> cpu .: "percent"
2044+ <*> pure load
2045+ <*> mem .: "total_in_bytes"
2046+ <*> mem .: "free_in_bytes"
2047+ <*> mem .: "free_percent"
2048+ <*> mem .: "used_in_bytes"
2049+ <*> mem .: "used_percent"
2050+ <*> swap .: "total_in_bytes"
2051+ <*> swap .: "free_in_bytes"
2052+ <*> swap .: "used_in_bytes"
2053+
2054+instance FromJSON LoadAvgs where
2055+ parseJSON = withArray "LoadAvgs" parse
2056+ where
2057+ parse v = case V.toList v of
2058+ [one, five, fifteen] -> LoadAvgs <$> parseJSON one
2059+ <*> parseJSON five
2060+ <*> parseJSON fifteen
2061+ _ -> fail "Expecting a triple of Doubles"
2062+
2063+instance FromJSON NodeIndicesStats where
2064+ parseJSON = withObject "NodeIndicesStats" parse
2065+ where
2066+ parse o = do
2067+ let (.::) mv k = case mv of
2068+ Just v -> Just <$> v .: k
2069+ Nothing -> pure Nothing
2070+ mRecovery <- o .:? "recovery"
2071+ mQueryCache <- o .:? "query_cache"
2072+ mSuggest <- o .:? "suggest"
2073+ translog <- o .: "translog"
2074+ segments <- o .: "segments"
2075+ completion <- o .: "completion"
2076+ mPercolate <- o .:? "percolate"
2077+ fielddata <- o .: "fielddata"
2078+ warmer <- o .: "warmer"
2079+ flush <- o .: "flush"
2080+ refresh <- o .: "refresh"
2081+ merges <- o .: "merges"
2082+ search <- o .: "search"
2083+ getStats <- o .: "get"
2084+ indexing <- o .: "indexing"
2085+ store <- o .: "store"
2086+ docs <- o .: "docs"
2087+ NodeIndicesStats <$> (fmap unMS <$> mRecovery .:: "throttle_time_in_millis")
2088+ <*> mRecovery .:: "current_as_target"
2089+ <*> mRecovery .:: "current_as_source"
2090+ <*> mQueryCache .:: "miss_count"
2091+ <*> mQueryCache .:: "hit_count"
2092+ <*> mQueryCache .:: "evictions"
2093+ <*> mQueryCache .:: "memory_size_in_bytes"
2094+ <*> mSuggest .:: "current"
2095+ <*> (fmap unMS <$> mSuggest .:: "time_in_millis")
2096+ <*> mSuggest .:: "total"
2097+ <*> translog .: "size_in_bytes"
2098+ <*> translog .: "operations"
2099+ <*> segments .:? "fixed_bit_set_memory_in_bytes"
2100+ <*> segments .: "version_map_memory_in_bytes"
2101+ <*> segments .:? "index_writer_max_memory_in_bytes"
2102+ <*> segments .: "index_writer_memory_in_bytes"
2103+ <*> segments .: "memory_in_bytes"
2104+ <*> segments .: "count"
2105+ <*> completion .: "size_in_bytes"
2106+ <*> mPercolate .:: "queries"
2107+ <*> mPercolate .:: "memory_size_in_bytes"
2108+ <*> mPercolate .:: "current"
2109+ <*> (fmap unMS <$> mPercolate .:: "time_in_millis")
2110+ <*> mPercolate .:: "total"
2111+ <*> fielddata .: "evictions"
2112+ <*> fielddata .: "memory_size_in_bytes"
2113+ <*> (unMS <$> warmer .: "total_time_in_millis")
2114+ <*> warmer .: "total"
2115+ <*> warmer .: "current"
2116+ <*> (unMS <$> flush .: "total_time_in_millis")
2117+ <*> flush .: "total"
2118+ <*> (unMS <$> refresh .: "total_time_in_millis")
2119+ <*> refresh .: "total"
2120+ <*> merges .: "total_size_in_bytes"
2121+ <*> merges .: "total_docs"
2122+ <*> (unMS <$> merges .: "total_time_in_millis")
2123+ <*> merges .: "total"
2124+ <*> merges .: "current_size_in_bytes"
2125+ <*> merges .: "current_docs"
2126+ <*> merges .: "current"
2127+ <*> search .: "fetch_current"
2128+ <*> (unMS <$> search .: "fetch_time_in_millis")
2129+ <*> search .: "fetch_total"
2130+ <*> search .: "query_current"
2131+ <*> (unMS <$> search .: "query_time_in_millis")
2132+ <*> search .: "query_total"
2133+ <*> search .: "open_contexts"
2134+ <*> getStats .: "current"
2135+ <*> (unMS <$> getStats .: "missing_time_in_millis")
2136+ <*> getStats .: "missing_total"
2137+ <*> (unMS <$> getStats .: "exists_time_in_millis")
2138+ <*> getStats .: "exists_total"
2139+ <*> (unMS <$> getStats .: "time_in_millis")
2140+ <*> getStats .: "total"
2141+ <*> (fmap unMS <$> indexing .:? "throttle_time_in_millis")
2142+ <*> indexing .:? "is_throttled"
2143+ <*> indexing .:? "noop_update_total"
2144+ <*> indexing .: "delete_current"
2145+ <*> (unMS <$> indexing .: "delete_time_in_millis")
2146+ <*> indexing .: "delete_total"
2147+ <*> indexing .: "index_current"
2148+ <*> (unMS <$> indexing .: "index_time_in_millis")
2149+ <*> indexing .: "index_total"
2150+ <*> (unMS <$> store .: "throttle_time_in_millis")
2151+ <*> store .: "size_in_bytes"
2152+ <*> docs .: "deleted"
2153+ <*> docs .: "count"
2154+
2155+instance FromJSON NodeBreakersStats where
2156+ parseJSON = withObject "NodeBreakersStats" parse
2157+ where
2158+ parse o = NodeBreakersStats <$> o .: "parent"
2159+ <*> o .: "request"
2160+ <*> o .: "fielddata"
2161+
2162+parseNodeStats :: FullNodeId -> Object -> Parser NodeStats
2163+parseNodeStats fnid o =
2164+ NodeStats <$> o .: "name"
2165+ <*> pure fnid
2166+ <*> o .:? "breakers"
2167+ <*> o .: "http"
2168+ <*> o .: "transport"
2169+ <*> o .: "fs"
2170+ <*> o .:? "network"
2171+ <*> o .: "thread_pool"
2172+ <*> o .: "jvm"
2173+ <*> o .: "process"
2174+ <*> o .: "os"
2175+ <*> o .: "indices"
2176+
2177+parseNodeInfo :: FullNodeId -> Object -> Parser NodeInfo
2178+parseNodeInfo nid o =
2179+ NodeInfo <$> o .:? "http_address"
2180+ <*> o .: "build_hash"
2181+ <*> o .: "version"
2182+ <*> o .: "ip"
2183+ <*> o .: "host"
2184+ <*> o .: "transport_address"
2185+ <*> o .: "name"
2186+ <*> pure nid
2187+ <*> o .: "plugins"
2188+ <*> o .: "http"
2189+ <*> o .: "transport"
2190+ <*> o .:? "network"
2191+ <*> o .: "thread_pool"
2192+ <*> o .: "jvm"
2193+ <*> o .: "process"
2194+ <*> o .: "os"
2195+ <*> o .: "settings"
2196+
2197+instance FromJSON NodePluginInfo where
2198+ parseJSON = withObject "NodePluginInfo" parse
2199+ where
2200+ parse o = NodePluginInfo <$> o .:? "site"
2201+ <*> o .:? "jvm"
2202+ <*> o .: "description"
2203+ <*> o .: "version"
2204+ <*> o .: "name"
2205+
2206+instance FromJSON NodeHTTPInfo where
2207+ parseJSON = withObject "NodeHTTPInfo" parse
2208+ where
2209+ parse o = NodeHTTPInfo <$> o .: "max_content_length_in_bytes"
2210+ <*> parseJSON (Object o)
2211+
2212+instance FromJSON BoundTransportAddress where
2213+ parseJSON = withObject "BoundTransportAddress" parse
2214+ where
2215+ parse o = BoundTransportAddress <$> o .: "publish_address"
2216+ <*> o .: "bound_address"
2217+
2218+instance FromJSON NodeOSInfo where
2219+ parseJSON = withObject "NodeOSInfo" parse
2220+ where
2221+ parse o =
2222+ NodeOSInfo <$> (unMS <$> o .: "refresh_interval_in_millis")
2223+ <*> o .: "name"
2224+ <*> o .: "arch"
2225+ <*> o .: "version"
2226+ <*> o .: "available_processors"
2227+ <*> o .: "allocated_processors"
2228+
2229+
2230+instance FromJSON CPUInfo where
2231+ parseJSON = withObject "CPUInfo" parse
2232+ where
2233+ parse o = CPUInfo <$> o .: "cache_size_in_bytes"
2234+ <*> o .: "cores_per_socket"
2235+ <*> o .: "total_sockets"
2236+ <*> o .: "total_cores"
2237+ <*> o .: "mhz"
2238+ <*> o .: "model"
2239+ <*> o .: "vendor"
2240+
2241+instance FromJSON NodeProcessInfo where
2242+ parseJSON = withObject "NodeProcessInfo" parse
2243+ where
2244+ parse o = NodeProcessInfo <$> o .: "mlockall"
2245+ <*> o .:? "max_file_descriptors"
2246+ <*> o .: "id"
2247+ <*> (unMS <$> o .: "refresh_interval_in_millis")
2248+
2249+instance FromJSON NodeJVMInfo where
2250+ parseJSON = withObject "NodeJVMInfo" parse
2251+ where
2252+ parse o = NodeJVMInfo <$> o .: "memory_pools"
2253+ <*> o .: "gc_collectors"
2254+ <*> o .: "mem"
2255+ <*> (posixMS <$> o .: "start_time_in_millis")
2256+ <*> o .: "vm_vendor"
2257+ <*> o .: "vm_version"
2258+ <*> o .: "vm_name"
2259+ <*> o .: "version"
2260+ <*> o .: "pid"
2261+
2262+instance FromJSON JVMMemoryInfo where
2263+ parseJSON = withObject "JVMMemoryInfo" parse
2264+ where
2265+ parse o = JVMMemoryInfo <$> o .: "direct_max_in_bytes"
2266+ <*> o .: "non_heap_max_in_bytes"
2267+ <*> o .: "non_heap_init_in_bytes"
2268+ <*> o .: "heap_max_in_bytes"
2269+ <*> o .: "heap_init_in_bytes"
2270+
2271+instance FromJSON NodeThreadPoolsInfo where
2272+ parseJSON = withObject "NodeThreadPoolsInfo" parse
2273+ where
2274+ parse o = NodeThreadPoolsInfo <$> o .: "refresh"
2275+ <*> o .: "management"
2276+ <*> o .:? "percolate"
2277+ <*> o .:? "listener"
2278+ <*> o .:? "fetch_shard_started"
2279+ <*> o .: "search"
2280+ <*> o .: "flush"
2281+ <*> o .: "warmer"
2282+ <*> o .:? "optimize"
2283+ <*> o .: "bulk"
2284+ <*> o .:? "suggest"
2285+ <*> o .: "force_merge"
2286+ <*> o .: "snapshot"
2287+ <*> o .: "get"
2288+ <*> o .:? "fetch_shard_store"
2289+ <*> o .: "index"
2290+ <*> o .: "generic"
2291+
2292+instance FromJSON NodeThreadPoolInfo where
2293+ parseJSON = withObject "NodeThreadPoolInfo" parse
2294+ where
2295+ parse o = do
2296+ ka <- maybe (return Nothing) (fmap Just . parseStringInterval) =<< o .:? "keep_alive"
2297+ NodeThreadPoolInfo <$> (parseJSON . unStringlyTypeJSON =<< o .: "queue_size")
2298+ <*> pure ka
2299+ <*> o .:? "min"
2300+ <*> o .:? "max"
2301+ <*> o .: "type"
2302+
2303+data TimeInterval = Weeks
2304+ | Days
2305+ | Hours
2306+ | Minutes
2307+ | Seconds deriving Eq
2308+
2309+instance Show TimeInterval where
2310+ show Weeks = "w"
2311+ show Days = "d"
2312+ show Hours = "h"
2313+ show Minutes = "m"
2314+ show Seconds = "s"
2315+
2316+instance Read TimeInterval where
2317+ readPrec = f =<< TR.get
2318+ where
2319+ f 'w' = return Weeks
2320+ f 'd' = return Days
2321+ f 'h' = return Hours
2322+ f 'm' = return Minutes
2323+ f 's' = return Seconds
2324+ f _ = fail "TimeInterval expected one of w, d, h, m, s"
2325+
2326+data Interval = Year
2327+ | Quarter
2328+ | Month
2329+ | Week
2330+ | Day
2331+ | Hour
2332+ | Minute
2333+ | Second deriving (Eq, Show)
2334+
2335+instance ToJSON Interval where
2336+ toJSON Year = "year"
2337+ toJSON Quarter = "quarter"
2338+ toJSON Month = "month"
2339+ toJSON Week = "week"
2340+ toJSON Day = "day"
2341+ toJSON Hour = "hour"
2342+ toJSON Minute = "minute"
2343+ toJSON Second = "second"
2344+
2345+parseStringInterval :: (Monad m) => String -> m NominalDiffTime
2346+parseStringInterval s = case span isNumber s of
2347+ ("", _) -> fail "Invalid interval"
2348+ (nS, unitS) -> case (readMay nS, readMay unitS) of
2349+ (Just n, Just unit) -> return (fromInteger (n * unitNDT unit))
2350+ (Nothing, _) -> fail "Invalid interval number"
2351+ (_, Nothing) -> fail "Invalid interval unit"
2352+ where
2353+ unitNDT Seconds = 1
2354+ unitNDT Minutes = 60
2355+ unitNDT Hours = 60 * 60
2356+ unitNDT Days = 24 * 60 * 60
2357+ unitNDT Weeks = 7 * 24 * 60 * 60
2358+
2359+instance FromJSON ThreadPoolSize where
2360+ parseJSON v = parseAsNumber v <|> parseAsString v
2361+ where
2362+ parseAsNumber = parseAsInt <=< parseJSON
2363+ parseAsInt (-1) = return ThreadPoolUnbounded
2364+ parseAsInt n
2365+ | n >= 0 = return (ThreadPoolBounded n)
2366+ | otherwise = fail "Thread pool size must be >= -1."
2367+ parseAsString = withText "ThreadPoolSize" $ \t ->
2368+ case first (readMay . T.unpack) (T.span isNumber t) of
2369+ (Just n, "k") -> return (ThreadPoolBounded (n * 1000))
2370+ (Just n, "") -> return (ThreadPoolBounded n)
2371+ _ -> fail ("Invalid thread pool size " <> T.unpack t)
2372+
2373+instance FromJSON ThreadPoolType where
2374+ parseJSON = withText "ThreadPoolType" parse
2375+ where
2376+ parse "scaling" = return ThreadPoolScaling
2377+ parse "fixed" = return ThreadPoolFixed
2378+ parse "cached" = return ThreadPoolCached
2379+ parse e = fail ("Unexpected thread pool type" <> T.unpack e)
2380+
2381+instance FromJSON NodeTransportInfo where
2382+ parseJSON = withObject "NodeTransportInfo" parse
2383+ where
2384+ parse o = NodeTransportInfo <$> (maybe (return mempty) parseProfiles =<< o .:? "profiles")
2385+ <*> parseJSON (Object o)
2386+ parseProfiles (Object o) | HM.null o = return []
2387+ parseProfiles v@(Array _) = parseJSON v
2388+ parseProfiles Null = return []
2389+ parseProfiles _ = fail "Could not parse profiles"
2390+
2391+instance FromJSON NodeNetworkInfo where
2392+ parseJSON = withObject "NodeNetworkInfo" parse
2393+ where
2394+ parse o = NodeNetworkInfo <$> o .: "primary_interface"
2395+ <*> (unMS <$> o .: "refresh_interval_in_millis")
2396+
2397+
2398+instance FromJSON NodeNetworkInterface where
2399+ parseJSON = withObject "NodeNetworkInterface" parse
2400+ where
2401+ parse o = NodeNetworkInterface <$> o .: "mac_address"
2402+ <*> o .: "name"
2403+ <*> o .: "address"
2404+
2405+
2406+instance ToJSON Version where
2407+ toJSON Version {..} = object ["number" .= number
2408+ ,"build_hash" .= build_hash
2409+ ,"build_date" .= build_date
2410+ ,"build_snapshot" .= build_snapshot
2411+ ,"lucene_version" .= lucene_version]
2412+
2413+instance FromJSON Version where
2414+ parseJSON = withObject "Version" parse
2415+ where parse o = Version
2416+ <$> o .: "number"
2417+ <*> o .: "build_hash"
2418+ <*> o .: "build_date"
2419+ <*> o .: "build_snapshot"
2420+ <*> o .: "lucene_version"
2421+
2422+instance ToJSON VersionNumber where
2423+ toJSON = toJSON . SemVer.toText . versionNumber
2424+
2425+instance FromJSON VersionNumber where
2426+ parseJSON = withText "VersionNumber" parse
2427+ where
2428+ parse t =
2429+ case SemVer.fromText t of
2430+ (Left err) -> fail err
2431+ (Right v) -> return (VersionNumber v)
src/Database/Bloodhound/Internal/Highlight.hsnew file+164
@@ -0,0 +1,164 @@
1+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
2+{-# LANGUAGE OverloadedStrings #-}
3+
4+module Database.Bloodhound.Internal.Highlight where
5+
6+import Bloodhound.Import
7+
8+import qualified Data.Map.Strict as M
9+
10+import Database.Bloodhound.Internal.Newtypes
11+import Database.Bloodhound.Internal.Query
12+
13+type HitHighlight = M.Map Text [Text]
14+
15+data Highlights = Highlights
16+ { globalsettings :: Maybe HighlightSettings
17+ , highlightFields :: [FieldHighlight]
18+ } deriving (Eq, Show)
19+
20+instance ToJSON Highlights where
21+ toJSON (Highlights global fields) =
22+ omitNulls (("fields" .= fields)
23+ : highlightSettingsPairs global)
24+
25+data FieldHighlight =
26+ FieldHighlight FieldName (Maybe HighlightSettings)
27+ deriving (Eq, Show)
28+
29+
30+instance ToJSON FieldHighlight where
31+ toJSON (FieldHighlight (FieldName fName) (Just fSettings)) =
32+ object [ fName .= fSettings ]
33+ toJSON (FieldHighlight (FieldName fName) Nothing) =
34+ object [ fName .= emptyObject ]
35+
36+data HighlightSettings =
37+ Plain PlainHighlight
38+ | Postings PostingsHighlight
39+ | FastVector FastVectorHighlight
40+ deriving (Eq, Show)
41+
42+
43+instance ToJSON HighlightSettings where
44+ toJSON hs = omitNulls (highlightSettingsPairs (Just hs))
45+
46+data PlainHighlight =
47+ PlainHighlight { plainCommon :: Maybe CommonHighlight
48+ , plainNonPost :: Maybe NonPostings }
49+ deriving (Eq, Show)
50+
51+ -- This requires that index_options are set to 'offset' in the mapping.
52+data PostingsHighlight =
53+ PostingsHighlight (Maybe CommonHighlight)
54+ deriving (Eq, Show)
55+
56+-- This requires that term_vector is set to 'with_positions_offsets' in the mapping.
57+data FastVectorHighlight = FastVectorHighlight
58+ { fvCommon :: Maybe CommonHighlight
59+ , fvNonPostSettings :: Maybe NonPostings
60+ , boundaryChars :: Maybe Text
61+ , boundaryMaxScan :: Maybe Int
62+ , fragmentOffset :: Maybe Int
63+ , matchedFields :: [Text]
64+ , phraseLimit :: Maybe Int
65+ } deriving (Eq, Show)
66+
67+data CommonHighlight = CommonHighlight
68+ { order :: Maybe Text
69+ , forceSource :: Maybe Bool
70+ , tag :: Maybe HighlightTag
71+ , encoder :: Maybe HighlightEncoder
72+ , noMatchSize :: Maybe Int
73+ , highlightQuery :: Maybe Query
74+ , requireFieldMatch :: Maybe Bool
75+ } deriving (Eq, Show)
76+
77+-- Settings that are only applicable to FastVector and Plain highlighters.
78+data NonPostings =
79+ NonPostings { fragmentSize :: Maybe Int
80+ , numberOfFragments :: Maybe Int
81+ } deriving (Eq, Show)
82+
83+data HighlightEncoder = DefaultEncoder
84+ | HTMLEncoder
85+ deriving (Eq, Show)
86+
87+instance ToJSON HighlightEncoder where
88+ toJSON DefaultEncoder = String "default"
89+ toJSON HTMLEncoder = String "html"
90+
91+-- NOTE: Should the tags use some kind of HTML type, rather than Text?
92+data HighlightTag =
93+ TagSchema Text
94+ -- Only uses more than the first value in the lists if fvh
95+ | CustomTags ([Text], [Text])
96+ deriving (Eq, Show)
97+
98+highlightSettingsPairs :: Maybe HighlightSettings -> [Pair]
99+highlightSettingsPairs Nothing = []
100+highlightSettingsPairs (Just (Plain plh)) = plainHighPairs (Just plh)
101+highlightSettingsPairs (Just (Postings ph)) = postHighPairs (Just ph)
102+highlightSettingsPairs (Just (FastVector fvh)) = fastVectorHighPairs (Just fvh)
103+
104+
105+plainHighPairs :: Maybe PlainHighlight -> [Pair]
106+plainHighPairs Nothing = []
107+plainHighPairs (Just (PlainHighlight plCom plNonPost)) =
108+ [ "type" .= String "plain"]
109+ ++ commonHighlightPairs plCom
110+ ++ nonPostingsToPairs plNonPost
111+
112+postHighPairs :: Maybe PostingsHighlight -> [Pair]
113+postHighPairs Nothing = []
114+postHighPairs (Just (PostingsHighlight pCom)) =
115+ ("type" .= String "postings")
116+ : commonHighlightPairs pCom
117+
118+fastVectorHighPairs :: Maybe FastVectorHighlight -> [Pair]
119+fastVectorHighPairs Nothing = []
120+fastVectorHighPairs
121+ (Just
122+ (FastVectorHighlight fvCom fvNonPostSettings' fvBoundChars
123+ fvBoundMaxScan fvFragOff fvMatchedFields
124+ fvPhraseLim)) =
125+ [ "type" .= String "fvh"
126+ , "boundary_chars" .= fvBoundChars
127+ , "boundary_max_scan" .= fvBoundMaxScan
128+ , "fragment_offset" .= fvFragOff
129+ , "matched_fields" .= fvMatchedFields
130+ , "phraseLimit" .= fvPhraseLim]
131+ ++ commonHighlightPairs fvCom
132+ ++ nonPostingsToPairs fvNonPostSettings'
133+
134+commonHighlightPairs :: Maybe CommonHighlight -> [Pair]
135+commonHighlightPairs Nothing = []
136+commonHighlightPairs (Just (CommonHighlight chScore chForceSource
137+ chTag chEncoder chNoMatchSize
138+ chHighlightQuery chRequireFieldMatch)) =
139+ [ "order" .= chScore
140+ , "force_source" .= chForceSource
141+ , "encoder" .= chEncoder
142+ , "no_match_size" .= chNoMatchSize
143+ , "highlight_query" .= chHighlightQuery
144+ , "require_fieldMatch" .= chRequireFieldMatch
145+ ]
146+ ++ highlightTagToPairs chTag
147+
148+
149+nonPostingsToPairs :: Maybe NonPostings -> [Pair]
150+nonPostingsToPairs Nothing = []
151+nonPostingsToPairs (Just (NonPostings npFragSize npNumOfFrags)) =
152+ [ "fragment_size" .= npFragSize
153+ , "number_of_fragments" .= npNumOfFrags
154+ ]
155+
156+highlightTagToPairs :: Maybe HighlightTag -> [Pair]
157+highlightTagToPairs (Just (TagSchema _)) =
158+ [ "scheme" .= String "default"
159+ ]
160+highlightTagToPairs (Just (CustomTags (pre, post))) =
161+ [ "pre_tags" .= pre
162+ , "post_tags" .= post
163+ ]
164+highlightTagToPairs Nothing = []
src/Database/Bloodhound/Internal/Newtypes.hsnew file+237
@@ -0,0 +1,237 @@
1+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
2+{-# LANGUAGE OverloadedStrings #-}
3+
4+module Database.Bloodhound.Internal.Newtypes where
5+
6+import Bloodhound.Import
7+
8+import qualified Data.Map.Strict as M
9+
10+newtype From = From Int deriving (Eq, Show, ToJSON)
11+newtype Size = Size Int deriving (Eq, Show, ToJSON, FromJSON)
12+
13+-- Used with scripts
14+newtype HitFields =
15+ HitFields (M.Map Text [Value])
16+ deriving (Eq, Show)
17+
18+instance FromJSON HitFields where
19+ parseJSON x
20+ = HitFields <$> parseJSON x
21+
22+-- Slight misnomer.
23+type Score = Maybe Double
24+
25+{-| 'MappingName' is part of mappings which are how ES describes and schematizes
26+ the data in the indices.
27+-}
28+newtype MappingName =
29+ MappingName Text
30+ deriving (Eq, Show, ToJSON, FromJSON)
31+
32+newtype ShardId = ShardId { shardId :: Int }
33+ deriving (Eq, Show, FromJSON)
34+
35+{-| 'DocId' is a generic wrapper value for expressing unique Document IDs.
36+ Can be set by the user or created by ES itself. Often used in client
37+ functions for poking at specific documents.
38+-}
39+newtype DocId =
40+ DocId Text
41+ deriving (Eq, Show, ToJSON, FromJSON)
42+
43+{-| 'FieldName' is used all over the place wherever a specific field within
44+ a document needs to be specified, usually in 'Query's or 'Filter's.
45+-}
46+newtype FieldName =
47+ FieldName Text
48+ deriving (Eq, Read, Show, ToJSON, FromJSON)
49+
50+newtype TypeName =
51+ TypeName Text
52+ deriving (Eq, Show, ToJSON, FromJSON)
53+
54+{-| 'QueryString' is used to wrap query text bodies, be they human written or not.
55+-}
56+newtype QueryString =
57+ QueryString Text
58+ deriving (Eq, Show, ToJSON, FromJSON)
59+
60+
61+-- {-| 'Script' is often used in place of 'FieldName' to specify more
62+-- complex ways of extracting a value from a document.
63+-- -}
64+-- newtype Script =
65+-- Script { scriptText :: Text }
66+-- deriving (Eq, Show)
67+
68+{-| 'CacheName' is used in 'RegexpFilter' for describing the
69+ 'CacheKey' keyed caching behavior.
70+-}
71+newtype CacheName =
72+ CacheName Text
73+ deriving (Eq, Show, FromJSON, ToJSON)
74+
75+{-| 'CacheKey' is used in 'RegexpFilter' to key regex caching.
76+-}
77+newtype CacheKey =
78+ CacheKey Text deriving (Eq, Show, FromJSON, ToJSON)
79+newtype Existence =
80+ Existence Bool deriving (Eq, Show, FromJSON, ToJSON)
81+newtype NullValue =
82+ NullValue Bool deriving (Eq, Show, FromJSON, ToJSON)
83+newtype CutoffFrequency =
84+ CutoffFrequency Double deriving (Eq, Show, FromJSON, ToJSON)
85+newtype Analyzer =
86+ Analyzer Text deriving (Eq, Show, FromJSON, ToJSON)
87+newtype MaxExpansions =
88+ MaxExpansions Int deriving (Eq, Show, FromJSON, ToJSON)
89+
90+{-| 'Lenient', if set to true, will cause format based failures to be
91+ ignored. I don't know what the bloody default is, Elasticsearch
92+ documentation didn't say what it was. Let me know if you figure it out.
93+-}
94+newtype Lenient =
95+ Lenient Bool deriving (Eq, Show, FromJSON, ToJSON)
96+newtype Tiebreaker =
97+ Tiebreaker Double deriving (Eq, Show, FromJSON, ToJSON)
98+
99+{-| 'MinimumMatch' controls how many should clauses in the bool query should
100+ match. Can be an absolute value (2) or a percentage (30%) or a
101+ combination of both.
102+-}
103+newtype MinimumMatch =
104+ MinimumMatch Int deriving (Eq, Show, FromJSON, ToJSON)
105+newtype DisableCoord =
106+ DisableCoord Bool deriving (Eq, Show, FromJSON, ToJSON)
107+newtype IgnoreTermFrequency =
108+ IgnoreTermFrequency Bool deriving (Eq, Show, FromJSON, ToJSON)
109+newtype MinimumTermFrequency =
110+ MinimumTermFrequency Int deriving (Eq, Show, FromJSON, ToJSON)
111+newtype MaxQueryTerms =
112+ MaxQueryTerms Int deriving (Eq, Show, FromJSON, ToJSON)
113+
114+{-| 'PrefixLength' is the prefix length used in queries, defaults to 0. -}
115+newtype PrefixLength =
116+ PrefixLength Int deriving (Eq, Show, FromJSON, ToJSON)
117+newtype PercentMatch =
118+ PercentMatch Double deriving (Eq, Show, FromJSON, ToJSON)
119+newtype StopWord =
120+ StopWord Text deriving (Eq, Show, FromJSON, ToJSON)
121+newtype QueryPath =
122+ QueryPath Text deriving (Eq, Show, FromJSON, ToJSON)
123+
124+{-| Allowing a wildcard at the beginning of a word (eg "*ing") is particularly
125+ heavy, because all terms in the index need to be examined, just in case
126+ they match. Leading wildcards can be disabled by setting
127+ 'AllowLeadingWildcard' to false. -}
128+newtype AllowLeadingWildcard =
129+ AllowLeadingWildcard Bool deriving (Eq, Show, FromJSON, ToJSON)
130+newtype LowercaseExpanded =
131+ LowercaseExpanded Bool deriving (Eq, Show, FromJSON, ToJSON)
132+newtype EnablePositionIncrements =
133+ EnablePositionIncrements Bool deriving (Eq, Show, FromJSON, ToJSON)
134+
135+{-| By default, wildcard terms in a query are not analyzed.
136+ Setting 'AnalyzeWildcard' to true enables best-effort analysis.
137+-}
138+newtype AnalyzeWildcard = AnalyzeWildcard Bool deriving (Eq, Show, FromJSON, ToJSON)
139+
140+{-| 'GeneratePhraseQueries' defaults to false.
141+-}
142+newtype GeneratePhraseQueries =
143+ GeneratePhraseQueries Bool deriving (Eq, Show, FromJSON, ToJSON)
144+
145+{-| 'Locale' is used for string conversions - defaults to ROOT.
146+-}
147+newtype Locale = Locale Text deriving (Eq, Show, FromJSON, ToJSON)
148+newtype MaxWordLength = MaxWordLength Int deriving (Eq, Show, FromJSON, ToJSON)
149+newtype MinWordLength = MinWordLength Int deriving (Eq, Show, FromJSON, ToJSON)
150+
151+{-| 'PhraseSlop' sets the default slop for phrases, 0 means exact
152+ phrase matches. Default is 0.
153+-}
154+newtype PhraseSlop = PhraseSlop Int deriving (Eq, Show, FromJSON, ToJSON)
155+newtype MinDocFrequency = MinDocFrequency Int deriving (Eq, Show, FromJSON, ToJSON)
156+newtype MaxDocFrequency = MaxDocFrequency Int deriving (Eq, Show, FromJSON, ToJSON)
157+
158+-- | Newtype wrapper to parse ES's concerning tendency to in some APIs return a floating point number of milliseconds since epoch ಠ_ಠ
159+newtype POSIXMS = POSIXMS { posixMS :: UTCTime }
160+
161+instance FromJSON POSIXMS where
162+ parseJSON = withScientific "POSIXMS" (return . parse)
163+ where parse n =
164+ let n' = truncate n :: Integer
165+ in POSIXMS (posixSecondsToUTCTime (fromInteger (n' `div` 1000)))
166+
167+newtype Boost =
168+ Boost Double
169+ deriving (Eq, Show, ToJSON, FromJSON)
170+
171+newtype BoostTerms =
172+ BoostTerms Double
173+ deriving (Eq, Show, ToJSON, FromJSON)
174+
175+{-| 'ReplicaCount' is part of 'IndexSettings' -}
176+newtype ReplicaCount =
177+ ReplicaCount Int
178+ deriving (Eq, Show, ToJSON)
179+
180+{-| 'ShardCount' is part of 'IndexSettings' -}
181+newtype ShardCount =
182+ ShardCount Int
183+ deriving (Eq, Show, ToJSON)
184+
185+-- This insanity is because ES *sometimes* returns Replica/Shard counts as strings
186+instance FromJSON ReplicaCount where
187+ parseJSON v = parseAsInt v
188+ <|> parseAsString v
189+ where parseAsInt = fmap ReplicaCount . parseJSON
190+ parseAsString = withText "ReplicaCount" (fmap ReplicaCount . parseReadText)
191+
192+instance FromJSON ShardCount where
193+ parseJSON v = parseAsInt v
194+ <|> parseAsString v
195+ where parseAsInt = fmap ShardCount . parseJSON
196+ parseAsString = withText "ShardCount" (fmap ShardCount . parseReadText)
197+
198+{-| 'IndexName' is used to describe which index to query/create/delete -}
199+newtype IndexName =
200+ IndexName Text
201+ deriving (Eq, Show, ToJSON, FromJSON)
202+
203+newtype IndexAliasName =
204+ IndexAliasName { indexAliasName :: IndexName }
205+ deriving (Eq, Show, ToJSON)
206+
207+newtype MaybeNA a = MaybeNA { unMaybeNA :: Maybe a }
208+ deriving (Show, Eq)
209+
210+instance FromJSON a => FromJSON (MaybeNA a) where
211+ parseJSON (String "NA") = pure $ MaybeNA Nothing
212+ parseJSON o = MaybeNA . Just <$> parseJSON o
213+
214+newtype SnapshotName =
215+ SnapshotName { snapshotName :: Text }
216+ deriving (Eq, Show, ToJSON, FromJSON)
217+
218+-- | Milliseconds
219+newtype MS = MS NominalDiffTime
220+
221+-- keeps the unexported constructor warnings at bay
222+unMS :: MS -> NominalDiffTime
223+unMS (MS t) = t
224+
225+
226+instance FromJSON MS where
227+ parseJSON = withScientific "MS" (return . MS . parse)
228+ where
229+ parse n = fromInteger (truncate n * 1000)
230+
231+newtype TokenFilter =
232+ TokenFilter Text
233+ deriving (Eq, Show, FromJSON, ToJSON)
234+
235+newtype CharFilter =
236+ CharFilter Text
237+ deriving (Eq, Show, FromJSON, ToJSON)
src/Database/Bloodhound/Internal/Query.hsnew file+1640
@@ -0,0 +1,1640 @@
1+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
2+{-# LANGUAGE OverloadedStrings #-}
3+{-# LANGUAGE RecordWildCards #-}
4+
5+module Database.Bloodhound.Internal.Query
6+ ( module X
7+ , module Database.Bloodhound.Internal.Query
8+ ) where
9+
10+import Bloodhound.Import
11+
12+import Data.Char (isNumber)
13+import qualified Data.HashMap.Strict as HM
14+import Data.List (nub)
15+import qualified Data.Text as T
16+
17+import Database.Bloodhound.Common.Script as X
18+import Database.Bloodhound.Internal.Newtypes
19+
20+data Query =
21+ TermQuery Term (Maybe Boost)
22+ | TermsQuery Text (NonEmpty Text)
23+ | QueryMatchQuery MatchQuery
24+ | QueryMultiMatchQuery MultiMatchQuery
25+ | QueryBoolQuery BoolQuery
26+ | QueryBoostingQuery BoostingQuery
27+ | QueryCommonTermsQuery CommonTermsQuery
28+ | ConstantScoreQuery Query Boost
29+ | QueryFunctionScoreQuery FunctionScoreQuery
30+ | QueryDisMaxQuery DisMaxQuery
31+ | QueryFuzzyLikeThisQuery FuzzyLikeThisQuery
32+ | QueryFuzzyLikeFieldQuery FuzzyLikeFieldQuery
33+ | QueryFuzzyQuery FuzzyQuery
34+ | QueryHasChildQuery HasChildQuery
35+ | QueryHasParentQuery HasParentQuery
36+ | IdsQuery MappingName [DocId]
37+ | QueryIndicesQuery IndicesQuery
38+ | MatchAllQuery (Maybe Boost)
39+ | QueryMoreLikeThisQuery MoreLikeThisQuery
40+ | QueryMoreLikeThisFieldQuery MoreLikeThisFieldQuery
41+ | QueryNestedQuery NestedQuery
42+ | QueryPrefixQuery PrefixQuery
43+ | QueryQueryStringQuery QueryStringQuery
44+ | QuerySimpleQueryStringQuery SimpleQueryStringQuery
45+ | QueryRangeQuery RangeQuery
46+ | QueryRegexpQuery RegexpQuery
47+ | QueryExistsQuery FieldName
48+ | QueryTemplateQueryInline TemplateQueryInline
49+ | QueryMatchNoneQuery
50+ | QueryWildcardQuery WildcardQuery
51+ deriving (Eq, Show)
52+
53+instance ToJSON Query where
54+ toJSON (TermQuery (Term termQueryField termQueryValue) boost) =
55+ object [ "term" .=
56+ object [termQueryField .= object merged]]
57+ where
58+ base = [ "value" .= termQueryValue ]
59+ boosted = maybe [] (return . ("boost" .=)) boost
60+ merged = mappend base boosted
61+
62+ toJSON (TermsQuery fieldName terms) =
63+ object [ "terms" .= object conjoined ]
64+ where conjoined = [fieldName .= terms]
65+
66+ toJSON (IdsQuery idsQueryMappingName docIds) =
67+ object [ "ids" .= object conjoined ]
68+ where conjoined = [ "type" .= idsQueryMappingName
69+ , "values" .= fmap toJSON docIds ]
70+
71+ toJSON (QueryQueryStringQuery qQueryStringQuery) =
72+ object [ "query_string" .= qQueryStringQuery ]
73+
74+ toJSON (QueryMatchQuery matchQuery) =
75+ object [ "match" .= matchQuery ]
76+
77+ toJSON (QueryMultiMatchQuery multiMatchQuery) =
78+ toJSON multiMatchQuery
79+
80+ toJSON (QueryBoolQuery boolQuery) =
81+ object [ "bool" .= boolQuery ]
82+
83+ toJSON (QueryBoostingQuery boostingQuery) =
84+ object [ "boosting" .= boostingQuery ]
85+
86+ toJSON (QueryCommonTermsQuery commonTermsQuery) =
87+ object [ "common" .= commonTermsQuery ]
88+
89+ toJSON (ConstantScoreQuery query boost) =
90+ object ["constant_score" .= object ["query" .= query
91+ , "boost" .= boost]]
92+
93+ toJSON (QueryFunctionScoreQuery functionScoreQuery) =
94+ object [ "function_score" .= functionScoreQuery ]
95+
96+ toJSON (QueryDisMaxQuery disMaxQuery) =
97+ object [ "dis_max" .= disMaxQuery ]
98+
99+ toJSON (QueryFuzzyLikeThisQuery fuzzyQuery) =
100+ object [ "fuzzy_like_this" .= fuzzyQuery ]
101+
102+ toJSON (QueryFuzzyLikeFieldQuery fuzzyFieldQuery) =
103+ object [ "fuzzy_like_this_field" .= fuzzyFieldQuery ]
104+
105+ toJSON (QueryFuzzyQuery fuzzyQuery) =
106+ object [ "fuzzy" .= fuzzyQuery ]
107+
108+ toJSON (QueryHasChildQuery childQuery) =
109+ object [ "has_child" .= childQuery ]
110+
111+ toJSON (QueryHasParentQuery parentQuery) =
112+ object [ "has_parent" .= parentQuery ]
113+
114+ toJSON (QueryIndicesQuery qIndicesQuery) =
115+ object [ "indices" .= qIndicesQuery ]
116+
117+ toJSON (MatchAllQuery boost) =
118+ object [ "match_all" .= omitNulls [ "boost" .= boost ] ]
119+
120+ toJSON (QueryMoreLikeThisQuery query) =
121+ object [ "more_like_this" .= query ]
122+
123+ toJSON (QueryMoreLikeThisFieldQuery query) =
124+ object [ "more_like_this_field" .= query ]
125+
126+ toJSON (QueryNestedQuery query) =
127+ object [ "nested" .= query ]
128+
129+ toJSON (QueryPrefixQuery query) =
130+ object [ "prefix" .= query ]
131+
132+ toJSON (QueryRangeQuery query) =
133+ object [ "range" .= query ]
134+
135+ toJSON (QueryRegexpQuery query) =
136+ object [ "regexp" .= query ]
137+
138+ toJSON (QuerySimpleQueryStringQuery query) =
139+ object [ "simple_query_string" .= query ]
140+
141+ toJSON (QueryExistsQuery (FieldName fieldName)) =
142+ object ["exists" .= object
143+ ["field" .= fieldName]
144+ ]
145+ toJSON QueryMatchNoneQuery =
146+ object ["match_none" .= object []]
147+
148+ toJSON (QueryTemplateQueryInline templateQuery) =
149+ object [ "template" .= templateQuery ]
150+
151+ toJSON (QueryWildcardQuery query) =
152+ object [ "wildcard" .= query ]
153+
154+instance FromJSON Query where
155+ parseJSON v = withObject "Query" parse v
156+ where parse o = termQuery `taggedWith` "term"
157+ <|> termsQuery `taggedWith` "terms"
158+ <|> idsQuery `taggedWith` "ids"
159+ <|> queryQueryStringQuery `taggedWith` "query_string"
160+ <|> queryMatchQuery `taggedWith` "match"
161+ <|> queryMultiMatchQuery
162+ <|> queryBoolQuery `taggedWith` "bool"
163+ <|> queryBoostingQuery `taggedWith` "boosting"
164+ <|> queryCommonTermsQuery `taggedWith` "common"
165+ <|> constantScoreQuery `taggedWith` "constant_score"
166+ <|> queryFunctionScoreQuery `taggedWith` "function_score"
167+ <|> queryDisMaxQuery `taggedWith` "dis_max"
168+ <|> queryFuzzyLikeThisQuery `taggedWith` "fuzzy_like_this"
169+ <|> queryFuzzyLikeFieldQuery `taggedWith` "fuzzy_like_this_field"
170+ <|> queryFuzzyQuery `taggedWith` "fuzzy"
171+ <|> queryHasChildQuery `taggedWith` "has_child"
172+ <|> queryHasParentQuery `taggedWith` "has_parent"
173+ <|> queryIndicesQuery `taggedWith` "indices"
174+ <|> matchAllQuery `taggedWith` "match_all"
175+ <|> queryMoreLikeThisQuery `taggedWith` "more_like_this"
176+ <|> queryMoreLikeThisFieldQuery `taggedWith` "more_like_this_field"
177+ <|> queryNestedQuery `taggedWith` "nested"
178+ <|> queryPrefixQuery `taggedWith` "prefix"
179+ <|> queryRangeQuery `taggedWith` "range"
180+ <|> queryRegexpQuery `taggedWith` "regexp"
181+ <|> querySimpleQueryStringQuery `taggedWith` "simple_query_string"
182+ <|> queryTemplateQueryInline `taggedWith` "template"
183+ <|> queryWildcardQuery `taggedWith` "wildcard"
184+ where taggedWith parser k = parser =<< o .: k
185+ termQuery = fieldTagged $ \(FieldName fn) o ->
186+ TermQuery <$> (Term fn <$> o .: "value") <*> o .:? "boost"
187+ termsQuery o = case HM.toList o of
188+ [(fn, vs)] -> do vals <- parseJSON vs
189+ case vals of
190+ x:xs -> return (TermsQuery fn (x :| xs))
191+ _ -> fail "Expected non empty list of values"
192+ _ -> fail "Expected object with 1 field-named key"
193+ idsQuery o = IdsQuery <$> o .: "type"
194+ <*> o .: "values"
195+ queryQueryStringQuery = pure . QueryQueryStringQuery
196+ queryMatchQuery = pure . QueryMatchQuery
197+ queryMultiMatchQuery = QueryMultiMatchQuery <$> parseJSON v
198+ queryBoolQuery = pure . QueryBoolQuery
199+ queryBoostingQuery = pure . QueryBoostingQuery
200+ queryCommonTermsQuery = pure . QueryCommonTermsQuery
201+ constantScoreQuery o = case HM.lookup "query" o of
202+ Just x -> ConstantScoreQuery <$> parseJSON x
203+ <*> o .: "boost"
204+ _ -> fail "Does not appear to be a ConstantScoreQuery"
205+ queryFunctionScoreQuery = pure . QueryFunctionScoreQuery
206+ queryDisMaxQuery = pure . QueryDisMaxQuery
207+ queryFuzzyLikeThisQuery = pure . QueryFuzzyLikeThisQuery
208+ queryFuzzyLikeFieldQuery = pure . QueryFuzzyLikeFieldQuery
209+ queryFuzzyQuery = pure . QueryFuzzyQuery
210+ queryHasChildQuery = pure . QueryHasChildQuery
211+ queryHasParentQuery = pure . QueryHasParentQuery
212+ queryIndicesQuery = pure . QueryIndicesQuery
213+ matchAllQuery o = MatchAllQuery <$> o .:? "boost"
214+ queryMoreLikeThisQuery = pure . QueryMoreLikeThisQuery
215+ queryMoreLikeThisFieldQuery = pure . QueryMoreLikeThisFieldQuery
216+ queryNestedQuery = pure . QueryNestedQuery
217+ queryPrefixQuery = pure . QueryPrefixQuery
218+ queryRangeQuery = pure . QueryRangeQuery
219+ queryRegexpQuery = pure . QueryRegexpQuery
220+ querySimpleQueryStringQuery = pure . QuerySimpleQueryStringQuery
221+ -- queryExistsQuery o = QueryExistsQuery <$> o .: "field"
222+ queryTemplateQueryInline = pure . QueryTemplateQueryInline
223+ queryWildcardQuery = pure . QueryWildcardQuery
224+
225+-- | As of Elastic 2.0, 'Filters' are just 'Queries' housed in a
226+-- Bool Query, and flagged in a different context.
227+newtype Filter = Filter { unFilter :: Query }
228+ deriving (Eq, Show)
229+
230+instance ToJSON Filter where
231+ toJSON = toJSON . unFilter
232+
233+instance FromJSON Filter where
234+ parseJSON v = Filter <$> parseJSON v
235+
236+data RegexpQuery =
237+ RegexpQuery { regexpQueryField :: FieldName
238+ , regexpQuery :: Regexp
239+ , regexpQueryFlags :: RegexpFlags
240+ , regexpQueryBoost :: Maybe Boost
241+ } deriving (Eq, Show)
242+
243+instance ToJSON RegexpQuery where
244+ toJSON (RegexpQuery (FieldName rqQueryField)
245+ (Regexp regexpQueryQuery) rqQueryFlags
246+ rqQueryBoost) =
247+ object [ rqQueryField .= omitNulls base ]
248+ where base = [ "value" .= regexpQueryQuery
249+ , "flags" .= rqQueryFlags
250+ , "boost" .= rqQueryBoost ]
251+
252+instance FromJSON RegexpQuery where
253+ parseJSON = withObject "RegexpQuery" parse
254+ where parse = fieldTagged $ \fn o ->
255+ RegexpQuery fn
256+ <$> o .: "value"
257+ <*> o .: "flags"
258+ <*> o .:? "boost"
259+
260+data WildcardQuery =
261+ WildcardQuery { wildcardQueryField :: FieldName
262+ , wildcardQuery :: Text
263+ , wildcardQueryBoost :: Maybe Boost
264+ } deriving (Eq, Show)
265+
266+instance ToJSON WildcardQuery where
267+ toJSON (WildcardQuery (FieldName wcQueryField)
268+ (wcQueryQuery) wcQueryBoost) =
269+ object [ wcQueryField .= omitNulls base ]
270+ where base = [ "value" .= wcQueryQuery
271+ , "boost" .= wcQueryBoost ]
272+
273+instance FromJSON WildcardQuery where
274+ parseJSON = withObject "WildcardQuery" parse
275+ where parse = fieldTagged $ \fn o ->
276+ WildcardQuery fn
277+ <$> o .: "value"
278+ <*> o .:? "boost"
279+
280+data RangeQuery =
281+ RangeQuery { rangeQueryField :: FieldName
282+ , rangeQueryRange :: RangeValue
283+ , rangeQueryBoost :: Boost } deriving (Eq, Show)
284+
285+instance ToJSON RangeQuery where
286+ toJSON (RangeQuery (FieldName fieldName) range boost) =
287+ object [ fieldName .= object conjoined ]
288+ where
289+ conjoined = ("boost" .= boost) : rangeValueToPair range
290+
291+instance FromJSON RangeQuery where
292+ parseJSON = withObject "RangeQuery" parse
293+ where parse = fieldTagged $ \fn o ->
294+ RangeQuery fn
295+ <$> parseJSON (Object o)
296+ <*> o .: "boost"
297+
298+mkRangeQuery :: FieldName -> RangeValue -> RangeQuery
299+mkRangeQuery f r = RangeQuery f r (Boost 1.0)
300+
301+data SimpleQueryStringQuery =
302+ SimpleQueryStringQuery
303+ { simpleQueryStringQuery :: QueryString
304+ , simpleQueryStringField :: Maybe FieldOrFields
305+ , simpleQueryStringOperator :: Maybe BooleanOperator
306+ , simpleQueryStringAnalyzer :: Maybe Analyzer
307+ , simpleQueryStringFlags :: Maybe (NonEmpty SimpleQueryFlag)
308+ , simpleQueryStringLowercaseExpanded :: Maybe LowercaseExpanded
309+ , simpleQueryStringLocale :: Maybe Locale
310+ } deriving (Eq, Show)
311+
312+
313+instance ToJSON SimpleQueryStringQuery where
314+ toJSON SimpleQueryStringQuery {..} =
315+ omitNulls (base ++ maybeAdd)
316+ where base = [ "query" .= simpleQueryStringQuery ]
317+ maybeAdd = [ "fields" .= simpleQueryStringField
318+ , "default_operator" .= simpleQueryStringOperator
319+ , "analyzer" .= simpleQueryStringAnalyzer
320+ , "flags" .= simpleQueryStringFlags
321+ , "lowercase_expanded_terms" .= simpleQueryStringLowercaseExpanded
322+ , "locale" .= simpleQueryStringLocale ]
323+
324+instance FromJSON SimpleQueryStringQuery where
325+ parseJSON = withObject "SimpleQueryStringQuery" parse
326+ where parse o = SimpleQueryStringQuery <$> o .: "query"
327+ <*> o .:? "fields"
328+ <*> o .:? "default_operator"
329+ <*> o .:? "analyzer"
330+ <*> (parseFlags <$> o .:? "flags")
331+ <*> o .:? "lowercase_expanded_terms"
332+ <*> o .:? "locale"
333+ parseFlags (Just (x:xs)) = Just (x :| xs)
334+ parseFlags _ = Nothing
335+
336+data SimpleQueryFlag =
337+ SimpleQueryAll
338+ | SimpleQueryNone
339+ | SimpleQueryAnd
340+ | SimpleQueryOr
341+ | SimpleQueryPrefix
342+ | SimpleQueryPhrase
343+ | SimpleQueryPrecedence
344+ | SimpleQueryEscape
345+ | SimpleQueryWhitespace
346+ | SimpleQueryFuzzy
347+ | SimpleQueryNear
348+ | SimpleQuerySlop deriving (Eq, Show)
349+
350+instance ToJSON SimpleQueryFlag where
351+ toJSON SimpleQueryAll = "ALL"
352+ toJSON SimpleQueryNone = "NONE"
353+ toJSON SimpleQueryAnd = "AND"
354+ toJSON SimpleQueryOr = "OR"
355+ toJSON SimpleQueryPrefix = "PREFIX"
356+ toJSON SimpleQueryPhrase = "PHRASE"
357+ toJSON SimpleQueryPrecedence = "PRECEDENCE"
358+ toJSON SimpleQueryEscape = "ESCAPE"
359+ toJSON SimpleQueryWhitespace = "WHITESPACE"
360+ toJSON SimpleQueryFuzzy = "FUZZY"
361+ toJSON SimpleQueryNear = "NEAR"
362+ toJSON SimpleQuerySlop = "SLOP"
363+
364+instance FromJSON SimpleQueryFlag where
365+ parseJSON = withText "SimpleQueryFlag" parse
366+ where parse "ALL" = pure SimpleQueryAll
367+ parse "NONE" = pure SimpleQueryNone
368+ parse "AND" = pure SimpleQueryAnd
369+ parse "OR" = pure SimpleQueryOr
370+ parse "PREFIX" = pure SimpleQueryPrefix
371+ parse "PHRASE" = pure SimpleQueryPhrase
372+ parse "PRECEDENCE" = pure SimpleQueryPrecedence
373+ parse "ESCAPE" = pure SimpleQueryEscape
374+ parse "WHITESPACE" = pure SimpleQueryWhitespace
375+ parse "FUZZY" = pure SimpleQueryFuzzy
376+ parse "NEAR" = pure SimpleQueryNear
377+ parse "SLOP" = pure SimpleQuerySlop
378+ parse f = fail ("Unexpected SimpleQueryFlag: " <> show f)
379+
380+-- use_dis_max and tie_breaker when fields are plural?
381+data QueryStringQuery =
382+ QueryStringQuery
383+ { queryStringQuery :: QueryString
384+ , queryStringDefaultField :: Maybe FieldName
385+ , queryStringOperator :: Maybe BooleanOperator
386+ , queryStringAnalyzer :: Maybe Analyzer
387+ , queryStringAllowLeadingWildcard :: Maybe AllowLeadingWildcard
388+ , queryStringLowercaseExpanded :: Maybe LowercaseExpanded
389+ , queryStringEnablePositionIncrements :: Maybe EnablePositionIncrements
390+ , queryStringFuzzyMaxExpansions :: Maybe MaxExpansions
391+ , queryStringFuzziness :: Maybe Fuzziness
392+ , queryStringFuzzyPrefixLength :: Maybe PrefixLength
393+ , queryStringPhraseSlop :: Maybe PhraseSlop
394+ , queryStringBoost :: Maybe Boost
395+ , queryStringAnalyzeWildcard :: Maybe AnalyzeWildcard
396+ , queryStringGeneratePhraseQueries :: Maybe GeneratePhraseQueries
397+ , queryStringMinimumShouldMatch :: Maybe MinimumMatch
398+ , queryStringLenient :: Maybe Lenient
399+ , queryStringLocale :: Maybe Locale
400+ } deriving (Eq, Show)
401+
402+
403+instance ToJSON QueryStringQuery where
404+ toJSON (QueryStringQuery qsQueryString
405+ qsDefaultField qsOperator
406+ qsAnalyzer qsAllowWildcard
407+ qsLowercaseExpanded qsEnablePositionIncrements
408+ qsFuzzyMaxExpansions qsFuzziness
409+ qsFuzzyPrefixLength qsPhraseSlop
410+ qsBoost qsAnalyzeWildcard
411+ qsGeneratePhraseQueries qsMinimumShouldMatch
412+ qsLenient qsLocale) =
413+ omitNulls base
414+ where
415+ base = [ "query" .= qsQueryString
416+ , "default_field" .= qsDefaultField
417+ , "default_operator" .= qsOperator
418+ , "analyzer" .= qsAnalyzer
419+ , "allow_leading_wildcard" .= qsAllowWildcard
420+ , "lowercase_expanded_terms" .= qsLowercaseExpanded
421+ , "enable_position_increments" .= qsEnablePositionIncrements
422+ , "fuzzy_max_expansions" .= qsFuzzyMaxExpansions
423+ , "fuzziness" .= qsFuzziness
424+ , "fuzzy_prefix_length" .= qsFuzzyPrefixLength
425+ , "phrase_slop" .= qsPhraseSlop
426+ , "boost" .= qsBoost
427+ , "analyze_wildcard" .= qsAnalyzeWildcard
428+ , "auto_generate_phrase_queries" .= qsGeneratePhraseQueries
429+ , "minimum_should_match" .= qsMinimumShouldMatch
430+ , "lenient" .= qsLenient
431+ , "locale" .= qsLocale ]
432+
433+instance FromJSON QueryStringQuery where
434+ parseJSON = withObject "QueryStringQuery" parse
435+ where parse o = QueryStringQuery
436+ <$> o .: "query"
437+ <*> o .:? "default_field"
438+ <*> o .:? "default_operator"
439+ <*> o .:? "analyzer"
440+ <*> o .:? "allow_leading_wildcard"
441+ <*> o .:? "lowercase_expanded_terms"
442+ <*> o .:? "enable_position_increments"
443+ <*> o .:? "fuzzy_max_expansions"
444+ <*> o .:? "fuzziness"
445+ <*> o .:? "fuzzy_prefix_length"
446+ <*> o .:? "phrase_slop"
447+ <*> o .:? "boost"
448+ <*> o .:? "analyze_wildcard"
449+ <*> o .:? "auto_generate_phrase_queries"
450+ <*> o .:? "minimum_should_match"
451+ <*> o .:? "lenient"
452+ <*> o .:? "locale"
453+
454+mkQueryStringQuery :: QueryString -> QueryStringQuery
455+mkQueryStringQuery qs =
456+ QueryStringQuery qs Nothing Nothing
457+ Nothing Nothing Nothing Nothing
458+ Nothing Nothing Nothing Nothing
459+ Nothing Nothing Nothing Nothing
460+ Nothing Nothing
461+
462+data FieldOrFields = FofField FieldName
463+ | FofFields (NonEmpty FieldName) deriving (Eq, Show)
464+
465+instance ToJSON FieldOrFields where
466+ toJSON (FofField fieldName) =
467+ toJSON fieldName
468+ toJSON (FofFields fieldNames) =
469+ toJSON fieldNames
470+
471+instance FromJSON FieldOrFields where
472+ parseJSON v = FofField <$> parseJSON v
473+ <|> FofFields <$> (parseNEJSON =<< parseJSON v)
474+
475+data PrefixQuery =
476+ PrefixQuery
477+ { prefixQueryField :: FieldName
478+ , prefixQueryPrefixValue :: Text
479+ , prefixQueryBoost :: Maybe Boost } deriving (Eq, Show)
480+
481+instance ToJSON PrefixQuery where
482+ toJSON (PrefixQuery (FieldName fieldName) queryValue boost) =
483+ object [ fieldName .= omitNulls base ]
484+ where base = [ "value" .= queryValue
485+ , "boost" .= boost ]
486+
487+instance FromJSON PrefixQuery where
488+ parseJSON = withObject "PrefixQuery" parse
489+ where parse = fieldTagged $ \fn o ->
490+ PrefixQuery fn
491+ <$> o .: "value"
492+ <*> o .:? "boost"
493+
494+data NestedQuery =
495+ NestedQuery
496+ { nestedQueryPath :: QueryPath
497+ , nestedQueryScoreType :: ScoreType
498+ , nestedQuery :: Query } deriving (Eq, Show)
499+
500+instance ToJSON NestedQuery where
501+ toJSON (NestedQuery nqPath nqScoreType nqQuery) =
502+ object [ "path" .= nqPath
503+ , "score_mode" .= nqScoreType
504+ , "query" .= nqQuery ]
505+
506+instance FromJSON NestedQuery where
507+ parseJSON = withObject "NestedQuery" parse
508+ where parse o = NestedQuery
509+ <$> o .: "path"
510+ <*> o .: "score_mode"
511+ <*> o .: "query"
512+
513+data MoreLikeThisFieldQuery =
514+ MoreLikeThisFieldQuery
515+ { moreLikeThisFieldText :: Text
516+ , moreLikeThisFieldFields :: FieldName
517+ -- default 0.3 (30%)
518+ , moreLikeThisFieldPercentMatch :: Maybe PercentMatch
519+ , moreLikeThisFieldMinimumTermFreq :: Maybe MinimumTermFrequency
520+ , moreLikeThisFieldMaxQueryTerms :: Maybe MaxQueryTerms
521+ , moreLikeThisFieldStopWords :: Maybe (NonEmpty StopWord)
522+ , moreLikeThisFieldMinDocFrequency :: Maybe MinDocFrequency
523+ , moreLikeThisFieldMaxDocFrequency :: Maybe MaxDocFrequency
524+ , moreLikeThisFieldMinWordLength :: Maybe MinWordLength
525+ , moreLikeThisFieldMaxWordLength :: Maybe MaxWordLength
526+ , moreLikeThisFieldBoostTerms :: Maybe BoostTerms
527+ , moreLikeThisFieldBoost :: Maybe Boost
528+ , moreLikeThisFieldAnalyzer :: Maybe Analyzer
529+ } deriving (Eq, Show)
530+
531+
532+instance ToJSON MoreLikeThisFieldQuery where
533+ toJSON (MoreLikeThisFieldQuery text (FieldName fieldName)
534+ percent mtf mqt stopwords mindf maxdf
535+ minwl maxwl boostTerms boost analyzer) =
536+ object [ fieldName .= omitNulls base ]
537+ where base = [ "like_text" .= text
538+ , "percent_terms_to_match" .= percent
539+ , "min_term_freq" .= mtf
540+ , "max_query_terms" .= mqt
541+ , "stop_words" .= stopwords
542+ , "min_doc_freq" .= mindf
543+ , "max_doc_freq" .= maxdf
544+ , "min_word_length" .= minwl
545+ , "max_word_length" .= maxwl
546+ , "boost_terms" .= boostTerms
547+ , "boost" .= boost
548+ , "analyzer" .= analyzer ]
549+
550+instance FromJSON MoreLikeThisFieldQuery where
551+ parseJSON = withObject "MoreLikeThisFieldQuery" parse
552+ where parse = fieldTagged $ \fn o ->
553+ MoreLikeThisFieldQuery
554+ <$> o .: "like_text"
555+ <*> pure fn
556+ <*> o .:? "percent_terms_to_match"
557+ <*> o .:? "min_term_freq"
558+ <*> o .:? "max_query_terms"
559+ -- <*> (optionalNE =<< o .:? "stop_words")
560+ <*> o .:? "stop_words"
561+ <*> o .:? "min_doc_freq"
562+ <*> o .:? "max_doc_freq"
563+ <*> o .:? "min_word_length"
564+ <*> o .:? "max_word_length"
565+ <*> o .:? "boost_terms"
566+ <*> o .:? "boost"
567+ <*> o .:? "analyzer"
568+ -- optionalNE = maybe (pure Nothing) (fmap Just . parseNEJSON)
569+
570+data MoreLikeThisQuery =
571+ MoreLikeThisQuery
572+ { moreLikeThisText :: Text
573+ , moreLikeThisFields :: Maybe (NonEmpty FieldName)
574+ -- default 0.3 (30%)
575+ , moreLikeThisPercentMatch :: Maybe PercentMatch
576+ , moreLikeThisMinimumTermFreq :: Maybe MinimumTermFrequency
577+ , moreLikeThisMaxQueryTerms :: Maybe MaxQueryTerms
578+ , moreLikeThisStopWords :: Maybe (NonEmpty StopWord)
579+ , moreLikeThisMinDocFrequency :: Maybe MinDocFrequency
580+ , moreLikeThisMaxDocFrequency :: Maybe MaxDocFrequency
581+ , moreLikeThisMinWordLength :: Maybe MinWordLength
582+ , moreLikeThisMaxWordLength :: Maybe MaxWordLength
583+ , moreLikeThisBoostTerms :: Maybe BoostTerms
584+ , moreLikeThisBoost :: Maybe Boost
585+ , moreLikeThisAnalyzer :: Maybe Analyzer
586+ } deriving (Eq, Show)
587+
588+
589+instance ToJSON MoreLikeThisQuery where
590+ toJSON (MoreLikeThisQuery text fields percent
591+ mtf mqt stopwords mindf maxdf
592+ minwl maxwl boostTerms boost analyzer) =
593+ omitNulls base
594+ where base = [ "like_text" .= text
595+ , "fields" .= fields
596+ , "percent_terms_to_match" .= percent
597+ , "min_term_freq" .= mtf
598+ , "max_query_terms" .= mqt
599+ , "stop_words" .= stopwords
600+ , "min_doc_freq" .= mindf
601+ , "max_doc_freq" .= maxdf
602+ , "min_word_length" .= minwl
603+ , "max_word_length" .= maxwl
604+ , "boost_terms" .= boostTerms
605+ , "boost" .= boost
606+ , "analyzer" .= analyzer ]
607+
608+instance FromJSON MoreLikeThisQuery where
609+ parseJSON = withObject "MoreLikeThisQuery" parse
610+ where parse o = MoreLikeThisQuery
611+ <$> o .: "like_text"
612+ -- <*> (optionalNE =<< o .:? "fields")
613+ <*> o .:? "fields"
614+ <*> o .:? "percent_terms_to_match"
615+ <*> o .:? "min_term_freq"
616+ <*> o .:? "max_query_terms"
617+ -- <*> (optionalNE =<< o .:? "stop_words")
618+ <*> o .:? "stop_words"
619+ <*> o .:? "min_doc_freq"
620+ <*> o .:? "max_doc_freq"
621+ <*> o .:? "min_word_length"
622+ <*> o .:? "max_word_length"
623+ <*> o .:? "boost_terms"
624+ <*> o .:? "boost"
625+ <*> o .:? "analyzer"
626+ -- optionalNE = maybe (pure Nothing) (fmap Just . parseNEJSON)
627+
628+data IndicesQuery =
629+ IndicesQuery
630+ { indicesQueryIndices :: [IndexName]
631+ , indicesQuery :: Query
632+ -- default "all"
633+ , indicesQueryNoMatch :: Maybe Query } deriving (Eq, Show)
634+
635+
636+instance ToJSON IndicesQuery where
637+ toJSON (IndicesQuery indices query noMatch) =
638+ omitNulls [ "indices" .= indices
639+ , "no_match_query" .= noMatch
640+ , "query" .= query ]
641+
642+instance FromJSON IndicesQuery where
643+ parseJSON = withObject "IndicesQuery" parse
644+ where parse o = IndicesQuery
645+ <$> o .:? "indices" .!= []
646+ <*> o .: "query"
647+ <*> o .:? "no_match_query"
648+
649+data HasParentQuery =
650+ HasParentQuery
651+ { hasParentQueryType :: TypeName
652+ , hasParentQuery :: Query
653+ , hasParentQueryScoreType :: Maybe ScoreType } deriving (Eq, Show)
654+
655+instance ToJSON HasParentQuery where
656+ toJSON (HasParentQuery queryType query scoreType) =
657+ omitNulls [ "parent_type" .= queryType
658+ , "score_type" .= scoreType
659+ , "query" .= query ]
660+
661+instance FromJSON HasParentQuery where
662+ parseJSON = withObject "HasParentQuery" parse
663+ where parse o = HasParentQuery
664+ <$> o .: "parent_type"
665+ <*> o .: "query"
666+ <*> o .:? "score_type"
667+
668+data HasChildQuery =
669+ HasChildQuery
670+ { hasChildQueryType :: TypeName
671+ , hasChildQuery :: Query
672+ , hasChildQueryScoreType :: Maybe ScoreType } deriving (Eq, Show)
673+
674+instance ToJSON HasChildQuery where
675+ toJSON (HasChildQuery queryType query scoreType) =
676+ omitNulls [ "query" .= query
677+ , "score_type" .= scoreType
678+ , "type" .= queryType ]
679+
680+instance FromJSON HasChildQuery where
681+ parseJSON = withObject "HasChildQuery" parse
682+ where parse o = HasChildQuery
683+ <$> o .: "type"
684+ <*> o .: "query"
685+ <*> o .:? "score_type"
686+
687+data ScoreType =
688+ ScoreTypeMax
689+ | ScoreTypeSum
690+ | ScoreTypeAvg
691+ | ScoreTypeNone deriving (Eq, Show)
692+
693+instance ToJSON ScoreType where
694+ toJSON ScoreTypeMax = "max"
695+ toJSON ScoreTypeAvg = "avg"
696+ toJSON ScoreTypeSum = "sum"
697+ toJSON ScoreTypeNone = "none"
698+
699+instance FromJSON ScoreType where
700+ parseJSON = withText "ScoreType" parse
701+ where parse "max" = pure ScoreTypeMax
702+ parse "avg" = pure ScoreTypeAvg
703+ parse "sum" = pure ScoreTypeSum
704+ parse "none" = pure ScoreTypeNone
705+ parse t = fail ("Unexpected ScoreType: " <> show t)
706+
707+data FuzzyQuery =
708+ FuzzyQuery { fuzzyQueryField :: FieldName
709+ , fuzzyQueryValue :: Text
710+ , fuzzyQueryPrefixLength :: PrefixLength
711+ , fuzzyQueryMaxExpansions :: MaxExpansions
712+ , fuzzyQueryFuzziness :: Fuzziness
713+ , fuzzyQueryBoost :: Maybe Boost
714+ } deriving (Eq, Show)
715+
716+
717+instance ToJSON FuzzyQuery where
718+ toJSON (FuzzyQuery (FieldName fieldName) queryText
719+ prefixLength maxEx fuzziness boost) =
720+ object [ fieldName .= omitNulls base ]
721+ where base = [ "value" .= queryText
722+ , "fuzziness" .= fuzziness
723+ , "prefix_length" .= prefixLength
724+ , "boost" .= boost
725+ , "max_expansions" .= maxEx ]
726+
727+instance FromJSON FuzzyQuery where
728+ parseJSON = withObject "FuzzyQuery" parse
729+ where parse = fieldTagged $ \fn o ->
730+ FuzzyQuery fn
731+ <$> o .: "value"
732+ <*> o .: "prefix_length"
733+ <*> o .: "max_expansions"
734+ <*> o .: "fuzziness"
735+ <*> o .:? "boost"
736+
737+data FuzzyLikeFieldQuery =
738+ FuzzyLikeFieldQuery
739+ { fuzzyLikeField :: FieldName
740+ -- anaphora is good for the soul.
741+ , fuzzyLikeFieldText :: Text
742+ , fuzzyLikeFieldMaxQueryTerms :: MaxQueryTerms
743+ , fuzzyLikeFieldIgnoreTermFrequency :: IgnoreTermFrequency
744+ , fuzzyLikeFieldFuzziness :: Fuzziness
745+ , fuzzyLikeFieldPrefixLength :: PrefixLength
746+ , fuzzyLikeFieldBoost :: Boost
747+ , fuzzyLikeFieldAnalyzer :: Maybe Analyzer
748+ } deriving (Eq, Show)
749+
750+
751+instance ToJSON FuzzyLikeFieldQuery where
752+ toJSON (FuzzyLikeFieldQuery (FieldName fieldName)
753+ fieldText maxTerms ignoreFreq fuzziness prefixLength
754+ boost analyzer) =
755+ object [ fieldName .=
756+ omitNulls [ "like_text" .= fieldText
757+ , "max_query_terms" .= maxTerms
758+ , "ignore_tf" .= ignoreFreq
759+ , "fuzziness" .= fuzziness
760+ , "prefix_length" .= prefixLength
761+ , "analyzer" .= analyzer
762+ , "boost" .= boost ]]
763+
764+instance FromJSON FuzzyLikeFieldQuery where
765+ parseJSON = withObject "FuzzyLikeFieldQuery" parse
766+ where parse = fieldTagged $ \fn o ->
767+ FuzzyLikeFieldQuery fn
768+ <$> o .: "like_text"
769+ <*> o .: "max_query_terms"
770+ <*> o .: "ignore_tf"
771+ <*> o .: "fuzziness"
772+ <*> o .: "prefix_length"
773+ <*> o .: "boost"
774+ <*> o .:? "analyzer"
775+
776+data FuzzyLikeThisQuery =
777+ FuzzyLikeThisQuery
778+ { fuzzyLikeFields :: [FieldName]
779+ , fuzzyLikeText :: Text
780+ , fuzzyLikeMaxQueryTerms :: MaxQueryTerms
781+ , fuzzyLikeIgnoreTermFrequency :: IgnoreTermFrequency
782+ , fuzzyLikeFuzziness :: Fuzziness
783+ , fuzzyLikePrefixLength :: PrefixLength
784+ , fuzzyLikeBoost :: Boost
785+ , fuzzyLikeAnalyzer :: Maybe Analyzer
786+ } deriving (Eq, Show)
787+
788+
789+instance ToJSON FuzzyLikeThisQuery where
790+ toJSON (FuzzyLikeThisQuery fields text maxTerms
791+ ignoreFreq fuzziness prefixLength boost analyzer) =
792+ omitNulls base
793+ where base = [ "fields" .= fields
794+ , "like_text" .= text
795+ , "max_query_terms" .= maxTerms
796+ , "ignore_tf" .= ignoreFreq
797+ , "fuzziness" .= fuzziness
798+ , "prefix_length" .= prefixLength
799+ , "analyzer" .= analyzer
800+ , "boost" .= boost ]
801+
802+instance FromJSON FuzzyLikeThisQuery where
803+ parseJSON = withObject "FuzzyLikeThisQuery" parse
804+ where parse o = FuzzyLikeThisQuery
805+ <$> o .:? "fields" .!= []
806+ <*> o .: "like_text"
807+ <*> o .: "max_query_terms"
808+ <*> o .: "ignore_tf"
809+ <*> o .: "fuzziness"
810+ <*> o .: "prefix_length"
811+ <*> o .: "boost"
812+ <*> o .:? "analyzer"
813+
814+data DisMaxQuery =
815+ DisMaxQuery { disMaxQueries :: [Query]
816+ -- default 0.0
817+ , disMaxTiebreaker :: Tiebreaker
818+ , disMaxBoost :: Maybe Boost
819+ } deriving (Eq, Show)
820+
821+
822+instance ToJSON DisMaxQuery where
823+ toJSON (DisMaxQuery queries tiebreaker boost) =
824+ omitNulls base
825+ where base = [ "queries" .= queries
826+ , "boost" .= boost
827+ , "tie_breaker" .= tiebreaker ]
828+
829+instance FromJSON DisMaxQuery where
830+ parseJSON = withObject "DisMaxQuery" parse
831+ where parse o = DisMaxQuery
832+ <$> o .:? "queries" .!= []
833+ <*> o .: "tie_breaker"
834+ <*> o .:? "boost"
835+
836+data MatchQuery = MatchQuery
837+ { matchQueryField :: FieldName
838+ , matchQueryQueryString :: QueryString
839+ , matchQueryOperator :: BooleanOperator
840+ , matchQueryZeroTerms :: ZeroTermsQuery
841+ , matchQueryCutoffFrequency :: Maybe CutoffFrequency
842+ , matchQueryMatchType :: Maybe MatchQueryType
843+ , matchQueryAnalyzer :: Maybe Analyzer
844+ , matchQueryMaxExpansions :: Maybe MaxExpansions
845+ , matchQueryLenient :: Maybe Lenient
846+ , matchQueryBoost :: Maybe Boost
847+ , matchQueryMinimumShouldMatch :: Maybe Text
848+ , matchQueryFuzziness :: Maybe Fuzziness
849+ } deriving (Eq, Show)
850+
851+
852+instance ToJSON MatchQuery where
853+ toJSON (MatchQuery (FieldName fieldName)
854+ (QueryString mqQueryString) booleanOperator
855+ zeroTermsQuery cutoffFrequency matchQueryType
856+ analyzer maxExpansions lenient boost
857+ minShouldMatch mqFuzziness
858+ ) =
859+ object [ fieldName .= omitNulls base ]
860+ where base = [ "query" .= mqQueryString
861+ , "operator" .= booleanOperator
862+ , "zero_terms_query" .= zeroTermsQuery
863+ , "cutoff_frequency" .= cutoffFrequency
864+ , "type" .= matchQueryType
865+ , "analyzer" .= analyzer
866+ , "max_expansions" .= maxExpansions
867+ , "lenient" .= lenient
868+ , "boost" .= boost
869+ , "minimum_should_match" .= minShouldMatch
870+ , "fuzziness" .= mqFuzziness
871+ ]
872+
873+instance FromJSON MatchQuery where
874+ parseJSON = withObject "MatchQuery" parse
875+ where parse = fieldTagged $ \fn o ->
876+ MatchQuery fn
877+ <$> o .: "query"
878+ <*> o .: "operator"
879+ <*> o .: "zero_terms_query"
880+ <*> o .:? "cutoff_frequency"
881+ <*> o .:? "type"
882+ <*> o .:? "analyzer"
883+ <*> o .:? "max_expansions"
884+ <*> o .:? "lenient"
885+ <*> o .:? "boost"
886+ <*> o .:? "minimum_should_match"
887+ <*> o .:? "fuzziness"
888+
889+{-| 'mkMatchQuery' is a convenience function that defaults the less common parameters,
890+ enabling you to provide only the 'FieldName' and 'QueryString' to make a 'MatchQuery'
891+-}
892+mkMatchQuery :: FieldName -> QueryString -> MatchQuery
893+mkMatchQuery field query = MatchQuery field query Or ZeroTermsNone Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing
894+
895+data MatchQueryType =
896+ MatchPhrase
897+ | MatchPhrasePrefix deriving (Eq, Show)
898+
899+instance ToJSON MatchQueryType where
900+ toJSON MatchPhrase = "phrase"
901+ toJSON MatchPhrasePrefix = "phrase_prefix"
902+
903+instance FromJSON MatchQueryType where
904+ parseJSON = withText "MatchQueryType" parse
905+ where parse "phrase" = pure MatchPhrase
906+ parse "phrase_prefix" = pure MatchPhrasePrefix
907+ parse t = fail ("Unexpected MatchQueryType: " <> show t)
908+
909+data MultiMatchQuery = MultiMatchQuery
910+ { multiMatchQueryFields :: [FieldName]
911+ , multiMatchQueryString :: QueryString
912+ , multiMatchQueryOperator :: BooleanOperator
913+ , multiMatchQueryZeroTerms :: ZeroTermsQuery
914+ , multiMatchQueryTiebreaker :: Maybe Tiebreaker
915+ , multiMatchQueryType :: Maybe MultiMatchQueryType
916+ , multiMatchQueryCutoffFrequency :: Maybe CutoffFrequency
917+ , multiMatchQueryAnalyzer :: Maybe Analyzer
918+ , multiMatchQueryMaxExpansions :: Maybe MaxExpansions
919+ , multiMatchQueryLenient :: Maybe Lenient
920+ } deriving (Eq, Show)
921+
922+instance ToJSON MultiMatchQuery where
923+ toJSON (MultiMatchQuery fields (QueryString query) boolOp
924+ ztQ tb mmqt cf analyzer maxEx lenient) =
925+ object ["multi_match" .= omitNulls base]
926+ where base = [ "fields" .= fmap toJSON fields
927+ , "query" .= query
928+ , "operator" .= boolOp
929+ , "zero_terms_query" .= ztQ
930+ , "tie_breaker" .= tb
931+ , "type" .= mmqt
932+ , "cutoff_frequency" .= cf
933+ , "analyzer" .= analyzer
934+ , "max_expansions" .= maxEx
935+ , "lenient" .= lenient ]
936+
937+instance FromJSON MultiMatchQuery where
938+ parseJSON = withObject "MultiMatchQuery" parse
939+ where parse raw = do o <- raw .: "multi_match"
940+ MultiMatchQuery
941+ <$> o .:? "fields" .!= []
942+ <*> o .: "query"
943+ <*> o .: "operator"
944+ <*> o .: "zero_terms_query"
945+ <*> o .:? "tie_breaker"
946+ <*> o .:? "type"
947+ <*> o .:? "cutoff_frequency"
948+ <*> o .:? "analyzer"
949+ <*> o .:? "max_expansions"
950+ <*> o .:? "lenient"
951+
952+{-| 'mkMultiMatchQuery' is a convenience function that defaults the less common parameters,
953+ enabling you to provide only the list of 'FieldName's and 'QueryString' to
954+ make a 'MultiMatchQuery'.
955+-}
956+
957+mkMultiMatchQuery :: [FieldName] -> QueryString -> MultiMatchQuery
958+mkMultiMatchQuery matchFields query =
959+ MultiMatchQuery matchFields query
960+ Or ZeroTermsNone Nothing Nothing Nothing Nothing Nothing Nothing
961+
962+data MultiMatchQueryType =
963+ MultiMatchBestFields
964+ | MultiMatchMostFields
965+ | MultiMatchCrossFields
966+ | MultiMatchPhrase
967+ | MultiMatchPhrasePrefix deriving (Eq, Show)
968+
969+instance ToJSON MultiMatchQueryType where
970+ toJSON MultiMatchBestFields = "best_fields"
971+ toJSON MultiMatchMostFields = "most_fields"
972+ toJSON MultiMatchCrossFields = "cross_fields"
973+ toJSON MultiMatchPhrase = "phrase"
974+ toJSON MultiMatchPhrasePrefix = "phrase_prefix"
975+
976+instance FromJSON MultiMatchQueryType where
977+ parseJSON = withText "MultiMatchPhrasePrefix" parse
978+ where parse "best_fields" = pure MultiMatchBestFields
979+ parse "most_fields" = pure MultiMatchMostFields
980+ parse "cross_fields" = pure MultiMatchCrossFields
981+ parse "phrase" = pure MultiMatchPhrase
982+ parse "phrase_prefix" = pure MultiMatchPhrasePrefix
983+ parse t = fail ("Unexpected MultiMatchPhrasePrefix: " <> show t)
984+
985+data BoolQuery =
986+ BoolQuery { boolQueryMustMatch :: [Query]
987+ , boolQueryFilter :: [Filter]
988+ , boolQueryMustNotMatch :: [Query]
989+ , boolQueryShouldMatch :: [Query]
990+ , boolQueryMinimumShouldMatch :: Maybe MinimumMatch
991+ , boolQueryBoost :: Maybe Boost
992+ , boolQueryDisableCoord :: Maybe DisableCoord
993+ } deriving (Eq, Show)
994+
995+
996+instance ToJSON BoolQuery where
997+ toJSON (BoolQuery mustM filterM' notM shouldM bqMin boost disableCoord) =
998+ omitNulls base
999+ where base = [ "must" .= mustM
1000+ , "filter" .= filterM'
1001+ , "must_not" .= notM
1002+ , "should" .= shouldM
1003+ , "minimum_should_match" .= bqMin
1004+ , "boost" .= boost
1005+ , "disable_coord" .= disableCoord ]
1006+
1007+instance FromJSON BoolQuery where
1008+ parseJSON = withObject "BoolQuery" parse
1009+ where parse o = BoolQuery
1010+ <$> o .:? "must" .!= []
1011+ <*> o .:? "filter" .!= []
1012+ <*> o .:? "must_not" .!= []
1013+ <*> o .:? "should" .!= []
1014+ <*> o .:? "minimum_should_match"
1015+ <*> o .:? "boost"
1016+ <*> o .:? "disable_coord"
1017+
1018+mkBoolQuery :: [Query] -> [Filter] -> [Query] -> [Query] -> BoolQuery
1019+mkBoolQuery must filt mustNot should =
1020+ BoolQuery must filt mustNot should Nothing Nothing Nothing
1021+
1022+data BoostingQuery =
1023+ BoostingQuery { positiveQuery :: Query
1024+ , negativeQuery :: Query
1025+ , negativeBoost :: Boost } deriving (Eq, Show)
1026+
1027+instance ToJSON BoostingQuery where
1028+ toJSON (BoostingQuery bqPositiveQuery bqNegativeQuery bqNegativeBoost) =
1029+ object [ "positive" .= bqPositiveQuery
1030+ , "negative" .= bqNegativeQuery
1031+ , "negative_boost" .= bqNegativeBoost ]
1032+
1033+instance FromJSON BoostingQuery where
1034+ parseJSON = withObject "BoostingQuery" parse
1035+ where parse o = BoostingQuery
1036+ <$> o .: "positive"
1037+ <*> o .: "negative"
1038+ <*> o .: "negative_boost"
1039+
1040+data CommonTermsQuery =
1041+ CommonTermsQuery { commonField :: FieldName
1042+ , commonQuery :: QueryString
1043+ , commonCutoffFrequency :: CutoffFrequency
1044+ , commonLowFreqOperator :: BooleanOperator
1045+ , commonHighFreqOperator :: BooleanOperator
1046+ , commonMinimumShouldMatch :: Maybe CommonMinimumMatch
1047+ , commonBoost :: Maybe Boost
1048+ , commonAnalyzer :: Maybe Analyzer
1049+ , commonDisableCoord :: Maybe DisableCoord
1050+ } deriving (Eq, Show)
1051+
1052+
1053+instance ToJSON CommonTermsQuery where
1054+ toJSON (CommonTermsQuery (FieldName fieldName)
1055+ (QueryString query) cf lfo hfo msm
1056+ boost analyzer disableCoord) =
1057+ object [fieldName .= omitNulls base ]
1058+ where base = [ "query" .= query
1059+ , "cutoff_frequency" .= cf
1060+ , "low_freq_operator" .= lfo
1061+ , "minimum_should_match" .= msm
1062+ , "boost" .= boost
1063+ , "analyzer" .= analyzer
1064+ , "disable_coord" .= disableCoord
1065+ , "high_freq_operator" .= hfo ]
1066+
1067+instance FromJSON CommonTermsQuery where
1068+ parseJSON = withObject "CommonTermsQuery" parse
1069+ where parse = fieldTagged $ \fn o ->
1070+ CommonTermsQuery fn
1071+ <$> o .: "query"
1072+ <*> o .: "cutoff_frequency"
1073+ <*> o .: "low_freq_operator"
1074+ <*> o .: "high_freq_operator"
1075+ <*> o .:? "minimum_should_match"
1076+ <*> o .:? "boost"
1077+ <*> o .:? "analyzer"
1078+ <*> o .:? "disable_coord"
1079+
1080+data CommonMinimumMatch =
1081+ CommonMinimumMatchHighLow MinimumMatchHighLow
1082+ | CommonMinimumMatch MinimumMatch
1083+ deriving (Eq, Show)
1084+
1085+
1086+instance ToJSON CommonMinimumMatch where
1087+ toJSON (CommonMinimumMatch mm) = toJSON mm
1088+ toJSON (CommonMinimumMatchHighLow (MinimumMatchHighLow lowF highF)) =
1089+ object [ "low_freq" .= lowF
1090+ , "high_freq" .= highF ]
1091+
1092+instance FromJSON CommonMinimumMatch where
1093+ parseJSON v = parseMinimum v
1094+ <|> parseMinimumHighLow v
1095+ where parseMinimum = fmap CommonMinimumMatch . parseJSON
1096+ parseMinimumHighLow = fmap CommonMinimumMatchHighLow . withObject "CommonMinimumMatchHighLow" (\o ->
1097+ MinimumMatchHighLow
1098+ <$> o .: "low_freq"
1099+ <*> o .: "high_freq")
1100+
1101+data MinimumMatchHighLow =
1102+ MinimumMatchHighLow { lowFreq :: MinimumMatch
1103+ , highFreq :: MinimumMatch } deriving (Eq, Show)
1104+
1105+data ZeroTermsQuery =
1106+ ZeroTermsNone
1107+ | ZeroTermsAll deriving (Eq, Show)
1108+
1109+instance ToJSON ZeroTermsQuery where
1110+ toJSON ZeroTermsNone = String "none"
1111+ toJSON ZeroTermsAll = String "all"
1112+
1113+instance FromJSON ZeroTermsQuery where
1114+ parseJSON = withText "ZeroTermsQuery" parse
1115+ where parse "none" = pure ZeroTermsNone
1116+ parse "all" = pure ZeroTermsAll
1117+ parse q = fail ("Unexpected ZeroTermsQuery: " <> show q)
1118+
1119+data RangeExecution = RangeExecutionIndex
1120+ | RangeExecutionFielddata deriving (Eq, Show)
1121+
1122+-- index for smaller ranges, fielddata for longer ranges
1123+instance ToJSON RangeExecution where
1124+ toJSON RangeExecutionIndex = "index"
1125+ toJSON RangeExecutionFielddata = "fielddata"
1126+
1127+
1128+instance FromJSON RangeExecution where
1129+ parseJSON = withText "RangeExecution" parse
1130+ where parse "index" = pure RangeExecutionIndex
1131+ parse "fielddata" = pure RangeExecutionFielddata
1132+ parse t = error ("Unrecognized RangeExecution " <> show t)
1133+
1134+newtype Regexp = Regexp Text deriving (Eq, Show, FromJSON)
1135+
1136+data RegexpFlags = AllRegexpFlags
1137+ | NoRegexpFlags
1138+ | SomeRegexpFlags (NonEmpty RegexpFlag) deriving (Eq, Show)
1139+
1140+instance ToJSON RegexpFlags where
1141+ toJSON AllRegexpFlags = String "ALL"
1142+ toJSON NoRegexpFlags = String "NONE"
1143+ toJSON (SomeRegexpFlags (h :| fs)) = String $ T.intercalate "|" flagStrs
1144+ where flagStrs = map flagStr . nub $ h:fs
1145+ flagStr AnyString = "ANYSTRING"
1146+ flagStr Automaton = "AUTOMATON"
1147+ flagStr Complement = "COMPLEMENT"
1148+ flagStr Empty = "EMPTY"
1149+ flagStr Intersection = "INTERSECTION"
1150+ flagStr Interval = "INTERVAL"
1151+
1152+instance FromJSON RegexpFlags where
1153+ parseJSON = withText "RegexpFlags" parse
1154+ where parse "ALL" = pure AllRegexpFlags
1155+ parse "NONE" = pure NoRegexpFlags
1156+ parse t = SomeRegexpFlags <$> parseNEJSON (String <$> T.splitOn "|" t)
1157+
1158+data RegexpFlag = AnyString
1159+ | Automaton
1160+ | Complement
1161+ | Empty
1162+ | Intersection
1163+ | Interval deriving (Eq, Show)
1164+
1165+instance FromJSON RegexpFlag where
1166+ parseJSON = withText "RegexpFlag" parse
1167+ where parse "ANYSTRING" = pure AnyString
1168+ parse "AUTOMATON" = pure Automaton
1169+ parse "COMPLEMENT" = pure Complement
1170+ parse "EMPTY" = pure Empty
1171+ parse "INTERSECTION" = pure Intersection
1172+ parse "INTERVAL" = pure Interval
1173+ parse f = fail ("Unknown RegexpFlag: " <> show f)
1174+
1175+newtype LessThan = LessThan Double deriving (Eq, Show)
1176+newtype LessThanEq = LessThanEq Double deriving (Eq, Show)
1177+newtype GreaterThan = GreaterThan Double deriving (Eq, Show)
1178+newtype GreaterThanEq = GreaterThanEq Double deriving (Eq, Show)
1179+
1180+newtype LessThanD = LessThanD UTCTime deriving (Eq, Show)
1181+newtype LessThanEqD = LessThanEqD UTCTime deriving (Eq, Show)
1182+newtype GreaterThanD = GreaterThanD UTCTime deriving (Eq, Show)
1183+newtype GreaterThanEqD = GreaterThanEqD UTCTime deriving (Eq, Show)
1184+
1185+data RangeValue = RangeDateLte LessThanEqD
1186+ | RangeDateLt LessThanD
1187+ | RangeDateGte GreaterThanEqD
1188+ | RangeDateGt GreaterThanD
1189+ | RangeDateGtLt GreaterThanD LessThanD
1190+ | RangeDateGteLte GreaterThanEqD LessThanEqD
1191+ | RangeDateGteLt GreaterThanEqD LessThanD
1192+ | RangeDateGtLte GreaterThanD LessThanEqD
1193+ | RangeDoubleLte LessThanEq
1194+ | RangeDoubleLt LessThan
1195+ | RangeDoubleGte GreaterThanEq
1196+ | RangeDoubleGt GreaterThan
1197+ | RangeDoubleGtLt GreaterThan LessThan
1198+ | RangeDoubleGteLte GreaterThanEq LessThanEq
1199+ | RangeDoubleGteLt GreaterThanEq LessThan
1200+ | RangeDoubleGtLte GreaterThan LessThanEq
1201+ deriving (Eq, Show)
1202+
1203+
1204+parseRangeValue :: ( FromJSON t4
1205+ , FromJSON t3
1206+ , FromJSON t2
1207+ , FromJSON t1
1208+ )
1209+ => (t3 -> t5)
1210+ -> (t1 -> t6)
1211+ -> (t4 -> t7)
1212+ -> (t2 -> t8)
1213+ -> (t5 -> t6 -> b)
1214+ -> (t7 -> t6 -> b)
1215+ -> (t5 -> t8 -> b)
1216+ -> (t7 -> t8 -> b)
1217+ -> (t5 -> b)
1218+ -> (t6 -> b)
1219+ -> (t7 -> b)
1220+ -> (t8 -> b)
1221+ -> Parser b
1222+ -> Object
1223+ -> Parser b
1224+parseRangeValue mkGt mkLt mkGte mkLte
1225+ fGtLt fGteLt fGtLte fGteLte
1226+ fGt fLt fGte fLte nada o = do
1227+ lt <- o .:? "lt"
1228+ lte <- o .:? "lte"
1229+ gt <- o .:? "gt"
1230+ gte <- o .:? "gte"
1231+ case (lt, lte, gt, gte) of
1232+ (Just a, _, Just b, _) ->
1233+ return (fGtLt (mkGt b) (mkLt a))
1234+ (Just a, _, _, Just b) ->
1235+ return (fGteLt (mkGte b) (mkLt a))
1236+ (_, Just a, Just b, _) ->
1237+ return (fGtLte (mkGt b) (mkLte a))
1238+ (_, Just a, _, Just b) ->
1239+ return (fGteLte (mkGte b) (mkLte a))
1240+ (_, _, Just a, _) ->
1241+ return (fGt (mkGt a))
1242+ (Just a, _, _, _) ->
1243+ return (fLt (mkLt a))
1244+ (_, _, _, Just a) ->
1245+ return (fGte (mkGte a))
1246+ (_, Just a, _, _) ->
1247+ return (fLte (mkLte a))
1248+ (Nothing, Nothing, Nothing, Nothing) ->
1249+ nada
1250+
1251+
1252+instance FromJSON RangeValue where
1253+ parseJSON = withObject "RangeValue" parse
1254+ where parse o = parseDate o
1255+ <|> parseDouble o
1256+ parseDate o =
1257+ parseRangeValue
1258+ GreaterThanD LessThanD
1259+ GreaterThanEqD LessThanEqD
1260+ RangeDateGtLt RangeDateGteLt
1261+ RangeDateGtLte RangeDateGteLte
1262+ RangeDateGt RangeDateLt
1263+ RangeDateGte RangeDateLte
1264+ mzero o
1265+ parseDouble o =
1266+ parseRangeValue
1267+ GreaterThan LessThan
1268+ GreaterThanEq LessThanEq
1269+ RangeDoubleGtLt RangeDoubleGteLt
1270+ RangeDoubleGtLte RangeDoubleGteLte
1271+ RangeDoubleGt RangeDoubleLt
1272+ RangeDoubleGte RangeDoubleLte
1273+ mzero o
1274+
1275+rangeValueToPair :: RangeValue -> [Pair]
1276+rangeValueToPair rv = case rv of
1277+ RangeDateLte (LessThanEqD t) -> ["lte" .= t]
1278+ RangeDateGte (GreaterThanEqD t) -> ["gte" .= t]
1279+ RangeDateLt (LessThanD t) -> ["lt" .= t]
1280+ RangeDateGt (GreaterThanD t) -> ["gt" .= t]
1281+ RangeDateGteLte (GreaterThanEqD l) (LessThanEqD g) -> ["gte" .= l, "lte" .= g]
1282+ RangeDateGtLte (GreaterThanD l) (LessThanEqD g) -> ["gt" .= l, "lte" .= g]
1283+ RangeDateGteLt (GreaterThanEqD l) (LessThanD g) -> ["gte" .= l, "lt" .= g]
1284+ RangeDateGtLt (GreaterThanD l) (LessThanD g) -> ["gt" .= l, "lt" .= g]
1285+ RangeDoubleLte (LessThanEq t) -> ["lte" .= t]
1286+ RangeDoubleGte (GreaterThanEq t) -> ["gte" .= t]
1287+ RangeDoubleLt (LessThan t) -> ["lt" .= t]
1288+ RangeDoubleGt (GreaterThan t) -> ["gt" .= t]
1289+ RangeDoubleGteLte (GreaterThanEq l) (LessThanEq g) -> ["gte" .= l, "lte" .= g]
1290+ RangeDoubleGtLte (GreaterThan l) (LessThanEq g) -> ["gt" .= l, "lte" .= g]
1291+ RangeDoubleGteLt (GreaterThanEq l) (LessThan g) -> ["gte" .= l, "lt" .= g]
1292+ RangeDoubleGtLt (GreaterThan l) (LessThan g) -> ["gt" .= l, "lt" .= g]
1293+
1294+data Term = Term { termField :: Text
1295+ , termValue :: Text } deriving (Eq, Show)
1296+
1297+instance ToJSON Term where
1298+ toJSON (Term field value) = object ["term" .= object
1299+ [field .= value]]
1300+
1301+instance FromJSON Term where
1302+ parseJSON = withObject "Term" parse
1303+ where parse o = do termObj <- o .: "term"
1304+ case HM.toList termObj of
1305+ [(fn, v)] -> Term fn <$> parseJSON v
1306+ _ -> fail "Expected object with 1 field-named key"
1307+
1308+data BoolMatch = MustMatch Term Cache
1309+ | MustNotMatch Term Cache
1310+ | ShouldMatch [Term] Cache deriving (Eq, Show)
1311+
1312+
1313+instance ToJSON BoolMatch where
1314+ toJSON (MustMatch term cache) = object ["must" .= term,
1315+ "_cache" .= cache]
1316+ toJSON (MustNotMatch term cache) = object ["must_not" .= term,
1317+ "_cache" .= cache]
1318+ toJSON (ShouldMatch terms cache) = object ["should" .= fmap toJSON terms,
1319+ "_cache" .= cache]
1320+
1321+instance FromJSON BoolMatch where
1322+ parseJSON = withObject "BoolMatch" parse
1323+ where parse o = mustMatch `taggedWith` "must"
1324+ <|> mustNotMatch `taggedWith` "must_not"
1325+ <|> shouldMatch `taggedWith` "should"
1326+ where taggedWith parser k = parser =<< o .: k
1327+ mustMatch t = MustMatch t <$> o .:? "_cache" .!= defaultCache
1328+ mustNotMatch t = MustNotMatch t <$> o .:? "_cache" .!= defaultCache
1329+ shouldMatch t = ShouldMatch t <$> o .:? "_cache" .!= defaultCache
1330+
1331+-- "memory" or "indexed"
1332+data GeoFilterType = GeoFilterMemory
1333+ | GeoFilterIndexed deriving (Eq, Show)
1334+
1335+instance ToJSON GeoFilterType where
1336+ toJSON GeoFilterMemory = String "memory"
1337+ toJSON GeoFilterIndexed = String "indexed"
1338+
1339+instance FromJSON GeoFilterType where
1340+ parseJSON = withText "GeoFilterType" parse
1341+ where parse "memory" = pure GeoFilterMemory
1342+ parse "indexed" = pure GeoFilterIndexed
1343+ parse t = fail ("Unrecognized GeoFilterType: " <> show t)
1344+
1345+data LatLon = LatLon { lat :: Double
1346+ , lon :: Double } deriving (Eq, Show)
1347+
1348+instance ToJSON LatLon where
1349+ toJSON (LatLon lLat lLon) =
1350+ object ["lat" .= lLat
1351+ , "lon" .= lLon]
1352+
1353+instance FromJSON LatLon where
1354+ parseJSON = withObject "LatLon" parse
1355+ where parse o = LatLon <$> o .: "lat"
1356+ <*> o .: "lon"
1357+
1358+data GeoBoundingBox =
1359+ GeoBoundingBox { topLeft :: LatLon
1360+ , bottomRight :: LatLon } deriving (Eq, Show)
1361+
1362+instance ToJSON GeoBoundingBox where
1363+ toJSON (GeoBoundingBox gbbTopLeft gbbBottomRight) =
1364+ object ["top_left" .= gbbTopLeft
1365+ , "bottom_right" .= gbbBottomRight]
1366+
1367+instance FromJSON GeoBoundingBox where
1368+ parseJSON = withObject "GeoBoundingBox" parse
1369+ where parse o = GeoBoundingBox
1370+ <$> o .: "top_left"
1371+ <*> o .: "bottom_right"
1372+
1373+data GeoBoundingBoxConstraint =
1374+ GeoBoundingBoxConstraint { geoBBField :: FieldName
1375+ , constraintBox :: GeoBoundingBox
1376+ , bbConstraintcache :: Cache
1377+ , geoType :: GeoFilterType
1378+ } deriving (Eq, Show)
1379+
1380+instance ToJSON GeoBoundingBoxConstraint where
1381+ toJSON (GeoBoundingBoxConstraint
1382+ (FieldName gbbcGeoBBField) gbbcConstraintBox cache type') =
1383+ object [gbbcGeoBBField .= gbbcConstraintBox
1384+ , "_cache" .= cache
1385+ , "type" .= type']
1386+
1387+instance FromJSON GeoBoundingBoxConstraint where
1388+ parseJSON = withObject "GeoBoundingBoxConstraint" parse
1389+ where parse o = case HM.toList (deleteSeveral ["type", "_cache"] o) of
1390+ [(fn, v)] -> GeoBoundingBoxConstraint (FieldName fn)
1391+ <$> parseJSON v
1392+ <*> o .:? "_cache" .!= defaultCache
1393+ <*> o .: "type"
1394+ _ -> fail "Could not find field name for GeoBoundingBoxConstraint"
1395+
1396+data GeoPoint =
1397+ GeoPoint { geoField :: FieldName
1398+ , latLon :: LatLon} deriving (Eq, Show)
1399+
1400+instance ToJSON GeoPoint where
1401+ toJSON (GeoPoint (FieldName geoPointField) geoPointLatLon) =
1402+ object [ geoPointField .= geoPointLatLon ]
1403+
1404+data DistanceUnit = Miles
1405+ | Yards
1406+ | Feet
1407+ | Inches
1408+ | Kilometers
1409+ | Meters
1410+ | Centimeters
1411+ | Millimeters
1412+ | NauticalMiles deriving (Eq, Show)
1413+
1414+instance ToJSON DistanceUnit where
1415+ toJSON Miles = String "mi"
1416+ toJSON Yards = String "yd"
1417+ toJSON Feet = String "ft"
1418+ toJSON Inches = String "in"
1419+ toJSON Kilometers = String "km"
1420+ toJSON Meters = String "m"
1421+ toJSON Centimeters = String "cm"
1422+ toJSON Millimeters = String "mm"
1423+ toJSON NauticalMiles = String "nmi"
1424+
1425+instance FromJSON DistanceUnit where
1426+ parseJSON = withText "DistanceUnit" parse
1427+ where parse "mi" = pure Miles
1428+ parse "yd" = pure Yards
1429+ parse "ft" = pure Feet
1430+ parse "in" = pure Inches
1431+ parse "km" = pure Kilometers
1432+ parse "m" = pure Meters
1433+ parse "cm" = pure Centimeters
1434+ parse "mm" = pure Millimeters
1435+ parse "nmi" = pure NauticalMiles
1436+ parse u = fail ("Unrecognized DistanceUnit: " <> show u)
1437+
1438+data DistanceType = Arc
1439+ | SloppyArc -- doesn't exist <1.0
1440+ | Plane deriving (Eq, Show)
1441+
1442+instance ToJSON DistanceType where
1443+ toJSON Arc = String "arc"
1444+ toJSON SloppyArc = String "sloppy_arc"
1445+ toJSON Plane = String "plane"
1446+
1447+instance FromJSON DistanceType where
1448+ parseJSON = withText "DistanceType" parse
1449+ where parse "arc" = pure Arc
1450+ parse "sloppy_arc" = pure SloppyArc
1451+ parse "plane" = pure Plane
1452+ parse t = fail ("Unrecognized DistanceType: " <> show t)
1453+
1454+data OptimizeBbox = OptimizeGeoFilterType GeoFilterType
1455+ | NoOptimizeBbox deriving (Eq, Show)
1456+
1457+
1458+instance ToJSON OptimizeBbox where
1459+ toJSON NoOptimizeBbox = String "none"
1460+ toJSON (OptimizeGeoFilterType gft) = toJSON gft
1461+
1462+instance FromJSON OptimizeBbox where
1463+ parseJSON v = withText "NoOptimizeBbox" parseNoOptimize v
1464+ <|> parseOptimize v
1465+ where parseNoOptimize "none" = pure NoOptimizeBbox
1466+ parseNoOptimize _ = mzero
1467+ parseOptimize = fmap OptimizeGeoFilterType . parseJSON
1468+
1469+data Distance =
1470+ Distance { coefficient :: Double
1471+ , unit :: DistanceUnit } deriving (Eq, Show)
1472+
1473+
1474+instance ToJSON Distance where
1475+ toJSON (Distance dCoefficient dUnit) =
1476+ String boltedTogether where
1477+ coefText = showText dCoefficient
1478+ (String unitText) = toJSON dUnit
1479+ boltedTogether = mappend coefText unitText
1480+
1481+instance FromJSON Distance where
1482+ parseJSON = withText "Distance" parse
1483+ where parse t = Distance <$> parseCoeff nT
1484+ <*> parseJSON (String unitT)
1485+ where (nT, unitT) = T.span validForNumber t
1486+ -- may be a better way to do this
1487+ validForNumber '-' = True
1488+ validForNumber '.' = True
1489+ validForNumber 'e' = True
1490+ validForNumber c = isNumber c
1491+ parseCoeff "" = fail "Empty string cannot be parsed as number"
1492+ parseCoeff s = return (read (T.unpack s))
1493+
1494+data DistanceRange =
1495+ DistanceRange { distanceFrom :: Distance
1496+ , distanceTo :: Distance } deriving (Eq, Show)
1497+
1498+type TemplateQueryKey = Text
1499+type TemplateQueryValue = Text
1500+
1501+newtype TemplateQueryKeyValuePairs =
1502+ TemplateQueryKeyValuePairs (HM.HashMap TemplateQueryKey TemplateQueryValue)
1503+ deriving (Eq, Show)
1504+
1505+instance ToJSON TemplateQueryKeyValuePairs where
1506+ toJSON (TemplateQueryKeyValuePairs x) =
1507+ Object $ HM.map toJSON x
1508+
1509+instance FromJSON TemplateQueryKeyValuePairs where
1510+ parseJSON (Object o) =
1511+ pure . TemplateQueryKeyValuePairs $ HM.mapMaybe getValue o
1512+ where getValue (String x) = Just x
1513+ getValue _ = Nothing
1514+ parseJSON _ =
1515+ fail "error parsing TemplateQueryKeyValuePairs"
1516+
1517+data TemplateQueryInline =
1518+ TemplateQueryInline { inline :: Query
1519+ , params :: TemplateQueryKeyValuePairs
1520+ }
1521+ deriving (Eq, Show)
1522+
1523+instance ToJSON TemplateQueryInline where
1524+ toJSON TemplateQueryInline{..} = object [ "inline" .= inline
1525+ , "params" .= params
1526+ ]
1527+
1528+instance FromJSON TemplateQueryInline where
1529+ parseJSON = withObject "TemplateQueryInline" parse
1530+ where parse o = TemplateQueryInline
1531+ <$> o .: "inline"
1532+ <*> o .: "params"
1533+
1534+{-| 'BooleanOperator' is the usual And/Or operators with an ES compatible
1535+ JSON encoding baked in. Used all over the place.
1536+-}
1537+data BooleanOperator = And | Or deriving (Eq, Show)
1538+
1539+instance ToJSON BooleanOperator where
1540+ toJSON And = String "and"
1541+ toJSON Or = String "or"
1542+
1543+instance FromJSON BooleanOperator where
1544+ parseJSON = withText "BooleanOperator" parse
1545+ where parse "and" = pure And
1546+ parse "or" = pure Or
1547+ parse o = fail ("Unexpected BooleanOperator: " <> show o)
1548+
1549+{-| 'Cache' is for telling ES whether it should cache a 'Filter' not.
1550+ 'Query's cannot be cached.
1551+-}
1552+type Cache = Bool -- caching on/off
1553+defaultCache :: Cache
1554+defaultCache = False
1555+
1556+
1557+data FunctionScoreQuery =
1558+ FunctionScoreQuery { functionScoreQuery :: Maybe Query
1559+ , functionScoreBoost :: Maybe Boost
1560+ , functionScoreFunctions :: FunctionScoreFunctions
1561+ , functionScoreMaxBoost :: Maybe Boost
1562+ , functionScoreBoostMode :: Maybe BoostMode
1563+ , functionScoreMinScore :: Score
1564+ , functionScoreScoreMode :: Maybe ScoreMode
1565+ } deriving (Eq, Show)
1566+
1567+instance ToJSON FunctionScoreQuery where
1568+ toJSON (FunctionScoreQuery query boost fns maxBoost boostMode minScore scoreMode) =
1569+ omitNulls base
1570+ where base = functionScoreFunctionsPair fns :
1571+ [ "query" .= query
1572+ , "boost" .= boost
1573+ , "max_boost" .= maxBoost
1574+ , "boost_mode" .= boostMode
1575+ , "min_score" .= minScore
1576+ , "score_mode" .= scoreMode ]
1577+
1578+instance FromJSON FunctionScoreQuery where
1579+ parseJSON = withObject "FunctionScoreQuery" parse
1580+ where parse o = FunctionScoreQuery
1581+ <$> o .:? "query"
1582+ <*> o .:? "boost"
1583+ <*> (singleFunction o
1584+ <|> multipleFunctions `taggedWith` "functions")
1585+ <*> o .:? "max_boost"
1586+ <*> o .:? "boost_mode"
1587+ <*> o .:? "min_score"
1588+ <*> o .:? "score_mode"
1589+ where taggedWith parser k = parser =<< o .: k
1590+ singleFunction = fmap FunctionScoreSingle . parseFunctionScoreFunction
1591+ multipleFunctions = pure . FunctionScoreMultiple
1592+
1593+data FunctionScoreFunctions =
1594+ FunctionScoreSingle FunctionScoreFunction
1595+ | FunctionScoreMultiple (NonEmpty ComponentFunctionScoreFunction) deriving (Eq, Show)
1596+
1597+data ComponentFunctionScoreFunction =
1598+ ComponentFunctionScoreFunction { componentScoreFunctionFilter :: Maybe Filter
1599+ , componentScoreFunction :: FunctionScoreFunction
1600+ , componentScoreFunctionWeight :: Maybe Weight
1601+ } deriving (Eq, Show)
1602+
1603+instance ToJSON ComponentFunctionScoreFunction where
1604+ toJSON (ComponentFunctionScoreFunction filter' fn weight) =
1605+ omitNulls base
1606+ where base = functionScoreFunctionPair fn :
1607+ [ "filter" .= filter'
1608+ , "weight" .= weight ]
1609+
1610+instance FromJSON ComponentFunctionScoreFunction where
1611+ parseJSON = withObject "ComponentFunctionScoreFunction" parse
1612+ where parse o = ComponentFunctionScoreFunction
1613+ <$> o .:? "filter"
1614+ <*> parseFunctionScoreFunction o
1615+ <*> o .:? "weight"
1616+
1617+functionScoreFunctionsPair :: FunctionScoreFunctions -> (Text, Value)
1618+functionScoreFunctionsPair (FunctionScoreSingle fn)
1619+ = functionScoreFunctionPair fn
1620+functionScoreFunctionsPair (FunctionScoreMultiple componentFns) =
1621+ ("functions", toJSON componentFns)
1622+
1623+fieldTagged :: Monad m => (FieldName -> Object -> m a) -> Object -> m a
1624+fieldTagged f o = case HM.toList o of
1625+ [(k, Object o')] -> f (FieldName k) o'
1626+ _ -> fail "Expected object with 1 field-named key"
1627+
1628+-- | Fuzziness value as a number or 'AUTO'.
1629+-- See:
1630+-- https://www.elastic.co/guide/en/elasticsearch/reference/current/common-options.html#fuzziness
1631+data Fuzziness = Fuzziness Double | FuzzinessAuto
1632+ deriving (Eq, Show)
1633+
1634+instance ToJSON Fuzziness where
1635+ toJSON (Fuzziness n) = toJSON n
1636+ toJSON FuzzinessAuto = String "AUTO"
1637+
1638+instance FromJSON Fuzziness where
1639+ parseJSON (String "AUTO") = return FuzzinessAuto
1640+ parseJSON v = Fuzziness <$> parseJSON v
src/Database/Bloodhound/Internal/Sort.hsnew file+107
@@ -0,0 +1,107 @@
1+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
2+{-# LANGUAGE OverloadedStrings #-}
3+{-# LANGUAGE RecordWildCards #-}
4+
5+module Database.Bloodhound.Internal.Sort where
6+
7+import Bloodhound.Import
8+
9+import Database.Bloodhound.Internal.Newtypes
10+import Database.Bloodhound.Internal.Query
11+
12+{-| 'SortMode' prescribes how to handle sorting array/multi-valued fields.
13+
14+http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/search-request-sort.html#_sort_mode_option
15+-}
16+data SortMode = SortMin
17+ | SortMax
18+ | SortSum
19+ | SortAvg deriving (Eq, Show)
20+
21+instance ToJSON SortMode where
22+ toJSON SortMin = String "min"
23+ toJSON SortMax = String "max"
24+ toJSON SortSum = String "sum"
25+ toJSON SortAvg = String "avg"
26+
27+{-| 'mkSort' defaults everything but the 'FieldName' and the 'SortOrder' so
28+ that you can concisely describe the usual kind of 'SortSpec's you want.
29+-}
30+mkSort :: FieldName -> SortOrder -> DefaultSort
31+mkSort fieldName sOrder = DefaultSort fieldName sOrder Nothing Nothing Nothing Nothing
32+
33+{-| 'Sort' is a synonym for a list of 'SortSpec's. Sort behavior is order
34+ dependent with later sorts acting as tie-breakers for earlier sorts.
35+-}
36+type Sort = [SortSpec]
37+
38+{-| The two main kinds of 'SortSpec' are 'DefaultSortSpec' and
39+ 'GeoDistanceSortSpec'. The latter takes a 'SortOrder', 'GeoPoint', and
40+ 'DistanceUnit' to express "nearness" to a single geographical point as a
41+ sort specification.
42+
43+<http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/search-request-sort.html#search-request-sort>
44+-}
45+data SortSpec =
46+ DefaultSortSpec DefaultSort
47+ | GeoDistanceSortSpec SortOrder GeoPoint DistanceUnit
48+ deriving (Eq, Show)
49+
50+instance ToJSON SortSpec where
51+ toJSON (DefaultSortSpec
52+ (DefaultSort (FieldName dsSortFieldName) dsSortOrder dsIgnoreUnmapped
53+ dsSortMode dsMissingSort dsNestedFilter)) =
54+ object [dsSortFieldName .= omitNulls base] where
55+ base = [ "order" .= dsSortOrder
56+ , "unmapped_type" .= dsIgnoreUnmapped
57+ , "mode" .= dsSortMode
58+ , "missing" .= dsMissingSort
59+ , "nested_filter" .= dsNestedFilter ]
60+
61+ toJSON (GeoDistanceSortSpec gdsSortOrder (GeoPoint (FieldName field) gdsLatLon) units) =
62+ object [ "unit" .= units
63+ , field .= gdsLatLon
64+ , "order" .= gdsSortOrder ]
65+
66+{-| 'DefaultSort' is usually the kind of 'SortSpec' you'll want. There's a
67+ 'mkSort' convenience function for when you want to specify only the most
68+ common parameters.
69+
70+ The `ignoreUnmapped`, when `Just` field is used to set the elastic 'unmapped_type'
71+
72+<http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/search-request-sort.html#search-request-sort>
73+-}
74+data DefaultSort =
75+ DefaultSort { sortFieldName :: FieldName
76+ , sortOrder :: SortOrder
77+ -- default False
78+ , ignoreUnmapped :: Maybe Text
79+ , sortMode :: Maybe SortMode
80+ , missingSort :: Maybe Missing
81+ , nestedFilter :: Maybe Filter } deriving (Eq, Show)
82+
83+{-| 'SortOrder' is 'Ascending' or 'Descending', as you might expect. These get
84+ encoded into "asc" or "desc" when turned into JSON.
85+
86+<http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/search-request-sort.html#search-request-sort>
87+-}
88+data SortOrder = Ascending
89+ | Descending deriving (Eq, Show)
90+
91+instance ToJSON SortOrder where
92+ toJSON Ascending = String "asc"
93+ toJSON Descending = String "desc"
94+
95+{-| 'Missing' prescribes how to handle missing fields. A missing field can be
96+ sorted last, first, or using a custom value as a substitute.
97+
98+<http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/search-request-sort.html#_missing_values>
99+-}
100+data Missing = LastMissing
101+ | FirstMissing
102+ | CustomMissing Text deriving (Eq, Show)
103+
104+instance ToJSON Missing where
105+ toJSON LastMissing = String "_last"
106+ toJSON FirstMissing = String "_first"
107+ toJSON (CustomMissing txt) = String txt
src/Database/Bloodhound/Internal/StringlyTyped.hsnew file+51
@@ -0,0 +1,51 @@
1+{-# LANGUAGE OverloadedStrings #-}
2+
3+module Database.Bloodhound.Internal.StringlyTyped where
4+
5+import Bloodhound.Import
6+
7+import qualified Data.Text as T
8+
9+
10+-- This whole module is a sin bucket to deal with Elasticsearch badness.
11+newtype StringlyTypedDouble = StringlyTypedDouble
12+ { unStringlyTypedDouble :: Double }
13+
14+instance FromJSON StringlyTypedDouble where
15+ parseJSON =
16+ fmap StringlyTypedDouble
17+ . parseJSON
18+ . unStringlyTypeJSON
19+
20+newtype StringlyTypedInt = StringlyTypedInt
21+ { unStringlyTypedInt :: Int }
22+
23+instance FromJSON StringlyTypedInt where
24+ parseJSON =
25+ fmap StringlyTypedInt
26+ . parseJSON
27+ . unStringlyTypeJSON
28+
29+newtype StringlyTypedBool = StringlyTypedBool { unStringlyTypedBool :: Bool }
30+
31+instance FromJSON StringlyTypedBool where
32+ parseJSON =
33+ fmap StringlyTypedBool
34+ . parseJSON
35+ . unStringlyTypeJSON
36+
37+-- | For some reason in several settings APIs, all leaf values get returned
38+-- as strings. This function attempts to recover from this for all
39+-- non-recursive JSON types. If nothing can be done, the value is left alone.
40+unStringlyTypeJSON :: Value -> Value
41+unStringlyTypeJSON (String "true") =
42+ Bool True
43+unStringlyTypeJSON (String "false") =
44+ Bool False
45+unStringlyTypeJSON (String "null") =
46+ Null
47+unStringlyTypeJSON v@(String t) =
48+ case readMay (T.unpack t) of
49+ Just n -> Number n
50+ Nothing -> v
51+unStringlyTypeJSON v = v
src/Database/Bloodhound/Internal/Suggest.hsnew file+270
@@ -0,0 +1,270 @@
1+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
2+{-# LANGUAGE RecordWildCards #-}
3+{-# LANGUAGE OverloadedStrings #-}
4+
5+module Database.Bloodhound.Internal.Suggest where
6+
7+import Bloodhound.Import
8+
9+import qualified Data.HashMap.Strict as HM
10+
11+import Database.Bloodhound.Internal.Newtypes
12+import Database.Bloodhound.Internal.Query (TemplateQueryInline(..), params)
13+
14+data Suggest = Suggest
15+ { suggestText :: Text
16+ , suggestName :: Text
17+ , suggestType :: SuggestType
18+ } deriving (Eq, Show)
19+
20+instance ToJSON Suggest where
21+ toJSON Suggest{..} =
22+ object [ "text" .= suggestText
23+ , suggestName .= suggestType
24+ ]
25+
26+instance FromJSON Suggest where
27+ parseJSON (Object o) = do
28+ suggestText' <- o .: "text"
29+ let dropTextList =
30+ HM.toList
31+ $ HM.filterWithKey (\x _ -> x /= "text") o
32+ suggestName' <-
33+ case dropTextList of
34+ [(x, _)] -> return x
35+ _ -> fail "error parsing Suggest field name"
36+ suggestType' <- o .: suggestName'
37+ return $ Suggest suggestText' suggestName' suggestType'
38+ parseJSON x = typeMismatch "Suggest" x
39+
40+data SuggestType =
41+ SuggestTypePhraseSuggester PhraseSuggester
42+ deriving (Eq, Show)
43+
44+instance ToJSON SuggestType where
45+ toJSON (SuggestTypePhraseSuggester x) =
46+ object [ "phrase" .= x ]
47+
48+instance FromJSON SuggestType where
49+ parseJSON = withObject "SuggestType" parse
50+ where parse o = phraseSuggester `taggedWith` "phrase"
51+ where taggedWith parser k = parser =<< o .: k
52+ phraseSuggester = pure . SuggestTypePhraseSuggester
53+
54+data PhraseSuggester = PhraseSuggester
55+ { phraseSuggesterField :: FieldName
56+ , phraseSuggesterGramSize :: Maybe Int
57+ , phraseSuggesterRealWordErrorLikelihood :: Maybe Int
58+ , phraseSuggesterConfidence :: Maybe Int
59+ , phraseSuggesterMaxErrors :: Maybe Int
60+ , phraseSuggesterSeparator :: Maybe Text
61+ , phraseSuggesterSize :: Maybe Size
62+ , phraseSuggesterAnalyzer :: Maybe Analyzer
63+ , phraseSuggesterShardSize :: Maybe Int
64+ , phraseSuggesterHighlight :: Maybe PhraseSuggesterHighlighter
65+ , phraseSuggesterCollate :: Maybe PhraseSuggesterCollate
66+ , phraseSuggesterCandidateGenerators :: [DirectGenerators]
67+ } deriving (Eq, Show)
68+
69+instance ToJSON PhraseSuggester where
70+ toJSON PhraseSuggester{..} =
71+ omitNulls [ "field" .= phraseSuggesterField
72+ , "gram_size" .= phraseSuggesterGramSize
73+ , "real_word_error_likelihood" .=
74+ phraseSuggesterRealWordErrorLikelihood
75+ , "confidence" .= phraseSuggesterConfidence
76+ , "max_errors" .= phraseSuggesterMaxErrors
77+ , "separator" .= phraseSuggesterSeparator
78+ , "size" .= phraseSuggesterSize
79+ , "analyzer" .= phraseSuggesterAnalyzer
80+ , "shard_size" .= phraseSuggesterShardSize
81+ , "highlight" .= phraseSuggesterHighlight
82+ , "collate" .= phraseSuggesterCollate
83+ , "direct_generator" .=
84+ phraseSuggesterCandidateGenerators
85+ ]
86+
87+instance FromJSON PhraseSuggester where
88+ parseJSON = withObject "PhraseSuggester" parse
89+ where parse o = PhraseSuggester
90+ <$> o .: "field"
91+ <*> o .:? "gram_size"
92+ <*> o .:? "real_word_error_likelihood"
93+ <*> o .:? "confidence"
94+ <*> o .:? "max_errors"
95+ <*> o .:? "separator"
96+ <*> o .:? "size"
97+ <*> o .:? "analyzer"
98+ <*> o .:? "shard_size"
99+ <*> o .:? "highlight"
100+ <*> o .:? "collate"
101+ <*> o .:? "direct_generator" .!= []
102+
103+mkPhraseSuggester :: FieldName -> PhraseSuggester
104+mkPhraseSuggester fName =
105+ PhraseSuggester fName Nothing Nothing Nothing Nothing Nothing Nothing
106+ Nothing Nothing Nothing Nothing []
107+
108+data PhraseSuggesterHighlighter =
109+ PhraseSuggesterHighlighter { phraseSuggesterHighlighterPreTag :: Text
110+ , phraseSuggesterHighlighterPostTag :: Text
111+ }
112+ deriving (Eq, Show)
113+
114+instance ToJSON PhraseSuggesterHighlighter where
115+ toJSON PhraseSuggesterHighlighter{..} =
116+ object [ "pre_tag" .= phraseSuggesterHighlighterPreTag
117+ , "post_tag" .= phraseSuggesterHighlighterPostTag
118+ ]
119+
120+instance FromJSON PhraseSuggesterHighlighter where
121+ parseJSON = withObject "PhraseSuggesterHighlighter" parse
122+ where parse o = PhraseSuggesterHighlighter
123+ <$> o .: "pre_tag"
124+ <*> o .: "post_tag"
125+
126+data PhraseSuggesterCollate = PhraseSuggesterCollate
127+ { phraseSuggesterCollateTemplateQuery :: TemplateQueryInline
128+ , phraseSuggesterCollatePrune :: Bool
129+ } deriving (Eq, Show)
130+
131+instance ToJSON PhraseSuggesterCollate where
132+ toJSON PhraseSuggesterCollate{..} =
133+ object [ "query" .= object
134+ [ "inline" .= (inline phraseSuggesterCollateTemplateQuery)
135+ ]
136+ , "params" .= (params phraseSuggesterCollateTemplateQuery)
137+ , "prune" .= phraseSuggesterCollatePrune
138+ ]
139+
140+instance FromJSON PhraseSuggesterCollate where
141+ parseJSON (Object o) = do
142+ query' <- o .: "query"
143+ inline' <- query' .: "inline"
144+ params' <- o .: "params"
145+ prune' <- o .:? "prune" .!= False
146+ return $ PhraseSuggesterCollate
147+ (TemplateQueryInline inline' params') prune'
148+ parseJSON x = typeMismatch "PhraseSuggesterCollate" x
149+
150+data SuggestOptions =
151+ SuggestOptions { suggestOptionsText :: Text
152+ , suggestOptionsScore :: Double
153+ , suggestOptionsFreq :: Maybe Int
154+ , suggestOptionsHighlighted :: Maybe Text
155+ }
156+ deriving (Eq, Read, Show)
157+
158+instance FromJSON SuggestOptions where
159+ parseJSON = withObject "SuggestOptions" parse
160+ where
161+ parse o = SuggestOptions
162+ <$> o .: "text"
163+ <*> o .: "score"
164+ <*> o .:? "freq"
165+ <*> o .:? "highlighted"
166+
167+data SuggestResponse =
168+ SuggestResponse { suggestResponseText :: Text
169+ , suggestResponseOffset :: Int
170+ , suggestResponseLength :: Int
171+ , suggestResponseOptions :: [SuggestOptions]
172+ }
173+ deriving (Eq, Read, Show)
174+
175+instance FromJSON SuggestResponse where
176+ parseJSON = withObject "SuggestResponse" parse
177+ where parse o = SuggestResponse
178+ <$> o .: "text"
179+ <*> o .: "offset"
180+ <*> o .: "length"
181+ <*> o .: "options"
182+
183+data NamedSuggestionResponse = NamedSuggestionResponse
184+ { nsrName :: Text
185+ , nsrResponses :: [SuggestResponse]
186+ } deriving (Eq, Read, Show)
187+
188+instance FromJSON NamedSuggestionResponse where
189+ parseJSON (Object o) = do
190+ suggestionName' <- case HM.toList o of
191+ [(x, _)] -> return x
192+ _ -> fail "error parsing NamedSuggestionResponse name"
193+ suggestionResponses' <- o .: suggestionName'
194+ return $ NamedSuggestionResponse suggestionName' suggestionResponses'
195+
196+ parseJSON x = typeMismatch "NamedSuggestionResponse" x
197+
198+data DirectGeneratorSuggestModeTypes = DirectGeneratorSuggestModeMissing
199+ | DirectGeneratorSuggestModePopular
200+ | DirectGeneratorSuggestModeAlways
201+ deriving (Eq, Show)
202+
203+instance ToJSON DirectGeneratorSuggestModeTypes where
204+ toJSON DirectGeneratorSuggestModeMissing = "missing"
205+ toJSON DirectGeneratorSuggestModePopular = "popular"
206+ toJSON DirectGeneratorSuggestModeAlways = "always"
207+
208+instance FromJSON DirectGeneratorSuggestModeTypes where
209+ parseJSON = withText "DirectGeneratorSuggestModeTypes" parse
210+ where
211+ parse "missing" =
212+ pure DirectGeneratorSuggestModeMissing
213+ parse "popular" =
214+ pure DirectGeneratorSuggestModePopular
215+ parse "always" =
216+ pure DirectGeneratorSuggestModeAlways
217+ parse f =
218+ fail ("Unexpected DirectGeneratorSuggestModeTypes: " <> show f)
219+
220+data DirectGenerators = DirectGenerators
221+ { directGeneratorsField :: FieldName
222+ , directGeneratorsSize :: Maybe Int
223+ , directGeneratorSuggestMode :: DirectGeneratorSuggestModeTypes
224+ , directGeneratorMaxEdits :: Maybe Double
225+ , directGeneratorPrefixLength :: Maybe Int
226+ , directGeneratorMinWordLength :: Maybe Int
227+ , directGeneratorMaxInspections :: Maybe Int
228+ , directGeneratorMinDocFreq :: Maybe Double
229+ , directGeneratorMaxTermFreq :: Maybe Double
230+ , directGeneratorPreFilter :: Maybe Text
231+ , directGeneratorPostFilter :: Maybe Text
232+ } deriving (Eq, Show)
233+
234+instance ToJSON DirectGenerators where
235+ toJSON DirectGenerators{..} =
236+ omitNulls [ "field" .= directGeneratorsField
237+ , "size" .= directGeneratorsSize
238+ , "suggest_mode" .= directGeneratorSuggestMode
239+ , "max_edits" .= directGeneratorMaxEdits
240+ , "prefix_length" .= directGeneratorPrefixLength
241+ , "min_word_length" .= directGeneratorMinWordLength
242+ , "max_inspections" .= directGeneratorMaxInspections
243+ , "min_doc_freq" .= directGeneratorMinDocFreq
244+ , "max_term_freq" .= directGeneratorMaxTermFreq
245+ , "pre_filter" .= directGeneratorPreFilter
246+ , "post_filter" .= directGeneratorPostFilter
247+ ]
248+
249+instance FromJSON DirectGenerators where
250+ parseJSON = withObject "DirectGenerators" parse
251+ where parse o = DirectGenerators
252+ <$> o .: "field"
253+ <*> o .:? "size"
254+ <*> o .: "suggest_mode"
255+ <*> o .:? "max_edits"
256+ <*> o .:? "prefix_length"
257+ <*> o .:? "min_word_length"
258+ <*> o .:? "max_inspections"
259+ <*> o .:? "min_doc_freq"
260+ <*> o .:? "max_term_freq"
261+ <*> o .:? "pre_filter"
262+ <*> o .:? "post_filter"
263+
264+mkDirectGenerators :: FieldName -> DirectGenerators
265+mkDirectGenerators fn =
266+ DirectGenerators
267+ fn
268+ Nothing
269+ DirectGeneratorSuggestModeMissing
270+ Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing
src/Database/Bloodhound/Types.hsnew file+542
@@ -0,0 +1,542 @@
1+{-# LANGUAGE FlexibleContexts #-}
2+{-# LANGUAGE FlexibleInstances #-}
3+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
4+{-# LANGUAGE MultiParamTypeClasses #-}
5+{-# LANGUAGE NamedFieldPuns #-}
6+{-# LANGUAGE OverloadedStrings #-}
7+{-# LANGUAGE RecordWildCards #-}
8+{-# LANGUAGE UndecidableInstances #-}
9+
10+-------------------------------------------------------------------------------
11+-- |
12+-- Module : Database.Bloodhound.Types
13+-- Copyright : (C) 2014, 2018 Chris Allen
14+-- License : BSD-style (see the file LICENSE)
15+-- Maintainer : Chris Allen <cma@bitemyapp.com
16+-- Stability : provisional
17+-- Portability : RecordWildCards
18+--
19+-- Data types for describing actions and data structures performed to interact
20+-- with Elasticsearch. The two main buckets your queries against Elasticsearch
21+-- will fall into are 'Query's and 'Filter's. 'Filter's are more like
22+-- traditional database constraints and often have preferable performance
23+-- properties. 'Query's support human-written textual queries, such as fuzzy
24+-- queries.
25+-------------------------------------------------------------------------------
26+
27+
28+
29+module Database.Bloodhound.Types
30+ ( defaultCache
31+ , defaultIndexSettings
32+ , defaultIndexDocumentSettings
33+ , mkSort
34+ , showText
35+ , unpackId
36+ , mkMatchQuery
37+ , mkMultiMatchQuery
38+ , mkBoolQuery
39+ , mkRangeQuery
40+ , mkQueryStringQuery
41+ , mkAggregations
42+ , mkTermsAggregation
43+ , mkTermsScriptAggregation
44+ , mkDateHistogram
45+ , mkCardinalityAggregation
46+ , mkDocVersion
47+ , mkStatsAggregation
48+ , mkExtendedStatsAggregation
49+ , docVersionNumber
50+ , toMissing
51+ , toTerms
52+ , toDateHistogram
53+ , toTopHits
54+ , omitNulls
55+ , BH(..)
56+ , runBH
57+ , BHEnv
58+ , bhServer
59+ , bhManager
60+ , bhRequestHook
61+ , mkBHEnv
62+ , MonadBH(..)
63+ , Version(..)
64+ , VersionNumber(..)
65+ , MaybeNA(..)
66+ , BuildHash(..)
67+ , Status(..)
68+ , Existence(..)
69+ , NullValue(..)
70+ , IndexSettings(..)
71+ , UpdatableIndexSetting(..)
72+ , IndexSettingsSummary(..)
73+ , AllocationPolicy(..)
74+ , Compression(..)
75+ , ReplicaBounds(..)
76+ , Bytes(..)
77+ , gigabytes
78+ , megabytes
79+ , kilobytes
80+ , FSType(..)
81+ , InitialShardCount(..)
82+ , NodeAttrFilter(..)
83+ , NodeAttrName(..)
84+ , CompoundFormat(..)
85+ , IndexTemplate(..)
86+ , Server(..)
87+ , Reply
88+ , EsResult(..)
89+ , EsResultFound(..)
90+ , EsError(..)
91+ , EsProtocolException(..)
92+ , IndexAlias(..)
93+ , IndexAliasName(..)
94+ , IndexAliasAction(..)
95+ , IndexAliasCreate(..)
96+ , IndexAliasSummary(..)
97+ , IndexAliasesSummary(..)
98+ , AliasRouting(..)
99+ , SearchAliasRouting(..)
100+ , IndexAliasRouting(..)
101+ , RoutingValue(..)
102+ , DocVersion
103+ , ExternalDocVersion(..)
104+ , VersionControl(..)
105+ , DocumentParent(..)
106+ , IndexDocumentSettings(..)
107+ , Query(..)
108+ , Search(..)
109+ , SearchType(..)
110+ , SearchResult(..)
111+ , ScrollId(..)
112+ , SearchHits(..)
113+ , TrackSortScores
114+ , From(..)
115+ , Size(..)
116+ , Source(..)
117+ , PatternOrPatterns(..)
118+ , Include(..)
119+ , Exclude(..)
120+ , Pattern(..)
121+ , ShardResult(..)
122+ , Hit(..)
123+ , HitFields(..)
124+ , Filter(..)
125+ , BoolMatch(..)
126+ , Term(..)
127+ , GeoPoint(..)
128+ , GeoBoundingBoxConstraint(..)
129+ , GeoBoundingBox(..)
130+ , GeoFilterType(..)
131+ , Distance(..)
132+ , DistanceUnit(..)
133+ , DistanceType(..)
134+ , DistanceRange(..)
135+ , OptimizeBbox(..)
136+ , LatLon(..)
137+ , RangeValue(..)
138+ , RangeExecution(..)
139+ , LessThan(..)
140+ , LessThanEq(..)
141+ , GreaterThan(..)
142+ , GreaterThanEq(..)
143+ , LessThanD(..)
144+ , LessThanEqD(..)
145+ , GreaterThanD(..)
146+ , GreaterThanEqD(..)
147+ , Regexp(..)
148+ , RegexpFlags(..)
149+ , RegexpFlag(..)
150+ , FieldName(..)
151+ , ScriptFields(..)
152+ , ScriptFieldName
153+ , ScriptFieldValue
154+ , Script(..)
155+ , ScriptLanguage(..)
156+ , ScriptInline(..)
157+ , ScriptId(..)
158+ , ScriptParams(..)
159+ , ScriptParamName
160+ , ScriptParamValue
161+ , IndexName(..)
162+ , IndexSelection(..)
163+ , NodeSelection(..)
164+ , NodeSelector(..)
165+ , ForceMergeIndexSettings(..)
166+ , defaultForceMergeIndexSettings
167+ , TemplateName(..)
168+ , TemplatePattern(..)
169+ , MappingName(..)
170+ , DocId(..)
171+ , CacheName(..)
172+ , CacheKey(..)
173+ , BulkOperation(..)
174+ , ReplicaCount(..)
175+ , ShardCount(..)
176+ , Sort
177+ , SortMode(..)
178+ , SortOrder(..)
179+ , SortSpec(..)
180+ , DefaultSort(..)
181+ , Missing(..)
182+ , OpenCloseIndex(..)
183+ , Method
184+ , Boost(..)
185+ , MatchQuery(..)
186+ , MultiMatchQuery(..)
187+ , BoolQuery(..)
188+ , BoostingQuery(..)
189+ , CommonTermsQuery(..)
190+ , FunctionScoreQuery(..)
191+ , BoostMode(..)
192+ , ScoreMode(..)
193+ , FunctionScoreFunctions(..)
194+ , ComponentFunctionScoreFunction(..)
195+ , FunctionScoreFunction(..)
196+ , Weight(..)
197+ , Seed(..)
198+ , FieldValueFactor(..)
199+ , Factor(..)
200+ , FactorModifier(..)
201+ , FactorMissingFieldValue(..)
202+ , DisMaxQuery(..)
203+ , FuzzyLikeThisQuery(..)
204+ , FuzzyLikeFieldQuery(..)
205+ , FuzzyQuery(..)
206+ , HasChildQuery(..)
207+ , HasParentQuery(..)
208+ , IndicesQuery(..)
209+ , MoreLikeThisQuery(..)
210+ , MoreLikeThisFieldQuery(..)
211+ , NestedQuery(..)
212+ , PrefixQuery(..)
213+ , QueryStringQuery(..)
214+ , SimpleQueryStringQuery(..)
215+ , RangeQuery(..)
216+ , RegexpQuery(..)
217+ , QueryString(..)
218+ , TemplateQueryInline(..)
219+ , TemplateQueryKeyValuePairs(..)
220+ , WildcardQuery(..)
221+ , BooleanOperator(..)
222+ , ZeroTermsQuery(..)
223+ , CutoffFrequency(..)
224+ , Analyzer(..)
225+ , Tokenizer(..)
226+ , TokenFilter(..)
227+ , CharFilter(..)
228+ , MaxExpansions(..)
229+ , Lenient(..)
230+ , MatchQueryType(..)
231+ , MultiMatchQueryType(..)
232+ , Tiebreaker(..)
233+ , MinimumMatch(..)
234+ , DisableCoord(..)
235+ , CommonMinimumMatch(..)
236+ , MinimumMatchHighLow(..)
237+ , PrefixLength(..)
238+ , Fuzziness(..)
239+ , IgnoreTermFrequency(..)
240+ , MaxQueryTerms(..)
241+ , ScoreType(..)
242+ , Score
243+ , Cache
244+ , TypeName(..)
245+ , BoostTerms(..)
246+ , MaxWordLength(..)
247+ , MinWordLength(..)
248+ , MaxDocFrequency(..)
249+ , MinDocFrequency(..)
250+ , PhraseSlop(..)
251+ , StopWord(..)
252+ , QueryPath(..)
253+ , MinimumTermFrequency(..)
254+ , PercentMatch(..)
255+ , FieldDefinition(..)
256+ , MappingField(..)
257+ , Mapping(..)
258+ , AllowLeadingWildcard(..)
259+ , LowercaseExpanded(..)
260+ , GeneratePhraseQueries(..)
261+ , Locale(..)
262+ , AnalyzeWildcard(..)
263+ , EnablePositionIncrements(..)
264+ , SimpleQueryFlag(..)
265+ , FieldOrFields(..)
266+ , Monoid(..)
267+ , ToJSON(..)
268+ , Interval(..)
269+ , TimeInterval(..)
270+ , ExecutionHint(..)
271+ , CollectionMode(..)
272+ , TermOrder(..)
273+ , TermInclusion(..)
274+ , SnapshotRepoSelection(..)
275+ , GenericSnapshotRepo(..)
276+ , SnapshotRepo(..)
277+ , SnapshotRepoConversionError(..)
278+ , SnapshotRepoType(..)
279+ , GenericSnapshotRepoSettings(..)
280+ , SnapshotRepoUpdateSettings(..)
281+ , defaultSnapshotRepoUpdateSettings
282+ , SnapshotRepoName(..)
283+ , SnapshotRepoPattern(..)
284+ , SnapshotVerification(..)
285+ , SnapshotNodeVerification(..)
286+ , FullNodeId(..)
287+ , NodeName(..)
288+ , ClusterName(..)
289+ , NodesInfo(..)
290+ , NodesStats(..)
291+ , NodeStats(..)
292+ , NodeBreakersStats(..)
293+ , NodeBreakerStats(..)
294+ , NodeHTTPStats(..)
295+ , NodeTransportStats(..)
296+ , NodeFSStats(..)
297+ , NodeDataPathStats(..)
298+ , NodeFSTotalStats(..)
299+ , NodeNetworkStats(..)
300+ , NodeThreadPoolsStats(..)
301+ , NodeThreadPoolStats(..)
302+ , NodeJVMStats(..)
303+ , JVMBufferPoolStats(..)
304+ , JVMGCStats(..)
305+ , JVMPoolStats(..)
306+ , NodeProcessStats(..)
307+ , NodeOSStats(..)
308+ , LoadAvgs(..)
309+ , NodeIndicesStats(..)
310+ , EsAddress(..)
311+ , PluginName(..)
312+ , NodeInfo(..)
313+ , NodePluginInfo(..)
314+ , NodeHTTPInfo(..)
315+ , NodeTransportInfo(..)
316+ , BoundTransportAddress(..)
317+ , NodeNetworkInfo(..)
318+ , MacAddress(..)
319+ , NetworkInterfaceName(..)
320+ , NodeNetworkInterface(..)
321+ , NodeThreadPoolsInfo(..)
322+ , NodeThreadPoolInfo(..)
323+ , ThreadPoolSize(..)
324+ , ThreadPoolType(..)
325+ , NodeJVMInfo(..)
326+ , JVMMemoryPool(..)
327+ , JVMGCCollector(..)
328+ , JVMMemoryInfo(..)
329+ , PID(..)
330+ , NodeOSInfo(..)
331+ , CPUInfo(..)
332+ , NodeProcessInfo(..)
333+ , FsSnapshotRepo(..)
334+ , SnapshotCreateSettings(..)
335+ , defaultSnapshotCreateSettings
336+ , SnapshotSelection(..)
337+ , SnapshotPattern(..)
338+ , SnapshotInfo(..)
339+ , SnapshotShardFailure(..)
340+ , ShardId(..)
341+ , SnapshotName(..)
342+ , SnapshotState(..)
343+ , SnapshotRestoreSettings(..)
344+ , defaultSnapshotRestoreSettings
345+ , RestoreRenamePattern(..)
346+ , RestoreRenameToken(..)
347+ , RRGroupRefNum
348+ , rrGroupRefNum
349+ , mkRRGroupRefNum
350+ , RestoreIndexSettings(..)
351+ , Suggest(..)
352+ , SuggestType(..)
353+ , PhraseSuggester(..)
354+ , PhraseSuggesterHighlighter(..)
355+ , PhraseSuggesterCollate(..)
356+ , mkPhraseSuggester
357+ , SuggestOptions(..)
358+ , SuggestResponse(..)
359+ , NamedSuggestionResponse(..)
360+ , DirectGenerators(..)
361+ , mkDirectGenerators
362+ , DirectGeneratorSuggestModeTypes (..)
363+
364+ , Aggregation(..)
365+ , Aggregations
366+ , AggregationResults
367+ , BucketValue(..)
368+ , Bucket(..)
369+ , BucketAggregation(..)
370+ , TermsAggregation(..)
371+ , MissingAggregation(..)
372+ , ValueCountAggregation(..)
373+ , FilterAggregation(..)
374+ , CardinalityAggregation(..)
375+ , MaxAggregation(..)
376+ , DateHistogramAggregation(..)
377+ , DateRangeAggregation(..)
378+ , DateRangeAggRange(..)
379+ , DateMathExpr(..)
380+ , DateMathAnchor(..)
381+ , DateMathModifier(..)
382+ , DateMathUnit(..)
383+ , TopHitsAggregation(..)
384+ , StatisticsAggregation(..)
385+ , SearchAfterKey
386+
387+ , Highlights(..)
388+ , FieldHighlight(..)
389+ , HighlightSettings(..)
390+ , PlainHighlight(..)
391+ , PostingsHighlight(..)
392+ , FastVectorHighlight(..)
393+ , CommonHighlight(..)
394+ , NonPostings(..)
395+ , HighlightEncoder(..)
396+ , HighlightTag(..)
397+ , HitHighlight
398+
399+ , MissingResult(..)
400+ , TermsResult(..)
401+ , DateHistogramResult(..)
402+ , DateRangeResult(..)
403+ , TopHitResult(..)
404+
405+ , EsUsername(..)
406+ , EsPassword(..)
407+
408+ , Analysis(..)
409+ , AnalyzerDefinition(..)
410+ , TokenizerDefinition(..)
411+ , TokenFilterDefinition(..)
412+ , CharFilterDefinition(..)
413+ , Ngram(..)
414+ , TokenChar(..)
415+ , Shingle(..)
416+ , Language(..)
417+ ) where
418+
419+import Bloodhound.Import
420+
421+import Database.Bloodhound.Internal.Aggregation
422+import Database.Bloodhound.Internal.Analysis
423+import Database.Bloodhound.Internal.Client
424+import Database.Bloodhound.Internal.Highlight
425+import Database.Bloodhound.Internal.Newtypes
426+import Database.Bloodhound.Internal.Query
427+import Database.Bloodhound.Internal.Sort
428+import Database.Bloodhound.Internal.Suggest
429+
430+{-| 'unpackId' is a silly convenience function that gets used once.
431+-}
432+unpackId :: DocId -> Text
433+unpackId (DocId docId) = docId
434+
435+type TrackSortScores = Bool
436+
437+data Search = Search { queryBody :: Maybe Query
438+ , filterBody :: Maybe Filter
439+ , sortBody :: Maybe Sort
440+ , aggBody :: Maybe Aggregations
441+ , highlight :: Maybe Highlights
442+ -- default False
443+ , trackSortScores :: TrackSortScores
444+ , from :: From
445+ , size :: Size
446+ , searchType :: SearchType
447+ , searchAfterKey :: Maybe SearchAfterKey
448+ , fields :: Maybe [FieldName]
449+ , scriptFields :: Maybe ScriptFields
450+ , source :: Maybe Source
451+ , suggestBody :: Maybe Suggest -- ^ Only one Suggestion request / response per Search is supported.
452+ } deriving (Eq, Show)
453+
454+
455+instance ToJSON Search where
456+ toJSON (Search mquery sFilter sort searchAggs
457+ highlight sTrackSortScores sFrom sSize _ sAfter sFields
458+ sScriptFields sSource sSuggest) =
459+ omitNulls [ "query" .= query'
460+ , "sort" .= sort
461+ , "aggregations" .= searchAggs
462+ , "highlight" .= highlight
463+ , "from" .= sFrom
464+ , "size" .= sSize
465+ , "track_scores" .= sTrackSortScores
466+ , "search_after" .= sAfter
467+ , "fields" .= sFields
468+ , "script_fields" .= sScriptFields
469+ , "_source" .= sSource
470+ , "suggest" .= sSuggest]
471+
472+ where query' = case sFilter of
473+ Nothing -> mquery
474+ Just x ->
475+ Just
476+ . QueryBoolQuery
477+ $ mkBoolQuery (maybeToList mquery)
478+ [x] [] []
479+
480+data SearchType = SearchTypeQueryThenFetch
481+ | SearchTypeDfsQueryThenFetch
482+ deriving (Eq, Show)
483+
484+data Source =
485+ NoSource
486+ | SourcePatterns PatternOrPatterns
487+ | SourceIncludeExclude Include Exclude
488+ deriving (Eq, Show)
489+
490+instance ToJSON Source where
491+ toJSON NoSource = toJSON False
492+ toJSON (SourcePatterns patterns) = toJSON patterns
493+ toJSON (SourceIncludeExclude incl excl) = object [ "includes" .= incl, "excludes" .= excl ]
494+
495+data PatternOrPatterns = PopPattern Pattern
496+ | PopPatterns [Pattern] deriving (Eq, Read, Show)
497+
498+instance ToJSON PatternOrPatterns where
499+ toJSON (PopPattern pattern) = toJSON pattern
500+ toJSON (PopPatterns patterns) = toJSON patterns
501+
502+data Include = Include [Pattern] deriving (Eq, Read, Show)
503+data Exclude = Exclude [Pattern] deriving (Eq, Read, Show)
504+
505+instance ToJSON Include where
506+ toJSON (Include patterns) = toJSON patterns
507+
508+instance ToJSON Exclude where
509+ toJSON (Exclude patterns) = toJSON patterns
510+
511+newtype Pattern = Pattern Text deriving (Eq, Read, Show)
512+
513+instance ToJSON Pattern where
514+ toJSON (Pattern pattern) = toJSON pattern
515+
516+data SearchResult a =
517+ SearchResult { took :: Int
518+ , timedOut :: Bool
519+ , shards :: ShardResult
520+ , searchHits :: SearchHits a
521+ , aggregations :: Maybe AggregationResults
522+ , scrollId :: Maybe ScrollId
523+ -- ^ Only one Suggestion request / response per
524+ -- Search is supported.
525+ , suggest :: Maybe NamedSuggestionResponse
526+ }
527+ deriving (Eq, Show)
528+
529+instance (FromJSON a) => FromJSON (SearchResult a) where
530+ parseJSON (Object v) = SearchResult <$>
531+ v .: "took" <*>
532+ v .: "timed_out" <*>
533+ v .: "_shards" <*>
534+ v .: "hits" <*>
535+ v .:? "aggregations" <*>
536+ v .:? "_scroll_id" <*>
537+ v .:? "suggest"
538+ parseJSON _ = empty
539+
540+newtype ScrollId =
541+ ScrollId Text
542+ deriving (Eq, Show, Ord, ToJSON, FromJSON)
src/Database/V1/Bloodhound.hsdeleted−10
@@ -1,10 +0,0 @@
1−module Database.V1.Bloodhound
2− ( -- module Data.Aeson.Types
3− -- ,
4− module Database.V1.Bloodhound.Client
5− , module Database.V1.Bloodhound.Types
6− ) where
7−
8−-- import Data.Aeson.Types
9−import Database.V1.Bloodhound.Client
10−import Database.V1.Bloodhound.Types
src/Database/V1/Bloodhound/Client.hsdeleted−1097
@@ -1,1097 +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−-- $setup
127−-- >>> :set -XOverloadedStrings
128−-- >>> :set -XDeriveGeneric
129−-- >>> import Database.V1.Bloodhound
130−-- >>> let testServer = (Server "http://localhost:9200")
131−-- >>> let runBH' = withBH defaultManagerSettings testServer
132−-- >>> let testIndex = IndexName "twitter"
133−-- >>> let testMapping = MappingName "tweet"
134−-- >>> let defaultIndexSettings = IndexSettings (ShardCount 1) (ReplicaCount 0)
135−-- >>> data TweetMapping = TweetMapping deriving (Eq, Show)
136−-- >>> _ <- runBH' $ deleteIndex testIndex >> deleteMapping testIndex testMapping
137−-- >>> import GHC.Generics
138−-- >>> import Data.Time.Calendar (Day (..))
139−-- >>> import Data.Time.Clock (UTCTime (..), secondsToDiffTime)
140−-- >>> :{
141−--instance ToJSON TweetMapping where
142−-- toJSON TweetMapping =
143−-- object ["properties" .=
144−-- object ["location" .=
145−-- object ["type" .= ("geo_point" :: Text)]]]
146−--data Location = Location { lat :: Double
147−-- , lon :: Double } deriving (Eq, Generic, Show)
148−--data Tweet = Tweet { user :: Text
149−-- , postDate :: UTCTime
150−-- , message :: Text
151−-- , age :: Int
152−-- , location :: Location } deriving (Eq, Generic, Show)
153−--exampleTweet = Tweet { user = "bitemyapp"
154−-- , postDate = UTCTime
155−-- (ModifiedJulianDay 55000)
156−-- (secondsToDiffTime 10)
157−-- , message = "Use haskell!"
158−-- , age = 10000
159−-- , location = Location 40.12 (-71.34) }
160−--instance ToJSON Tweet where
161−-- toJSON = genericToJSON defaultOptions
162−--instance FromJSON Tweet where
163−-- parseJSON = genericParseJSON defaultOptions
164−--instance ToJSON Location where
165−-- toJSON = genericToJSON defaultOptions
166−--instance FromJSON Location where
167−-- parseJSON = genericParseJSON defaultOptions
168−--data BulkTest = BulkTest { name :: Text } deriving (Eq, Generic, Show)
169−--instance FromJSON BulkTest where
170−-- parseJSON = genericParseJSON defaultOptions
171−--instance ToJSON BulkTest where
172−-- toJSON = genericToJSON defaultOptions
173−-- :}
174−
175−-- | 'mkShardCount' is a straight-forward smart constructor for 'ShardCount'
176−-- which rejects 'Int' values below 1 and above 1000.
177−--
178−-- >>> mkShardCount 10
179−-- Just (ShardCount 10)
180−mkShardCount :: Int -> Maybe ShardCount
181−mkShardCount n
182− | n < 1 = Nothing
183− | n > 1000 = Nothing
184− | otherwise = Just (ShardCount n)
185−
186−-- | 'mkReplicaCount' is a straight-forward smart constructor for 'ReplicaCount'
187−-- which rejects 'Int' values below 0 and above 1000.
188−--
189−-- >>> mkReplicaCount 10
190−-- Just (ReplicaCount 10)
191−mkReplicaCount :: Int -> Maybe ReplicaCount
192−mkReplicaCount n
193− | n < 0 = Nothing
194− | n > 1000 = Nothing -- ...
195− | otherwise = Just (ReplicaCount n)
196−
197−emptyBody :: L.ByteString
198−emptyBody = L.pack ""
199−
200−dispatch :: MonadBH m
201− => Method
202− -> Text
203− -> Maybe L.ByteString
204− -> m Reply
205−dispatch dMethod url body = do
206− initReq <- liftIO $ parseUrl' url
207− reqHook <- bhRequestHook A.<$> getBHEnv
208− let reqBody = RequestBodyLBS $ fromMaybe emptyBody body
209− req <- liftIO $ reqHook $ setRequestIgnoreStatus $ initReq { method = dMethod
210− , requestBody = reqBody }
211− mgr <- bhManager <$> getBHEnv
212− liftIO $ httpLbs req mgr
213−
214−joinPath' :: [Text] -> Text
215−joinPath' = T.intercalate "/"
216−
217−joinPath :: MonadBH m => [Text] -> m Text
218−joinPath ps = do
219− Server s <- bhServer <$> getBHEnv
220− return $ joinPath' (s:ps)
221−
222−appendSearchTypeParam :: Text -> SearchType -> Text
223−appendSearchTypeParam originalUrl st = addQuery params originalUrl
224− where stText = "search_type"
225− params
226− | st == SearchTypeDfsQueryThenFetch = [(stText, Just "dfs_query_then_fetch")]
227− | st == SearchTypeCount = [(stText, Just "count")]
228− | st == SearchTypeScan = [(stText, Just "scan"), ("scroll", Just "1m")]
229− | st == SearchTypeQueryAndFetch = [(stText, Just "query_and_fetch")]
230− | st == SearchTypeDfsQueryAndFetch = [(stText, Just "dfs_query_and_fetch")]
231− -- used to catch 'SearchTypeQueryThenFetch', which is also the default
232− | otherwise = [(stText, Just "query_then_fetch")]
233−
234−-- | Severely dumbed down query renderer. Assumes your data doesn't
235−-- need any encoding
236−addQuery :: [(Text, Maybe Text)] -> Text -> Text
237−addQuery q u = u <> rendered
238− where
239− rendered =
240− T.decodeUtf8 $ BB.toByteString $ NHTU.renderQueryText prependQuestionMark q
241− prependQuestionMark = True
242−
243−bindM2 :: (Applicative m, Monad m) => (a -> b -> m c) -> m a -> m b -> m c
244−bindM2 f ma mb = join (f <$> ma <*> mb)
245−
246−-- | Convenience function that sets up a manager and BHEnv and runs
247−-- the given set of bloodhound operations. Connections will be
248−-- pipelined automatically in accordance with the given manager
249−-- settings in IO. If you've got your own monad transformer stack, you
250−-- should use 'runBH' directly.
251−withBH :: ManagerSettings -> Server -> BH IO a -> IO a
252−withBH ms s f = do
253− mgr <- newManager ms
254− let env = mkBHEnv s mgr
255− runBH env f
256−
257−-- Shortcut functions for HTTP methods
258−delete :: MonadBH m => Text -> m Reply
259−delete = flip (dispatch NHTM.methodDelete) Nothing
260−get :: MonadBH m => Text -> m Reply
261−get = flip (dispatch NHTM.methodGet) Nothing
262−head :: MonadBH m => Text -> m Reply
263−head = flip (dispatch NHTM.methodHead) Nothing
264−put :: MonadBH m => Text -> Maybe L.ByteString -> m Reply
265−put = dispatch NHTM.methodPut
266−post :: MonadBH m => Text -> Maybe L.ByteString -> m Reply
267−post = dispatch NHTM.methodPost
268−
269−-- indexDocument s ix name doc = put (root </> s </> ix </> name </> doc) (Just encode doc)
270−-- http://hackage.haskell.org/package/http-client-lens-0.1.0/docs/Network-HTTP-Client-Lens.html
271−-- https://github.com/supki/libjenkins/blob/master/src/Jenkins/Rest/Internal.hs
272−
273−-- | 'getStatus' fetches the 'Status' of a 'Server'
274−--
275−-- >>> serverStatus <- runBH' getStatus
276−-- >>> fmap status (serverStatus)
277−-- Just 200
278−getStatus :: MonadBH m => m (Maybe Status)
279−getStatus = do
280− response <- get =<< url
281− return $ decode (responseBody response)
282− where url = joinPath []
283−
284−-- | 'getSnapshotRepos' gets the definitions of a subset of the
285−-- defined snapshot repos.
286−getSnapshotRepos
287− :: ( MonadBH m
288− , MonadThrow m
289− )
290− => SnapshotRepoSelection
291− -> m (Either EsError [GenericSnapshotRepo])
292−getSnapshotRepos sel = fmap (fmap unGSRs) . parseEsResponse =<< get =<< url
293− where
294− url = joinPath ["_snapshot", selectorSeg]
295− selectorSeg = case sel of
296− AllSnapshotRepos -> "_all"
297− SnapshotRepoList (p :| ps) -> T.intercalate "," (renderPat <$> (p:ps))
298− renderPat (RepoPattern t) = t
299− renderPat (ExactRepo (SnapshotRepoName t)) = t
300−
301−
302−-- | Wrapper to extract the list of 'GenericSnapshotRepo' in the
303−-- format they're returned in
304−newtype GSRs = GSRs { unGSRs :: [GenericSnapshotRepo] }
305−
306−
307−instance FromJSON GSRs where
308− parseJSON = withObject "Collection of GenericSnapshotRepo" parse
309− where
310− parse = fmap GSRs . mapM (uncurry go) . HM.toList
311− go rawName = withObject "GenericSnapshotRepo" $ \o -> do
312− GenericSnapshotRepo (SnapshotRepoName rawName) <$> o .: "type"
313− <*> o .: "settings"
314−
315−
316−-- | Create or update a snapshot repo
317−updateSnapshotRepo
318− :: ( MonadBH m
319− , SnapshotRepo repo
320− )
321− => SnapshotRepoUpdateSettings
322− -- ^ Use 'defaultSnapshotRepoUpdateSettings' if unsure
323− -> repo
324− -> m Reply
325−updateSnapshotRepo SnapshotRepoUpdateSettings {..} repo =
326− bindM2 put url (return (Just body))
327− where
328− url = addQuery params <$> joinPath ["_snapshot", snapshotRepoName gSnapshotRepoName]
329− params
330− | repoUpdateVerify = []
331− | otherwise = [("verify", Just "false")]
332− body = encode $ object [ "type" .= gSnapshotRepoType
333− , "settings" .= gSnapshotRepoSettings
334− ]
335− GenericSnapshotRepo {..} = toGSnapshotRepo repo
336−
337−
338−
339−-- | Verify if a snapshot repo is working. __NOTE:__ this API did not
340−-- make it into ElasticSearch until 1.4. If you use an older version,
341−-- you will get an error here.
342−verifySnapshotRepo
343− :: ( MonadBH m
344− , MonadThrow m
345− )
346− => SnapshotRepoName
347− -> m (Either EsError SnapshotVerification)
348−verifySnapshotRepo (SnapshotRepoName n) =
349− parseEsResponse =<< bindM2 post url (return Nothing)
350− where
351− url = joinPath ["_snapshot", n, "_verify"]
352−
353−
354−deleteSnapshotRepo :: MonadBH m => SnapshotRepoName -> m Reply
355−deleteSnapshotRepo (SnapshotRepoName n) = delete =<< url
356− where
357− url = joinPath ["_snapshot", n]
358−
359−
360−-- | Create and start a snapshot
361−createSnapshot
362− :: (MonadBH m)
363− => SnapshotRepoName
364− -> SnapshotName
365− -> SnapshotCreateSettings
366− -> m Reply
367−createSnapshot (SnapshotRepoName repoName)
368− (SnapshotName snapName)
369− SnapshotCreateSettings {..} =
370− bindM2 put url (return (Just body))
371− where
372− url = addQuery params <$> joinPath ["_snapshot", repoName, snapName]
373− params = [("wait_for_completion", Just (boolQP snapWaitForCompletion))]
374− body = encode $ object prs
375− prs = catMaybes [ ("indices" .=) . indexSelectionName <$> snapIndices
376− , Just ("ignore_unavailable" .= snapIgnoreUnavailable)
377− , Just ("ignore_global_state" .= snapIncludeGlobalState)
378− , Just ("partial" .= snapPartial)
379− ]
380−
381−
382−indexSelectionName :: IndexSelection -> Text
383−indexSelectionName AllIndexes = "_all"
384−indexSelectionName (IndexList (i :| is)) = T.intercalate "," (renderIndex <$> (i:is))
385− where
386− renderIndex (IndexName n) = n
387−
388−
389−-- | Get info about known snapshots given a pattern and repo name.
390−getSnapshots
391− :: ( MonadBH m
392− , MonadThrow m
393− )
394− => SnapshotRepoName
395− -> SnapshotSelection
396− -> m (Either EsError [SnapshotInfo])
397−getSnapshots (SnapshotRepoName repoName) sel =
398− fmap (fmap unSIs) . parseEsResponse =<< get =<< url
399− where
400− url = joinPath ["_snapshot", repoName, snapPath]
401− snapPath = case sel of
402− AllSnapshots -> "_all"
403− SnapshotList (s :| ss) -> T.intercalate "," (renderPath <$> (s:ss))
404− renderPath (SnapPattern t) = t
405− renderPath (ExactSnap (SnapshotName t)) = t
406−
407−
408−newtype SIs = SIs { unSIs :: [SnapshotInfo] }
409−
410−
411−instance FromJSON SIs where
412− parseJSON = withObject "Collection of SnapshotInfo" parse
413− where
414− parse o = SIs <$> o .: "snapshots"
415−
416−
417−-- | Delete a snapshot. Cancels if it is running.
418−deleteSnapshot :: MonadBH m => SnapshotRepoName -> SnapshotName -> m Reply
419−deleteSnapshot (SnapshotRepoName repoName) (SnapshotName snapName) =
420− delete =<< url
421− where
422− url = joinPath ["_snapshot", repoName, snapName]
423−
424−
425−-- | Restore a snapshot to the cluster See
426−-- <https://www.elastic.co/guide/en/elasticsearch/reference/1.7/modules-snapshots.html#_restore>
427−-- for more details.
428−restoreSnapshot
429− :: MonadBH m
430− => SnapshotRepoName
431− -> SnapshotName
432− -> SnapshotRestoreSettings
433− -- ^ Start with 'defaultSnapshotRestoreSettings' and customize
434− -- from there for reasonable defaults.
435− -> m Reply
436−restoreSnapshot (SnapshotRepoName repoName)
437− (SnapshotName snapName)
438− SnapshotRestoreSettings {..} = bindM2 post url (return (Just body))
439− where
440− url = addQuery params <$> joinPath ["_snapshot", repoName, snapName, "_restore"]
441− params = [("wait_for_completion", Just (boolQP snapRestoreWaitForCompletion))]
442− body = encode (object prs)
443−
444−
445− prs = catMaybes [ ("indices" .=) . indexSelectionName <$> snapRestoreIndices
446− , Just ("ignore_unavailable" .= snapRestoreIgnoreUnavailable)
447− , Just ("include_global_state" .= snapRestoreIncludeGlobalState)
448− , ("rename_pattern" .=) <$> snapRestoreRenamePattern
449− , ("rename_replacement" .=) . renderTokens <$> snapRestoreRenameReplacement
450− , Just ("include_aliases" .= snapRestoreIncludeAliases)
451− , ("index_settings" .= ) <$> snapRestoreIndexSettingsOverrides
452− , ("ignore_index_settings" .= ) <$> snapRestoreIgnoreIndexSettings
453− ]
454− renderTokens (t :| ts) = mconcat (renderToken <$> (t:ts))
455− renderToken (RRTLit t) = t
456− renderToken RRSubWholeMatch = "$0"
457− renderToken (RRSubGroup g) = T.pack (show (rrGroupRefNum g))
458−
459−
460−getNodesInfo
461− :: ( MonadBH m
462− , MonadThrow m
463− )
464− => NodeSelection
465− -> m (Either EsError NodesInfo)
466−getNodesInfo sel = parseEsResponse =<< get =<< url
467− where
468− url = joinPath ["_nodes", selectionSeg]
469− selectionSeg = case sel of
470− LocalNode -> "_local"
471− NodeList (l :| ls) -> T.intercalate "," (selToSeg <$> (l:ls))
472− AllNodes -> "_all"
473− selToSeg (NodeByName (NodeName n)) = n
474− selToSeg (NodeByFullNodeId (FullNodeId i)) = i
475− selToSeg (NodeByHost (Server s)) = s
476− selToSeg (NodeByAttribute (NodeAttrName a) v) = a <> ":" <> v
477−
478−getNodesStats
479− :: ( MonadBH m
480− , MonadThrow m
481− )
482− => NodeSelection
483− -> m (Either EsError NodesStats)
484−getNodesStats sel = parseEsResponse =<< get =<< url
485− where
486− url = joinPath ["_nodes", selectionSeg, "stats"]
487− selectionSeg = case sel of
488− LocalNode -> "_local"
489− NodeList (l :| ls) -> T.intercalate "," (selToSeg <$> (l:ls))
490− AllNodes -> "_all"
491− selToSeg (NodeByName (NodeName n)) = n
492− selToSeg (NodeByFullNodeId (FullNodeId i)) = i
493− selToSeg (NodeByHost (Server s)) = s
494− selToSeg (NodeByAttribute (NodeAttrName a) v) = a <> ":" <> v
495−
496−-- | 'createIndex' will create an index given a 'Server', 'IndexSettings', and an 'IndexName'.
497−--
498−-- >>> response <- runBH' $ createIndex defaultIndexSettings (IndexName "didimakeanindex")
499−-- >>> respIsTwoHunna response
500−-- True
501−-- >>> runBH' $ indexExists (IndexName "didimakeanindex")
502−-- True
503−createIndex :: MonadBH m => IndexSettings -> IndexName -> m Reply
504−createIndex indexSettings (IndexName indexName) =
505− bindM2 put url (return body)
506− where url = joinPath [indexName]
507− body = Just $ encode indexSettings
508−
509−
510−-- | 'deleteIndex' will delete an index given a 'Server', and an 'IndexName'.
511−--
512−-- >>> _ <- runBH' $ createIndex defaultIndexSettings (IndexName "didimakeanindex")
513−-- >>> response <- runBH' $ deleteIndex (IndexName "didimakeanindex")
514−-- >>> respIsTwoHunna response
515−-- True
516−-- >>> runBH' $ indexExists testIndex
517−-- False
518−deleteIndex :: MonadBH m => IndexName -> m Reply
519−deleteIndex (IndexName indexName) =
520− delete =<< joinPath [indexName]
521−
522−-- | 'updateIndexSettings' will apply a non-empty list of setting updates to an index
523−--
524−-- >>> _ <- runBH' $ createIndex defaultIndexSettings (IndexName "unconfiguredindex")
525−-- >>> response <- runBH' $ updateIndexSettings (BlocksWrite False :| []) (IndexName "unconfiguredindex")
526−-- >>> respIsTwoHunna response
527−-- True
528−updateIndexSettings :: MonadBH m => NonEmpty UpdatableIndexSetting -> IndexName -> m Reply
529−updateIndexSettings updates (IndexName indexName) =
530− bindM2 put url (return body)
531− where url = joinPath [indexName, "_settings"]
532− body = Just (encode jsonBody)
533− jsonBody = Object (deepMerge [u | Object u <- toJSON <$> toList updates])
534−
535−
536−getIndexSettings :: (MonadBH m, MonadThrow m) => IndexName
537− -> m (Either EsError IndexSettingsSummary)
538−getIndexSettings (IndexName indexName) = do
539− parseEsResponse =<< get =<< url
540− where url = joinPath [indexName, "_settings"]
541−
542−
543−-- | 'optimizeIndex' will optimize a single index, list of indexes or
544−-- all indexes. Note that this call will block until finishing but
545−-- will continue even if the request times out. Concurrent requests to
546−-- optimize an index while another is performing will block until the
547−-- previous one finishes. For more information see
548−-- <https://www.elastic.co/guide/en/elasticsearch/reference/1.7/indices-optimize.html>. Nothing
549−-- worthwhile comes back in the reply body, so matching on the status
550−-- should suffice.
551−--
552−-- 'optimizeIndex' with a maxNumSegments of 1 and onlyExpungeDeletes
553−-- to True is the main way to release disk space back to the OS being
554−-- held by deleted documents.
555−--
556−-- Note that this API was deprecated in ElasticSearch 2.1 for the
557−-- almost completely identical forcemerge API. Adding support to that
558−-- API would be trivial but due to the significant breaking changes,
559−-- this library cannot currently be used with >= 2.0, so that feature was omitted.
560−--
561−-- >>> let ixn = IndexName "unoptimizedindex"
562−-- >>> _ <- runBH' $ deleteIndex ixn >> createIndex defaultIndexSettings ixn
563−-- >>> response <- runBH' $ optimizeIndex (IndexList (ixn :| [])) (defaultIndexOptimizationSettings { maxNumSegments = Just 1, onlyExpungeDeletes = True })
564−-- >>> respIsTwoHunna response
565−-- True
566−optimizeIndex :: MonadBH m => IndexSelection -> IndexOptimizationSettings -> m Reply
567−optimizeIndex ixs IndexOptimizationSettings {..} =
568− bindM2 post url (return body)
569− where url = addQuery params <$> joinPath [indexName, "_optimize"]
570− params = catMaybes [ ("max_num_segments",) . Just . showText <$> maxNumSegments
571− , Just ("only_expunge_deletes", Just (boolQP onlyExpungeDeletes))
572− , Just ("flush", Just (boolQP flushAfterOptimize))
573− ]
574− indexName = indexSelectionName ixs
575− body = Nothing
576−
577−
578−deepMerge :: [Object] -> Object
579−deepMerge = LS.foldl' go mempty
580− where go acc = LS.foldl' go' acc . HM.toList
581− go' acc (k, v) = HM.insertWith merge k v acc
582− merge (Object a) (Object b) = Object (deepMerge [a, b])
583− merge _ b = b
584−
585−
586−statusCodeIs :: (Int, Int) -> Reply -> Bool
587−statusCodeIs r resp = inRange r $ NHTS.statusCode (responseStatus resp)
588−
589−respIsTwoHunna :: Reply -> Bool
590−respIsTwoHunna = statusCodeIs (200, 299)
591−
592−existentialQuery :: MonadBH m => Text -> m (Reply, Bool)
593−existentialQuery url = do
594− reply <- head url
595− return (reply, respIsTwoHunna reply)
596−
597−
598−-- | Tries to parse a response body as the expected type @a@ and
599−-- failing that tries to parse it as an EsError. All well-formed, JSON
600−-- responses from elasticsearch should fall into these two
601−-- categories. If they don't, a 'EsProtocolException' will be
602−-- thrown. If you encounter this, please report the full body it
603−-- reports along with your ElasticSearch verison.
604−parseEsResponse :: (MonadThrow m, FromJSON a) => Reply
605− -> m (Either EsError a)
606−parseEsResponse reply
607− | respIsTwoHunna reply = case eitherDecode body of
608− Right a -> return (Right a)
609− Left _ -> tryParseError
610− | otherwise = tryParseError
611− where body = responseBody reply
612− tryParseError = case eitherDecode body of
613− Right e -> return (Left e)
614− -- this case should not be possible
615− Left _ -> explode
616− explode = throwM (EsProtocolException body)
617−
618−-- | 'indexExists' enables you to check if an index exists. Returns 'Bool'
619−-- in IO
620−--
621−-- >>> exists <- runBH' $ indexExists testIndex
622−indexExists :: MonadBH m => IndexName -> m Bool
623−indexExists (IndexName indexName) = do
624− (_, exists) <- existentialQuery =<< joinPath [indexName]
625− return exists
626−
627−-- | 'refreshIndex' will force a refresh on an index. You must
628−-- do this if you want to read what you wrote.
629−--
630−-- >>> _ <- runBH' $ createIndex defaultIndexSettings testIndex
631−-- >>> _ <- runBH' $ refreshIndex testIndex
632−refreshIndex :: MonadBH m => IndexName -> m Reply
633−refreshIndex (IndexName indexName) =
634− bindM2 post url (return Nothing)
635− where url = joinPath [indexName, "_refresh"]
636−
637−-- | Block until the index becomes available for indexing
638−-- documents. This is useful for integration tests in which
639−-- indices are rapidly created and deleted.
640−waitForYellowIndex :: MonadBH m => IndexName -> m Reply
641−waitForYellowIndex (IndexName indexName) = get =<< url
642− where url = addQuery q <$> joinPath ["_cluster","health",indexName]
643− q = [("wait_for_status",Just "yellow"),("timeout",Just "10s")]
644−
645−stringifyOCIndex :: OpenCloseIndex -> Text
646−stringifyOCIndex oci = case oci of
647− OpenIndex -> "_open"
648− CloseIndex -> "_close"
649−
650−openOrCloseIndexes :: MonadBH m => OpenCloseIndex -> IndexName -> m Reply
651−openOrCloseIndexes oci (IndexName indexName) =
652− bindM2 post url (return Nothing)
653− where ociString = stringifyOCIndex oci
654− url = joinPath [indexName, ociString]
655−
656−-- | 'openIndex' opens an index given a 'Server' and an 'IndexName'. Explained in further detail at
657−-- <http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/indices-open-close.html>
658−--
659−-- >>> reply <- runBH' $ openIndex testIndex
660−openIndex :: MonadBH m => IndexName -> m Reply
661−openIndex = openOrCloseIndexes OpenIndex
662−
663−-- | 'closeIndex' closes an index given a 'Server' and an 'IndexName'. Explained in further detail at
664−-- <http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/indices-open-close.html>
665−--
666−-- >>> reply <- runBH' $ closeIndex testIndex
667−closeIndex :: MonadBH m => IndexName -> m Reply
668−closeIndex = openOrCloseIndexes CloseIndex
669−
670−-- | 'listIndices' returns a list of all index names on a given 'Server'
671−listIndices :: (MonadThrow m, MonadBH m) => m [IndexName]
672−listIndices =
673− parse . responseBody =<< get =<< url
674− where
675− url = joinPath ["_cat/indices?v"]
676− -- parses the tabular format the indices api provides
677− parse body = case T.lines (T.decodeUtf8 (L.toStrict body)) of
678− (hdr:rows) -> let ks = T.words hdr
679− keyedRows = [ HM.fromList (zip ks (T.words row)) | row <- rows ]
680− names = catMaybes (HM.lookup "index" <$> keyedRows)
681− in return (IndexName <$> names)
682− [] -> throwM (EsProtocolException body)
683−
684−-- | 'updateIndexAliases' updates the server's index alias
685−-- table. Operations are atomic. Explained in further detail at
686−-- <https://www.elastic.co/guide/en/elasticsearch/reference/current/indices-aliases.html>
687−--
688−-- >>> let src = IndexName "a-real-index"
689−-- >>> let aliasName = IndexName "an-alias"
690−-- >>> let iAlias = IndexAlias src (IndexAliasName aliasName)
691−-- >>> let aliasCreate = IndexAliasCreate Nothing Nothing
692−-- >>> _ <- runBH' $ deleteIndex src
693−-- >>> respIsTwoHunna <$> runBH' (createIndex defaultIndexSettings src)
694−-- True
695−-- >>> runBH' $ indexExists src
696−-- True
697−-- >>> respIsTwoHunna <$> runBH' (updateIndexAliases (AddAlias iAlias aliasCreate :| []))
698−-- True
699−-- >>> runBH' $ indexExists aliasName
700−-- True
701−updateIndexAliases :: MonadBH m => NonEmpty IndexAliasAction -> m Reply
702−updateIndexAliases actions = bindM2 post url (return body)
703− where url = joinPath ["_aliases"]
704− body = Just (encode bodyJSON)
705− bodyJSON = object [ "actions" .= toList actions]
706−
707−-- | Get all aliases configured on the server.
708−getIndexAliases :: (MonadBH m, MonadThrow m)
709− => m (Either EsError IndexAliasesSummary)
710−getIndexAliases = parseEsResponse =<< get =<< url
711− where url = joinPath ["_aliases"]
712−
713−-- | 'putTemplate' creates a template given an 'IndexTemplate' and a 'TemplateName'.
714−-- Explained in further detail at
715−-- <https://www.elastic.co/guide/en/elasticsearch/reference/1.7/indices-templates.html>
716−--
717−-- >>> let idxTpl = IndexTemplate (TemplatePattern "tweet-*") (Just (IndexSettings (ShardCount 1) (ReplicaCount 1))) [toJSON TweetMapping]
718−-- >>> resp <- runBH' $ putTemplate idxTpl (TemplateName "tweet-tpl")
719−putTemplate :: MonadBH m => IndexTemplate -> TemplateName -> m Reply
720−putTemplate indexTemplate (TemplateName templateName) =
721− bindM2 put url (return body)
722− where url = joinPath ["_template", templateName]
723− body = Just $ encode indexTemplate
724−
725−-- | 'templateExists' checks to see if a template exists.
726−--
727−-- >>> exists <- runBH' $ templateExists (TemplateName "tweet-tpl")
728−templateExists :: MonadBH m => TemplateName -> m Bool
729−templateExists (TemplateName templateName) = do
730− (_, exists) <- existentialQuery =<< joinPath ["_template", templateName]
731− return exists
732−
733−-- | 'deleteTemplate' is an HTTP DELETE and deletes a template.
734−--
735−-- >>> let idxTpl = IndexTemplate (TemplatePattern "tweet-*") (Just (IndexSettings (ShardCount 1) (ReplicaCount 1))) [toJSON TweetMapping]
736−-- >>> _ <- runBH' $ putTemplate idxTpl (TemplateName "tweet-tpl")
737−-- >>> resp <- runBH' $ deleteTemplate (TemplateName "tweet-tpl")
738−deleteTemplate :: MonadBH m => TemplateName -> m Reply
739−deleteTemplate (TemplateName templateName) =
740− delete =<< joinPath ["_template", templateName]
741−
742−-- | 'putMapping' is an HTTP PUT and has upsert semantics. Mappings are schemas
743−-- for documents in indexes.
744−--
745−-- >>> _ <- runBH' $ createIndex defaultIndexSettings testIndex
746−-- >>> resp <- runBH' $ putMapping testIndex testMapping TweetMapping
747−-- >>> print resp
748−-- Response {responseStatus = Status {statusCode = 200, statusMessage = "OK"}, responseVersion = HTTP/1.1, responseHeaders = [("Content-Type","application/json; charset=UTF-8"),("Content-Length","21")], responseBody = "{\"acknowledged\":true}", responseCookieJar = CJ {expose = []}, responseClose' = ResponseClose}
749−putMapping :: (MonadBH m, ToJSON a) => IndexName
750− -> MappingName -> a -> m Reply
751−putMapping (IndexName indexName) (MappingName mappingName) mapping =
752− bindM2 put url (return body)
753− where url = joinPath [indexName, "_mapping", mappingName]
754− -- "_mapping" and mappingName above were originally transposed
755− -- erroneously. The correct API call is: "/INDEX/_mapping/MAPPING_NAME"
756− body = Just $ encode mapping
757−
758−-- | 'deleteMapping' is an HTTP DELETE and deletes a mapping for a given index.
759−-- Mappings are schemas for documents in indexes.
760−--
761−-- >>> _ <- runBH' $ createIndex defaultIndexSettings testIndex
762−-- >>> _ <- runBH' $ putMapping testIndex testMapping TweetMapping
763−-- >>> resp <- runBH' $ deleteMapping testIndex testMapping
764−-- >>> print resp
765−-- Response {responseStatus = Status {statusCode = 200, statusMessage = "OK"}, responseVersion = HTTP/1.1, responseHeaders = [("Content-Type","application/json; charset=UTF-8"),("Content-Length","21")], responseBody = "{\"acknowledged\":true}", responseCookieJar = CJ {expose = []}, responseClose' = ResponseClose}
766−deleteMapping :: MonadBH m => IndexName -> MappingName -> m Reply
767−deleteMapping (IndexName indexName)
768− (MappingName mappingName) =
769− -- "_mapping" and mappingName below were originally transposed
770− -- erroneously. The correct API call is: "/INDEX/_mapping/MAPPING_NAME"
771− delete =<< joinPath [indexName, "_mapping", mappingName]
772−
773−versionCtlParams :: IndexDocumentSettings -> [(Text, Maybe Text)]
774−versionCtlParams cfg =
775− case idsVersionControl cfg of
776− NoVersionControl -> []
777− InternalVersion v -> versionParams v "internal"
778− ExternalGT (ExternalDocVersion v) -> versionParams v "external_gt"
779− ExternalGTE (ExternalDocVersion v) -> versionParams v "external_gte"
780− ForceVersion (ExternalDocVersion v) -> versionParams v "force"
781− where
782− vt = showText . docVersionNumber
783− versionParams v t = [ ("version", Just $ vt v)
784− , ("version_type", Just t)
785− ]
786−
787−-- | 'indexDocument' is the primary way to save a single document in
788−-- Elasticsearch. The document itself is simply something we can
789−-- convert into a JSON 'Value'. The 'DocId' will function as the
790−-- primary key for the document.
791−--
792−-- >>> resp <- runBH' $ indexDocument testIndex testMapping defaultIndexDocumentSettings exampleTweet (DocId "1")
793−-- >>> print resp
794−-- Response {responseStatus = Status {statusCode = 201, statusMessage = "Created"}, responseVersion = HTTP/1.1, responseHeaders = [("Content-Type","application/json; charset=UTF-8"),("Content-Length","74")], responseBody = "{\"_index\":\"twitter\",\"_type\":\"tweet\",\"_id\":\"1\",\"_version\":1,\"created\":true}", responseCookieJar = CJ {expose = []}, responseClose' = ResponseClose}
795−indexDocument :: (ToJSON doc, MonadBH m) => IndexName -> MappingName
796− -> IndexDocumentSettings -> doc -> DocId -> m Reply
797−indexDocument (IndexName indexName)
798− (MappingName mappingName) cfg document (DocId docId) =
799− bindM2 put url (return body)
800− where url = addQuery params <$> joinPath [indexName, mappingName, docId]
801− parentParams = case idsParent cfg of
802− Nothing -> []
803− Just (DocumentParent (DocId p)) -> [ ("parent", Just p) ]
804− params = versionCtlParams cfg ++ parentParams
805− body = Just (encode document)
806−
807−-- | 'updateDocument' provides a way to perform an partial update of a
808−-- an already indexed document.
809−updateDocument :: (ToJSON patch, MonadBH m) => IndexName -> MappingName
810− -> IndexDocumentSettings -> patch -> DocId -> m Reply
811−updateDocument (IndexName indexName)
812− (MappingName mappingName) cfg patch (DocId docId) =
813− bindM2 post url (return body)
814− where url = addQuery (versionCtlParams cfg) <$>
815− joinPath [indexName, mappingName, docId, "_update"]
816− body = Just (encode $ object ["doc" .= toJSON patch])
817−
818−-- | 'deleteDocument' is the primary way to delete a single document.
819−--
820−-- >>> _ <- runBH' $ deleteDocument testIndex testMapping (DocId "1")
821−deleteDocument :: MonadBH m => IndexName -> MappingName
822− -> DocId -> m Reply
823−deleteDocument (IndexName indexName)
824− (MappingName mappingName) (DocId docId) =
825− delete =<< joinPath [indexName, mappingName, docId]
826−
827−-- | 'bulk' uses
828−-- <http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/docs-bulk.html Elasticsearch's bulk API>
829−-- to perform bulk operations. The 'BulkOperation' data type encodes the
830−-- index\/update\/delete\/create operations. You pass a 'V.Vector' of 'BulkOperation's
831−-- and a 'Server' to 'bulk' in order to send those operations up to your Elasticsearch
832−-- server to be performed. I changed from [BulkOperation] to a Vector due to memory overhead.
833−--
834−-- >>> let stream = V.fromList [BulkIndex testIndex testMapping (DocId "2") (toJSON (BulkTest "blah"))]
835−-- >>> _ <- runBH' $ bulk stream
836−-- >>> _ <- runBH' $ refreshIndex testIndex
837−bulk :: MonadBH m => V.Vector BulkOperation -> m Reply
838−bulk bulkOps = bindM2 post url (return body)
839− where url = joinPath ["_bulk"]
840− body = Just $ encodeBulkOperations bulkOps
841−
842−-- | 'encodeBulkOperations' is a convenience function for dumping a vector of 'BulkOperation'
843−-- into an 'L.ByteString'
844−--
845−-- >>> let bulkOps = V.fromList [BulkIndex testIndex testMapping (DocId "2") (toJSON (BulkTest "blah"))]
846−-- >>> encodeBulkOperations bulkOps
847−-- "\n{\"index\":{\"_type\":\"tweet\",\"_id\":\"2\",\"_index\":\"twitter\"}}\n{\"name\":\"blah\"}\n"
848−encodeBulkOperations :: V.Vector BulkOperation -> L.ByteString
849−encodeBulkOperations stream = collapsed where
850− blobs = fmap encodeBulkOperation stream
851− mashedTaters = mash (mempty :: Builder) blobs
852− collapsed = toLazyByteString $ mappend mashedTaters (byteString "\n")
853−
854−mash :: Builder -> V.Vector L.ByteString -> Builder
855−mash = V.foldl' (\b x -> b `mappend` (byteString "\n") `mappend` (lazyByteString x))
856−
857−mkBulkStreamValue :: Text -> Text -> Text -> Text -> Value
858−mkBulkStreamValue operation indexName mappingName docId =
859− object [operation .=
860− object [ "_index" .= indexName
861− , "_type" .= mappingName
862− , "_id" .= docId]]
863−
864−-- | 'encodeBulkOperation' is a convenience function for dumping a single 'BulkOperation'
865−-- into an 'L.ByteString'
866−--
867−-- >>> let bulkOp = BulkIndex testIndex testMapping (DocId "2") (toJSON (BulkTest "blah"))
868−-- >>> encodeBulkOperation bulkOp
869−-- "{\"index\":{\"_type\":\"tweet\",\"_id\":\"2\",\"_index\":\"twitter\"}}\n{\"name\":\"blah\"}"
870−encodeBulkOperation :: BulkOperation -> L.ByteString
871−encodeBulkOperation (BulkIndex (IndexName indexName)
872− (MappingName mappingName)
873− (DocId docId) value) = blob
874− where metadata = mkBulkStreamValue "index" indexName mappingName docId
875− blob = encode metadata `mappend` "\n" `mappend` encode value
876−
877−encodeBulkOperation (BulkCreate (IndexName indexName)
878− (MappingName mappingName)
879− (DocId docId) value) = blob
880− where metadata = mkBulkStreamValue "create" indexName mappingName docId
881− blob = encode metadata `mappend` "\n" `mappend` encode value
882−
883−encodeBulkOperation (BulkDelete (IndexName indexName)
884− (MappingName mappingName)
885− (DocId docId)) = blob
886− where metadata = mkBulkStreamValue "delete" indexName mappingName docId
887− blob = encode metadata
888−
889−encodeBulkOperation (BulkUpdate (IndexName indexName)
890− (MappingName mappingName)
891− (DocId docId) value) = blob
892− where metadata = mkBulkStreamValue "update" indexName mappingName docId
893− doc = object ["doc" .= value]
894− blob = encode metadata `mappend` "\n" `mappend` encode doc
895−
896−-- | 'getDocument' is a straight-forward way to fetch a single document from
897−-- Elasticsearch using a 'Server', 'IndexName', 'MappingName', and a 'DocId'.
898−-- The 'DocId' is the primary key for your Elasticsearch document.
899−--
900−-- >>> yourDoc <- runBH' $ getDocument testIndex testMapping (DocId "1")
901−getDocument :: MonadBH m => IndexName -> MappingName
902− -> DocId -> m Reply
903−getDocument (IndexName indexName)
904− (MappingName mappingName) (DocId docId) =
905− get =<< joinPath [indexName, mappingName, docId]
906−
907−-- | 'documentExists' enables you to check if a document exists. Returns 'Bool'
908−-- in IO
909−--
910−-- >>> exists <- runBH' $ documentExists testIndex testMapping Nothing (DocId "1")
911−documentExists :: MonadBH m => IndexName -> MappingName
912− -> Maybe DocumentParent -> DocId -> m Bool
913−documentExists (IndexName indexName) (MappingName mappingName)
914− parent (DocId docId) = do
915− (_, exists) <- existentialQuery =<< url
916− return exists
917− where url = addQuery params <$> joinPath [indexName, mappingName, docId]
918− parentParam = fmap (\(DocumentParent (DocId p)) -> p) parent
919− params = LS.filter (\(_, v) -> isJust v) [("parent", parentParam)]
920−
921−dispatchSearch :: MonadBH m => Text -> Search -> m Reply
922−dispatchSearch url search = post url' (Just (encode search))
923− where url' = appendSearchTypeParam url (searchType search)
924−
925−-- | 'searchAll', given a 'Search', will perform that search against all indexes
926−-- on an Elasticsearch server. Try to avoid doing this if it can be helped.
927−--
928−-- >>> let query = TermQuery (Term "user" "bitemyapp") Nothing
929−-- >>> let search = mkSearch (Just query) Nothing
930−-- >>> reply <- runBH' $ searchAll search
931−searchAll :: MonadBH m => Search -> m Reply
932−searchAll = bindM2 dispatchSearch url . return
933− where url = joinPath ["_search"]
934−
935−-- | 'searchByIndex', given a 'Search' and an 'IndexName', will perform that search
936−-- against all mappings within an index on an Elasticsearch server.
937−--
938−-- >>> let query = TermQuery (Term "user" "bitemyapp") Nothing
939−-- >>> let search = mkSearch (Just query) Nothing
940−-- >>> reply <- runBH' $ searchByIndex testIndex search
941−searchByIndex :: MonadBH m => IndexName -> Search -> m Reply
942−searchByIndex (IndexName indexName) = bindM2 dispatchSearch url . return
943− where url = joinPath [indexName, "_search"]
944−
945−-- | 'searchByType', given a 'Search', 'IndexName', and 'MappingName', will perform that
946−-- search against a specific mapping within an index on an Elasticsearch server.
947−--
948−-- >>> let query = TermQuery (Term "user" "bitemyapp") Nothing
949−-- >>> let search = mkSearch (Just query) Nothing
950−-- >>> reply <- runBH' $ searchByType testIndex testMapping search
951−searchByType :: MonadBH m => IndexName -> MappingName -> Search
952− -> m Reply
953−searchByType (IndexName indexName)
954− (MappingName mappingName) = bindM2 dispatchSearch url . return
955− where url = joinPath [indexName, mappingName, "_search"]
956−
957−-- | For a given scearch, request a scroll for efficient streaming of
958−-- search results. Note that the search is put into 'SearchTypeScan'
959−-- mode and thus results will not be sorted. Combine this with
960−-- 'advanceScroll' to efficiently stream through the full result set
961−getInitialScroll :: MonadBH m => IndexName -> MappingName -> Search -> m (Maybe ScrollId)
962−getInitialScroll (IndexName indexName) (MappingName mappingName) search = do
963− let url = joinPath [indexName, mappingName, "_search"]
964− search' = search { searchType = SearchTypeScan }
965− resp' <- bindM2 dispatchSearch url (return search')
966− let msr = decode' $ responseBody resp' :: Maybe (SearchResult ())
967− msid = maybe Nothing scrollId msr
968− return msid
969−
970−scroll' :: (FromJSON a, MonadBH m, MonadThrow m) => Maybe ScrollId -> m ([Hit a], Maybe ScrollId)
971−scroll' Nothing = return ([], Nothing)
972−scroll' (Just sid) = do
973− res <- advanceScroll sid 60
974− case res of
975− Right SearchResult {..} -> return (hits searchHits, scrollId)
976− Left _ -> return ([], Nothing)
977−
978−-- | Use the given scroll to fetch the next page of documents. If there are no
979−-- further pages, 'SearchResult.searchHits.hits' will be '[]'.
980−advanceScroll
981− :: ( FromJSON a
982− , MonadBH m
983− , MonadThrow m
984− )
985− => ScrollId
986− -> NominalDiffTime
987− -- ^ 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.
988− -> m (Either EsError (SearchResult a))
989−advanceScroll (ScrollId sid) scroll = do
990− url <- joinPath ["_search/scroll?scroll=" <> scrollTime]
991− parseEsResponse =<< post url (Just . L.fromStrict $ T.encodeUtf8 sid)
992− where scrollTime = showText secs <> "s"
993− secs :: Integer
994− secs = round scroll
995−
996−simpleAccumulator :: (FromJSON a, MonadBH m, MonadThrow m) => [Hit a] -> ([Hit a], Maybe ScrollId) -> m ([Hit a], Maybe ScrollId)
997−simpleAccumulator oldHits (newHits, Nothing) = return (oldHits ++ newHits, Nothing)
998−simpleAccumulator oldHits ([], _) = return (oldHits, Nothing)
999−simpleAccumulator oldHits (newHits, msid) = do
1000− (newHits', msid') <- scroll' msid
1001− simpleAccumulator (oldHits ++ newHits) (newHits', msid')
1002−
1003−-- | 'scanSearch' uses the 'scan&scroll' API of elastic,
1004−-- for a given 'IndexName' and 'MappingName'. Note that this will
1005−-- consume the entire search result set and will be doing O(n) list
1006−-- appends so this may not be suitable for large result sets. In that
1007−-- case, 'getInitialScroll' and 'advanceScroll' are good low level
1008−-- tools. You should be able to hook them up trivially to conduit,
1009−-- pipes, or your favorite streaming IO abstraction of choice. Note
1010−-- that ordering on the search would destroy performance and thus is
1011−-- ignored.
1012−scanSearch :: (FromJSON a, MonadBH m, MonadThrow m) => IndexName -> MappingName -> Search -> m [Hit a]
1013−scanSearch indexName mappingName search = do
1014− msid <- getInitialScroll indexName mappingName search
1015− (hits, msid') <- scroll' msid
1016− (totalHits, _) <- simpleAccumulator [] (hits, msid')
1017− return totalHits
1018−
1019−-- | 'mkSearch' is a helper function for defaulting additional fields of a 'Search'
1020−-- to Nothing in case you only care about your 'Query' and 'Filter'. Use record update
1021−-- syntax if you want to add things like aggregations or highlights while still using
1022−-- this helper function.
1023−--
1024−-- >>> let query = TermQuery (Term "user" "bitemyapp") Nothing
1025−-- >>> mkSearch (Just query) Nothing
1026−-- 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}
1027−mkSearch :: Maybe Query -> Maybe Filter -> Search
1028−mkSearch query filter = Search query filter Nothing Nothing Nothing False (From 0) (Size 10) SearchTypeQueryThenFetch Nothing Nothing
1029−
1030−-- | 'mkAggregateSearch' is a helper function that defaults everything in a 'Search' except for
1031−-- the 'Query' and the 'Aggregation'.
1032−--
1033−-- >>> let terms = TermsAgg $ (mkTermsAggregation "user") { termCollectMode = Just BreadthFirst }
1034−-- >>> terms
1035−-- TermsAgg (TermsAggregation {term = Left "user", termInclude = Nothing, termExclude = Nothing, termOrder = Nothing, termMinDocCount = Nothing, termSize = Nothing, termShardSize = Nothing, termCollectMode = Just BreadthFirst, termExecutionHint = Nothing, termAggs = Nothing})
1036−-- >>> let myAggregation = mkAggregateSearch Nothing $ mkAggregations "users" terms
1037−mkAggregateSearch :: Maybe Query -> Aggregations -> Search
1038−mkAggregateSearch query mkSearchAggs = Search query Nothing Nothing (Just mkSearchAggs) Nothing False (From 0) (Size 0) SearchTypeQueryThenFetch Nothing Nothing
1039−
1040−-- | 'mkHighlightSearch' is a helper function that defaults everything in a 'Search' except for
1041−-- the 'Query' and the 'Aggregation'.
1042−--
1043−-- >>> let query = QueryMatchQuery $ mkMatchQuery (FieldName "_all") (QueryString "haskell")
1044−-- >>> let testHighlight = Highlights Nothing [FieldHighlight (FieldName "message") Nothing]
1045−-- >>> let search = mkHighlightSearch (Just query) testHighlight
1046−mkHighlightSearch :: Maybe Query -> Highlights -> Search
1047−mkHighlightSearch query searchHighlights = Search query Nothing Nothing Nothing (Just searchHighlights) False (From 0) (Size 10) SearchTypeQueryThenFetch Nothing Nothing
1048−
1049−-- | 'pageSearch' is a helper function that takes a search and assigns the from
1050−-- and size fields for the search. The from parameter defines the offset
1051−-- from the first result you want to fetch. The size parameter allows you to
1052−-- configure the maximum amount of hits to be returned.
1053−--
1054−-- >>> let query = QueryMatchQuery $ mkMatchQuery (FieldName "_all") (QueryString "haskell")
1055−-- >>> let search = mkSearch (Just query) Nothing
1056−-- >>> search
1057−-- Search {queryBody = Just (QueryMatchQuery (MatchQuery {matchQueryField = FieldName "_all", matchQueryQueryString = QueryString "haskell", matchQueryOperator = Or, matchQueryZeroTerms = ZeroTermsNone, matchQueryCutoffFrequency = Nothing, matchQueryMatchType = Nothing, matchQueryAnalyzer = Nothing, matchQueryMaxExpansions = Nothing, matchQueryLenient = Nothing, matchQueryBoost = Nothing})), filterBody = Nothing, sortBody = Nothing, aggBody = Nothing, highlight = Nothing, trackSortScores = False, from = From 0, size = Size 10, searchType = SearchTypeQueryThenFetch, fields = Nothing, source = Nothing}
1058−-- >>> pageSearch (From 10) (Size 100) search
1059−-- Search {queryBody = Just (QueryMatchQuery (MatchQuery {matchQueryField = FieldName "_all", matchQueryQueryString = QueryString "haskell", matchQueryOperator = Or, matchQueryZeroTerms = ZeroTermsNone, matchQueryCutoffFrequency = Nothing, matchQueryMatchType = Nothing, matchQueryAnalyzer = Nothing, matchQueryMaxExpansions = Nothing, matchQueryLenient = Nothing, matchQueryBoost = Nothing})), filterBody = Nothing, sortBody = Nothing, aggBody = Nothing, highlight = Nothing, trackSortScores = False, from = From 10, size = Size 100, searchType = SearchTypeQueryThenFetch, fields = Nothing, source = Nothing}
1060−pageSearch :: From -- ^ The result offset
1061− -> Size -- ^ The number of results to return
1062− -> Search -- ^ The current seach
1063− -> Search -- ^ The paged search
1064−pageSearch resultOffset pageSize search = search { from = resultOffset, size = pageSize }
1065−
1066−parseUrl' :: MonadThrow m => Text -> m Request
1067−parseUrl' t = parseRequest (URI.escapeURIString URI.isAllowedInURI (T.unpack t))
1068−
1069−-- | Was there an optimistic concurrency control conflict when
1070−-- indexing a document?
1071−isVersionConflict :: Reply -> Bool
1072−isVersionConflict = statusCheck (== 409)
1073−
1074−isSuccess :: Reply -> Bool
1075−isSuccess = statusCheck (inRange (200, 299))
1076−
1077−isCreated :: Reply -> Bool
1078−isCreated = statusCheck (== 201)
1079−
1080−statusCheck :: (Int -> Bool) -> Reply -> Bool
1081−statusCheck prd = prd . NHTS.statusCode . responseStatus
1082−
1083−-- | This is a hook that can be set via the 'bhRequestHook' function
1084−-- that will authenticate all requests using an HTTP Basic
1085−-- Authentication header. Note that it is *strongly* recommended that
1086−-- this option only be used over an SSL connection.
1087−--
1088−-- >> (mkBHEnv myServer myManager) { bhRequestHook = basicAuthHook (EsUsername "myuser") (EsPassword "mypass") }
1089−basicAuthHook :: Monad m => EsUsername -> EsPassword -> Request -> m Request
1090−basicAuthHook (EsUsername u) (EsPassword p) = return . applyBasicAuth u' p'
1091− where u' = T.encodeUtf8 u
1092− p' = T.encodeUtf8 p
1093−
1094−
1095−boolQP :: Bool -> Text
1096−boolQP True = "true"
1097−boolQP False = "false"
src/Database/V1/Bloodhound/Types.hsdeleted−5271
@@ -1,5271 +0,0 @@
1−{-# LANGUAGE DeriveDataTypeable #-}
2−{-# LANGUAGE DeriveGeneric #-}
3−{-# LANGUAGE FlexibleContexts #-}
4−{-# LANGUAGE FlexibleInstances #-}
5−{-# LANGUAGE GeneralizedNewtypeDeriving #-}
6−{-# LANGUAGE MultiParamTypeClasses #-}
7−-- {-# LANGUAGE NoMonomorphismRestriction #-}
8−{-# LANGUAGE NamedFieldPuns #-}
9−{-# LANGUAGE OverloadedStrings #-}
10−{-# LANGUAGE RecordWildCards #-}
11−{-# LANGUAGE UndecidableInstances #-}
12−
13−-------------------------------------------------------------------------------
14−-- |
15−-- Module : Database.Bloodhound.Types
16−-- Copyright : (C) 2014, 2015, 2016 Chris Allen
17−-- License : BSD-style (see the file LICENSE)
18−-- Maintainer : Chris Allen <cma@bitemyapp.com
19−-- Stability : provisional
20−-- Portability : DeriveGeneric, RecordWildCards
21−--
22−-- Data types for describing actions and data structures performed to interact
23−-- with Elasticsearch. The two main buckets your queries against Elasticsearch
24−-- will fall into are 'Query's and 'Filter's. 'Filter's are more like
25−-- traditional database constraints and often have preferable performance
26−-- properties. 'Query's support human-written textual queries, such as fuzzy
27−-- queries.
28−-------------------------------------------------------------------------------
29−
30−
31−
32−module Database.V1.Bloodhound.Types
33− ( defaultCache
34− , defaultIndexSettings
35− , defaultIndexDocumentSettings
36− , mkSort
37− , showText
38− , unpackId
39− , mkMatchQuery
40− , mkMultiMatchQuery
41− , mkBoolQuery
42− , mkRangeQuery
43− , mkQueryStringQuery
44− , mkAggregations
45− , mkTermsAggregation
46− , mkTermsScriptAggregation
47− , mkDateHistogram
48− , mkCardinalityAggregation
49− , mkDocVersion
50− , docVersionNumber
51− , toMissing
52− , toTerms
53− , toDateHistogram
54− , toTopHits
55− , omitNulls
56− , BH(..)
57− , runBH
58− , BHEnv
59− , bhServer
60− , bhManager
61− , bhRequestHook
62− , mkBHEnv
63− , MonadBH(..)
64− , Version(..)
65− , VersionNumber(..)
66− , MaybeNA(..)
67− , BuildHash(..)
68− , Status(..)
69− , Existence(..)
70− , NullValue(..)
71− , IndexSettings(..)
72− , UpdatableIndexSetting(..)
73− , IndexSettingsSummary(..)
74− , AllocationPolicy(..)
75− , ReplicaBounds(..)
76− , Bytes(..)
77− , gigabytes
78− , megabytes
79− , kilobytes
80− , FSType(..)
81− , InitialShardCount(..)
82− , NodeAttrFilter(..)
83− , NodeAttrName(..)
84− , CompoundFormat(..)
85− , IndexTemplate(..)
86− , Server(..)
87− , Reply
88− , EsResult(..)
89− , EsResultFound(..)
90− , EsError(..)
91− , EsProtocolException(..)
92− , IndexAlias(..)
93− , IndexAliasName(..)
94− , IndexAliasAction(..)
95− , IndexAliasCreate(..)
96− , IndexAliasSummary(..)
97− , IndexAliasesSummary(..)
98− , AliasRouting(..)
99− , SearchAliasRouting(..)
100− , IndexAliasRouting(..)
101− , RoutingValue(..)
102− , DocVersion
103− , ExternalDocVersion(..)
104− , VersionControl(..)
105− , DocumentParent(..)
106− , IndexDocumentSettings(..)
107− , Query(..)
108− , Search(..)
109− , SearchType(..)
110− , SearchResult(..)
111− , ScrollId(..)
112− , SearchHits(..)
113− , TrackSortScores
114− , From(..)
115− , Size(..)
116− , Source(..)
117− , PatternOrPatterns(..)
118− , Include(..)
119− , Exclude(..)
120− , Pattern(..)
121− , ShardResult(..)
122− , Hit(..)
123− , Filter(..)
124− , Seminearring(..)
125− , BoolMatch(..)
126− , Term(..)
127− , GeoPoint(..)
128− , GeoBoundingBoxConstraint(..)
129− , GeoBoundingBox(..)
130− , GeoFilterType(..)
131− , Distance(..)
132− , DistanceUnit(..)
133− , DistanceType(..)
134− , DistanceRange(..)
135− , OptimizeBbox(..)
136− , LatLon(..)
137− , RangeValue(..)
138− , RangeExecution(..)
139− , LessThan(..)
140− , LessThanEq(..)
141− , GreaterThan(..)
142− , GreaterThanEq(..)
143− , LessThanD(..)
144− , LessThanEqD(..)
145− , GreaterThanD(..)
146− , GreaterThanEqD(..)
147− , Regexp(..)
148− , RegexpFlags(..)
149− , RegexpFlag(..)
150− , FieldName(..)
151− , Script(..)
152− , IndexName(..)
153− , IndexSelection(..)
154− , NodeSelection(..)
155− , NodeSelector(..)
156− , IndexOptimizationSettings(..)
157− , defaultIndexOptimizationSettings
158− , TemplateName(..)
159− , TemplatePattern(..)
160− , MappingName(..)
161− , DocId(..)
162− , CacheName(..)
163− , CacheKey(..)
164− , BulkOperation(..)
165− , ReplicaCount(..)
166− , ShardCount(..)
167− , Sort
168− , SortMode(..)
169− , SortOrder(..)
170− , SortSpec(..)
171− , DefaultSort(..)
172− , Missing(..)
173− , OpenCloseIndex(..)
174− , Method
175− , Boost(..)
176− , MatchQuery(..)
177− , MultiMatchQuery(..)
178− , BoolQuery(..)
179− , BoostingQuery(..)
180− , CommonTermsQuery(..)
181− , DisMaxQuery(..)
182− , FilteredQuery(..)
183− , FuzzyLikeThisQuery(..)
184− , FuzzyLikeFieldQuery(..)
185− , FuzzyQuery(..)
186− , HasChildQuery(..)
187− , HasParentQuery(..)
188− , IndicesQuery(..)
189− , MoreLikeThisQuery(..)
190− , MoreLikeThisFieldQuery(..)
191− , NestedQuery(..)
192− , PrefixQuery(..)
193− , QueryStringQuery(..)
194− , SimpleQueryStringQuery(..)
195− , RangeQuery(..)
196− , RegexpQuery(..)
197− , QueryString(..)
198− , BooleanOperator(..)
199− , ZeroTermsQuery(..)
200− , CutoffFrequency(..)
201− , Analyzer(..)
202− , MaxExpansions(..)
203− , Lenient(..)
204− , MatchQueryType(..)
205− , MultiMatchQueryType(..)
206− , Tiebreaker(..)
207− , MinimumMatch(..)
208− , DisableCoord(..)
209− , CommonMinimumMatch(..)
210− , MinimumMatchHighLow(..)
211− , PrefixLength(..)
212− , Fuzziness(..)
213− , IgnoreTermFrequency(..)
214− , MaxQueryTerms(..)
215− , ScoreType(..)
216− , Score
217− , Cache
218− , TypeName(..)
219− , BoostTerms(..)
220− , MaxWordLength(..)
221− , MinWordLength(..)
222− , MaxDocFrequency(..)
223− , MinDocFrequency(..)
224− , PhraseSlop(..)
225− , StopWord(..)
226− , QueryPath(..)
227− , MinimumTermFrequency(..)
228− , PercentMatch(..)
229− , FieldDefinition(..)
230− , MappingField(..)
231− , Mapping(..)
232− , AllowLeadingWildcard(..)
233− , LowercaseExpanded(..)
234− , GeneratePhraseQueries(..)
235− , Locale(..)
236− , AnalyzeWildcard(..)
237− , EnablePositionIncrements(..)
238− , SimpleQueryFlag(..)
239− , FieldOrFields(..)
240− , Monoid(..)
241− , ToJSON(..)
242− , Interval(..)
243− , TimeInterval(..)
244− , ExecutionHint(..)
245− , CollectionMode(..)
246− , TermOrder(..)
247− , TermInclusion(..)
248− , SnapshotRepoSelection(..)
249− , GenericSnapshotRepo(..)
250− , SnapshotRepo(..)
251− , SnapshotRepoConversionError(..)
252− , SnapshotRepoType(..)
253− , GenericSnapshotRepoSettings(..)
254− , SnapshotRepoUpdateSettings(..)
255− , defaultSnapshotRepoUpdateSettings
256− , SnapshotRepoName(..)
257− , SnapshotRepoPattern(..)
258− , SnapshotVerification(..)
259− , SnapshotNodeVerification(..)
260− , FullNodeId(..)
261− , NodeName(..)
262− , ClusterName(..)
263− , NodesInfo(..)
264− , NodesStats(..)
265− , NodeStats(..)
266− , NodeBreakersStats(..)
267− , NodeBreakerStats(..)
268− , NodeHTTPStats(..)
269− , NodeTransportStats(..)
270− , NodeFSStats(..)
271− , NodeDataPathStats(..)
272− , NodeFSTotalStats(..)
273− , NodeNetworkStats(..)
274− , NodeThreadPoolsStats(..)
275− , NodeThreadPoolStats(..)
276− , NodeJVMStats(..)
277− , JVMBufferPoolStats(..)
278− , JVMGCStats(..)
279− , JVMPoolStats(..)
280− , NodeProcessStats(..)
281− , NodeOSStats(..)
282− , LoadAvgs(..)
283− , NodeIndicesStats(..)
284− , EsAddress(..)
285− , PluginName(..)
286− , NodeInfo(..)
287− , NodePluginInfo(..)
288− , NodeHTTPInfo(..)
289− , NodeTransportInfo(..)
290− , BoundTransportAddress(..)
291− , NodeNetworkInfo(..)
292− , MacAddress(..)
293− , NetworkInterfaceName(..)
294− , NodeNetworkInterface(..)
295− , NodeThreadPoolsInfo(..)
296− , NodeThreadPoolInfo(..)
297− , ThreadPoolSize(..)
298− , ThreadPoolType(..)
299− , NodeJVMInfo(..)
300− , JVMMemoryPool(..)
301− , JVMGCCollector(..)
302− , JVMMemoryInfo(..)
303− , PID(..)
304− , NodeOSInfo(..)
305− , CPUInfo(..)
306− , NodeProcessInfo(..)
307− , FsSnapshotRepo(..)
308− , SnapshotCreateSettings(..)
309− , defaultSnapshotCreateSettings
310− , SnapshotSelection(..)
311− , SnapshotPattern(..)
312− , SnapshotInfo(..)
313− , SnapshotShardFailure(..)
314− , ShardId(..)
315− , SnapshotName(..)
316− , SnapshotState(..)
317− , SnapshotRestoreSettings(..)
318− , defaultSnapshotRestoreSettings
319− , RestoreRenamePattern(..)
320− , RestoreRenameToken(..)
321− , RRGroupRefNum
322− , rrGroupRefNum
323− , mkRRGroupRefNum
324− , RestoreIndexSettings(..)
325−
326− , Aggregation(..)
327− , Aggregations
328− , AggregationResults
329− , BucketValue(..)
330− , Bucket(..)
331− , BucketAggregation(..)
332− , TermsAggregation(..)
333− , MissingAggregation(..)
334− , ValueCountAggregation(..)
335− , FilterAggregation(..)
336− , CardinalityAggregation(..)
337− , DateHistogramAggregation(..)
338− , DateRangeAggregation(..)
339− , DateRangeAggRange(..)
340− , DateMathExpr(..)
341− , DateMathAnchor(..)
342− , DateMathModifier(..)
343− , DateMathUnit(..)
344− , TopHitsAggregation(..)
345−
346− , Highlights(..)
347− , FieldHighlight(..)
348− , HighlightSettings(..)
349− , PlainHighlight(..)
350− , PostingsHighlight(..)
351− , FastVectorHighlight(..)
352− , CommonHighlight(..)
353− , NonPostings(..)
354− , HighlightEncoder(..)
355− , HighlightTag(..)
356− , HitHighlight
357−
358− , MissingResult(..)
359− , TermsResult(..)
360− , DateHistogramResult(..)
361− , DateRangeResult(..)
362− , TopHitResult(..)
363−
364− , EsUsername(..)
365− , EsPassword(..)
366− ) where
367−
368−import Control.Applicative as A
369−import Control.Arrow (first)
370−import Control.Monad.Catch
371−import Control.Monad.Except
372−import Control.Monad.Reader
373−import Control.Monad.State
374−import Control.Monad.Writer
375−import Data.Aeson
376−import Data.Aeson.Types (Pair, Parser, emptyObject,
377− parseEither, parseMaybe)
378−import qualified Data.ByteString.Lazy.Char8 as L
379−import Data.Char
380−import Data.Hashable (Hashable)
381−import qualified Data.HashMap.Strict as HM
382−import Data.List (foldl', intercalate, nub)
383−import Data.List.NonEmpty (NonEmpty (..), toList)
384−import qualified Data.Map.Strict as M
385−import Data.Maybe
386−import Data.Scientific (Scientific)
387−import Data.Text (Text)
388−import qualified Data.Text as T
389−import Data.Time.Calendar
390−import Data.Time.Clock (NominalDiffTime, UTCTime)
391−import Data.Time.Clock.POSIX
392−import qualified Data.Traversable as DT
393−import Data.Typeable (Typeable)
394−import qualified Data.Vector as V
395−import qualified Data.Version as Vers
396−import GHC.Enum
397−import GHC.Generics (Generic)
398−import Network.HTTP.Client
399−import qualified Network.HTTP.Types.Method as NHTM
400−import qualified Text.ParserCombinators.ReadP as RP
401−import qualified Text.Read as TR
402−
403−import Database.V1.Bloodhound.Types.Class
404−import Database.V1.Bloodhound.Types.Internal
405−
406−-- $setup
407−-- >>> :set -XOverloadedStrings
408−-- >>> import Data.Aeson
409−-- >>> import Database.V1.Bloodhound
410−-- >>> let testServer = (Server "http://localhost:9200")
411−-- >>> let testIndex = IndexName "twitter"
412−-- >>> let testMapping = MappingName "tweet"
413−-- >>> let defaultIndexSettings = IndexSettings (ShardCount 3) (ReplicaCount 2)
414−
415−-- defaultIndexSettings is exported by Database.Bloodhound as well
416−-- no trailing slashes in servers, library handles building the path.
417−
418−-- | Create a 'BHEnv' with all optional fields defaulted. HTTP hook
419−-- will be a noop. You can use the exported fields to customize it further, e.g.:
420−--
421−-- >> (mkBHEnv myServer myManager) { bhRequestHook = customHook }
422−mkBHEnv :: Server -> Manager -> BHEnv
423−mkBHEnv s m = BHEnv s m return
424−
425−newtype BH m a = BH {
426− unBH :: ReaderT BHEnv m a
427− } deriving ( Functor
428− , A.Applicative
429− , Monad
430− , MonadIO
431− , MonadState s
432− , MonadWriter w
433− , MonadError e
434− , Alternative
435− , MonadPlus
436− , MonadFix
437− , MonadThrow
438− , MonadCatch
439− , MonadMask)
440−
441−instance MonadTrans BH where
442− lift = BH . lift
443−
444−instance (MonadReader r m) => MonadReader r (BH m) where
445− ask = lift ask
446− local f (BH (ReaderT m)) = BH $ ReaderT $ \r ->
447− local f (m r)
448−
449−instance (Functor m, Applicative m, MonadIO m) => MonadBH (BH m) where
450− getBHEnv = BH getBHEnv
451−
452−runBH :: BHEnv -> BH m a -> m a
453−runBH e f = runReaderT (unBH f) e
454−
455−{-| 'Version' is embedded in 'Status' -}
456−data Version = Version { number :: VersionNumber
457− , build_hash :: BuildHash
458− , build_timestamp :: UTCTime
459− , build_snapshot :: Bool
460− , lucene_version :: VersionNumber } deriving (Eq, Read, Show, Generic, Typeable)
461−
462−-- | Traditional software versioning number
463−newtype VersionNumber = VersionNumber { versionNumber :: Vers.Version
464− } deriving (Eq, Read, Show, Generic, Typeable, Ord)
465−
466−{-| 'Status' is a data type for describing the JSON body returned by
467− Elasticsearch when you query its status. This was deprecated in 1.2.0.
468−
469− <http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/indices-status.html#indices-status>
470−-}
471−
472−data Status = Status { ok :: Maybe Bool
473− , status :: Int
474− , name :: Text
475− , version :: Version
476− , tagline :: Text } deriving (Eq, Read, Show, Generic)
477−
478−{-| 'IndexSettings' is used to configure the shards and replicas when you create
479− an Elasticsearch Index.
480−
481− <http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/indices-create-index.html>
482−-}
483−
484−data IndexSettings =
485− IndexSettings { indexShards :: ShardCount
486− , indexReplicas :: ReplicaCount } deriving (Eq, Read, Show, Generic, Typeable)
487−
488−{-| 'defaultIndexSettings' is an 'IndexSettings' with 3 shards and 2 replicas. -}
489−defaultIndexSettings :: IndexSettings
490−defaultIndexSettings = IndexSettings (ShardCount 3) (ReplicaCount 2)
491−
492−
493−{-| 'IndexOptimizationSettings' is used to configure index optimization. See
494− <https://www.elastic.co/guide/en/elasticsearch/reference/1.7/indices-optimize.html>
495− for more info.
496−-}
497−data IndexOptimizationSettings =
498− IndexOptimizationSettings { maxNumSegments :: Maybe Int
499− -- ^ 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.
500− , onlyExpungeDeletes :: Bool
501− -- ^ 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.
502− , flushAfterOptimize :: Bool
503− -- ^ Should a flush be performed after the optimize.
504− } deriving (Eq, Show, Generic, Typeable)
505−
506−
507−{-| 'defaultIndexOptimizationSettings' implements the default settings that
508− ElasticSearch uses for index optimization. 'maxNumSegments' is Nothing,
509− 'onlyExpungeDeletes' is False, and flushAfterOptimize is True.
510−-}
511−defaultIndexOptimizationSettings :: IndexOptimizationSettings
512−defaultIndexOptimizationSettings = IndexOptimizationSettings Nothing False True
513−
514−{-| 'UpdatableIndexSetting' are settings which may be updated after an index is created.
515−
516− <https://www.elastic.co/guide/en/elasticsearch/reference/current/indices-update-settings.html>
517−-}
518−data UpdatableIndexSetting = NumberOfReplicas ReplicaCount
519− -- ^ The number of replicas each shard has.
520− | AutoExpandReplicas ReplicaBounds
521− | BlocksReadOnly Bool
522− -- ^ Set to True to have the index read only. False to allow writes and metadata changes.
523− | BlocksRead Bool
524− -- ^ Set to True to disable read operations against the index.
525− | BlocksWrite Bool
526− -- ^ Set to True to disable write operations against the index.
527− | BlocksMetaData Bool
528− -- ^ Set to True to disable metadata operations against the index.
529− | RefreshInterval NominalDiffTime
530− -- ^ The async refresh interval of a shard
531− | IndexConcurrency Int
532− | FailOnMergeFailure Bool
533− | TranslogFlushThresholdOps Int
534− -- ^ When to flush on operations.
535− | TranslogFlushThresholdSize Bytes
536− -- ^ When to flush based on translog (bytes) size.
537− | TranslogFlushThresholdPeriod NominalDiffTime
538− -- ^ When to flush based on a period of not flushing.
539− | TranslogDisableFlush Bool
540− -- ^ Disables flushing. Note, should be set for a short interval and then enabled.
541− | CacheFilterMaxSize (Maybe Bytes)
542− -- ^ The maximum size of filter cache (per segment in shard).
543− | CacheFilterExpire (Maybe NominalDiffTime)
544− -- ^ The expire after access time for filter cache.
545− | GatewaySnapshotInterval NominalDiffTime
546− -- ^ The gateway snapshot interval (only applies to shared gateways).
547− | RoutingAllocationInclude (NonEmpty NodeAttrFilter)
548− -- ^ A node matching any rule will be allowed to host shards from the index.
549− | RoutingAllocationExclude (NonEmpty NodeAttrFilter)
550− -- ^ A node matching any rule will NOT be allowed to host shards from the index.
551− | RoutingAllocationRequire (NonEmpty NodeAttrFilter)
552− -- ^ Only nodes matching all rules will be allowed to host shards from the index.
553− | RoutingAllocationEnable AllocationPolicy
554− -- ^ Enables shard allocation for a specific index.
555− | RoutingAllocationShardsPerNode ShardCount
556− -- ^ Controls the total number of shards (replicas and primaries) allowed to be allocated on a single node.
557− | RecoveryInitialShards InitialShardCount
558− -- ^ When using local gateway a particular shard is recovered only if there can be allocated quorum shards in the cluster.
559− | GCDeletes NominalDiffTime
560− | TTLDisablePurge Bool
561− -- ^ Disables temporarily the purge of expired docs.
562− | TranslogFSType FSType
563− | IndexCompoundFormat CompoundFormat
564− | IndexCompoundOnFlush Bool
565− | WarmerEnabled Bool
566− deriving (Eq, Show, Generic, Typeable)
567−
568−data AllocationPolicy = AllocAll
569− -- ^ Allows shard allocation for all shards.
570− | AllocPrimaries
571− -- ^ Allows shard allocation only for primary shards.
572− | AllocNewPrimaries
573− -- ^ Allows shard allocation only for primary shards for new indices.
574− | AllocNone
575− -- ^ No shard allocation is allowed
576− deriving (Eq, Read, Show, Generic, Typeable)
577−
578−data ReplicaBounds = ReplicasBounded Int Int
579− | ReplicasLowerBounded Int
580− | ReplicasUnbounded
581− deriving (Eq, Read, Show, Generic, Typeable)
582−
583−-- | A measure of bytes used for various configurations. You may want
584−-- to use smart constructors like 'gigabytes' for larger values.
585−--
586−-- >>> gigabytes 9
587−-- Bytes 9000000000
588−--
589−-- >>> megabytes 9
590−-- Bytes 9000000
591−--
592−-- >>> kilobytes 9
593−-- Bytes 9000
594−newtype Bytes = Bytes Int deriving (Eq, Read, Show, Generic, Typeable, Ord, ToJSON, FromJSON)
595−
596−gigabytes :: Int -> Bytes
597−gigabytes n = megabytes (1000 * n)
598−
599−
600−megabytes :: Int -> Bytes
601−megabytes n = kilobytes (1000 * n)
602−
603−
604−kilobytes :: Int -> Bytes
605−kilobytes n = Bytes (1000 * n)
606−
607−
608−data FSType = FSSimple
609− | FSBuffered deriving (Eq, Read, Show, Generic, Typeable, Ord)
610−
611−data InitialShardCount = QuorumShards
612− | QuorumMinus1Shards
613− | FullShards
614− | FullMinus1Shards
615− | ExplicitShards Int
616− deriving (Eq, Read, Show, Generic, Typeable)
617−
618−data NodeAttrFilter = NodeAttrFilter { nodeAttrFilterName :: NodeAttrName
619− , nodeAttrFilterValues :: NonEmpty Text}
620− deriving (Eq, Read, Show, Generic, Ord, Typeable)
621−
622−newtype NodeAttrName = NodeAttrName Text deriving (Eq, Read, Show, Ord, Generic, Typeable)
623−
624−data CompoundFormat = CompoundFileFormat Bool
625− | MergeSegmentVsTotalIndex Double
626− -- ^ percentage between 0 and 1 where 0 is false, 1 is true
627− deriving (Eq, Read, Show, Generic, Typeable)
628−
629−newtype NominalDiffTimeJSON = NominalDiffTimeJSON { ndtJSON :: NominalDiffTime }
630−
631−data IndexSettingsSummary = IndexSettingsSummary { sSummaryIndexName :: IndexName
632− , sSummaryFixedSettings :: IndexSettings
633− , sSummaryUpdateable :: [UpdatableIndexSetting]}
634− deriving (Eq, Show, Generic, Typeable)
635−
636−{-| 'Reply' and 'Method' are type synonyms from 'Network.HTTP.Types.Method.Method' -}
637−type Reply = Network.HTTP.Client.Response L.ByteString
638−type Method = NHTM.Method
639−
640−{-| 'OpenCloseIndex' is a sum type for opening and closing indices.
641−
642− <http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/indices-open-close.html>
643−-}
644−data OpenCloseIndex = OpenIndex | CloseIndex deriving (Eq, Read, Show, Generic, Typeable)
645−
646−data FieldType = GeoPointType
647− | GeoShapeType
648− | FloatType
649− | IntegerType
650− | LongType
651− | ShortType
652− | ByteType deriving (Eq, Read, Show, Generic, Typeable)
653−
654−data FieldDefinition =
655− FieldDefinition { fieldType :: FieldType } deriving (Eq, Read, Show, Generic, Typeable)
656−
657−{-| An 'IndexTemplate' defines a template that will automatically be
658− applied to new indices created. The templates include both
659− 'IndexSettings' and mappings, and a simple 'TemplatePattern' that
660− controls if the template will be applied to the index created.
661− Specify mappings as follows: @[toJSON TweetMapping, ...]@
662−
663− https://www.elastic.co/guide/en/elasticsearch/reference/1.7/indices-templates.html
664−-}
665−data IndexTemplate =
666− IndexTemplate { templatePattern :: TemplatePattern
667− , templateSettings :: Maybe IndexSettings
668− , templateMappings :: [Value]
669− }
670−
671−data MappingField =
672− MappingField { mappingFieldName :: FieldName
673− , fieldDefinition :: FieldDefinition } deriving (Eq, Read, Show, Generic, Typeable)
674−
675−{-| Support for type reification of 'Mapping's is currently incomplete, for
676− now the mapping API verbiage expects a 'ToJSON'able blob.
677−
678− Indexes have mappings, mappings are schemas for the documents contained in the
679− index. I'd recommend having only one mapping per index, always having a mapping,
680− and keeping different kinds of documents separated if possible.
681−-}
682−data Mapping = Mapping { typeName :: TypeName
683− , mappingFields :: [MappingField] } deriving (Eq, Read, Show, Generic, Typeable)
684−
685−{-| 'BulkOperation' is a sum type for expressing the four kinds of bulk
686− operation index, create, delete, and update. 'BulkIndex' behaves like an
687− "upsert", 'BulkCreate' will fail if a document already exists at the DocId.
688−
689− <http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/docs-bulk.html#docs-bulk>
690−-}
691−data BulkOperation =
692− BulkIndex IndexName MappingName DocId Value
693− | BulkCreate IndexName MappingName DocId Value
694− | BulkDelete IndexName MappingName DocId
695− | BulkUpdate IndexName MappingName DocId Value deriving (Eq, Read, Show, Generic, Typeable)
696−
697−{-| 'EsResult' describes the standard wrapper JSON document that you see in
698− successful Elasticsearch lookups or lookups that couldn't find the document.
699−-}
700−data EsResult a = EsResult { _index :: Text
701− , _type :: Text
702− , _id :: Text
703− , foundResult :: Maybe (EsResultFound a)} deriving (Eq, Read, Show, Generic, Typeable)
704−
705−{-| 'EsResultFound' contains the document and its metadata inside of an
706− 'EsResult' when the document was successfully found.
707−-}
708−data EsResultFound a = EsResultFound { _version :: DocVersion
709− , _source :: a } deriving (Eq, Read, Show, Generic, Typeable)
710−
711−{-| 'EsError' is the generic type that will be returned when there was a
712− problem. If you can't parse the expected response, its a good idea to
713− try parsing this.
714−-}
715−data EsError = EsError { errorStatus :: Int
716− , errorMessage :: Text } deriving (Eq, Read, Show, Generic, Typeable)
717−
718−{-| 'EsProtocolException' will be thrown if Bloodhound cannot parse a response
719−returned by the ElasticSearch server. If you encounter this error, please
720−verify that your domain data types and FromJSON instances are working properly
721−(for example, the 'a' of '[Hit a]' in 'SearchResult.searchHits.hits'). If you're
722−sure that your mappings are correct, then this error may be an indication of an
723−incompatibility between Bloodhound and ElasticSearch. Please open a bug report
724−and be sure to include the exception body.
725−-}
726−data EsProtocolException = EsProtocolException { esProtoExBody :: L.ByteString }
727− deriving (Eq, Read, Show, Generic, Typeable)
728−
729−instance Exception EsProtocolException
730−
731−data IndexAlias = IndexAlias { srcIndex :: IndexName
732− , indexAlias :: IndexAliasName } deriving (Eq, Read, Show, Generic, Typeable)
733−
734−newtype IndexAliasName = IndexAliasName { indexAliasName :: IndexName } deriving (Eq, Read, Show, Generic, ToJSON)
735−
736−data IndexAliasAction = AddAlias IndexAlias IndexAliasCreate
737− | RemoveAlias IndexAlias deriving (Read, Show, Eq, Generic, Typeable)
738−
739−data IndexAliasCreate = IndexAliasCreate { aliasCreateRouting :: Maybe AliasRouting
740− , aliasCreateFilter :: Maybe Filter}
741− deriving (Read, Show, Eq, Generic, Typeable)
742−
743−data AliasRouting = AllAliasRouting RoutingValue
744− | GranularAliasRouting (Maybe SearchAliasRouting) (Maybe IndexAliasRouting)
745− deriving (Read, Show, Eq, Generic, Typeable)
746−
747−newtype SearchAliasRouting = SearchAliasRouting (NonEmpty RoutingValue) deriving (Read, Show, Eq, Generic, Typeable)
748−
749−newtype IndexAliasRouting = IndexAliasRouting RoutingValue deriving (Read, Show, Eq, Generic, ToJSON, FromJSON, Typeable)
750−
751−newtype RoutingValue = RoutingValue { routingValue :: Text } deriving (Read, Show, Eq, Generic, ToJSON, FromJSON, Typeable)
752−
753−newtype IndexAliasesSummary = IndexAliasesSummary { indexAliasesSummary :: [IndexAliasSummary] } deriving (Read, Show, Eq, Generic, Typeable)
754−
755−{-| 'IndexAliasSummary' is a summary of an index alias configured for a server. -}
756−data IndexAliasSummary = IndexAliasSummary { indexAliasSummaryAlias :: IndexAlias
757− , indexAliasSummaryCreate :: IndexAliasCreate} deriving (Read, Show, Eq, Generic, Typeable)
758−
759−{-| 'DocVersion' is an integer version number for a document between 1
760−and 9.2e+18 used for <<https://www.elastic.co/guide/en/elasticsearch/guide/current/optimistic-concurrency-control.html optimistic concurrency control>>.
761−-}
762−newtype DocVersion = DocVersion {
763− docVersionNumber :: Int
764− } deriving (Eq, Read, Show, Generic, Ord, ToJSON)
765−
766−-- | Smart constructor for in-range doc version
767−mkDocVersion :: Int -> Maybe DocVersion
768−mkDocVersion i
769− | i >= (docVersionNumber minBound) && i <= (docVersionNumber maxBound) =
770− Just $ DocVersion i
771− | otherwise = Nothing
772−
773−
774−{-| 'ExternalDocVersion' is a convenience wrapper if your code uses its
775−own version numbers instead of ones from ES.
776−-}
777−newtype ExternalDocVersion = ExternalDocVersion DocVersion
778− deriving (Eq, Read, Show, Generic, Ord, Bounded, Enum, ToJSON)
779−
780−{-| 'VersionControl' is specified when indexing documents as a
781−optimistic concurrency control.
782−-}
783−data VersionControl = NoVersionControl
784− -- ^ Don't send a version. This is a pure overwrite.
785− | InternalVersion DocVersion
786− -- ^ Use the default ES versioning scheme. Only
787− -- index the document if the version is the same
788− -- as the one specified. Only applicable to
789− -- updates, as you should be getting Version from
790− -- a search result.
791− | ExternalGT ExternalDocVersion
792− -- ^ Use your own version numbering. Only index
793− -- the document if the version is strictly higher
794− -- OR the document doesn't exist. The given
795− -- version will be used as the new version number
796− -- for the stored document. N.B. All updates must
797− -- increment this number, meaning there is some
798− -- global, external ordering of updates.
799− | ExternalGTE ExternalDocVersion
800− -- ^ Use your own version numbering. Only index
801− -- the document if the version is equal or higher
802− -- than the stored version. Will succeed if there
803− -- is no existing document. The given version will
804− -- be used as the new version number for the
805− -- stored document. Use with care, as this could
806− -- result in data loss.
807− | ForceVersion ExternalDocVersion
808− -- ^ The document will always be indexed and the
809− -- given version will be the new version. This is
810− -- typically used for correcting errors. Use with
811− -- care, as this could result in data loss.
812− deriving (Read, Show, Eq, Generic, Ord)
813−
814−{-| 'DocumentParent' is used to specify a parent document.
815−-}
816−newtype DocumentParent = DocumentParent DocId
817− deriving (Eq, Read, Show, Generic, Typeable)
818−
819−{-| 'IndexDocumentSettings' are special settings supplied when indexing
820−a document. For the best backwards compatiblity when new fields are
821−added, you should probably prefer to start with 'defaultIndexDocumentSettings'
822−-}
823−data IndexDocumentSettings =
824− IndexDocumentSettings { idsVersionControl :: VersionControl
825− , idsParent :: Maybe DocumentParent
826− } deriving (Eq, Read, Show, Generic, Typeable)
827−
828−{-| Reasonable default settings. Chooses no version control and no parent.
829−-}
830−defaultIndexDocumentSettings :: IndexDocumentSettings
831−defaultIndexDocumentSettings = IndexDocumentSettings NoVersionControl Nothing
832−
833−{-| 'Sort' is a synonym for a list of 'SortSpec's. Sort behavior is order
834− dependent with later sorts acting as tie-breakers for earlier sorts.
835−-}
836−type Sort = [SortSpec]
837−
838−{-| The two main kinds of 'SortSpec' are 'DefaultSortSpec' and
839− 'GeoDistanceSortSpec'. The latter takes a 'SortOrder', 'GeoPoint', and
840− 'DistanceUnit' to express "nearness" to a single geographical point as a
841− sort specification.
842−
843−<http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/search-request-sort.html#search-request-sort>
844−-}
845−data SortSpec = DefaultSortSpec DefaultSort
846− | GeoDistanceSortSpec SortOrder GeoPoint DistanceUnit deriving (Eq, Read, Show, Generic, Typeable)
847−
848−{-| 'DefaultSort' is usually the kind of 'SortSpec' you'll want. There's a
849− 'mkSort' convenience function for when you want to specify only the most
850− common parameters.
851−
852−<http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/search-request-sort.html#search-request-sort>
853−-}
854−data DefaultSort =
855− DefaultSort { sortFieldName :: FieldName
856− , sortOrder :: SortOrder
857− -- default False
858− , ignoreUnmapped :: Bool
859− , sortMode :: Maybe SortMode
860− , missingSort :: Maybe Missing
861− , nestedFilter :: Maybe Filter } deriving (Eq, Read, Show, Generic, Typeable)
862−
863−{-| 'SortOrder' is 'Ascending' or 'Descending', as you might expect. These get
864− encoded into "asc" or "desc" when turned into JSON.
865−
866−<http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/search-request-sort.html#search-request-sort>
867−-}
868−data SortOrder = Ascending
869− | Descending deriving (Eq, Read, Show, Generic, Typeable)
870−
871−{-| 'Missing' prescribes how to handle missing fields. A missing field can be
872− sorted last, first, or using a custom value as a substitute.
873−
874−<http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/search-request-sort.html#_missing_values>
875−-}
876−data Missing = LastMissing
877− | FirstMissing
878− | CustomMissing Text deriving (Eq, Read, Show, Generic, Typeable)
879−
880−{-| 'SortMode' prescribes how to handle sorting array/multi-valued fields.
881−
882−http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/search-request-sort.html#_sort_mode_option
883−-}
884−data SortMode = SortMin
885− | SortMax
886− | SortSum
887− | SortAvg deriving (Eq, Read, Show, Generic, Typeable)
888−
889−{-| 'mkSort' defaults everything but the 'FieldName' and the 'SortOrder' so
890− that you can concisely describe the usual kind of 'SortSpec's you want.
891−-}
892−mkSort :: FieldName -> SortOrder -> DefaultSort
893−mkSort fieldName sOrder = DefaultSort fieldName sOrder False Nothing Nothing Nothing
894−
895−{-| 'Cache' is for telling ES whether it should cache a 'Filter' not.
896− 'Query's cannot be cached.
897−-}
898−type Cache = Bool -- caching on/off
899−defaultCache :: Cache
900−defaultCache = False
901−
902−{-| 'PrefixValue' is used in 'PrefixQuery' as the main query component.
903−-}
904−type PrefixValue = Text
905−
906−{-| 'BooleanOperator' is the usual And/Or operators with an ES compatible
907− JSON encoding baked in. Used all over the place.
908−-}
909−data BooleanOperator = And | Or deriving (Eq, Read, Show, Generic, Typeable)
910−
911−{-| 'ShardCount' is part of 'IndexSettings'
912−-}
913−newtype ShardCount = ShardCount Int deriving (Eq, Read, Show, Generic, ToJSON, Typeable)
914−
915−{-| 'ReplicaCount' is part of 'IndexSettings'
916−-}
917−newtype ReplicaCount = ReplicaCount Int deriving (Eq, Read, Show, Generic, ToJSON, Typeable)
918−
919−{-| 'IndexName' is used to describe which index to query/create/delete
920−-}
921−newtype IndexName = IndexName Text deriving (Eq, Generic, Read, Show, ToJSON, FromJSON, Typeable)
922−
923−{-| 'IndexSelection' is used for APIs which take a single index, a list of
924− indexes, or the special @_all@ index.
925−-}
926−--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.
927−data IndexSelection = IndexList (NonEmpty IndexName)
928− | AllIndexes deriving (Eq, Generic, Show, Typeable)
929−
930−{-| '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.
931−-}
932−data NodeSelection = LocalNode
933− -- ^ Whatever node receives this request
934− | NodeList (NonEmpty NodeSelector)
935− | AllNodes deriving (Eq, Generic, Show, Typeable)
936−
937−
938−-- | An exact match or pattern to identify a node. Note that All of
939−-- these options support wildcarding, so your node name, server, attr
940−-- name can all contain * characters to be a fuzzy match.
941−data NodeSelector = NodeByName NodeName
942− | NodeByFullNodeId FullNodeId
943− | NodeByHost Server
944− -- ^ e.g. 10.0.0.1 or even 10.0.0.*
945− | NodeByAttribute NodeAttrName Text
946− -- ^ NodeAttrName can be a pattern, e.g. rack*. The value can too.
947− deriving (Eq, Generic, Show, Typeable)
948−
949−{-| 'TemplateName' is used to describe which template to query/create/delete
950−-}
951−newtype TemplateName = TemplateName Text deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
952−
953−{-| 'TemplatePattern' represents a pattern which is matched against index names
954−-}
955−newtype TemplatePattern = TemplatePattern Text deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
956−
957−{-| 'MappingName' is part of mappings which are how ES describes and schematizes
958− the data in the indices.
959−-}
960−newtype MappingName = MappingName Text deriving (Eq, Generic, Read, Show, ToJSON, FromJSON, Typeable)
961−
962−{-| 'DocId' is a generic wrapper value for expressing unique Document IDs.
963− Can be set by the user or created by ES itself. Often used in client
964− functions for poking at specific documents.
965−-}
966−newtype DocId = DocId Text deriving (Eq, Generic, Read, Show, ToJSON, FromJSON, Typeable)
967−
968−{-| 'QueryString' is used to wrap query text bodies, be they human written or not.
969−-}
970−newtype QueryString = QueryString Text deriving (Eq, Generic, Read, Show, ToJSON, FromJSON, Typeable)
971−
972−{-| 'FieldName' is used all over the place wherever a specific field within
973− a document needs to be specified, usually in 'Query's or 'Filter's.
974−-}
975−newtype FieldName = FieldName Text deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
976−
977−
978−{-| 'Script' is often used in place of 'FieldName' to specify more
979−complex ways of extracting a value from a document.
980−-}
981−newtype Script = Script { scriptText :: Text } deriving (Eq, Read, Show, Generic, Typeable)
982−
983−{-| 'CacheName' is used in 'RegexpFilter' for describing the
984− 'CacheKey' keyed caching behavior.
985−-}
986−newtype CacheName = CacheName Text deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
987−
988−{-| 'CacheKey' is used in 'RegexpFilter' to key regex caching.
989−-}
990−newtype CacheKey =
991− CacheKey Text deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
992−newtype Existence =
993− Existence Bool deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
994−newtype NullValue =
995− NullValue Bool deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
996−newtype CutoffFrequency =
997− CutoffFrequency Double deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
998−newtype Analyzer =
999− Analyzer Text deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1000−newtype MaxExpansions =
1001− MaxExpansions Int deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1002−
1003−{-| 'Lenient', if set to true, will cause format based failures to be
1004− ignored. I don't know what the bloody default is, Elasticsearch
1005− documentation didn't say what it was. Let me know if you figure it out.
1006−-}
1007−newtype Lenient =
1008− Lenient Bool deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1009−newtype Tiebreaker =
1010− Tiebreaker Double deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1011−newtype Boost =
1012− Boost Double deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1013−newtype BoostTerms =
1014− BoostTerms Double deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1015−
1016−{-| 'MinimumMatch' controls how many should clauses in the bool query should
1017− match. Can be an absolute value (2) or a percentage (30%) or a
1018− combination of both.
1019−-}
1020−newtype MinimumMatch =
1021− MinimumMatch Int deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1022−newtype DisableCoord =
1023− DisableCoord Bool deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1024−newtype IgnoreTermFrequency =
1025− IgnoreTermFrequency Bool deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1026−newtype MinimumTermFrequency =
1027− MinimumTermFrequency Int deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1028−newtype MaxQueryTerms =
1029− MaxQueryTerms Int deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1030−newtype Fuzziness =
1031− Fuzziness Double deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1032−
1033−{-| 'PrefixLength' is the prefix length used in queries, defaults to 0. -}
1034−newtype PrefixLength =
1035− PrefixLength Int deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1036−newtype TypeName =
1037− TypeName Text deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1038−newtype PercentMatch =
1039− PercentMatch Double deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1040−newtype StopWord =
1041− StopWord Text deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1042−newtype QueryPath =
1043− QueryPath Text deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1044−
1045−{-| Allowing a wildcard at the beginning of a word (eg "*ing") is particularly
1046− heavy, because all terms in the index need to be examined, just in case
1047− they match. Leading wildcards can be disabled by setting
1048− 'AllowLeadingWildcard' to false. -}
1049−newtype AllowLeadingWildcard =
1050− AllowLeadingWildcard Bool deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1051−newtype LowercaseExpanded =
1052− LowercaseExpanded Bool deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1053−newtype EnablePositionIncrements =
1054− EnablePositionIncrements Bool deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1055−
1056−{-| By default, wildcard terms in a query are not analyzed.
1057− Setting 'AnalyzeWildcard' to true enables best-effort analysis.
1058−-}
1059−newtype AnalyzeWildcard = AnalyzeWildcard Bool deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1060−
1061−{-| 'GeneratePhraseQueries' defaults to false.
1062−-}
1063−newtype GeneratePhraseQueries =
1064− GeneratePhraseQueries Bool deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1065−
1066−{-| 'Locale' is used for string conversions - defaults to ROOT.
1067−-}
1068−newtype Locale = Locale Text deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1069−newtype MaxWordLength = MaxWordLength Int deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1070−newtype MinWordLength = MinWordLength Int deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1071−
1072−{-| 'PhraseSlop' sets the default slop for phrases, 0 means exact
1073− phrase matches. Default is 0.
1074−-}
1075−newtype PhraseSlop = PhraseSlop Int deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1076−newtype MinDocFrequency = MinDocFrequency Int deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1077−newtype MaxDocFrequency = MaxDocFrequency Int deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1078−
1079−-- | Newtype wrapper to parse ES's concerning tendency to in some APIs return a floating point number of milliseconds since epoch ಠ_ಠ
1080−newtype POSIXMS = POSIXMS { posixMS :: UTCTime }
1081−
1082−{-| 'unpackId' is a silly convenience function that gets used once.
1083−-}
1084−unpackId :: DocId -> Text
1085−unpackId (DocId docId) = docId
1086−
1087−type TrackSortScores = Bool
1088−newtype From = From Int deriving (Eq, Read, Show, Generic, ToJSON)
1089−newtype Size = Size Int deriving (Eq, Read, Show, Generic, ToJSON)
1090−
1091−data Search = Search { queryBody :: Maybe Query
1092− , filterBody :: Maybe Filter
1093− , sortBody :: Maybe Sort
1094− , aggBody :: Maybe Aggregations
1095− , highlight :: Maybe Highlights
1096− -- default False
1097− , trackSortScores :: TrackSortScores
1098− , from :: From
1099− , size :: Size
1100− , searchType :: SearchType
1101− , fields :: Maybe [FieldName]
1102− , source :: Maybe Source } deriving (Eq, Read, Show, Generic, Typeable)
1103−
1104−data SearchType = SearchTypeQueryThenFetch
1105− | SearchTypeDfsQueryThenFetch
1106− | SearchTypeCount
1107− | SearchTypeScan
1108− | SearchTypeQueryAndFetch
1109− | SearchTypeDfsQueryAndFetch
1110− deriving (Eq, Read, Show, Generic, Typeable)
1111−
1112−data Source =
1113− NoSource
1114− | SourcePatterns PatternOrPatterns
1115− | SourceIncludeExclude Include Exclude
1116− deriving (Read, Show, Eq, Generic, Typeable)
1117−
1118−data PatternOrPatterns = PopPattern Pattern
1119− | PopPatterns [Pattern] deriving (Eq, Read, Show, Generic, Typeable)
1120−
1121−data Include = Include [Pattern] deriving (Eq, Read, Show, Generic, Typeable)
1122−data Exclude = Exclude [Pattern] deriving (Eq, Read, Show, Generic, Typeable)
1123−
1124−newtype Pattern = Pattern Text deriving (Eq, Read, Show, Generic, Typeable)
1125−
1126−data Highlights = Highlights { globalsettings :: Maybe HighlightSettings
1127− , highlightFields :: [FieldHighlight]
1128− } deriving (Read, Show, Eq, Generic, Typeable)
1129−
1130−data FieldHighlight = FieldHighlight FieldName (Maybe HighlightSettings)
1131− deriving (Read, Show, Eq, Generic, Typeable)
1132−
1133−
1134−data HighlightSettings = Plain PlainHighlight
1135− | Postings PostingsHighlight
1136− | FastVector FastVectorHighlight
1137− deriving (Read, Show, Eq, Generic, Typeable)
1138−data PlainHighlight =
1139− PlainHighlight { plainCommon :: Maybe CommonHighlight
1140− , plainNonPost :: Maybe NonPostings } deriving (Read, Show, Eq, Generic, Typeable)
1141−
1142− -- This requires that index_options are set to 'offset' in the mapping.
1143−data PostingsHighlight = PostingsHighlight (Maybe CommonHighlight) deriving (Read, Show, Eq, Generic, Typeable)
1144−
1145−-- This requires that term_vector is set to 'with_positions_offsets' in the mapping.
1146−data FastVectorHighlight =
1147− FastVectorHighlight { fvCommon :: Maybe CommonHighlight
1148− , fvNonPostSettings :: Maybe NonPostings
1149− , boundaryChars :: Maybe Text
1150− , boundaryMaxScan :: Maybe Int
1151− , fragmentOffset :: Maybe Int
1152− , matchedFields :: [Text]
1153− , phraseLimit :: Maybe Int
1154− } deriving (Read, Show, Eq, Generic, Typeable)
1155−
1156−data CommonHighlight =
1157− CommonHighlight { order :: Maybe Text
1158− , forceSource :: Maybe Bool
1159− , tag :: Maybe HighlightTag
1160− , encoder :: Maybe HighlightEncoder
1161− , noMatchSize :: Maybe Int
1162− , highlightQuery :: Maybe Query
1163− , requireFieldMatch :: Maybe Bool
1164− } deriving (Read, Show, Eq, Generic, Typeable)
1165−
1166−-- Settings that are only applicable to FastVector and Plain highlighters.
1167−data NonPostings =
1168− NonPostings { fragmentSize :: Maybe Int
1169− , numberOfFragments :: Maybe Int} deriving (Read, Show, Eq, Generic, Typeable)
1170−
1171−data HighlightEncoder = DefaultEncoder
1172− | HTMLEncoder
1173− deriving (Read, Show, Eq, Generic, Typeable)
1174−
1175−-- NOTE: Should the tags use some kind of HTML type, rather than Text?
1176−data HighlightTag = TagSchema Text
1177− | CustomTags ([Text], [Text]) -- Only uses more than the first value in the lists if fvh
1178− deriving (Read, Show, Eq, Generic, Typeable)
1179−
1180−
1181−data Query =
1182− TermQuery Term (Maybe Boost)
1183− | TermsQuery Text (NonEmpty Text)
1184− | QueryMatchQuery MatchQuery
1185− | QueryMultiMatchQuery MultiMatchQuery
1186− | QueryBoolQuery BoolQuery
1187− | QueryBoostingQuery BoostingQuery
1188− | QueryCommonTermsQuery CommonTermsQuery
1189− | ConstantScoreFilter Filter Boost
1190− | ConstantScoreQuery Query Boost
1191− | QueryDisMaxQuery DisMaxQuery
1192− | QueryFilteredQuery FilteredQuery
1193− | QueryFuzzyLikeThisQuery FuzzyLikeThisQuery
1194− | QueryFuzzyLikeFieldQuery FuzzyLikeFieldQuery
1195− | QueryFuzzyQuery FuzzyQuery
1196− | QueryHasChildQuery HasChildQuery
1197− | QueryHasParentQuery HasParentQuery
1198− | IdsQuery MappingName [DocId]
1199− | QueryIndicesQuery IndicesQuery
1200− | MatchAllQuery (Maybe Boost)
1201− | QueryMoreLikeThisQuery MoreLikeThisQuery
1202− | QueryMoreLikeThisFieldQuery MoreLikeThisFieldQuery
1203− | QueryNestedQuery NestedQuery
1204− | QueryPrefixQuery PrefixQuery
1205− | QueryQueryStringQuery QueryStringQuery
1206− | QuerySimpleQueryStringQuery SimpleQueryStringQuery
1207− | QueryRangeQuery RangeQuery
1208− | QueryRegexpQuery RegexpQuery
1209− deriving (Eq, Read, Show, Generic, Typeable)
1210−
1211−data RegexpQuery =
1212− RegexpQuery { regexpQueryField :: FieldName
1213− , regexpQuery :: Regexp
1214− , regexpQueryFlags :: RegexpFlags
1215− , regexpQueryBoost :: Maybe Boost
1216− } deriving (Eq, Read, Show, Generic, Typeable)
1217−
1218−data RangeQuery =
1219− RangeQuery { rangeQueryField :: FieldName
1220− , rangeQueryRange :: RangeValue
1221− , rangeQueryBoost :: Boost } deriving (Eq, Read, Show, Generic, Typeable)
1222−
1223−mkRangeQuery :: FieldName -> RangeValue -> RangeQuery
1224−mkRangeQuery f r = RangeQuery f r (Boost 1.0)
1225−
1226−data SimpleQueryStringQuery =
1227− SimpleQueryStringQuery
1228− { simpleQueryStringQuery :: QueryString
1229− , simpleQueryStringField :: Maybe FieldOrFields
1230− , simpleQueryStringOperator :: Maybe BooleanOperator
1231− , simpleQueryStringAnalyzer :: Maybe Analyzer
1232− , simpleQueryStringFlags :: Maybe (NonEmpty SimpleQueryFlag)
1233− , simpleQueryStringLowercaseExpanded :: Maybe LowercaseExpanded
1234− , simpleQueryStringLocale :: Maybe Locale
1235− } deriving (Eq, Read, Show, Generic, Typeable)
1236−
1237−data SimpleQueryFlag =
1238− SimpleQueryAll
1239− | SimpleQueryNone
1240− | SimpleQueryAnd
1241− | SimpleQueryOr
1242− | SimpleQueryPrefix
1243− | SimpleQueryPhrase
1244− | SimpleQueryPrecedence
1245− | SimpleQueryEscape
1246− | SimpleQueryWhitespace
1247− | SimpleQueryFuzzy
1248− | SimpleQueryNear
1249− | SimpleQuerySlop deriving (Eq, Read, Show, Generic, Typeable)
1250−
1251−-- use_dis_max and tie_breaker when fields are plural?
1252−data QueryStringQuery =
1253− QueryStringQuery
1254− { queryStringQuery :: QueryString
1255− , queryStringDefaultField :: Maybe FieldName
1256− , queryStringOperator :: Maybe BooleanOperator
1257− , queryStringAnalyzer :: Maybe Analyzer
1258− , queryStringAllowLeadingWildcard :: Maybe AllowLeadingWildcard
1259− , queryStringLowercaseExpanded :: Maybe LowercaseExpanded
1260− , queryStringEnablePositionIncrements :: Maybe EnablePositionIncrements
1261− , queryStringFuzzyMaxExpansions :: Maybe MaxExpansions
1262− , queryStringFuzziness :: Maybe Fuzziness
1263− , queryStringFuzzyPrefixLength :: Maybe PrefixLength
1264− , queryStringPhraseSlop :: Maybe PhraseSlop
1265− , queryStringBoost :: Maybe Boost
1266− , queryStringAnalyzeWildcard :: Maybe AnalyzeWildcard
1267− , queryStringGeneratePhraseQueries :: Maybe GeneratePhraseQueries
1268− , queryStringMinimumShouldMatch :: Maybe MinimumMatch
1269− , queryStringLenient :: Maybe Lenient
1270− , queryStringLocale :: Maybe Locale
1271− } deriving (Eq, Read, Show, Generic, Typeable)
1272−
1273−mkQueryStringQuery :: QueryString -> QueryStringQuery
1274−mkQueryStringQuery qs =
1275− QueryStringQuery qs Nothing Nothing
1276− Nothing Nothing Nothing Nothing
1277− Nothing Nothing Nothing Nothing
1278− Nothing Nothing Nothing Nothing
1279− Nothing Nothing
1280−
1281−data FieldOrFields = FofField FieldName
1282− | FofFields (NonEmpty FieldName) deriving (Eq, Read, Show, Generic, Typeable)
1283−
1284−data PrefixQuery =
1285− PrefixQuery
1286− { prefixQueryField :: FieldName
1287− , prefixQueryPrefixValue :: Text
1288− , prefixQueryBoost :: Maybe Boost } deriving (Eq, Read, Show, Generic, Typeable)
1289−
1290−data NestedQuery =
1291− NestedQuery
1292− { nestedQueryPath :: QueryPath
1293− , nestedQueryScoreType :: ScoreType
1294− , nestedQuery :: Query } deriving (Eq, Read, Show, Generic, Typeable)
1295−
1296−data MoreLikeThisFieldQuery =
1297− MoreLikeThisFieldQuery
1298− { moreLikeThisFieldText :: Text
1299− , moreLikeThisFieldFields :: FieldName
1300− -- default 0.3 (30%)
1301− , moreLikeThisFieldPercentMatch :: Maybe PercentMatch
1302− , moreLikeThisFieldMinimumTermFreq :: Maybe MinimumTermFrequency
1303− , moreLikeThisFieldMaxQueryTerms :: Maybe MaxQueryTerms
1304− , moreLikeThisFieldStopWords :: Maybe (NonEmpty StopWord)
1305− , moreLikeThisFieldMinDocFrequency :: Maybe MinDocFrequency
1306− , moreLikeThisFieldMaxDocFrequency :: Maybe MaxDocFrequency
1307− , moreLikeThisFieldMinWordLength :: Maybe MinWordLength
1308− , moreLikeThisFieldMaxWordLength :: Maybe MaxWordLength
1309− , moreLikeThisFieldBoostTerms :: Maybe BoostTerms
1310− , moreLikeThisFieldBoost :: Maybe Boost
1311− , moreLikeThisFieldAnalyzer :: Maybe Analyzer
1312− } deriving (Eq, Read, Show, Generic, Typeable)
1313−
1314−data MoreLikeThisQuery =
1315− MoreLikeThisQuery
1316− { moreLikeThisText :: Text
1317− , moreLikeThisFields :: Maybe (NonEmpty FieldName)
1318− -- default 0.3 (30%)
1319− , moreLikeThisPercentMatch :: Maybe PercentMatch
1320− , moreLikeThisMinimumTermFreq :: Maybe MinimumTermFrequency
1321− , moreLikeThisMaxQueryTerms :: Maybe MaxQueryTerms
1322− , moreLikeThisStopWords :: Maybe (NonEmpty StopWord)
1323− , moreLikeThisMinDocFrequency :: Maybe MinDocFrequency
1324− , moreLikeThisMaxDocFrequency :: Maybe MaxDocFrequency
1325− , moreLikeThisMinWordLength :: Maybe MinWordLength
1326− , moreLikeThisMaxWordLength :: Maybe MaxWordLength
1327− , moreLikeThisBoostTerms :: Maybe BoostTerms
1328− , moreLikeThisBoost :: Maybe Boost
1329− , moreLikeThisAnalyzer :: Maybe Analyzer
1330− } deriving (Eq, Read, Show, Generic, Typeable)
1331−
1332−data IndicesQuery =
1333− IndicesQuery
1334− { indicesQueryIndices :: [IndexName]
1335− , indicesQuery :: Query
1336− -- default "all"
1337− , indicesQueryNoMatch :: Maybe Query } deriving (Eq, Read, Show, Generic, Typeable)
1338−
1339−data HasParentQuery =
1340− HasParentQuery
1341− { hasParentQueryType :: TypeName
1342− , hasParentQuery :: Query
1343− , hasParentQueryScoreType :: Maybe ScoreType } deriving (Eq, Read, Show, Generic, Typeable)
1344−
1345−data HasChildQuery =
1346− HasChildQuery
1347− { hasChildQueryType :: TypeName
1348− , hasChildQuery :: Query
1349− , hasChildQueryScoreType :: Maybe ScoreType } deriving (Eq, Read, Show, Generic, Typeable)
1350−
1351−data ScoreType =
1352− ScoreTypeMax
1353− | ScoreTypeSum
1354− | ScoreTypeAvg
1355− | ScoreTypeNone deriving (Eq, Read, Show, Generic, Typeable)
1356−
1357−data FuzzyQuery =
1358− FuzzyQuery { fuzzyQueryField :: FieldName
1359− , fuzzyQueryValue :: Text
1360− , fuzzyQueryPrefixLength :: PrefixLength
1361− , fuzzyQueryMaxExpansions :: MaxExpansions
1362− , fuzzyQueryFuzziness :: Fuzziness
1363− , fuzzyQueryBoost :: Maybe Boost
1364− } deriving (Eq, Read, Show, Generic, Typeable)
1365−
1366−data FuzzyLikeFieldQuery =
1367− FuzzyLikeFieldQuery
1368− { fuzzyLikeField :: FieldName
1369− -- anaphora is good for the soul.
1370− , fuzzyLikeFieldText :: Text
1371− , fuzzyLikeFieldMaxQueryTerms :: MaxQueryTerms
1372− , fuzzyLikeFieldIgnoreTermFrequency :: IgnoreTermFrequency
1373− , fuzzyLikeFieldFuzziness :: Fuzziness
1374− , fuzzyLikeFieldPrefixLength :: PrefixLength
1375− , fuzzyLikeFieldBoost :: Boost
1376− , fuzzyLikeFieldAnalyzer :: Maybe Analyzer
1377− } deriving (Eq, Read, Show, Generic, Typeable)
1378−
1379−data FuzzyLikeThisQuery =
1380− FuzzyLikeThisQuery
1381− { fuzzyLikeFields :: [FieldName]
1382− , fuzzyLikeText :: Text
1383− , fuzzyLikeMaxQueryTerms :: MaxQueryTerms
1384− , fuzzyLikeIgnoreTermFrequency :: IgnoreTermFrequency
1385− , fuzzyLikeFuzziness :: Fuzziness
1386− , fuzzyLikePrefixLength :: PrefixLength
1387− , fuzzyLikeBoost :: Boost
1388− , fuzzyLikeAnalyzer :: Maybe Analyzer
1389− } deriving (Eq, Read, Show, Generic, Typeable)
1390−
1391−data FilteredQuery =
1392− FilteredQuery
1393− { filteredQuery :: Query
1394− , filteredFilter :: Filter } deriving (Eq, Read, Show, Generic, Typeable)
1395−
1396−data DisMaxQuery =
1397− DisMaxQuery { disMaxQueries :: [Query]
1398− -- default 0.0
1399− , disMaxTiebreaker :: Tiebreaker
1400− , disMaxBoost :: Maybe Boost
1401− } deriving (Eq, Read, Show, Generic, Typeable)
1402−
1403−data MatchQuery =
1404− MatchQuery { matchQueryField :: FieldName
1405− , matchQueryQueryString :: QueryString
1406− , matchQueryOperator :: BooleanOperator
1407− , matchQueryZeroTerms :: ZeroTermsQuery
1408− , matchQueryCutoffFrequency :: Maybe CutoffFrequency
1409− , matchQueryMatchType :: Maybe MatchQueryType
1410− , matchQueryAnalyzer :: Maybe Analyzer
1411− , matchQueryMaxExpansions :: Maybe MaxExpansions
1412− , matchQueryLenient :: Maybe Lenient
1413− , matchQueryBoost :: Maybe Boost } deriving (Eq, Read, Show, Generic, Typeable)
1414−
1415−{-| 'mkMatchQuery' is a convenience function that defaults the less common parameters,
1416− enabling you to provide only the 'FieldName' and 'QueryString' to make a 'MatchQuery'
1417−-}
1418−mkMatchQuery :: FieldName -> QueryString -> MatchQuery
1419−mkMatchQuery field query = MatchQuery field query Or ZeroTermsNone Nothing Nothing Nothing Nothing Nothing Nothing
1420−
1421−data MatchQueryType =
1422− MatchPhrase
1423− | MatchPhrasePrefix deriving (Eq, Read, Show, Generic, Typeable)
1424−
1425−data MultiMatchQuery =
1426− MultiMatchQuery { multiMatchQueryFields :: [FieldName]
1427− , multiMatchQueryString :: QueryString
1428− , multiMatchQueryOperator :: BooleanOperator
1429− , multiMatchQueryZeroTerms :: ZeroTermsQuery
1430− , multiMatchQueryTiebreaker :: Maybe Tiebreaker
1431− , multiMatchQueryType :: Maybe MultiMatchQueryType
1432− , multiMatchQueryCutoffFrequency :: Maybe CutoffFrequency
1433− , multiMatchQueryAnalyzer :: Maybe Analyzer
1434− , multiMatchQueryMaxExpansions :: Maybe MaxExpansions
1435− , multiMatchQueryLenient :: Maybe Lenient } deriving (Eq, Read, Show, Generic, Typeable)
1436−
1437−{-| 'mkMultiMatchQuery' is a convenience function that defaults the less common parameters,
1438− enabling you to provide only the list of 'FieldName's and 'QueryString' to
1439− make a 'MultiMatchQuery'.
1440−-}
1441−
1442−mkMultiMatchQuery :: [FieldName] -> QueryString -> MultiMatchQuery
1443−mkMultiMatchQuery matchFields query =
1444− MultiMatchQuery matchFields query
1445− Or ZeroTermsNone Nothing Nothing Nothing Nothing Nothing Nothing
1446−
1447−data MultiMatchQueryType =
1448− MultiMatchBestFields
1449− | MultiMatchMostFields
1450− | MultiMatchCrossFields
1451− | MultiMatchPhrase
1452− | MultiMatchPhrasePrefix deriving (Eq, Read, Show, Generic, Typeable)
1453−
1454−data BoolQuery =
1455− BoolQuery { boolQueryMustMatch :: [Query]
1456− , boolQueryMustNotMatch :: [Query]
1457− , boolQueryShouldMatch :: [Query]
1458− , boolQueryMinimumShouldMatch :: Maybe MinimumMatch
1459− , boolQueryBoost :: Maybe Boost
1460− , boolQueryDisableCoord :: Maybe DisableCoord
1461− } deriving (Eq, Read, Show, Generic, Typeable)
1462−
1463−mkBoolQuery :: [Query] -> [Query] -> [Query] -> BoolQuery
1464−mkBoolQuery must mustNot should =
1465− BoolQuery must mustNot should Nothing Nothing Nothing
1466−
1467−data BoostingQuery =
1468− BoostingQuery { positiveQuery :: Query
1469− , negativeQuery :: Query
1470− , negativeBoost :: Boost } deriving (Eq, Read, Show, Generic, Typeable)
1471−
1472−data CommonTermsQuery =
1473− CommonTermsQuery { commonField :: FieldName
1474− , commonQuery :: QueryString
1475− , commonCutoffFrequency :: CutoffFrequency
1476− , commonLowFreqOperator :: BooleanOperator
1477− , commonHighFreqOperator :: BooleanOperator
1478− , commonMinimumShouldMatch :: Maybe CommonMinimumMatch
1479− , commonBoost :: Maybe Boost
1480− , commonAnalyzer :: Maybe Analyzer
1481− , commonDisableCoord :: Maybe DisableCoord
1482− } deriving (Eq, Read, Show, Generic, Typeable)
1483−
1484−data CommonMinimumMatch =
1485− CommonMinimumMatchHighLow MinimumMatchHighLow
1486− | CommonMinimumMatch MinimumMatch
1487− deriving (Eq, Read, Show, Generic, Typeable)
1488−
1489−data MinimumMatchHighLow =
1490− MinimumMatchHighLow { lowFreq :: MinimumMatch
1491− , highFreq :: MinimumMatch } deriving (Eq, Read, Show, Generic, Typeable)
1492−
1493−data Filter = AndFilter [Filter] Cache
1494− | OrFilter [Filter] Cache
1495− | NotFilter Filter Cache
1496− | IdentityFilter
1497− | BoolFilter BoolMatch
1498− | ExistsFilter FieldName -- always cached
1499− | GeoBoundingBoxFilter GeoBoundingBoxConstraint
1500− | GeoDistanceFilter GeoPoint Distance DistanceType OptimizeBbox Cache
1501− | GeoDistanceRangeFilter GeoPoint DistanceRange
1502− | GeoPolygonFilter FieldName [LatLon]
1503− | IdsFilter MappingName [DocId]
1504− | LimitFilter Int
1505− | MissingFilter FieldName Existence NullValue
1506− | PrefixFilter FieldName PrefixValue Cache
1507− | QueryFilter Query Cache
1508− | RangeFilter FieldName RangeValue RangeExecution Cache
1509− | RegexpFilter FieldName Regexp RegexpFlags CacheName Cache CacheKey
1510− | TermFilter Term Cache
1511− deriving (Eq, Read, Show, Generic, Typeable)
1512−
1513−data ZeroTermsQuery = ZeroTermsNone
1514− | ZeroTermsAll deriving (Eq, Read, Show, Generic, Typeable)
1515−
1516−data RangeExecution = RangeExecutionIndex
1517− | RangeExecutionFielddata deriving (Eq, Read, Show, Generic, Typeable)
1518−
1519−newtype Regexp = Regexp Text deriving (Eq, Read, Show, Generic, Typeable, FromJSON)
1520−
1521−data RegexpFlags = AllRegexpFlags
1522− | NoRegexpFlags
1523− | SomeRegexpFlags (NonEmpty RegexpFlag) deriving (Eq, Read, Show, Generic, Typeable)
1524−
1525−data RegexpFlag = AnyString
1526− | Automaton
1527− | Complement
1528− | Empty
1529− | Intersection
1530− | Interval deriving (Eq, Read, Show, Generic, Typeable)
1531−
1532−newtype LessThan = LessThan Double deriving (Eq, Read, Show, Generic, Typeable)
1533−newtype LessThanEq = LessThanEq Double deriving (Eq, Read, Show, Generic, Typeable)
1534−newtype GreaterThan = GreaterThan Double deriving (Eq, Read, Show, Generic, Typeable)
1535−newtype GreaterThanEq = GreaterThanEq Double deriving (Eq, Read, Show, Generic, Typeable)
1536−
1537−newtype LessThanD = LessThanD UTCTime deriving (Eq, Read, Show, Generic, Typeable)
1538−newtype LessThanEqD = LessThanEqD UTCTime deriving (Eq, Read, Show, Generic, Typeable)
1539−newtype GreaterThanD = GreaterThanD UTCTime deriving (Eq, Read, Show, Generic, Typeable)
1540−newtype GreaterThanEqD = GreaterThanEqD UTCTime deriving (Eq, Read, Show, Generic, Typeable)
1541−
1542−data RangeValue = RangeDateLte LessThanEqD
1543− | RangeDateLt LessThanD
1544− | RangeDateGte GreaterThanEqD
1545− | RangeDateGt GreaterThanD
1546− | RangeDateGtLt GreaterThanD LessThanD
1547− | RangeDateGteLte GreaterThanEqD LessThanEqD
1548− | RangeDateGteLt GreaterThanEqD LessThanD
1549− | RangeDateGtLte GreaterThanD LessThanEqD
1550− | RangeDoubleLte LessThanEq
1551− | RangeDoubleLt LessThan
1552− | RangeDoubleGte GreaterThanEq
1553− | RangeDoubleGt GreaterThan
1554− | RangeDoubleGtLt GreaterThan LessThan
1555− | RangeDoubleGteLte GreaterThanEq LessThanEq
1556− | RangeDoubleGteLt GreaterThanEq LessThan
1557− | RangeDoubleGtLte GreaterThan LessThanEq
1558− deriving (Eq, Read, Show, Generic, Typeable)
1559−
1560−rangeValueToPair :: RangeValue -> [Pair]
1561−rangeValueToPair rv = case rv of
1562− RangeDateLte (LessThanEqD t) -> ["lte" .= t]
1563− RangeDateGte (GreaterThanEqD t) -> ["gte" .= t]
1564− RangeDateLt (LessThanD t) -> ["lt" .= t]
1565− RangeDateGt (GreaterThanD t) -> ["gt" .= t]
1566− RangeDateGteLte (GreaterThanEqD l) (LessThanEqD g) -> ["gte" .= l, "lte" .= g]
1567− RangeDateGtLte (GreaterThanD l) (LessThanEqD g) -> ["gt" .= l, "lte" .= g]
1568− RangeDateGteLt (GreaterThanEqD l) (LessThanD g) -> ["gte" .= l, "lt" .= g]
1569− RangeDateGtLt (GreaterThanD l) (LessThanD g) -> ["gt" .= l, "lt" .= g]
1570− RangeDoubleLte (LessThanEq t) -> ["lte" .= t]
1571− RangeDoubleGte (GreaterThanEq t) -> ["gte" .= t]
1572− RangeDoubleLt (LessThan t) -> ["lt" .= t]
1573− RangeDoubleGt (GreaterThan t) -> ["gt" .= t]
1574− RangeDoubleGteLte (GreaterThanEq l) (LessThanEq g) -> ["gte" .= l, "lte" .= g]
1575− RangeDoubleGtLte (GreaterThan l) (LessThanEq g) -> ["gt" .= l, "lte" .= g]
1576− RangeDoubleGteLt (GreaterThanEq l) (LessThan g) -> ["gte" .= l, "lt" .= g]
1577− RangeDoubleGtLt (GreaterThan l) (LessThan g) -> ["gt" .= l, "lt" .= g]
1578−
1579−data Term = Term { termField :: Text
1580− , termValue :: Text } deriving (Eq, Read, Show, Generic, Typeable)
1581−
1582−data BoolMatch = MustMatch Term Cache
1583− | MustNotMatch Term Cache
1584− | ShouldMatch [Term] Cache deriving (Eq, Read, Show, Generic, Typeable)
1585−
1586−-- "memory" or "indexed"
1587−data GeoFilterType = GeoFilterMemory
1588− | GeoFilterIndexed deriving (Eq, Read, Show, Generic, Typeable)
1589−
1590−data LatLon = LatLon { lat :: Double
1591− , lon :: Double } deriving (Eq, Read, Show, Generic, Typeable)
1592−
1593−data GeoBoundingBox =
1594− GeoBoundingBox { topLeft :: LatLon
1595− , bottomRight :: LatLon } deriving (Eq, Read, Show, Generic, Typeable)
1596−
1597−data GeoBoundingBoxConstraint =
1598− GeoBoundingBoxConstraint { geoBBField :: FieldName
1599− , constraintBox :: GeoBoundingBox
1600− , bbConstraintcache :: Cache
1601− , geoType :: GeoFilterType
1602− } deriving (Eq, Read, Show, Generic, Typeable)
1603−
1604−data GeoPoint =
1605− GeoPoint { geoField :: FieldName
1606− , latLon :: LatLon} deriving (Eq, Read, Show, Generic, Typeable)
1607−
1608−data DistanceUnit = Miles
1609− | Yards
1610− | Feet
1611− | Inches
1612− | Kilometers
1613− | Meters
1614− | Centimeters
1615− | Millimeters
1616− | NauticalMiles deriving (Eq, Read, Show, Generic, Typeable)
1617−
1618−data DistanceType = Arc
1619− | SloppyArc -- doesn't exist <1.0
1620− | Plane deriving (Eq, Read, Show, Generic, Typeable)
1621−
1622−data OptimizeBbox = OptimizeGeoFilterType GeoFilterType
1623− | NoOptimizeBbox deriving (Eq, Read, Show, Generic, Typeable)
1624−
1625−data Distance =
1626− Distance { coefficient :: Double
1627− , unit :: DistanceUnit } deriving (Eq, Read, Show, Generic, Typeable)
1628−
1629−data DistanceRange =
1630− DistanceRange { distanceFrom :: Distance
1631− , distanceTo :: Distance } deriving (Eq, Read, Show, Generic, Typeable)
1632−
1633−data SearchResult a =
1634− SearchResult { took :: Int
1635− , timedOut :: Bool
1636− , shards :: ShardResult
1637− , searchHits :: SearchHits a
1638− , aggregations :: Maybe AggregationResults
1639− , scrollId :: Maybe ScrollId } deriving (Eq, Read, Show, Generic, Typeable)
1640−
1641−newtype ScrollId = ScrollId Text deriving (Eq, Read, Show, Generic, Ord, ToJSON, FromJSON)
1642−
1643−type Score = Maybe Double
1644−
1645−data SearchHits a =
1646− SearchHits { hitsTotal :: Int
1647− , maxScore :: Score
1648− , hits :: [Hit a] } deriving (Eq, Read, Show, Generic, Typeable)
1649−
1650−
1651−instance Monoid (SearchHits a) where
1652− mempty = SearchHits 0 Nothing mempty
1653− mappend (SearchHits ta ma ha) (SearchHits tb mb hb) =
1654− SearchHits (ta + tb) (max ma mb) (ha <> hb)
1655−
1656−
1657−data Hit a =
1658− Hit { hitIndex :: IndexName
1659− , hitType :: MappingName
1660− , hitDocId :: DocId
1661− , hitScore :: Score
1662− , hitSource :: Maybe a
1663− , hitHighlight :: Maybe HitHighlight } deriving (Eq, Read, Show, Generic, Typeable)
1664−
1665−data ShardResult =
1666− ShardResult { shardTotal :: Int
1667− , shardsSuccessful :: Int
1668− , shardsFailed :: Int } deriving (Eq, Read, Show, Generic, Typeable)
1669−
1670−type HitHighlight = M.Map Text [Text]
1671−
1672−showText :: Show a => a -> Text
1673−showText = T.pack . show
1674−
1675−readMay :: Read a => String -> Maybe a
1676−readMay s = case reads s of
1677− (a, ""):_ -> Just a
1678− _ -> Nothing
1679−
1680−parseReadText :: Read a => Text -> Parser a
1681−parseReadText = maybe mzero return . readMay . T.unpack
1682−
1683−type Aggregations = M.Map Text Aggregation
1684−
1685−emptyAggregations :: Aggregations
1686−emptyAggregations = M.empty
1687−
1688−mkAggregations :: Text -> Aggregation -> Aggregations
1689−mkAggregations name aggregation = M.insert name aggregation emptyAggregations
1690−
1691−data TermOrder = TermOrder{ termSortField :: Text
1692− , termSortOrder :: SortOrder } deriving (Eq, Read, Show, Generic, Typeable)
1693−
1694−data TermInclusion = TermInclusion Text
1695− | TermPattern Text Text deriving (Eq, Read, Show, Generic, Typeable)
1696−
1697−data CollectionMode = BreadthFirst
1698− | DepthFirst deriving (Eq, Read, Show, Generic, Typeable)
1699−
1700−data ExecutionHint = Ordinals
1701− | GlobalOrdinals
1702− | GlobalOrdinalsHash
1703− | GlobalOrdinalsLowCardinality
1704− | Map deriving (Eq, Read, Show, Generic, Typeable)
1705−
1706−data TimeInterval = Weeks
1707− | Days
1708− | Hours
1709− | Minutes
1710− | Seconds deriving Eq
1711−
1712−data Interval = Year
1713− | Quarter
1714− | Month
1715− | Week
1716− | Day
1717− | Hour
1718− | Minute
1719− | Second
1720− | FractionalInterval Float TimeInterval deriving (Eq, Read, Show, Generic, Typeable)
1721−
1722−data Aggregation = TermsAgg TermsAggregation
1723− | CardinalityAgg CardinalityAggregation
1724− | DateHistogramAgg DateHistogramAggregation
1725− | ValueCountAgg ValueCountAggregation
1726− | FilterAgg FilterAggregation
1727− | DateRangeAgg DateRangeAggregation
1728− | MissingAgg MissingAggregation
1729− | TopHitsAgg TopHitsAggregation
1730− deriving (Eq, Read, Show, Generic, Typeable)
1731−
1732−data TopHitsAggregation = TopHitsAggregation
1733− { taFrom :: Maybe From
1734− , taSize :: Maybe Size
1735− , taSort :: Maybe Sort
1736− } deriving (Eq, Read, Show)
1737−
1738−data MissingAggregation = MissingAggregation
1739− { maField :: Text
1740− } deriving (Eq, Read, Show, Generic, Typeable)
1741−
1742−data TermsAggregation = TermsAggregation { term :: Either Text Text
1743− , termInclude :: Maybe TermInclusion
1744− , termExclude :: Maybe TermInclusion
1745− , termOrder :: Maybe TermOrder
1746− , termMinDocCount :: Maybe Int
1747− , termSize :: Maybe Int
1748− , termShardSize :: Maybe Int
1749− , termCollectMode :: Maybe CollectionMode
1750− , termExecutionHint :: Maybe ExecutionHint
1751− , termAggs :: Maybe Aggregations
1752− } deriving (Eq, Read, Show, Generic, Typeable)
1753−
1754−data CardinalityAggregation = CardinalityAggregation { cardinalityField :: FieldName,
1755− precisionThreshold :: Maybe Int
1756− } deriving (Eq, Read, Show, Generic, Typeable)
1757−
1758−data DateHistogramAggregation = DateHistogramAggregation { dateField :: FieldName
1759− , dateInterval :: Interval
1760− , dateFormat :: Maybe Text
1761− -- pre and post deprecated in 1.5
1762− , datePreZone :: Maybe Text
1763− , datePostZone :: Maybe Text
1764− , datePreOffset :: Maybe Text
1765− , datePostOffset :: Maybe Text
1766− , dateAggs :: Maybe Aggregations
1767− } deriving (Eq, Read, Show, Generic, Typeable)
1768−
1769−
1770−data DateRangeAggregation = DateRangeAggregation { draField :: FieldName
1771− , draFormat :: Maybe Text
1772− , draRanges :: NonEmpty DateRangeAggRange
1773− } deriving (Eq, Read, Show, Generic, Typeable)
1774−
1775−data DateRangeAggRange = DateRangeFrom DateMathExpr
1776− | DateRangeTo DateMathExpr
1777− | DateRangeFromAndTo DateMathExpr DateMathExpr deriving (Eq, Read, Show, Generic, Typeable)
1778−
1779−-- | See <https://www.elastic.co/guide/en/elasticsearch/reference/current/common-options.html#date-math> for more information.
1780−data DateMathExpr = DateMathExpr DateMathAnchor [DateMathModifier] deriving (Eq, Read, Show, Generic, Typeable)
1781−
1782−
1783−-- | Starting point for a date range. This along with the 'DateMathModifiers' gets you the date ES will start from.
1784−data DateMathAnchor = DMNow
1785− | DMDate Day deriving (Eq, Read, Show, Generic, Typeable)
1786−
1787−data DateMathModifier = AddTime Int DateMathUnit
1788− | SubtractTime Int DateMathUnit
1789− | RoundDownTo DateMathUnit deriving (Eq, Read, Show, Generic, Typeable)
1790−
1791−data DateMathUnit = DMYear
1792− | DMMonth
1793− | DMWeek
1794− | DMDay
1795− | DMHour
1796− | DMMinute
1797− | DMSecond deriving (Eq, Read, Show, Generic, Typeable)
1798−
1799−-- | See <https://www.elastic.co/guide/en/elasticsearch/reference/current/search-aggregations-metrics-valuecount-aggregation.html> for more information.
1800−data ValueCountAggregation = FieldValueCount FieldName
1801− | ScriptValueCount Script deriving (Eq, Read, Show, Generic, Typeable)
1802−
1803−-- | 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.
1804−data FilterAggregation = FilterAggregation { faFilter :: Filter
1805− , faAggs :: Maybe Aggregations} deriving (Eq, Read, Show, Generic, Typeable)
1806−
1807−mkTermsAggregation :: Text -> TermsAggregation
1808−mkTermsAggregation t = TermsAggregation (Left t) Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing
1809−
1810−mkTermsScriptAggregation :: Text -> TermsAggregation
1811−mkTermsScriptAggregation t = TermsAggregation (Right t) Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing
1812−
1813−mkDateHistogram :: FieldName -> Interval -> DateHistogramAggregation
1814−mkDateHistogram t i = DateHistogramAggregation t i Nothing Nothing Nothing Nothing Nothing Nothing
1815−
1816−mkCardinalityAggregation :: FieldName -> CardinalityAggregation
1817−mkCardinalityAggregation t = CardinalityAggregation t Nothing
1818−
1819−instance ToJSON Version where
1820− toJSON Version {..} = object ["number" .= number
1821− ,"build_hash" .= build_hash
1822− ,"build_timestamp" .= build_timestamp
1823− ,"build_snapshot" .= build_snapshot
1824− ,"lucene_version" .= lucene_version]
1825−
1826−instance FromJSON Version where
1827− parseJSON = withObject "Version" parse
1828− where parse o = Version
1829− <$> o .: "number"
1830− <*> o .: "build_hash"
1831− <*> o .: "build_timestamp"
1832− <*> o .: "build_snapshot"
1833− <*> o .: "lucene_version"
1834−
1835−instance ToJSON VersionNumber where
1836− toJSON = toJSON . Vers.showVersion . versionNumber
1837−
1838−instance FromJSON VersionNumber where
1839− parseJSON = withText "VersionNumber" (parse . T.unpack)
1840− where
1841− parse s = case filter (null . snd)(RP.readP_to_S Vers.parseVersion s) of
1842− [(v, _)] -> pure (VersionNumber v)
1843− [] -> fail ("Invalid version string " ++ s)
1844− xs -> fail ("Ambiguous version string " ++ s ++ " (" ++ intercalate ", " (Vers.showVersion . fst <$> xs) ++ ")")
1845−
1846−instance ToJSON TermOrder where
1847− toJSON (TermOrder termSortField termSortOrder) = object [termSortField .= termSortOrder]
1848−
1849−instance ToJSON TermInclusion where
1850− toJSON (TermInclusion x) = toJSON x
1851− toJSON (TermPattern pattern flags) = omitNulls [ "pattern" .= pattern,
1852− "flags" .= flags]
1853−
1854−instance ToJSON CollectionMode where
1855− toJSON BreadthFirst = "breadth_first"
1856− toJSON DepthFirst = "depth_first"
1857−
1858−instance ToJSON ExecutionHint where
1859− toJSON Ordinals = "ordinals"
1860− toJSON GlobalOrdinals = "global_ordinals"
1861− toJSON GlobalOrdinalsHash = "global_ordinals_hash"
1862− toJSON GlobalOrdinalsLowCardinality = "global_ordinals_low_cardinality"
1863− toJSON Map = "map"
1864−
1865−instance ToJSON Interval where
1866− toJSON Year = "year"
1867− toJSON Quarter = "quarter"
1868− toJSON Month = "month"
1869− toJSON Week = "week"
1870− toJSON Day = "day"
1871− toJSON Hour = "hour"
1872− toJSON Minute = "minute"
1873− toJSON Second = "second"
1874− toJSON (FractionalInterval fraction interval) = toJSON $ show fraction ++ show interval
1875−
1876−instance Show TimeInterval where
1877− show Weeks = "w"
1878− show Days = "d"
1879− show Hours = "h"
1880− show Minutes = "m"
1881− show Seconds = "s"
1882−
1883−instance Read TimeInterval where
1884− readPrec = f =<< TR.get
1885− where
1886− f 'w' = return Weeks
1887− f 'd' = return Days
1888− f 'h' = return Hours
1889− f 'm' = return Minutes
1890− f 's' = return Seconds
1891− f _ = fail "TimeInterval expected one of w, d, h, m, s"
1892−
1893−instance ToJSON Aggregation where
1894− toJSON (TermsAgg (TermsAggregation term include exclude order minDocCount size shardSize collectMode executionHint termAggs)) =
1895− omitNulls ["terms" .= omitNulls [ toJSON' term,
1896− "include" .= include,
1897− "exclude" .= exclude,
1898− "order" .= order,
1899− "min_doc_count" .= minDocCount,
1900− "size" .= size,
1901− "shard_size" .= shardSize,
1902− "collect_mode" .= collectMode,
1903− "execution_hint" .= executionHint
1904− ],
1905− "aggs" .= termAggs ]
1906− where
1907− toJSON' x = case x of { Left y -> "field" .= y; Right y -> "script" .= y }
1908−
1909− toJSON (CardinalityAgg (CardinalityAggregation field precisionThreshold)) =
1910− object ["cardinality" .= omitNulls [ "field" .= field,
1911− "precisionThreshold" .= precisionThreshold
1912− ]
1913− ]
1914−
1915− toJSON (DateHistogramAgg (DateHistogramAggregation field interval format preZone postZone preOffset postOffset dateHistoAggs)) =
1916− omitNulls ["date_histogram" .= omitNulls [ "field" .= field,
1917− "interval" .= interval,
1918− "format" .= format,
1919− "pre_zone" .= preZone,
1920− "post_zone" .= postZone,
1921− "pre_offset" .= preOffset,
1922− "post_offset" .= postOffset
1923− ],
1924− "aggs" .= dateHistoAggs ]
1925− toJSON (ValueCountAgg a) = object ["value_count" .= v]
1926− where v = case a of
1927− (FieldValueCount (FieldName n)) -> object ["field" .= n]
1928− (ScriptValueCount (Script s)) -> object ["script" .= s]
1929− toJSON (FilterAgg (FilterAggregation filt ags)) =
1930− omitNulls [ "filter" .= filt
1931− , "aggs" .= ags]
1932− toJSON (DateRangeAgg a) = object [ "date_range" .= a
1933− ]
1934− toJSON (MissingAgg (MissingAggregation{..})) =
1935− object ["missing" .= object ["field" .= maField]]
1936−
1937− toJSON (TopHitsAgg (TopHitsAggregation mfrom msize msort)) =
1938− omitNulls ["top_hits" .= omitNulls [ "size" .= msize
1939− , "from" .= mfrom
1940− , "sort" .= msort
1941− ]
1942− ]
1943−
1944−instance ToJSON DateRangeAggregation where
1945− toJSON DateRangeAggregation {..} =
1946− omitNulls [ "field" .= draField
1947− , "format" .= draFormat
1948− , "ranges" .= toList draRanges
1949− ]
1950−
1951−instance ToJSON DateRangeAggRange where
1952− toJSON (DateRangeFrom e) = object [ "from" .= e ]
1953− toJSON (DateRangeTo e) = object [ "to" .= e ]
1954− toJSON (DateRangeFromAndTo f t) = object [ "from" .= f, "to" .= t ]
1955−
1956−instance ToJSON DateMathExpr where
1957− toJSON (DateMathExpr a mods) = String (fmtA a <> mconcat (fmtMod <$> mods))
1958− where fmtA DMNow = "now"
1959− fmtA (DMDate date) = (T.pack $ showGregorian date) <> "||"
1960− fmtMod (AddTime n u) = "+" <> showText n <> fmtU u
1961− fmtMod (SubtractTime n u) = "-" <> showText n <> fmtU u
1962− fmtMod (RoundDownTo u) = "/" <> fmtU u
1963− fmtU DMYear = "y"
1964− fmtU DMMonth = "M"
1965− fmtU DMWeek = "w"
1966− fmtU DMDay = "d"
1967− fmtU DMHour = "h"
1968− fmtU DMMinute = "m"
1969− fmtU DMSecond = "s"
1970−
1971−
1972−type AggregationResults = M.Map Text Value
1973−
1974−class BucketAggregation a where
1975− key :: a -> BucketValue
1976− docCount :: a -> Int
1977− aggs :: a -> Maybe AggregationResults
1978−
1979−
1980−data Bucket a = Bucket { buckets :: [a]} deriving (Read, Show)
1981−
1982−data BucketValue = TextValue Text
1983− | ScientificValue Scientific
1984− | BoolValue Bool deriving (Read, Show)
1985−
1986−data MissingResult = MissingResult { missingDocCount :: Int } deriving (Show)
1987−
1988−data TopHitResult a = TopHitResult { tarHits :: (SearchHits a)
1989− } deriving Show
1990−
1991−data TermsResult = TermsResult { termKey :: BucketValue
1992− , termsDocCount :: Int
1993− , termsAggs :: Maybe AggregationResults } deriving (Read, Show)
1994−
1995−data DateHistogramResult = DateHistogramResult { dateKey :: Int
1996− , dateKeyStr :: Maybe Text
1997− , dateDocCount :: Int
1998− , dateHistogramAggs :: Maybe AggregationResults } deriving (Read, Show)
1999−
2000−data DateRangeResult = DateRangeResult { dateRangeKey :: Text
2001− , dateRangeFrom :: Maybe UTCTime
2002− , dateRangeFromAsString :: Maybe Text
2003− , dateRangeTo :: Maybe UTCTime
2004− , dateRangeToAsString :: Maybe Text
2005− , dateRangeDocCount :: Int
2006− , dateRangeAggs :: Maybe AggregationResults } deriving (Read, Show, Eq, Generic, Typeable)
2007−
2008−toTerms :: Text -> AggregationResults -> Maybe (Bucket TermsResult)
2009−toTerms = toAggResult
2010−
2011−toDateHistogram :: Text -> AggregationResults -> Maybe (Bucket DateHistogramResult)
2012−toDateHistogram = toAggResult
2013−
2014−toMissing :: Text -> AggregationResults -> Maybe MissingResult
2015−toMissing = toAggResult
2016−
2017−toTopHits :: (FromJSON a) => Text -> AggregationResults -> Maybe (TopHitResult a)
2018−toTopHits = toAggResult
2019−
2020−toAggResult :: (FromJSON a) => Text -> AggregationResults -> Maybe a
2021−toAggResult t a = M.lookup t a >>= deserialize
2022− where deserialize = parseMaybe parseJSON
2023−
2024−instance BucketAggregation TermsResult where
2025− key = termKey
2026− docCount = termsDocCount
2027− aggs = termsAggs
2028−
2029−instance BucketAggregation DateHistogramResult where
2030− key = TextValue . showText . dateKey
2031− docCount = dateDocCount
2032− aggs = dateHistogramAggs
2033−
2034−instance BucketAggregation DateRangeResult where
2035− key = TextValue . dateRangeKey
2036− docCount = dateRangeDocCount
2037− aggs = dateRangeAggs
2038−
2039−instance (FromJSON a) => FromJSON (Bucket a) where
2040− parseJSON (Object v) = Bucket <$>
2041− v .: "buckets"
2042− parseJSON _ = mempty
2043−
2044−instance FromJSON BucketValue where
2045− parseJSON (String t) = return $ TextValue t
2046− parseJSON (Number s) = return $ ScientificValue s
2047− parseJSON (Bool b) = return $ BoolValue b
2048− parseJSON _ = mempty
2049−
2050−instance FromJSON MissingResult where
2051− parseJSON = withObject "MissingResult" parse
2052− where parse v = MissingResult <$> v .: "doc_count"
2053−
2054−instance FromJSON TermsResult where
2055− parseJSON (Object v) = TermsResult <$>
2056− v .: "key" <*>
2057− v .: "doc_count" <*>
2058− (pure $ getNamedSubAgg v ["key", "doc_count"])
2059− parseJSON _ = mempty
2060−
2061−instance FromJSON DateHistogramResult where
2062− parseJSON (Object v) = DateHistogramResult <$>
2063− v .: "key" <*>
2064− v .:? "key_as_string" <*>
2065− v .: "doc_count" <*>
2066− (pure $ getNamedSubAgg v [ "key"
2067− , "doc_count"
2068− , "key_as_string"
2069− ]
2070− )
2071− parseJSON _ = mempty
2072−
2073−instance FromJSON DateRangeResult where
2074− parseJSON = withObject "DateRangeResult" parse
2075− where parse v = DateRangeResult <$>
2076− v .: "key" <*>
2077− (fmap posixMS <$> v .:? "from") <*>
2078− v .:? "from_as_string" <*>
2079− (fmap posixMS <$> v .:? "to") <*>
2080− v .:? "to_as_string" <*>
2081− v .: "doc_count" <*>
2082− (pure $ getNamedSubAgg v [ "key"
2083− , "from"
2084− , "from_as_string"
2085− , "to"
2086− , "to_as_string"
2087− , "doc_count"
2088− ]
2089− )
2090−
2091−instance FromJSON POSIXMS where
2092− parseJSON = withScientific "POSIXMS" (return . parse)
2093− where parse n = let n' = truncate n :: Integer
2094− in POSIXMS (posixSecondsToUTCTime (fromInteger (n' `div` 1000)))
2095−
2096−instance (FromJSON a) => FromJSON (TopHitResult a) where
2097− parseJSON (Object v) = TopHitResult <$>
2098− v .: "hits"
2099− parseJSON _ = fail "Failure in FromJSON (TopHitResult a)"
2100−
2101−instance Monoid Filter where
2102− mempty = IdentityFilter
2103− mappend a b = AndFilter [a, b] defaultCache
2104−
2105−instance Seminearring Filter where
2106− a <||> b = OrFilter [a, b] defaultCache
2107−
2108−instance ToJSON Filter where
2109− toJSON (AndFilter filters cache) =
2110− object ["and" .=
2111− object [ "filters" .= fmap toJSON filters
2112− , "_cache" .= cache]]
2113−
2114− toJSON (OrFilter filters cache) =
2115− object ["or" .=
2116− object [ "filters" .= fmap toJSON filters
2117− , "_cache" .= cache]]
2118−
2119− toJSON (NotFilter notFilter cache) =
2120− object ["not" .=
2121− object ["filter" .= notFilter
2122− , "_cache" .= cache]]
2123−
2124− toJSON (IdentityFilter) =
2125− object ["match_all" .= object []]
2126−
2127− toJSON (TermFilter (Term termFilterField termFilterValue) cache) =
2128− object ["term" .= object base]
2129− where base = [termFilterField .= termFilterValue,
2130− "_cache" .= cache]
2131−
2132− toJSON (ExistsFilter (FieldName fieldName)) =
2133− object ["exists" .= object
2134− ["field" .= fieldName]]
2135−
2136− toJSON (BoolFilter boolMatch) =
2137− object ["bool" .= boolMatch]
2138−
2139− toJSON (GeoBoundingBoxFilter bbConstraint) =
2140− object ["geo_bounding_box" .= bbConstraint]
2141−
2142− toJSON (GeoDistanceFilter (GeoPoint (FieldName distanceGeoField) geoDistLatLon)
2143− distance distanceType optimizeBbox cache) =
2144− object ["geo_distance" .=
2145− object ["distance" .= distance
2146− , "distance_type" .= distanceType
2147− , "optimize_bbox" .= optimizeBbox
2148− , distanceGeoField .= geoDistLatLon
2149− , "_cache" .= cache]]
2150−
2151− toJSON (GeoDistanceRangeFilter (GeoPoint (FieldName gddrField) drLatLon)
2152− (DistanceRange geoDistRangeDistFrom drDistanceTo)) =
2153− object ["geo_distance_range" .=
2154− object ["from" .= geoDistRangeDistFrom
2155− , "to" .= drDistanceTo
2156− , gddrField .= drLatLon]]
2157−
2158− toJSON (GeoPolygonFilter (FieldName geoPolygonFilterField) latLons) =
2159− object ["geo_polygon" .=
2160− object [geoPolygonFilterField .=
2161− object ["points" .= fmap toJSON latLons]]]
2162−
2163− toJSON (IdsFilter (MappingName mappingName) values) =
2164− object ["ids" .=
2165− object ["type" .= mappingName
2166− , "values" .= fmap unpackId values]]
2167−
2168− toJSON (LimitFilter limit) =
2169− object ["limit" .= object ["value" .= limit]]
2170−
2171− toJSON (MissingFilter (FieldName fieldName) (Existence existence) (NullValue nullValue)) =
2172− object ["missing" .=
2173− object ["field" .= fieldName
2174− , "existence" .= existence
2175− , "null_value" .= nullValue]]
2176−
2177− toJSON (PrefixFilter (FieldName fieldName) fieldValue cache) =
2178− object ["prefix" .=
2179− object [fieldName .= fieldValue
2180− , "_cache" .= cache]]
2181−
2182− toJSON (QueryFilter query False) =
2183− object ["query" .= toJSON query ]
2184− toJSON (QueryFilter query True) =
2185− object ["fquery" .=
2186− object [ "query" .= toJSON query
2187− , "_cache" .= True ]]
2188−
2189− toJSON (RangeFilter (FieldName fieldName) rangeValue rangeExecution cache) =
2190− object ["range" .=
2191− object [ fieldName .= object (rangeValueToPair rangeValue)
2192− , "execution" .= rangeExecution
2193− , "_cache" .= cache]]
2194−
2195− toJSON (RegexpFilter (FieldName fieldName)
2196− (Regexp regexText) flags (CacheName cacheName) cache (CacheKey cacheKey)) =
2197− object ["regexp" .=
2198− object [fieldName .=
2199− object ["value" .= regexText
2200− , "flags" .= flags]
2201− , "_name" .= cacheName
2202− , "_cache" .= cache
2203− , "_cache_key" .= cacheKey]]
2204−
2205−instance FromJSON Filter where
2206− parseJSON = withObject "Filter" parse
2207− where parse o = andFilter `taggedWith` "and"
2208− <|> orFilter `taggedWith` "or"
2209− <|> notFilter `taggedWith` "not"
2210− <|> identityFilter `taggedWith` "match_all"
2211− <|> boolFilter `taggedWith` "bool"
2212− <|> existsFilter `taggedWith` "exists"
2213− <|> geoBoundingBoxFilter `taggedWith` "geo_bounding_box"
2214− <|> geoDistanceFilter `taggedWith` "geo_distance"
2215− <|> geoDistanceRangeFilter `taggedWith` "geo_distance_range"
2216− <|> geoPolygonFilter `taggedWith` "geo_polygon"
2217− <|> idsFilter `taggedWith` "ids"
2218− <|> limitFilter `taggedWith` "limit"
2219− <|> missingFilter `taggedWith` "missing"
2220− <|> prefixFilter `taggedWith` "prefix"
2221− <|> queryFilter `taggedWith` "query"
2222− <|> fqueryFilter `taggedWith` "fquery"
2223− <|> rangeFilter `taggedWith` "range"
2224− <|> regexpFilter `taggedWith` "regexp"
2225− <|> termFilter `taggedWith` "term"
2226− where taggedWith parser k = parser =<< o .: k
2227− andFilter o = AndFilter <$> o .: "filters"
2228− <*> o .:? "_cache" .!= defaultCache
2229− orFilter o = OrFilter <$> o .: "filters"
2230− <*> o .:? "_cache" .!= defaultCache
2231− notFilter o = NotFilter <$> o .: "filter"
2232− <*> o .: "_cache" .!= defaultCache
2233− identityFilter :: Object -> Parser Filter
2234− identityFilter m
2235− | HM.null m = pure IdentityFilter
2236− | otherwise = fail ("Identityfilter expected empty object but got " <> show m)
2237− boolFilter = pure . BoolFilter
2238− existsFilter o = ExistsFilter <$> o .: "field"
2239− geoBoundingBoxFilter = pure . GeoBoundingBoxFilter
2240− geoDistanceFilter o = do
2241− case HM.toList (deleteSeveral ["distance", "distance_type", "optimize_bbox", "_cache"] o) of
2242− [(fn, v)] -> do
2243− gp <- GeoPoint (FieldName fn) <$> parseJSON v
2244− GeoDistanceFilter gp <$> o .: "distance"
2245− <*> o .: "distance_type"
2246− <*> o .: "optimize_bbox"
2247− <*> o .:? "_cache" .!= defaultCache
2248− _ -> fail "Could not find GeoDistanceFilter field name"
2249− geoDistanceRangeFilter o = do
2250− case HM.toList (deleteSeveral ["from", "to"] o) of
2251− [(fn, v)] -> do
2252− gp <- GeoPoint (FieldName fn) <$> parseJSON v
2253− rng <- DistanceRange <$> o .: "from" <*> o .: "to"
2254− return (GeoDistanceRangeFilter gp rng)
2255− _ -> fail "Could not find GeoDistanceRangeFilter field name"
2256− geoPolygonFilter = fieldTagged $ \fn o -> GeoPolygonFilter fn <$> o .: "points"
2257− idsFilter o = IdsFilter <$> o .: "type"
2258− <*> o .: "values"
2259− limitFilter o = LimitFilter <$> o .: "value"
2260− missingFilter o = MissingFilter <$> o .: "field"
2261− <*> o .: "existence"
2262− <*> o .: "null_value"
2263− prefixFilter o = case HM.toList (HM.delete "_cache" o) of
2264− [(fn, String v)] -> PrefixFilter (FieldName fn) v <$> o .:? "_cache" .!= defaultCache
2265− _ -> fail "Could not parse PrefixFilter"
2266−
2267− queryFilter q = pure (QueryFilter q False)
2268− fqueryFilter o = QueryFilter <$> o .: "query" <*> pure True
2269− rangeFilter o = case HM.toList (deleteSeveral ["execution", "_cache"] o) of
2270− [(fn, v)] -> RangeFilter (FieldName fn)
2271− <$> parseJSON v
2272− <*> o .: "execution"
2273− <*> o .:? "_cache" .!= defaultCache
2274− _ -> fail "Could not find field name for RangeFilter"
2275− regexpFilter o = case HM.toList (deleteSeveral ["_name", "_cache", "_cache_key"] o) of
2276− [(fn, Object o')] -> RegexpFilter (FieldName fn)
2277− <$> o' .: "value"
2278− <*> o' .: "flags"
2279− <*> o .: "_name"
2280− <*> o .:? "_cache" .!= defaultCache
2281− <*> o .: "_cache_key"
2282− _ -> fail "Could not find field name for RegexpFilter"
2283− termFilter o = case HM.toList (HM.delete "_cache" o) of
2284− [(termField, String termVal)] -> TermFilter (Term termField termVal)
2285− <$> o .:? "_cache" .!= defaultCache
2286− _ -> fail "Could not find term field for TermFilter"
2287−
2288−fieldTagged :: Monad m => (FieldName -> Object -> m a) -> Object -> m a
2289−fieldTagged f o = case HM.toList o of
2290− [(k, Object o')] -> f (FieldName k) o'
2291− _ -> fail "Expected object with 1 field-named key"
2292−
2293−-- Try to get an AggregationResults when we don't know the
2294−-- field name. We filter out the known keys to try to minimize the noise.
2295−getNamedSubAgg :: Object -> [Text] -> Maybe AggregationResults
2296−getNamedSubAgg o knownKeys = maggRes
2297− where unknownKeys = HM.filterWithKey (\k _ -> k `notElem` knownKeys) o
2298− maggRes
2299− | HM.null unknownKeys = Nothing
2300− | otherwise = Just . M.fromList $ HM.toList unknownKeys
2301−
2302−instance ToJSON GeoPoint where
2303− toJSON (GeoPoint (FieldName geoPointField) geoPointLatLon) =
2304− object [ geoPointField .= geoPointLatLon ]
2305−
2306−
2307−instance ToJSON Query where
2308− toJSON (TermQuery (Term termQueryField termQueryValue) boost) =
2309− object [ "term" .=
2310− object [termQueryField .= object merged]]
2311− where
2312− base = [ "value" .= termQueryValue ]
2313− boosted = maybe [] (return . ("boost" .=)) boost
2314− merged = mappend base boosted
2315−
2316− toJSON (TermsQuery fieldName terms) =
2317− object [ "terms" .= object conjoined ]
2318− where conjoined = [fieldName .= terms]
2319−
2320− toJSON (IdsQuery idsQueryMappingName docIds) =
2321− object [ "ids" .= object conjoined ]
2322− where conjoined = [ "type" .= idsQueryMappingName
2323− , "values" .= fmap toJSON docIds ]
2324−
2325− toJSON (QueryQueryStringQuery qQueryStringQuery) =
2326− object [ "query_string" .= qQueryStringQuery ]
2327−
2328− toJSON (QueryMatchQuery matchQuery) =
2329− object [ "match" .= matchQuery ]
2330−
2331− toJSON (QueryMultiMatchQuery multiMatchQuery) =
2332− toJSON multiMatchQuery
2333−
2334− toJSON (QueryBoolQuery boolQuery) =
2335− object [ "bool" .= boolQuery ]
2336−
2337− toJSON (QueryBoostingQuery boostingQuery) =
2338− object [ "boosting" .= boostingQuery ]
2339−
2340− toJSON (QueryCommonTermsQuery commonTermsQuery) =
2341− object [ "common" .= commonTermsQuery ]
2342−
2343− toJSON (ConstantScoreFilter csFilter boost) =
2344− object ["constant_score" .= object ["filter" .= csFilter
2345− , "boost" .= boost]]
2346−
2347− toJSON (ConstantScoreQuery query boost) =
2348− object ["constant_score" .= object ["query" .= query
2349− , "boost" .= boost]]
2350−
2351− toJSON (QueryDisMaxQuery disMaxQuery) =
2352− object [ "dis_max" .= disMaxQuery ]
2353−
2354− toJSON (QueryFilteredQuery qFilteredQuery) =
2355− object [ "filtered" .= qFilteredQuery ]
2356−
2357− toJSON (QueryFuzzyLikeThisQuery fuzzyQuery) =
2358− object [ "fuzzy_like_this" .= fuzzyQuery ]
2359−
2360− toJSON (QueryFuzzyLikeFieldQuery fuzzyFieldQuery) =
2361− object [ "fuzzy_like_this_field" .= fuzzyFieldQuery ]
2362−
2363− toJSON (QueryFuzzyQuery fuzzyQuery) =
2364− object [ "fuzzy" .= fuzzyQuery ]
2365−
2366− toJSON (QueryHasChildQuery childQuery) =
2367− object [ "has_child" .= childQuery ]
2368−
2369− toJSON (QueryHasParentQuery parentQuery) =
2370− object [ "has_parent" .= parentQuery ]
2371−
2372− toJSON (QueryIndicesQuery qIndicesQuery) =
2373− object [ "indices" .= qIndicesQuery ]
2374−
2375− toJSON (MatchAllQuery boost) =
2376− object [ "match_all" .= omitNulls [ "boost" .= boost ] ]
2377−
2378− toJSON (QueryMoreLikeThisQuery query) =
2379− object [ "more_like_this" .= query ]
2380−
2381− toJSON (QueryMoreLikeThisFieldQuery query) =
2382− object [ "more_like_this_field" .= query ]
2383−
2384− toJSON (QueryNestedQuery query) =
2385− object [ "nested" .= query ]
2386−
2387− toJSON (QueryPrefixQuery query) =
2388− object [ "prefix" .= query ]
2389−
2390− toJSON (QueryRangeQuery query) =
2391− object [ "range" .= query ]
2392−
2393− toJSON (QueryRegexpQuery query) =
2394− object [ "regexp" .= query ]
2395−
2396− toJSON (QuerySimpleQueryStringQuery query) =
2397− object [ "simple_query_string" .= query ]
2398−
2399−instance FromJSON Query where
2400− parseJSON v = withObject "Query" parse v
2401− where parse o = termQuery `taggedWith` "term"
2402− <|> termsQuery `taggedWith` "terms"
2403− <|> idsQuery `taggedWith` "ids"
2404− <|> queryQueryStringQuery `taggedWith` "query_string"
2405− <|> queryMatchQuery `taggedWith` "match"
2406− <|> queryMultiMatchQuery
2407− <|> queryBoolQuery `taggedWith` "bool"
2408− <|> queryBoostingQuery `taggedWith` "boosting"
2409− <|> queryCommonTermsQuery `taggedWith` "common"
2410− <|> constantScoreFilter `taggedWith` "constant_score"
2411− <|> constantScoreQuery `taggedWith` "constant_score"
2412− <|> queryDisMaxQuery `taggedWith` "dis_max"
2413− <|> queryFilteredQuery `taggedWith` "filtered"
2414− <|> queryFuzzyLikeThisQuery `taggedWith` "fuzzy_like_this"
2415− <|> queryFuzzyLikeFieldQuery `taggedWith` "fuzzy_like_this_field"
2416− <|> queryFuzzyQuery `taggedWith` "fuzzy"
2417− <|> queryHasChildQuery `taggedWith` "has_child"
2418− <|> queryHasParentQuery `taggedWith` "has_parent"
2419− <|> queryIndicesQuery `taggedWith` "indices"
2420− <|> matchAllQuery `taggedWith` "match_all"
2421− <|> queryMoreLikeThisQuery `taggedWith` "more_like_this"
2422− <|> queryMoreLikeThisFieldQuery `taggedWith` "more_like_this_field"
2423− <|> queryNestedQuery `taggedWith` "nested"
2424− <|> queryPrefixQuery `taggedWith` "prefix"
2425− <|> queryRangeQuery `taggedWith` "range"
2426− <|> queryRegexpQuery `taggedWith` "regexp"
2427− <|> querySimpleQueryStringQuery `taggedWith` "simple_query_string"
2428− where taggedWith parser k = parser =<< o .: k
2429− termQuery = fieldTagged $ \(FieldName fn) o ->
2430− TermQuery <$> (Term fn <$> o .: "value") <*> o .:? "boost"
2431− termsQuery o = case HM.toList o of
2432− [(fn, vs)] -> do vals <- parseJSON vs
2433− case vals of
2434− x:xs -> return (TermsQuery fn (x :| xs))
2435− _ -> fail "Expected non empty list of values"
2436− _ -> fail "Expected object with 1 field-named key"
2437− idsQuery o = IdsQuery <$> o .: "type"
2438− <*> o .: "values"
2439− queryQueryStringQuery = pure . QueryQueryStringQuery
2440− queryMatchQuery = pure . QueryMatchQuery
2441− queryMultiMatchQuery = QueryMultiMatchQuery <$> parseJSON v
2442− queryBoolQuery = pure . QueryBoolQuery
2443− queryBoostingQuery = pure . QueryBoostingQuery
2444− queryCommonTermsQuery = pure . QueryCommonTermsQuery
2445− constantScoreFilter o = case HM.lookup "filter" o of
2446− Just x -> ConstantScoreFilter <$> parseJSON x
2447− <*> o .: "boost"
2448− _ -> fail "Does not appear to be a ConstantScoreFilter"
2449− constantScoreQuery o = case HM.lookup "query" o of
2450− Just x -> ConstantScoreQuery <$> parseJSON x
2451− <*> o .: "boost"
2452− _ -> fail "Does not appear to be a ConstantScoreQuery"
2453− queryDisMaxQuery = pure . QueryDisMaxQuery
2454− queryFilteredQuery = pure . QueryFilteredQuery
2455− queryFuzzyLikeThisQuery = pure . QueryFuzzyLikeThisQuery
2456− queryFuzzyLikeFieldQuery = pure . QueryFuzzyLikeFieldQuery
2457− queryFuzzyQuery = pure . QueryFuzzyQuery
2458− queryHasChildQuery = pure . QueryHasChildQuery
2459− queryHasParentQuery = pure . QueryHasParentQuery
2460− queryIndicesQuery = pure . QueryIndicesQuery
2461− matchAllQuery o = MatchAllQuery <$> o .:? "boost"
2462− queryMoreLikeThisQuery = pure . QueryMoreLikeThisQuery
2463− queryMoreLikeThisFieldQuery = pure . QueryMoreLikeThisFieldQuery
2464− queryNestedQuery = pure . QueryNestedQuery
2465− queryPrefixQuery = pure . QueryPrefixQuery
2466− queryRangeQuery = pure . QueryRangeQuery
2467− queryRegexpQuery = pure . QueryRegexpQuery
2468− querySimpleQueryStringQuery = pure . QuerySimpleQueryStringQuery
2469−
2470−
2471−omitNulls :: [(Text, Value)] -> Value
2472−omitNulls = object . filter notNull where
2473− notNull (_, Null) = False
2474− notNull (_, Array a) = (not . V.null) a
2475− notNull _ = True
2476−
2477−
2478−instance ToJSON SimpleQueryStringQuery where
2479− toJSON SimpleQueryStringQuery {..} =
2480− omitNulls (base ++ maybeAdd)
2481− where base = [ "query" .= simpleQueryStringQuery ]
2482− maybeAdd = [ "fields" .= simpleQueryStringField
2483− , "default_operator" .= simpleQueryStringOperator
2484− , "analyzer" .= simpleQueryStringAnalyzer
2485− , "flags" .= simpleQueryStringFlags
2486− , "lowercase_expanded_terms" .= simpleQueryStringLowercaseExpanded
2487− , "locale" .= simpleQueryStringLocale ]
2488−
2489−instance FromJSON SimpleQueryStringQuery where
2490− parseJSON = withObject "SimpleQueryStringQuery" parse
2491− where parse o = SimpleQueryStringQuery <$> o .: "query"
2492− <*> o .:? "fields"
2493− <*> o .:? "default_operator"
2494− <*> o .:? "analyzer"
2495− <*> (parseFlags <$> o .:? "flags")
2496− <*> o .:? "lowercase_expanded_terms"
2497− <*> o .:? "locale"
2498− parseFlags (Just (x:xs)) = Just (x :| xs)
2499− parseFlags _ = Nothing
2500−
2501−instance ToJSON FieldOrFields where
2502− toJSON (FofField fieldName) =
2503− toJSON fieldName
2504− toJSON (FofFields fieldNames) =
2505− toJSON fieldNames
2506−
2507−instance FromJSON FieldOrFields where
2508− parseJSON v = FofField <$> parseJSON v
2509− <|> FofFields <$> (parseNEJSON =<< parseJSON v)
2510−
2511−instance ToJSON SimpleQueryFlag where
2512− toJSON SimpleQueryAll = "ALL"
2513− toJSON SimpleQueryNone = "NONE"
2514− toJSON SimpleQueryAnd = "AND"
2515− toJSON SimpleQueryOr = "OR"
2516− toJSON SimpleQueryPrefix = "PREFIX"
2517− toJSON SimpleQueryPhrase = "PHRASE"
2518− toJSON SimpleQueryPrecedence = "PRECEDENCE"
2519− toJSON SimpleQueryEscape = "ESCAPE"
2520− toJSON SimpleQueryWhitespace = "WHITESPACE"
2521− toJSON SimpleQueryFuzzy = "FUZZY"
2522− toJSON SimpleQueryNear = "NEAR"
2523− toJSON SimpleQuerySlop = "SLOP"
2524−
2525−instance FromJSON SimpleQueryFlag where
2526− parseJSON = withText "SimpleQueryFlag" parse
2527− where parse "ALL" = pure SimpleQueryAll
2528− parse "NONE" = pure SimpleQueryNone
2529− parse "AND" = pure SimpleQueryAnd
2530− parse "OR" = pure SimpleQueryOr
2531− parse "PREFIX" = pure SimpleQueryPrefix
2532− parse "PHRASE" = pure SimpleQueryPhrase
2533− parse "PRECEDENCE" = pure SimpleQueryPrecedence
2534− parse "ESCAPE" = pure SimpleQueryEscape
2535− parse "WHITESPACE" = pure SimpleQueryWhitespace
2536− parse "FUZZY" = pure SimpleQueryFuzzy
2537− parse "NEAR" = pure SimpleQueryNear
2538− parse "SLOP" = pure SimpleQuerySlop
2539− parse f = fail ("Unexpected SimpleQueryFlag: " <> show f)
2540−
2541−instance ToJSON RegexpQuery where
2542− toJSON (RegexpQuery (FieldName rqQueryField)
2543− (Regexp regexpQueryQuery) rqQueryFlags
2544− rqQueryBoost) =
2545− object [ rqQueryField .= omitNulls base ]
2546− where base = [ "value" .= regexpQueryQuery
2547− , "flags" .= rqQueryFlags
2548− , "boost" .= rqQueryBoost ]
2549−
2550−instance FromJSON RegexpQuery where
2551− parseJSON = withObject "RegexpQuery" parse
2552− where parse = fieldTagged $ \fn o ->
2553− RegexpQuery fn
2554− <$> o .: "value"
2555− <*> o .: "flags"
2556− <*> o .:? "boost"
2557−
2558−instance ToJSON QueryStringQuery where
2559− toJSON (QueryStringQuery qsQueryString
2560− qsDefaultField qsOperator
2561− qsAnalyzer qsAllowWildcard
2562− qsLowercaseExpanded qsEnablePositionIncrements
2563− qsFuzzyMaxExpansions qsFuzziness
2564− qsFuzzyPrefixLength qsPhraseSlop
2565− qsBoost qsAnalyzeWildcard
2566− qsGeneratePhraseQueries qsMinimumShouldMatch
2567− qsLenient qsLocale) =
2568− omitNulls base
2569− where
2570− base = [ "query" .= qsQueryString
2571− , "default_field" .= qsDefaultField
2572− , "default_operator" .= qsOperator
2573− , "analyzer" .= qsAnalyzer
2574− , "allow_leading_wildcard" .= qsAllowWildcard
2575− , "lowercase_expanded_terms" .= qsLowercaseExpanded
2576− , "enable_position_increments" .= qsEnablePositionIncrements
2577− , "fuzzy_max_expansions" .= qsFuzzyMaxExpansions
2578− , "fuzziness" .= qsFuzziness
2579− , "fuzzy_prefix_length" .= qsFuzzyPrefixLength
2580− , "phrase_slop" .= qsPhraseSlop
2581− , "boost" .= qsBoost
2582− , "analyze_wildcard" .= qsAnalyzeWildcard
2583− , "auto_generate_phrase_queries" .= qsGeneratePhraseQueries
2584− , "minimum_should_match" .= qsMinimumShouldMatch
2585− , "lenient" .= qsLenient
2586− , "locale" .= qsLocale ]
2587−
2588−instance FromJSON QueryStringQuery where
2589− parseJSON = withObject "QueryStringQuery" parse
2590− where parse o = QueryStringQuery
2591− <$> o .: "query"
2592− <*> o .:? "default_field"
2593− <*> o .:? "default_operator"
2594− <*> o .:? "analyzer"
2595− <*> o .:? "allow_leading_wildcard"
2596− <*> o .:? "lowercase_expanded_terms"
2597− <*> o .:? "enable_position_increments"
2598− <*> o .:? "fuzzy_max_expansions"
2599− <*> o .:? "fuzziness"
2600− <*> o .:? "fuzzy_prefix_length"
2601− <*> o .:? "phrase_slop"
2602− <*> o .:? "boost"
2603− <*> o .:? "analyze_wildcard"
2604− <*> o .:? "auto_generate_phrase_queries"
2605− <*> o .:? "minimum_should_match"
2606− <*> o .:? "lenient"
2607− <*> o .:? "locale"
2608−
2609−instance ToJSON RangeQuery where
2610− toJSON (RangeQuery (FieldName fieldName) range boost) =
2611− object [ fieldName .= object conjoined ]
2612− where conjoined = [ "boost" .= boost ] ++ (rangeValueToPair range)
2613−
2614−instance FromJSON RangeQuery where
2615− parseJSON = withObject "RangeQuery" parse
2616− where parse = fieldTagged $ \fn o ->
2617− RangeQuery fn
2618− <$> parseJSON (Object o)
2619− <*> o .: "boost"
2620−
2621−instance FromJSON RangeValue where
2622− parseJSON = withObject "RangeValue" parse
2623− where parse o = parseDate o
2624− <|> parseDouble o
2625− parseDate o = do lt <- o .:? "lt"
2626− lte <- o .:? "lte"
2627− gt <- o .:? "gt"
2628− gte <- o .:? "gte"
2629− case (lt, lte, gt, gte) of
2630− (Just a, _, Just b, _) -> return (RangeDateGtLt (GreaterThanD b) (LessThanD a))
2631− (Just a, _, _, Just b)-> return (RangeDateGteLt (GreaterThanEqD b) (LessThanD a))
2632− (_, Just a, Just b, _)-> return (RangeDateGtLte (GreaterThanD b) (LessThanEqD a))
2633− (_, Just a, _, Just b)-> return (RangeDateGteLte (GreaterThanEqD b) (LessThanEqD a))
2634− (_, _, Just a, _)-> return (RangeDateGt (GreaterThanD a))
2635− (Just a, _, _, _)-> return (RangeDateLt (LessThanD a))
2636− (_, _, _, Just a)-> return (RangeDateGte (GreaterThanEqD a))
2637− (_, Just a, _, _)-> return (RangeDateLte (LessThanEqD a))
2638− (Nothing, Nothing, Nothing, Nothing) -> mzero
2639− parseDouble o = do lt <- o .:? "lt"
2640− lte <- o .:? "lte"
2641− gt <- o .:? "gt"
2642− gte <- o .:? "gte"
2643− case (lt, lte, gt, gte) of
2644− (Just a, _, Just b, _) -> return (RangeDoubleGtLt (GreaterThan b) (LessThan a))
2645− (Just a, _, _, Just b)-> return (RangeDoubleGteLt (GreaterThanEq b) (LessThan a))
2646− (_, Just a, Just b, _)-> return (RangeDoubleGtLte (GreaterThan b) (LessThanEq a))
2647− (_, Just a, _, Just b)-> return (RangeDoubleGteLte (GreaterThanEq b) (LessThanEq a))
2648− (_, _, Just a, _)-> return (RangeDoubleGt (GreaterThan a))
2649− (Just a, _, _, _)-> return (RangeDoubleLt (LessThan a))
2650− (_, _, _, Just a)-> return (RangeDoubleGte (GreaterThanEq a))
2651− (_, Just a, _, _)-> return (RangeDoubleLte (LessThanEq a))
2652− (Nothing, Nothing, Nothing, Nothing) -> mzero
2653−
2654−instance ToJSON PrefixQuery where
2655− toJSON (PrefixQuery (FieldName fieldName) queryValue boost) =
2656− object [ fieldName .= omitNulls base ]
2657− where base = [ "value" .= queryValue
2658− , "boost" .= boost ]
2659−
2660−instance FromJSON PrefixQuery where
2661− parseJSON = withObject "PrefixQuery" parse
2662− where parse = fieldTagged $ \fn o ->
2663− PrefixQuery fn
2664− <$> o .: "value"
2665− <*> o .:? "boost"
2666−
2667−instance ToJSON NestedQuery where
2668− toJSON (NestedQuery nqPath nqScoreType nqQuery) =
2669− object [ "path" .= nqPath
2670− , "score_mode" .= nqScoreType
2671− , "query" .= nqQuery ]
2672−
2673−instance FromJSON NestedQuery where
2674− parseJSON = withObject "NestedQuery" parse
2675− where parse o = NestedQuery
2676− <$> o .: "path"
2677− <*> o .: "score_mode"
2678− <*> o .: "query"
2679−
2680−instance ToJSON MoreLikeThisFieldQuery where
2681− toJSON (MoreLikeThisFieldQuery text (FieldName fieldName)
2682− percent mtf mqt stopwords mindf maxdf
2683− minwl maxwl boostTerms boost analyzer) =
2684− object [ fieldName .= omitNulls base ]
2685− where base = [ "like_text" .= text
2686− , "percent_terms_to_match" .= percent
2687− , "min_term_freq" .= mtf
2688− , "max_query_terms" .= mqt
2689− , "stop_words" .= stopwords
2690− , "min_doc_freq" .= mindf
2691− , "max_doc_freq" .= maxdf
2692− , "min_word_length" .= minwl
2693− , "max_word_length" .= maxwl
2694− , "boost_terms" .= boostTerms
2695− , "boost" .= boost
2696− , "analyzer" .= analyzer ]
2697−
2698−instance FromJSON MoreLikeThisFieldQuery where
2699− parseJSON = withObject "MoreLikeThisFieldQuery" parse
2700− where parse = fieldTagged $ \fn o ->
2701− MoreLikeThisFieldQuery
2702− <$> o .: "like_text"
2703− <*> pure fn
2704− <*> o .:? "percent_terms_to_match"
2705− <*> o .:? "min_term_freq"
2706− <*> o .:? "max_query_terms"
2707− -- <*> (optionalNE =<< o .:? "stop_words")
2708− <*> o .:? "stop_words"
2709− <*> o .:? "min_doc_freq"
2710− <*> o .:? "max_doc_freq"
2711− <*> o .:? "min_word_length"
2712− <*> o .:? "max_word_length"
2713− <*> o .:? "boost_terms"
2714− <*> o .:? "boost"
2715− <*> o .:? "analyzer"
2716− -- optionalNE = maybe (pure Nothing) (fmap Just . parseNEJSON)
2717−
2718−instance ToJSON MoreLikeThisQuery where
2719− toJSON (MoreLikeThisQuery text fields percent
2720− mtf mqt stopwords mindf maxdf
2721− minwl maxwl boostTerms boost analyzer) =
2722− omitNulls base
2723− where base = [ "like_text" .= text
2724− , "fields" .= fields
2725− , "percent_terms_to_match" .= percent
2726− , "min_term_freq" .= mtf
2727− , "max_query_terms" .= mqt
2728− , "stop_words" .= stopwords
2729− , "min_doc_freq" .= mindf
2730− , "max_doc_freq" .= maxdf
2731− , "min_word_length" .= minwl
2732− , "max_word_length" .= maxwl
2733− , "boost_terms" .= boostTerms
2734− , "boost" .= boost
2735− , "analyzer" .= analyzer ]
2736−
2737−instance FromJSON MoreLikeThisQuery where
2738− parseJSON = withObject "MoreLikeThisQuery" parse
2739− where parse o = MoreLikeThisQuery
2740− <$> o .: "like_text"
2741− -- <*> (optionalNE =<< o .:? "fields")
2742− <*> o .:? "fields"
2743− <*> o .:? "percent_terms_to_match"
2744− <*> o .:? "min_term_freq"
2745− <*> o .:? "max_query_terms"
2746− -- <*> (optionalNE =<< o .:? "stop_words")
2747− <*> o .:? "stop_words"
2748− <*> o .:? "min_doc_freq"
2749− <*> o .:? "max_doc_freq"
2750− <*> o .:? "min_word_length"
2751− <*> o .:? "max_word_length"
2752− <*> o .:? "boost_terms"
2753− <*> o .:? "boost"
2754− <*> o .:? "analyzer"
2755− -- optionalNE = maybe (pure Nothing) (fmap Just . parseNEJSON)
2756−
2757−instance ToJSON IndicesQuery where
2758− toJSON (IndicesQuery indices query noMatch) =
2759− omitNulls [ "indices" .= indices
2760− , "no_match_query" .= noMatch
2761− , "query" .= query ]
2762−
2763−instance FromJSON IndicesQuery where
2764− parseJSON = withObject "IndicesQuery" parse
2765− where parse o = IndicesQuery
2766− <$> o .:? "indices" .!= []
2767− <*> o .: "query"
2768− <*> o .:? "no_match_query"
2769−
2770−instance ToJSON HasParentQuery where
2771− toJSON (HasParentQuery queryType query scoreType) =
2772− omitNulls [ "parent_type" .= queryType
2773− , "score_type" .= scoreType
2774− , "query" .= query ]
2775−
2776−instance FromJSON HasParentQuery where
2777− parseJSON = withObject "HasParentQuery" parse
2778− where parse o = HasParentQuery
2779− <$> o .: "parent_type"
2780− <*> o .: "query"
2781− <*> o .:? "score_type"
2782−
2783−instance ToJSON HasChildQuery where
2784− toJSON (HasChildQuery queryType query scoreType) =
2785− omitNulls [ "query" .= query
2786− , "score_type" .= scoreType
2787− , "type" .= queryType ]
2788−
2789−instance FromJSON HasChildQuery where
2790− parseJSON = withObject "HasChildQuery" parse
2791− where parse o = HasChildQuery
2792− <$> o .: "type"
2793− <*> o .: "query"
2794− <*> o .:? "score_type"
2795−
2796−instance ToJSON FuzzyQuery where
2797− toJSON (FuzzyQuery (FieldName fieldName) queryText
2798− prefixLength maxEx fuzziness boost) =
2799− object [ fieldName .= omitNulls base ]
2800− where base = [ "value" .= queryText
2801− , "fuzziness" .= fuzziness
2802− , "prefix_length" .= prefixLength
2803− , "boost" .= boost
2804− , "max_expansions" .= maxEx ]
2805−
2806−instance FromJSON FuzzyQuery where
2807− parseJSON = withObject "FuzzyQuery" parse
2808− where parse = fieldTagged $ \fn o ->
2809− FuzzyQuery fn
2810− <$> o .: "value"
2811− <*> o .: "prefix_length"
2812− <*> o .: "max_expansions"
2813− <*> o .: "fuzziness"
2814− <*> o .:? "boost"
2815−
2816−instance ToJSON FuzzyLikeFieldQuery where
2817− toJSON (FuzzyLikeFieldQuery (FieldName fieldName)
2818− fieldText maxTerms ignoreFreq fuzziness prefixLength
2819− boost analyzer) =
2820− object [ fieldName .=
2821− omitNulls [ "like_text" .= fieldText
2822− , "max_query_terms" .= maxTerms
2823− , "ignore_tf" .= ignoreFreq
2824− , "fuzziness" .= fuzziness
2825− , "prefix_length" .= prefixLength
2826− , "analyzer" .= analyzer
2827− , "boost" .= boost ]]
2828−
2829−instance FromJSON FuzzyLikeFieldQuery where
2830− parseJSON = withObject "FuzzyLikeFieldQuery" parse
2831− where parse = fieldTagged $ \fn o ->
2832− FuzzyLikeFieldQuery fn
2833− <$> o .: "like_text"
2834− <*> o .: "max_query_terms"
2835− <*> o .: "ignore_tf"
2836− <*> o .: "fuzziness"
2837− <*> o .: "prefix_length"
2838− <*> o .: "boost"
2839− <*> o .:? "analyzer"
2840−
2841−instance ToJSON FuzzyLikeThisQuery where
2842− toJSON (FuzzyLikeThisQuery fields text maxTerms
2843− ignoreFreq fuzziness prefixLength boost analyzer) =
2844− omitNulls base
2845− where base = [ "fields" .= fields
2846− , "like_text" .= text
2847− , "max_query_terms" .= maxTerms
2848− , "ignore_tf" .= ignoreFreq
2849− , "fuzziness" .= fuzziness
2850− , "prefix_length" .= prefixLength
2851− , "analyzer" .= analyzer
2852− , "boost" .= boost ]
2853−
2854−instance FromJSON FuzzyLikeThisQuery where
2855− parseJSON = withObject "FuzzyLikeThisQuery" parse
2856− where parse o = FuzzyLikeThisQuery
2857− <$> o .:? "fields" .!= []
2858− <*> o .: "like_text"
2859− <*> o .: "max_query_terms"
2860− <*> o .: "ignore_tf"
2861− <*> o .: "fuzziness"
2862− <*> o .: "prefix_length"
2863− <*> o .: "boost"
2864− <*> o .:? "analyzer"
2865−
2866−instance ToJSON FilteredQuery where
2867− toJSON (FilteredQuery query fFilter) =
2868− object [ "query" .= query
2869− , "filter" .= fFilter ]
2870−
2871−instance FromJSON FilteredQuery where
2872− parseJSON = withObject "FilteredQuery" parse
2873− where parse o = FilteredQuery
2874− <$> o .: "query"
2875− <*> o .: "filter"
2876−
2877−instance ToJSON DisMaxQuery where
2878− toJSON (DisMaxQuery queries tiebreaker boost) =
2879− omitNulls base
2880− where base = [ "queries" .= queries
2881− , "boost" .= boost
2882− , "tie_breaker" .= tiebreaker ]
2883−
2884−instance FromJSON DisMaxQuery where
2885− parseJSON = withObject "DisMaxQuery" parse
2886− where parse o = DisMaxQuery
2887− <$> o .:? "queries" .!= []
2888− <*> o .: "tie_breaker"
2889− <*> o .:? "boost"
2890−
2891−instance ToJSON CommonTermsQuery where
2892− toJSON (CommonTermsQuery (FieldName fieldName)
2893− (QueryString query) cf lfo hfo msm
2894− boost analyzer disableCoord) =
2895− object [fieldName .= omitNulls base ]
2896− where base = [ "query" .= query
2897− , "cutoff_frequency" .= cf
2898− , "low_freq_operator" .= lfo
2899− , "minimum_should_match" .= msm
2900− , "boost" .= boost
2901− , "analyzer" .= analyzer
2902− , "disable_coord" .= disableCoord
2903− , "high_freq_operator" .= hfo ]
2904−
2905−instance FromJSON CommonTermsQuery where
2906− parseJSON = withObject "CommonTermsQuery" parse
2907− where parse = fieldTagged $ \fn o ->
2908− CommonTermsQuery fn
2909− <$> o .: "query"
2910− <*> o .: "cutoff_frequency"
2911− <*> o .: "low_freq_operator"
2912− <*> o .: "high_freq_operator"
2913− <*> o .:? "minimum_should_match"
2914− <*> o .:? "boost"
2915− <*> o .:? "analyzer"
2916− <*> o .:? "disable_coord"
2917−
2918−instance ToJSON CommonMinimumMatch where
2919− toJSON (CommonMinimumMatch mm) = toJSON mm
2920− toJSON (CommonMinimumMatchHighLow (MinimumMatchHighLow lowF highF)) =
2921− object [ "low_freq" .= lowF
2922− , "high_freq" .= highF ]
2923−
2924−instance FromJSON CommonMinimumMatch where
2925− parseJSON v = parseMinimum v
2926− <|> parseMinimumHighLow v
2927− where parseMinimum = fmap CommonMinimumMatch . parseJSON
2928− parseMinimumHighLow = fmap CommonMinimumMatchHighLow . withObject "CommonMinimumMatchHighLow" (\o ->
2929− MinimumMatchHighLow
2930− <$> o .: "low_freq"
2931− <*> o .: "high_freq")
2932−
2933−
2934−instance ToJSON BoostingQuery where
2935− toJSON (BoostingQuery bqPositiveQuery bqNegativeQuery bqNegativeBoost) =
2936− object [ "positive" .= bqPositiveQuery
2937− , "negative" .= bqNegativeQuery
2938− , "negative_boost" .= bqNegativeBoost ]
2939−
2940−instance FromJSON BoostingQuery where
2941− parseJSON = withObject "BoostingQuery" parse
2942− where parse o = BoostingQuery
2943− <$> o .: "positive"
2944− <*> o .: "negative"
2945− <*> o .: "negative_boost"
2946−
2947−instance ToJSON BoolQuery where
2948− toJSON (BoolQuery mustM notM shouldM bqMin boost disableCoord) =
2949− omitNulls base
2950− where base = [ "must" .= mustM
2951− , "must_not" .= notM
2952− , "should" .= shouldM
2953− , "minimum_should_match" .= bqMin
2954− , "boost" .= boost
2955− , "disable_coord" .= disableCoord ]
2956−
2957−instance FromJSON BoolQuery where
2958− parseJSON = withObject "BoolQuery" parse
2959− where parse o = BoolQuery
2960− <$> o .:? "must" .!= []
2961− <*> o .:? "must_not" .!= []
2962− <*> o .:? "should" .!= []
2963− <*> o .:? "minimum_should_match"
2964− <*> o .:? "boost"
2965− <*> o .:? "disable_coord"
2966−
2967−instance ToJSON MatchQuery where
2968− toJSON (MatchQuery (FieldName fieldName)
2969− (QueryString mqQueryString) booleanOperator
2970− zeroTermsQuery cutoffFrequency matchQueryType
2971− analyzer maxExpansions lenient boost) =
2972− object [ fieldName .= omitNulls base ]
2973− where base = [ "query" .= mqQueryString
2974− , "operator" .= booleanOperator
2975− , "zero_terms_query" .= zeroTermsQuery
2976− , "cutoff_frequency" .= cutoffFrequency
2977− , "type" .= matchQueryType
2978− , "analyzer" .= analyzer
2979− , "max_expansions" .= maxExpansions
2980− , "lenient" .= lenient
2981− , "boost" .= boost ]
2982−
2983−instance FromJSON MatchQuery where
2984− parseJSON = withObject "MatchQuery" parse
2985− where parse = fieldTagged $ \fn o ->
2986− MatchQuery fn
2987− <$> o .: "query"
2988− <*> o .: "operator"
2989− <*> o .: "zero_terms_query"
2990− <*> o .:? "cutoff_frequency"
2991− <*> o .:? "type"
2992− <*> o .:? "analyzer"
2993− <*> o .:? "max_expansions"
2994− <*> o .:? "lenient"
2995− <*> o .:? "boost"
2996−
2997−instance ToJSON MultiMatchQuery where
2998− toJSON (MultiMatchQuery fields (QueryString query) boolOp
2999− ztQ tb mmqt cf analyzer maxEx lenient) =
3000− object ["multi_match" .= omitNulls base]
3001− where base = [ "fields" .= fmap toJSON fields
3002− , "query" .= query
3003− , "operator" .= boolOp
3004− , "zero_terms_query" .= ztQ
3005− , "tie_breaker" .= tb
3006− , "type" .= mmqt
3007− , "cutoff_frequency" .= cf
3008− , "analyzer" .= analyzer
3009− , "max_expansions" .= maxEx
3010− , "lenient" .= lenient ]
3011−
3012−instance FromJSON MultiMatchQuery where
3013− parseJSON = withObject "MultiMatchQuery" parse
3014− where parse raw = do o <- raw .: "multi_match"
3015− MultiMatchQuery
3016− <$> o .:? "fields" .!= []
3017− <*> o .: "query"
3018− <*> o .: "operator"
3019− <*> o .: "zero_terms_query"
3020− <*> o .:? "tie_breaker"
3021− <*> o .:? "type"
3022− <*> o .:? "cutoff_frequency"
3023− <*> o .:? "analyzer"
3024− <*> o .:? "max_expansions"
3025− <*> o .:? "lenient"
3026−
3027−instance ToJSON MultiMatchQueryType where
3028− toJSON MultiMatchBestFields = "best_fields"
3029− toJSON MultiMatchMostFields = "most_fields"
3030− toJSON MultiMatchCrossFields = "cross_fields"
3031− toJSON MultiMatchPhrase = "phrase"
3032− toJSON MultiMatchPhrasePrefix = "phrase_prefix"
3033−
3034−instance FromJSON MultiMatchQueryType where
3035− parseJSON = withText "MultiMatchPhrasePrefix" parse
3036− where parse "best_fields" = pure MultiMatchBestFields
3037− parse "most_fields" = pure MultiMatchMostFields
3038− parse "cross_fields" = pure MultiMatchCrossFields
3039− parse "phrase" = pure MultiMatchPhrase
3040− parse "phrase_prefix" = pure MultiMatchPhrasePrefix
3041− parse t = fail ("Unexpected MultiMatchPhrasePrefix: " <> show t)
3042−
3043−instance ToJSON BooleanOperator where
3044− toJSON And = String "and"
3045− toJSON Or = String "or"
3046−
3047−instance FromJSON BooleanOperator where
3048− parseJSON = withText "BooleanOperator" parse
3049− where parse "and" = pure And
3050− parse "or" = pure Or
3051− parse o = fail ("Unexpected BooleanOperator: " <> show o)
3052−
3053−instance ToJSON ZeroTermsQuery where
3054− toJSON ZeroTermsNone = String "none"
3055− toJSON ZeroTermsAll = String "all"
3056−
3057−instance FromJSON ZeroTermsQuery where
3058− parseJSON = withText "ZeroTermsQuery" parse
3059− where parse "none" = pure ZeroTermsNone
3060− parse "all" = pure ZeroTermsAll
3061− parse q = fail ("Unexpected ZeroTermsQuery: " <> show q)
3062−
3063−instance ToJSON MatchQueryType where
3064− toJSON MatchPhrase = "phrase"
3065− toJSON MatchPhrasePrefix = "phrase_prefix"
3066−
3067−instance FromJSON MatchQueryType where
3068− parseJSON = withText "MatchQueryType" parse
3069− where parse "phrase" = pure MatchPhrase
3070− parse "phrase_prefix" = pure MatchPhrasePrefix
3071− parse t = fail ("Unexpected MatchQueryType: " <> show t)
3072−
3073−instance FromJSON Status where
3074− parseJSON (Object v) = Status <$>
3075− v .:? "ok" <*>
3076− (v .:? "status" .!= 200) <*>
3077− v .: "name" <*>
3078− v .: "version" <*>
3079− v .: "tagline"
3080− parseJSON _ = empty
3081−
3082−
3083−instance ToJSON IndexSettings where
3084− toJSON (IndexSettings s r) = object ["settings" .=
3085− object ["index" .=
3086− object ["number_of_shards" .= s, "number_of_replicas" .= r]
3087− ]
3088− ]
3089−
3090−instance FromJSON IndexSettings where
3091− parseJSON = withObject "IndexSettings" parse
3092− where parse o = do s <- o .: "settings"
3093− i <- s .: "index"
3094− IndexSettings <$> i .: "number_of_shards"
3095− <*> i .: "number_of_replicas"
3096−
3097−instance ToJSON UpdatableIndexSetting where
3098− toJSON (NumberOfReplicas x) = oPath ("index" :| ["number_of_replicas"]) x
3099− toJSON (AutoExpandReplicas x) = oPath ("index" :| ["auto_expand_replicas"]) x
3100− toJSON (RefreshInterval x) = oPath ("index" :| ["refresh_interval"]) (NominalDiffTimeJSON x)
3101− toJSON (IndexConcurrency x) = oPath ("index" :| ["concurrency"]) x
3102− toJSON (FailOnMergeFailure x) = oPath ("index" :| ["fail_on_merge_failure"]) x
3103− toJSON (TranslogFlushThresholdOps x) = oPath ("index" :| ["translog", "flush_threshold_ops"]) x
3104− toJSON (TranslogFlushThresholdSize x) = oPath ("index" :| ["translog", "flush_threshold_size"]) x
3105− toJSON (TranslogFlushThresholdPeriod x) = oPath ("index" :| ["translog", "flush_threshold_period"]) (NominalDiffTimeJSON x)
3106− toJSON (TranslogDisableFlush x) = oPath ("index" :| ["translog", "disable_flush"]) x
3107− toJSON (CacheFilterMaxSize x) = oPath ("index" :| ["cache", "filter", "max_size"]) x
3108− toJSON (CacheFilterExpire x) = oPath ("index" :| ["cache", "filter", "expire"]) (NominalDiffTimeJSON <$> x)
3109− toJSON (GatewaySnapshotInterval x) = oPath ("index" :| ["gateway", "snapshot_interval"]) (NominalDiffTimeJSON x)
3110− toJSON (RoutingAllocationInclude fs) = oPath ("index" :| ["routing", "allocation", "include"]) (attrFilterJSON fs)
3111− toJSON (RoutingAllocationExclude fs) = oPath ("index" :| ["routing", "allocation", "exclude"]) (attrFilterJSON fs)
3112− toJSON (RoutingAllocationRequire fs) = oPath ("index" :| ["routing", "allocation", "require"]) (attrFilterJSON fs)
3113− toJSON (RoutingAllocationEnable x) = oPath ("index" :| ["routing", "allocation", "enable"]) x
3114− toJSON (RoutingAllocationShardsPerNode x) = oPath ("index" :| ["routing", "allocation", "total_shards_per_node"]) x
3115− toJSON (RecoveryInitialShards x) = oPath ("index" :| ["recovery", "initial_shards"]) x
3116− toJSON (GCDeletes x) = oPath ("index" :| ["gc_deletes"]) (NominalDiffTimeJSON x)
3117− toJSON (TTLDisablePurge x) = oPath ("index" :| ["ttl", "disable_purge"]) x
3118− toJSON (TranslogFSType x) = oPath ("index" :| ["translog", "fs", "type"]) x
3119− toJSON (IndexCompoundFormat x) = oPath ("index" :| ["compound_format"]) x
3120− toJSON (IndexCompoundOnFlush x) = oPath ("index" :| ["compound_on_flush"]) x
3121− toJSON (WarmerEnabled x) = oPath ("index" :| ["warmer", "enabled"]) x
3122− toJSON (BlocksReadOnly x) = oPath ("blocks" :| ["read_only"]) x
3123− toJSON (BlocksRead x) = oPath ("blocks" :| ["read"]) x
3124− toJSON (BlocksWrite x) = oPath ("blocks" :| ["write"]) x
3125− toJSON (BlocksMetaData x) = oPath ("blocks" :| ["metadata"]) x
3126−
3127−instance FromJSON UpdatableIndexSetting where
3128− parseJSON = withObject "UpdatableIndexSetting" parse
3129− where parse o = numberOfReplicas `taggedAt` ["index", "number_of_replicas"]
3130− <|> autoExpandReplicas `taggedAt` ["index", "auto_expand_replicas"]
3131− <|> refreshInterval `taggedAt` ["index", "refresh_interval"]
3132− <|> indexConcurrency `taggedAt` ["index", "concurrency"]
3133− <|> failOnMergeFailure `taggedAt` ["index", "fail_on_merge_failure"]
3134− <|> translogFlushThresholdOps `taggedAt` ["index", "translog", "flush_threshold_ops"]
3135− <|> translogFlushThresholdSize `taggedAt` ["index", "translog", "flush_threshold_size"]
3136− <|> translogFlushThresholdPeriod `taggedAt` ["index", "translog", "flush_threshold_period"]
3137− <|> translogDisableFlush `taggedAt` ["index", "translog", "disable_flush"]
3138− <|> cacheFilterMaxSize `taggedAt` ["index", "cache", "filter", "max_size"]
3139− <|> cacheFilterExpire `taggedAt` ["index", "cache", "filter", "expire"]
3140− <|> gatewaySnapshotInterval `taggedAt` ["index", "gateway", "snapshot_interval"]
3141− <|> routingAllocationInclude `taggedAt` ["index", "routing", "allocation", "include"]
3142− <|> routingAllocationExclude `taggedAt` ["index", "routing", "allocation", "exclude"]
3143− <|> routingAllocationRequire `taggedAt` ["index", "routing", "allocation", "require"]
3144− <|> routingAllocationEnable `taggedAt` ["index", "routing", "allocation", "enable"]
3145− <|> routingAllocationShardsPerNode `taggedAt` ["index", "routing", "allocation", "total_shards_per_node"]
3146− <|> recoveryInitialShards `taggedAt` ["index", "recovery", "initial_shards"]
3147− <|> gcDeletes `taggedAt` ["index", "gc_deletes"]
3148− <|> ttlDisablePurge `taggedAt` ["index", "ttl", "disable_purge"]
3149− <|> translogFSType `taggedAt` ["index", "translog", "fs", "type"]
3150− <|> compoundFormat `taggedAt` ["index", "compound_format"]
3151− <|> compoundOnFlush `taggedAt` ["index", "compound_on_flush"]
3152− <|> warmerEnabled `taggedAt` ["index", "warmer", "enabled"]
3153− <|> blocksReadOnly `taggedAt` ["blocks", "read_only"]
3154− <|> blocksRead `taggedAt` ["blocks", "read"]
3155− <|> blocksWrite `taggedAt` ["blocks", "write"]
3156− <|> blocksMetaData `taggedAt` ["blocks", "metadata"]
3157− where taggedAt f ks = taggedAt' f (Object o) ks
3158− taggedAt' f v [] = f =<< (parseJSON v <|> (parseJSON (unStringlyTypeJSON v)))
3159− taggedAt' f v (k:ks) = withObject "Object" (\o -> do v' <- o .: k
3160− taggedAt' f v' ks) v
3161− numberOfReplicas = pure . NumberOfReplicas
3162− autoExpandReplicas = pure . AutoExpandReplicas
3163− refreshInterval = pure . RefreshInterval . ndtJSON
3164− indexConcurrency = pure . IndexConcurrency
3165− failOnMergeFailure = pure . FailOnMergeFailure
3166− translogFlushThresholdOps = pure . TranslogFlushThresholdOps
3167− translogFlushThresholdSize = pure . TranslogFlushThresholdSize
3168− translogFlushThresholdPeriod = pure . TranslogFlushThresholdPeriod . ndtJSON
3169− translogDisableFlush = pure . TranslogDisableFlush
3170− cacheFilterMaxSize = pure . CacheFilterMaxSize
3171− cacheFilterExpire = pure . CacheFilterExpire . fmap ndtJSON
3172− gatewaySnapshotInterval = pure . GatewaySnapshotInterval . ndtJSON
3173− routingAllocationInclude = fmap RoutingAllocationInclude . parseAttrFilter
3174− routingAllocationExclude = fmap RoutingAllocationExclude . parseAttrFilter
3175− routingAllocationRequire = fmap RoutingAllocationRequire . parseAttrFilter
3176− routingAllocationEnable = pure . RoutingAllocationEnable
3177− routingAllocationShardsPerNode = pure . RoutingAllocationShardsPerNode
3178− recoveryInitialShards = pure . RecoveryInitialShards
3179− gcDeletes = pure . GCDeletes . ndtJSON
3180− ttlDisablePurge = pure . TTLDisablePurge
3181− translogFSType = pure . TranslogFSType
3182− compoundFormat = pure . IndexCompoundFormat
3183− compoundOnFlush = pure . IndexCompoundOnFlush
3184− warmerEnabled = pure . WarmerEnabled
3185− blocksReadOnly = pure . BlocksReadOnly
3186− blocksRead = pure . BlocksRead
3187− blocksWrite = pure . BlocksWrite
3188− blocksMetaData = pure . BlocksMetaData
3189−
3190−instance FromJSON IndexSettingsSummary where
3191− parseJSON = withObject "IndexSettingsSummary" parse
3192− where parse o = case HM.toList o of
3193− [(ixn, v@(Object o'))] -> IndexSettingsSummary (IndexName ixn)
3194− <$> parseJSON v
3195− <*> (fmap (filter (not . redundant)) . parseSettings =<< o' .: "settings")
3196− _ -> fail "Expected single-key object with index name"
3197− redundant (NumberOfReplicas _) = True
3198− redundant _ = False
3199−
3200−-- | For some reason in several settings APIs, all leaf values get returned
3201−-- as strings. This function attepmts to recover from this for all
3202−-- non-recursive JSON types. If nothing can be done, the value is left alone.
3203−unStringlyTypeJSON :: Value -> Value
3204−unStringlyTypeJSON (String "true") = Bool True
3205−unStringlyTypeJSON (String "false") = Bool False
3206−unStringlyTypeJSON (String "null") = Null
3207−unStringlyTypeJSON v@(String t) = case readMay (T.unpack t) of
3208− Just n -> Number n
3209− Nothing -> v
3210−unStringlyTypeJSON v = v
3211−
3212−
3213−parseSettings :: Object -> Parser [UpdatableIndexSetting]
3214−parseSettings o = do
3215− o' <- o .: "index"
3216− -- slice the index object into singleton hashmaps and try to parse each
3217− parses <- forM (HM.toList o') $ \(k, v) -> do
3218− -- blocks are now nested into the "index" key, which is not how they're serialized
3219− let atRoot = Object (HM.singleton k v)
3220− let atIndex = Object (HM.singleton "index" atRoot)
3221− optional (parseJSON atRoot <|> parseJSON atIndex)
3222− return (catMaybes parses)
3223−
3224−oPath :: ToJSON a => NonEmpty Text -> a -> Value
3225−oPath (k :| []) v = object [k .= v]
3226−oPath (k:| (h:t)) v = object [k .= oPath (h :| t) v]
3227−
3228−attrFilterJSON :: NonEmpty NodeAttrFilter -> Value
3229−attrFilterJSON fs = object [ n .= T.intercalate "," (toList vs)
3230− | NodeAttrFilter (NodeAttrName n) vs <- toList fs]
3231−
3232−parseAttrFilter :: Value -> Parser (NonEmpty NodeAttrFilter)
3233−parseAttrFilter = withObject "NonEmpty NodeAttrFilter" parse
3234− where parse o = case HM.toList o of
3235− [] -> fail "Expected non-empty list of NodeAttrFilters"
3236− x:xs -> DT.mapM (uncurry parse') (x :| xs)
3237− parse' n = withText "Text" $ \t ->
3238− case T.splitOn "," t of
3239− fv:fvs -> return (NodeAttrFilter (NodeAttrName n) (fv :| fvs))
3240− [] -> fail "Expected non-empty list of filter values"
3241−
3242−instance ToJSON ReplicaBounds where
3243− toJSON (ReplicasBounded a b) = String (showText a <> "-" <> showText b)
3244− toJSON (ReplicasLowerBounded a) = String (showText a <> "-all")
3245− toJSON ReplicasUnbounded = Bool False
3246−
3247−instance FromJSON ReplicaBounds where
3248− parseJSON v = withText "ReplicaBounds" parseText v
3249− <|> withBool "ReplicaBounds" parseBool v
3250− where parseText t = case T.splitOn "-" t of
3251− [a, "all"] -> ReplicasLowerBounded <$> parseReadText a
3252− [a, b] -> ReplicasBounded <$> parseReadText a
3253− <*> parseReadText b
3254− _ -> fail ("Could not parse ReplicaBounds: " <> show t)
3255− parseBool False = pure ReplicasUnbounded
3256− parseBool _ = fail "ReplicasUnbounded cannot be represented with True"
3257−
3258−instance ToJSON AllocationPolicy where
3259− toJSON AllocAll = String "all"
3260− toJSON AllocPrimaries = String "primaries"
3261− toJSON AllocNewPrimaries = String "new_primaries"
3262− toJSON AllocNone = String "none"
3263−
3264−instance FromJSON AllocationPolicy where
3265− parseJSON = withText "AllocationPolicy" parse
3266− where parse "all" = pure AllocAll
3267− parse "primaries" = pure AllocPrimaries
3268− parse "new_primaries" = pure AllocNewPrimaries
3269− parse "none" = pure AllocNone
3270− parse t = fail ("Invlaid AllocationPolicy: " <> show t)
3271−
3272−instance ToJSON InitialShardCount where
3273− toJSON QuorumShards = String "quorum"
3274− toJSON QuorumMinus1Shards = String "quorum-1"
3275− toJSON FullShards = String "full"
3276− toJSON FullMinus1Shards = String "full-1"
3277− toJSON (ExplicitShards x) = toJSON x
3278−
3279−instance FromJSON InitialShardCount where
3280− parseJSON v = withText "InitialShardCount" parseText v
3281− <|> ExplicitShards <$> parseJSON v
3282− where parseText "quorum" = pure QuorumShards
3283− parseText "quorum-1" = pure QuorumMinus1Shards
3284− parseText "full" = pure FullShards
3285− parseText "full-1" = pure FullMinus1Shards
3286− parseText _ = mzero
3287−
3288−instance ToJSON FSType where
3289− toJSON FSSimple = "simple"
3290− toJSON FSBuffered = "buffered"
3291−
3292−instance FromJSON FSType where
3293− parseJSON = withText "FSType" parse
3294− where parse "simple" = pure FSSimple
3295− parse "buffered" = pure FSBuffered
3296− parse t = fail ("Invalid FSType: " <> show t)
3297−
3298−instance ToJSON CompoundFormat where
3299− toJSON (CompoundFileFormat x) = Bool x
3300− toJSON (MergeSegmentVsTotalIndex x) = toJSON x
3301−
3302−instance FromJSON CompoundFormat where
3303− parseJSON v = CompoundFileFormat <$> parseJSON v
3304− <|> MergeSegmentVsTotalIndex <$> parseJSON v
3305−
3306−instance ToJSON NominalDiffTimeJSON where
3307− toJSON (NominalDiffTimeJSON t) = String (showText (round t :: Integer) <> "s")
3308−
3309−instance FromJSON NominalDiffTimeJSON where
3310− parseJSON = withText "NominalDiffTime" parse
3311− where parse t = case T.takeEnd 1 t of
3312− "s" -> NominalDiffTimeJSON . fromInteger <$> parseReadText (T.dropEnd 1 t)
3313− _ -> fail "Invalid or missing NominalDiffTime unit (expected s)"
3314−
3315−instance ToJSON IndexTemplate where
3316− toJSON (IndexTemplate p s m) = merge
3317− (object [ "template" .= p
3318− , "mappings" .= foldl' merge (object []) m
3319− ])
3320− (toJSON s)
3321− where
3322− merge (Object o1) (Object o2) = toJSON $ HM.union o1 o2
3323− merge o Null = o
3324− merge _ _ = undefined
3325−
3326−instance (FromJSON a) => FromJSON (EsResult a) where
3327− parseJSON jsonVal@(Object v) = do
3328− found <- v .:? "found" .!= False
3329− fr <- if found
3330− then parseJSON jsonVal
3331− else return Nothing
3332− EsResult <$> v .: "_index" <*>
3333− v .: "_type" <*>
3334− v .: "_id" <*>
3335− pure fr
3336− parseJSON _ = empty
3337−
3338−instance (FromJSON a) => FromJSON (EsResultFound a) where
3339− parseJSON (Object v) = EsResultFound <$>
3340− v .: "_version" <*>
3341− v .: "_source"
3342− parseJSON _ = empty
3343−
3344−instance FromJSON EsError where
3345− parseJSON (Object v) = EsError <$>
3346− v .: "status" <*>
3347− (v .: "error" <|> (v .: "error" >>= (.: "reason")))
3348− parseJSON _ = empty
3349−
3350−instance FromJSON IndexAliasesSummary where
3351− parseJSON = withObject "IndexAliasesSummary" parse
3352− where parse o = IndexAliasesSummary . mconcat <$> mapM (uncurry go) (HM.toList o)
3353− go ixn = withObject "index aliases" $ \ia -> do
3354− aliases <- ia .:? "aliases" .!= mempty
3355− forM (HM.toList aliases) $ \(aName, v) -> do
3356− let indexAlias = IndexAlias (IndexName ixn) (IndexAliasName (IndexName aName))
3357− IndexAliasSummary indexAlias <$> parseJSON v
3358−
3359−
3360−instance ToJSON IndexAliasAction where
3361− toJSON (AddAlias ia opts) = object ["add" .= (iaObj <> optsObj)]
3362− where Object iaObj = toJSON ia
3363− Object optsObj = toJSON opts
3364− toJSON (RemoveAlias ia) = object ["remove" .= iaObj]
3365− where Object iaObj = toJSON ia
3366−
3367−instance ToJSON IndexAlias where
3368− toJSON IndexAlias {..} = object ["index" .= srcIndex
3369− , "alias" .= indexAlias
3370− ]
3371−
3372−instance ToJSON IndexAliasCreate where
3373− toJSON IndexAliasCreate {..} = Object (filterObj <> routingObj)
3374− where filterObj = maybe mempty (HM.singleton "filter" . toJSON) aliasCreateFilter
3375− Object routingObj = maybe (Object mempty) toJSON aliasCreateRouting
3376−
3377−instance ToJSON AliasRouting where
3378− toJSON (AllAliasRouting v) = object ["routing" .= v]
3379− toJSON (GranularAliasRouting srch idx) = object (catMaybes prs)
3380− where prs = [("search_routing" .=) <$> srch
3381− ,("index_routing" .=) <$> idx]
3382−
3383−instance FromJSON AliasRouting where
3384− parseJSON = withObject "AliasRouting" parse
3385− where parse o = parseAll o <|> parseGranular o
3386− parseAll o = AllAliasRouting <$> o .: "routing"
3387− parseGranular o = do
3388− sr <- o .:? "search_routing"
3389− ir <- o .:? "index_routing"
3390− if isNothing sr && isNothing ir
3391− then fail "Both search_routing and index_routing can't be blank"
3392− else return (GranularAliasRouting sr ir)
3393−
3394−instance FromJSON IndexAliasCreate where
3395− parseJSON v = withObject "IndexAliasCreate" parse v
3396− where parse o = IndexAliasCreate <$> optional (parseJSON v)
3397− <*> o .:? "filter"
3398−
3399−instance ToJSON SearchAliasRouting where
3400− toJSON (SearchAliasRouting rvs) = toJSON (T.intercalate "," (routingValue <$> toList rvs))
3401−
3402−instance FromJSON SearchAliasRouting where
3403− parseJSON = withText "SearchAliasRouting" parse
3404− where parse t = SearchAliasRouting <$> parseNEJSON (String <$> T.splitOn "," t)
3405−
3406−instance ToJSON Search where
3407− toJSON (Search query sFilter sort searchAggs highlight sTrackSortScores sFrom sSize _ sFields sSource) =
3408− omitNulls [ "query" .= query
3409− , "filter" .= sFilter
3410− , "sort" .= sort
3411− , "aggregations" .= searchAggs
3412− , "highlight" .= highlight
3413− , "from" .= sFrom
3414− , "size" .= sSize
3415− , "track_scores" .= sTrackSortScores
3416− , "fields" .= sFields
3417− , "_source" .= sSource]
3418−
3419−
3420−instance ToJSON Source where
3421− toJSON NoSource = toJSON False
3422− toJSON (SourcePatterns patterns) = toJSON patterns
3423− toJSON (SourceIncludeExclude incl excl) = object [ "include" .= incl, "exclude" .= excl ]
3424−
3425−instance ToJSON PatternOrPatterns where
3426− toJSON (PopPattern pattern) = toJSON pattern
3427− toJSON (PopPatterns patterns) = toJSON patterns
3428−
3429−instance ToJSON Include where
3430− toJSON (Include patterns) = toJSON patterns
3431−
3432−instance ToJSON Exclude where
3433− toJSON (Exclude patterns) = toJSON patterns
3434−
3435−instance ToJSON Pattern where
3436− toJSON (Pattern pattern) = toJSON pattern
3437−
3438−
3439−instance ToJSON FieldHighlight where
3440− toJSON (FieldHighlight (FieldName fName) (Just fSettings)) =
3441− object [ fName .= fSettings ]
3442− toJSON (FieldHighlight (FieldName fName) Nothing) =
3443− object [ fName .= emptyObject ]
3444−
3445−instance ToJSON Highlights where
3446− toJSON (Highlights global fields) =
3447− omitNulls (("fields" .= fields)
3448− : highlightSettingsPairs global)
3449−
3450−instance ToJSON HighlightSettings where
3451− toJSON hs = omitNulls (highlightSettingsPairs (Just hs))
3452−
3453−highlightSettingsPairs :: Maybe HighlightSettings -> [Pair]
3454−highlightSettingsPairs Nothing = []
3455−highlightSettingsPairs (Just (Plain plh)) = plainHighPairs (Just plh)
3456−highlightSettingsPairs (Just (Postings ph)) = postHighPairs (Just ph)
3457−highlightSettingsPairs (Just (FastVector fvh)) = fastVectorHighPairs (Just fvh)
3458−
3459−
3460−plainHighPairs :: Maybe PlainHighlight -> [Pair]
3461−plainHighPairs Nothing = []
3462−plainHighPairs (Just (PlainHighlight plCom plNonPost)) =
3463− [ "type" .= String "plain"]
3464− ++ commonHighlightPairs plCom
3465− ++ nonPostingsToPairs plNonPost
3466−
3467−postHighPairs :: Maybe PostingsHighlight -> [Pair]
3468−postHighPairs Nothing = []
3469−postHighPairs (Just (PostingsHighlight pCom)) =
3470− ("type" .= String "postings")
3471− : commonHighlightPairs pCom
3472−
3473−fastVectorHighPairs :: Maybe FastVectorHighlight -> [Pair]
3474−fastVectorHighPairs Nothing = []
3475−fastVectorHighPairs (Just
3476− (FastVectorHighlight fvCom fvNonPostSettings fvBoundChars
3477− fvBoundMaxScan fvFragOff fvMatchedFields
3478− fvPhraseLim)) =
3479− [ "type" .= String "fvh"
3480− , "boundary_chars" .= fvBoundChars
3481− , "boundary_max_scan" .= fvBoundMaxScan
3482− , "fragment_offset" .= fvFragOff
3483− , "matched_fields" .= fvMatchedFields
3484− , "phraseLimit" .= fvPhraseLim]
3485− ++ commonHighlightPairs fvCom
3486− ++ nonPostingsToPairs fvNonPostSettings
3487−
3488−deleteSeveral :: (Eq k, Hashable k) => [k] -> HM.HashMap k v -> HM.HashMap k v
3489−deleteSeveral ks hm = foldr HM.delete hm ks
3490−
3491−commonHighlightPairs :: Maybe CommonHighlight -> [Pair]
3492−commonHighlightPairs Nothing = []
3493−commonHighlightPairs (Just (CommonHighlight chScore chForceSource chTag chEncoder
3494− chNoMatchSize chHighlightQuery
3495− chRequireFieldMatch)) =
3496− [ "order" .= chScore
3497− , "force_source" .= chForceSource
3498− , "encoder" .= chEncoder
3499− , "no_match_size" .= chNoMatchSize
3500− , "highlight_query" .= chHighlightQuery
3501− , "require_fieldMatch" .= chRequireFieldMatch]
3502− ++ highlightTagToPairs chTag
3503−
3504−
3505−nonPostingsToPairs :: Maybe NonPostings -> [Pair]
3506−nonPostingsToPairs Nothing = []
3507−nonPostingsToPairs (Just (NonPostings npFragSize npNumOfFrags)) =
3508− [ "fragment_size" .= npFragSize
3509− , "number_of_fragments" .= npNumOfFrags]
3510−
3511−parseNEJSON :: (FromJSON a) => [Value] -> Parser (NonEmpty a)
3512−parseNEJSON [] = fail "Expected non-empty list"
3513−parseNEJSON (x:xs) = DT.mapM parseJSON (x :| xs)
3514−
3515−
3516−instance ToJSON HighlightEncoder where
3517− toJSON DefaultEncoder = String "default"
3518− toJSON HTMLEncoder = String "html"
3519−
3520−highlightTagToPairs :: Maybe HighlightTag -> [Pair]
3521−highlightTagToPairs (Just (TagSchema _)) = [ "scheme" .= String "default"]
3522−highlightTagToPairs (Just (CustomTags (pre, post))) = [ "pre_tags" .= pre
3523− , "post_tags" .= post]
3524−highlightTagToPairs Nothing = []
3525−
3526−instance ToJSON SortSpec where
3527− toJSON (DefaultSortSpec
3528− (DefaultSort (FieldName dsSortFieldName) dsSortOrder dsIgnoreUnmapped
3529− dsSortMode dsMissingSort dsNestedFilter)) =
3530− object [dsSortFieldName .= omitNulls base] where
3531− base = [ "order" .= dsSortOrder
3532− , "ignore_unmapped" .= dsIgnoreUnmapped
3533− , "mode" .= dsSortMode
3534− , "missing" .= dsMissingSort
3535− , "nested_filter" .= dsNestedFilter ]
3536−
3537− toJSON (GeoDistanceSortSpec gdsSortOrder (GeoPoint (FieldName field) gdsLatLon) units) =
3538− object [ "unit" .= units
3539− , field .= gdsLatLon
3540− , "order" .= gdsSortOrder ]
3541−
3542−
3543−instance ToJSON SortOrder where
3544− toJSON Ascending = String "asc"
3545− toJSON Descending = String "desc"
3546−
3547−
3548−instance ToJSON SortMode where
3549− toJSON SortMin = String "min"
3550− toJSON SortMax = String "max"
3551− toJSON SortSum = String "sum"
3552− toJSON SortAvg = String "avg"
3553−
3554−
3555−instance ToJSON Missing where
3556− toJSON LastMissing = String "_last"
3557− toJSON FirstMissing = String "_first"
3558− toJSON (CustomMissing txt) = String txt
3559−
3560−
3561−instance ToJSON ScoreType where
3562− toJSON ScoreTypeMax = "max"
3563− toJSON ScoreTypeAvg = "avg"
3564− toJSON ScoreTypeSum = "sum"
3565− toJSON ScoreTypeNone = "none"
3566−
3567−instance FromJSON ScoreType where
3568− parseJSON = withText "ScoreType" parse
3569− where parse "max" = pure ScoreTypeMax
3570− parse "avg" = pure ScoreTypeAvg
3571− parse "sum" = pure ScoreTypeSum
3572− parse "none" = pure ScoreTypeNone
3573− parse t = fail ("Unexpected ScoreType: " <> show t)
3574−
3575−instance ToJSON Distance where
3576− toJSON (Distance dCoefficient dUnit) =
3577− String boltedTogether where
3578− coefText = showText dCoefficient
3579− (String unitText) = toJSON dUnit
3580− boltedTogether = mappend coefText unitText
3581−
3582−instance FromJSON Distance where
3583− parseJSON = withText "Distance" parse
3584− where parse t = Distance <$> parseCoeff nT
3585− <*> parseJSON (String unitT)
3586− where (nT, unitT) = T.span validForNumber t
3587− -- may be a better way to do this
3588− validForNumber '-' = True
3589− validForNumber '.' = True
3590− validForNumber 'e' = True
3591− validForNumber c = isNumber c
3592− parseCoeff "" = fail "Empty string cannot be parsed as number"
3593− parseCoeff s = return (read (T.unpack s))
3594−
3595−instance ToJSON DistanceUnit where
3596− toJSON Miles = String "mi"
3597− toJSON Yards = String "yd"
3598− toJSON Feet = String "ft"
3599− toJSON Inches = String "in"
3600− toJSON Kilometers = String "km"
3601− toJSON Meters = String "m"
3602− toJSON Centimeters = String "cm"
3603− toJSON Millimeters = String "mm"
3604− toJSON NauticalMiles = String "nmi"
3605−
3606−
3607−instance FromJSON DistanceUnit where
3608− parseJSON = withText "DistanceUnit" parse
3609− where parse "mi" = pure Miles
3610− parse "yd" = pure Yards
3611− parse "ft" = pure Feet
3612− parse "in" = pure Inches
3613− parse "km" = pure Kilometers
3614− parse "m" = pure Meters
3615− parse "cm" = pure Centimeters
3616− parse "mm" = pure Millimeters
3617− parse "nmi" = pure NauticalMiles
3618− parse u = fail ("Unrecognized DistanceUnit: " <> show u)
3619−
3620−instance ToJSON DistanceType where
3621− toJSON Arc = String "arc"
3622− toJSON SloppyArc = String "sloppy_arc"
3623− toJSON Plane = String "plane"
3624−
3625−instance FromJSON DistanceType where
3626− parseJSON = withText "DistanceType" parse
3627− where parse "arc" = pure Arc
3628− parse "sloppy_arc" = pure SloppyArc
3629− parse "plane" = pure Plane
3630− parse t = fail ("Unrecognized DistanceType: " <> show t)
3631−
3632−
3633−instance ToJSON OptimizeBbox where
3634− toJSON NoOptimizeBbox = String "none"
3635− toJSON (OptimizeGeoFilterType gft) = toJSON gft
3636−
3637−instance FromJSON OptimizeBbox where
3638− parseJSON v = withText "NoOptimizeBbox" parseNoOptimize v
3639− <|> parseOptimize v
3640− where parseNoOptimize "none" = pure NoOptimizeBbox
3641− parseNoOptimize _ = mzero
3642− parseOptimize = fmap OptimizeGeoFilterType . parseJSON
3643−
3644−instance ToJSON GeoBoundingBoxConstraint where
3645− toJSON (GeoBoundingBoxConstraint
3646− (FieldName gbbcGeoBBField) gbbcConstraintBox cache type') =
3647− object [gbbcGeoBBField .= gbbcConstraintBox
3648− , "_cache" .= cache
3649− , "type" .= type']
3650−
3651−instance FromJSON GeoBoundingBoxConstraint where
3652− parseJSON = withObject "GeoBoundingBoxConstraint" parse
3653− where parse o = case HM.toList (deleteSeveral ["type", "_cache"] o) of
3654− [(fn, v)] -> GeoBoundingBoxConstraint (FieldName fn)
3655− <$> parseJSON v
3656− <*> o .:? "_cache" .!= defaultCache
3657− <*> o .: "type"
3658− _ -> fail "Could not find field name for GeoBoundingBoxConstraint"
3659−
3660−instance ToJSON GeoFilterType where
3661− toJSON GeoFilterMemory = String "memory"
3662− toJSON GeoFilterIndexed = String "indexed"
3663−
3664−instance FromJSON GeoFilterType where
3665− parseJSON = withText "GeoFilterType" parse
3666− where parse "memory" = pure GeoFilterMemory
3667− parse "indexed" = pure GeoFilterIndexed
3668− parse t = fail ("Unrecognized GeoFilterType: " <> show t)
3669−
3670−instance ToJSON GeoBoundingBox where
3671− toJSON (GeoBoundingBox gbbTopLeft gbbBottomRight) =
3672− object ["top_left" .= gbbTopLeft
3673− , "bottom_right" .= gbbBottomRight]
3674−
3675−instance FromJSON GeoBoundingBox where
3676− parseJSON = withObject "GeoBoundingBox" parse
3677− where parse o = GeoBoundingBox
3678− <$> o .: "top_left"
3679− <*> o .: "bottom_right"
3680−
3681−instance ToJSON LatLon where
3682− toJSON (LatLon lLat lLon) =
3683− object ["lat" .= lLat
3684− , "lon" .= lLon]
3685−
3686−instance FromJSON LatLon where
3687− parseJSON = withObject "LatLon" parse
3688− where parse o = LatLon <$> o .: "lat"
3689− <*> o .: "lon"
3690−
3691−-- index for smaller ranges, fielddata for longer ranges
3692−instance ToJSON RangeExecution where
3693− toJSON RangeExecutionIndex = "index"
3694− toJSON RangeExecutionFielddata = "fielddata"
3695−
3696−
3697−instance FromJSON RangeExecution where
3698− parseJSON = withText "RangeExecution" parse
3699− where parse "index" = pure RangeExecutionIndex
3700− parse "fielddata" = pure RangeExecutionFielddata
3701− parse t = error ("Unrecognized RangeExecution " <> show t)
3702−
3703−instance ToJSON RegexpFlags where
3704− toJSON AllRegexpFlags = String "ALL"
3705− toJSON NoRegexpFlags = String "NONE"
3706− toJSON (SomeRegexpFlags (h :| fs)) = String $ T.intercalate "|" flagStrs
3707− where flagStrs = map flagStr . nub $ h:fs
3708− flagStr AnyString = "ANYSTRING"
3709− flagStr Automaton = "AUTOMATON"
3710− flagStr Complement = "COMPLEMENT"
3711− flagStr Empty = "EMPTY"
3712− flagStr Intersection = "INTERSECTION"
3713− flagStr Interval = "INTERVAL"
3714−
3715−instance FromJSON RegexpFlags where
3716− parseJSON = withText "RegexpFlags" parse
3717− where parse "ALL" = pure AllRegexpFlags
3718− parse "NONE" = pure NoRegexpFlags
3719− parse t = SomeRegexpFlags <$> parseNEJSON (String <$> T.splitOn "|" t)
3720−
3721−instance FromJSON RegexpFlag where
3722− parseJSON = withText "RegexpFlag" parse
3723− where parse "ANYSTRING" = pure AnyString
3724− parse "AUTOMATON" = pure Automaton
3725− parse "COMPLEMENT" = pure Complement
3726− parse "EMPTY" = pure Empty
3727− parse "INTERSECTION" = pure Intersection
3728− parse "INTERVAL" = pure Interval
3729− parse f = fail ("Unknown RegexpFlag: " <> show f)
3730−
3731−instance ToJSON Term where
3732− toJSON (Term field value) = object ["term" .= object
3733− [field .= value]]
3734−
3735−instance FromJSON Term where
3736− parseJSON = withObject "Term" parse
3737− where parse o = do termObj <- o .: "term"
3738− case HM.toList termObj of
3739− [(fn, v)] -> Term fn <$> parseJSON v
3740− _ -> fail "Expected object with 1 field-named key"
3741−
3742−instance ToJSON BoolMatch where
3743− toJSON (MustMatch term cache) = object ["must" .= term,
3744− "_cache" .= cache]
3745− toJSON (MustNotMatch term cache) = object ["must_not" .= term,
3746− "_cache" .= cache]
3747− toJSON (ShouldMatch terms cache) = object ["should" .= fmap toJSON terms,
3748− "_cache" .= cache]
3749−
3750−instance FromJSON BoolMatch where
3751− parseJSON = withObject "BoolMatch" parse
3752− where parse o = mustMatch `taggedWith` "must"
3753− <|> mustNotMatch `taggedWith` "must_not"
3754− <|> shouldMatch `taggedWith` "should"
3755− where taggedWith parser k = parser =<< o .: k
3756− mustMatch t = MustMatch t <$> o .:? "_cache" .!= defaultCache
3757− mustNotMatch t = MustNotMatch t <$> o .:? "_cache" .!= defaultCache
3758− shouldMatch t = ShouldMatch t <$> o .:? "_cache" .!= defaultCache
3759−
3760−instance (FromJSON a) => FromJSON (SearchResult a) where
3761− parseJSON (Object v) = SearchResult <$>
3762− v .: "took" <*>
3763− v .: "timed_out" <*>
3764− v .: "_shards" <*>
3765− v .: "hits" <*>
3766− v .:? "aggregations" <*>
3767− v .:? "_scroll_id"
3768− parseJSON _ = empty
3769−
3770−instance (FromJSON a) => FromJSON (SearchHits a) where
3771− parseJSON (Object v) = SearchHits <$>
3772− v .: "total" <*>
3773− v .: "max_score" <*>
3774− v .: "hits"
3775− parseJSON _ = empty
3776−
3777−instance (FromJSON a) => FromJSON (Hit a) where
3778− parseJSON (Object v) = Hit <$>
3779− v .: "_index" <*>
3780− v .: "_type" <*>
3781− v .: "_id" <*>
3782− v .: "_score" <*>
3783− v .:? "_source" <*>
3784− v .:? "highlight"
3785− parseJSON _ = empty
3786−
3787−instance FromJSON ShardResult where
3788− parseJSON (Object v) = ShardResult <$>
3789− v .: "total" <*>
3790− v .: "successful" <*>
3791− v .: "failed"
3792− parseJSON _ = empty
3793−
3794−
3795−instance FromJSON DocVersion where
3796− parseJSON v = do
3797− i <- parseJSON v
3798− maybe (fail "DocVersion out of range") return $ mkDocVersion i
3799−
3800−-- This insanity is because ES *sometimes* returns Replica/Shard counts as strings
3801−instance FromJSON ReplicaCount where
3802− parseJSON v = parseAsInt v
3803− <|> parseAsString v
3804− where parseAsInt = fmap ReplicaCount . parseJSON
3805− parseAsString = withText "ReplicaCount" (fmap ReplicaCount . parseReadText)
3806−
3807−instance FromJSON ShardCount where
3808− parseJSON v = parseAsInt v
3809− <|> parseAsString v
3810− where parseAsInt = fmap ShardCount . parseJSON
3811− parseAsString = withText "ShardCount" (fmap ShardCount . parseReadText)
3812−
3813−instance Bounded DocVersion where
3814− minBound = DocVersion 1
3815− maxBound = DocVersion 9200000000000000000 -- 9.2e+18
3816−
3817−instance Enum DocVersion where
3818− succ x
3819− | x /= maxBound = DocVersion (succ $ docVersionNumber x)
3820− | otherwise = succError "DocVersion"
3821− pred x
3822− | x /= minBound = DocVersion (pred $ docVersionNumber x)
3823− | otherwise = predError "DocVersion"
3824− toEnum i =
3825− fromMaybe (error $ show i ++ " out of DocVersion range") $ mkDocVersion i
3826− fromEnum = docVersionNumber
3827− enumFrom = boundedEnumFrom
3828− enumFromThen = boundedEnumFromThen
3829−
3830−-- | Username type used for HTTP Basic authentication. See 'basicAuthHook'.
3831−newtype EsUsername = EsUsername { esUsername :: Text } deriving (Read, Show, Eq)
3832−
3833−-- | Password type used for HTTP Basic authentication. See 'basicAuthHook'.
3834−newtype EsPassword = EsPassword { esPassword :: Text } deriving (Read, Show, Eq)
3835−
3836−
3837−data SnapshotRepoSelection = SnapshotRepoList (NonEmpty SnapshotRepoPattern)
3838− | AllSnapshotRepos deriving (Eq, Generic, Show, Typeable)
3839−
3840−
3841−-- | Either specifies an exact repo name or one with globs in it,
3842−-- e.g. @RepoPattern "foo*"@ __NOTE__: Patterns are not supported on ES < 1.7
3843−data SnapshotRepoPattern = ExactRepo SnapshotRepoName
3844− | RepoPattern Text
3845− deriving (Eq, Generic, Show, Typeable)
3846−
3847−-- | The unique name of a snapshot repository.
3848−newtype SnapshotRepoName = SnapshotRepoName { snapshotRepoName :: Text }
3849− deriving (Eq, Ord, Generic, Show, Typeable, ToJSON, FromJSON)
3850−
3851−
3852−-- | A generic representation of a snapshot repo. This is what gets
3853−-- sent to and parsed from the server. For repo types enabled by
3854−-- plugins that aren't exported by this library, consider making a
3855−-- custom type which implements 'SnapshotRepo'. If it is a common repo
3856−-- type, consider submitting a pull request to have it included in the
3857−-- library proper
3858−data GenericSnapshotRepo = GenericSnapshotRepo {
3859− gSnapshotRepoName :: SnapshotRepoName
3860− , gSnapshotRepoType :: SnapshotRepoType
3861− , gSnapshotRepoSettings :: GenericSnapshotRepoSettings
3862− } deriving (Eq, Generic, Show, Typeable)
3863−
3864−
3865−instance SnapshotRepo GenericSnapshotRepo where
3866− toGSnapshotRepo = id
3867− fromGSnapshotRepo = Right
3868−
3869−
3870−newtype SnapshotRepoType = SnapshotRepoType { snapshotRepoType :: Text }
3871− deriving (Eq, Ord, Generic, Show, Typeable, ToJSON, FromJSON)
3872−
3873−
3874−-- | Opaque representation of snapshot repo settings. Instances of
3875−-- 'SnapshotRepo' will produce this.
3876−newtype GenericSnapshotRepoSettings = GenericSnapshotRepoSettings { gSnapshotRepoSettingsObject :: Object }
3877− deriving (Eq, Generic, Show, Typeable, ToJSON)
3878−
3879−
3880− -- Regardless of whether you send strongly typed json, my version of
3881− -- ES sends back stringly typed json in the settings, e.g. booleans
3882− -- as strings, so we'll try to convert them.
3883−instance FromJSON GenericSnapshotRepoSettings where
3884− parseJSON = fmap (GenericSnapshotRepoSettings . fmap unStringlyTypeJSON). parseJSON
3885−
3886−-- | The result of running 'verifySnapshotRepo'.
3887−newtype SnapshotVerification = SnapshotVerification { snapshotNodeVerifications :: [SnapshotNodeVerification] }
3888− deriving (Eq, Generic, Show, Typeable)
3889−
3890−
3891−instance FromJSON SnapshotVerification where
3892− parseJSON = withObject "SnapshotVerification" parse
3893− where
3894− parse o = do
3895− o2 <- o .: "nodes"
3896− SnapshotVerification <$> mapM (uncurry parse') (HM.toList o2)
3897− parse' rawFullId = withObject "SnapshotNodeVerification" $ \o ->
3898− SnapshotNodeVerification (FullNodeId rawFullId) <$> o .: "name"
3899−
3900−
3901−-- | A node that has verified a snapshot
3902−data SnapshotNodeVerification = SnapshotNodeVerification {
3903− snvFullId :: FullNodeId
3904− , snvNodeName :: NodeName
3905− } deriving (Eq, Generic, Show, Typeable)
3906−
3907−
3908−-- | Unique, automatically-generated name assigned to nodes that are
3909−-- usually returned in node-oriented APIs.
3910−newtype FullNodeId = FullNodeId { fullNodeId :: Text }
3911− deriving (Eq, Ord, Generic, Show, Typeable, FromJSON)
3912−
3913−
3914−-- | A human-readable node name that is supplied by the user in the
3915−-- node config or automatically generated by ElasticSearch.
3916−newtype NodeName = NodeName { nodeName :: Text }
3917− deriving (Eq, Ord, Generic, Show, Typeable, FromJSON)
3918−
3919−newtype ClusterName = ClusterName { clusterName :: Text }
3920− deriving (Eq, Ord, Generic, Show, Typeable, FromJSON)
3921−
3922−data NodesInfo = NodesInfo {
3923− nodesInfo :: [NodeInfo]
3924− , nodesClusterName :: ClusterName
3925− } deriving (Eq, Show, Generic, Typeable)
3926−
3927−data NodesStats = NodesStats {
3928− nodesStats :: [NodeStats]
3929− , nodesStatsClusterName :: ClusterName
3930− } deriving (Eq, Show, Generic, Typeable)
3931−
3932−data NodeStats = NodeStats {
3933− nodeStatsName :: NodeName
3934− , nodeStatsFullId :: FullNodeId
3935− , nodeStatsBreakersStats :: Maybe NodeBreakersStats
3936− , nodeStatsHTTP :: NodeHTTPStats
3937− , nodeStatsTransport :: NodeTransportStats
3938− , nodeStatsFS :: NodeFSStats
3939− , nodeStatsNetwork :: NodeNetworkStats
3940− , nodeStatsThreadPool :: NodeThreadPoolsStats
3941− , nodeStatsJVM :: NodeJVMStats
3942− , nodeStatsProcess :: NodeProcessStats
3943− , nodeStatsOS :: NodeOSStats
3944− , nodeStatsIndices :: NodeIndicesStats
3945− } deriving (Eq, Show, Generic, Typeable)
3946−
3947−data NodeBreakersStats = NodeBreakersStats {
3948− nodeStatsParentBreaker :: NodeBreakerStats
3949− , nodeStatsRequestBreaker :: NodeBreakerStats
3950− , nodeStatsFieldDataBreaker :: NodeBreakerStats
3951− } deriving (Eq, Show, Generic, Typeable)
3952−
3953−data NodeBreakerStats = NodeBreakerStats {
3954− nodeBreakersTripped :: Int
3955− , nodeBreakersOverhead :: Double
3956− , nodeBreakersEstSize :: Bytes
3957− , nodeBreakersLimitSize :: Bytes
3958− } deriving (Eq, Show, Generic, Typeable)
3959−
3960−data NodeHTTPStats = NodeHTTPStats {
3961− nodeHTTPTotalOpened :: Int
3962− , nodeHTTPCurrentOpen :: Int
3963− } deriving (Eq, Show, Generic, Typeable)
3964−
3965−data NodeTransportStats = NodeTransportStats {
3966− nodeTransportTXSize :: Bytes
3967− , nodeTransportCount :: Int
3968− , nodeTransportRXSize :: Bytes
3969− , nodeTransportRXCount :: Int
3970− , nodeTransportServerOpen :: Int
3971− } deriving (Eq, Show, Generic, Typeable)
3972−
3973−data NodeFSStats = NodeFSStats {
3974− nodeFSDataPaths :: [NodeDataPathStats]
3975− , nodeFSTotal :: NodeFSTotalStats
3976− , nodeFSTimestamp :: UTCTime
3977− } deriving (Eq, Show, Generic, Typeable)
3978−
3979−data NodeDataPathStats = NodeDataPathStats {
3980− nodeDataPathDiskServiceTime :: Maybe Double
3981− , nodeDataPathDiskQueue :: Maybe Double
3982− , nodeDataPathIOSize :: Maybe Bytes
3983− , nodeDataPathWriteSize :: Maybe Bytes
3984− , nodeDataPathReadSize :: Maybe Bytes
3985− , nodeDataPathIOOps :: Maybe Int
3986− , nodeDataPathWrites :: Maybe Int
3987− , nodeDataPathReads :: Maybe Int
3988− , nodeDataPathAvailable :: Bytes
3989− , nodeDataPathFree :: Bytes
3990− , nodeDataPathTotal :: Bytes
3991− , nodeDataPathType :: Maybe Text
3992− , nodeDataPathDevice :: Text
3993− , nodeDataPathMount :: Text
3994− , nodeDataPathPath :: Text
3995− } deriving (Eq, Show, Generic, Typeable)
3996−
3997−data NodeFSTotalStats = NodeFSTotalStats {
3998− nodeFSTotalDiskServiceTime :: Maybe Double
3999− , nodeFSTotalDiskQueue :: Maybe Double
4000− , nodeFSTotalIOSize :: Maybe Bytes
4001− , nodeFSTotalWriteSize :: Maybe Bytes
4002− , nodeFSTotalReadSize :: Maybe Bytes
4003− , nodeFSTotalIOOps :: Maybe Int
4004− , nodeFSTotalWrites :: Maybe Int
4005− , nodeFSTotalReads :: Maybe Int
4006− , nodeFSTotalAvailable :: Bytes
4007− , nodeFSTotalFree :: Bytes
4008− , nodeFSTotalTotal :: Bytes
4009− } deriving (Eq, Show, Generic, Typeable)
4010−
4011−data NodeNetworkStats = NodeNetworkStats {
4012− nodeNetTCPOutRSTs :: Int
4013− , nodeNetTCPInErrs :: Int
4014− , nodeNetTCPAttemptFails :: Int
4015− , nodeNetTCPEstabResets :: Int
4016− , nodeNetTCPRetransSegs :: Int
4017− , nodeNetTCPOutSegs :: Int
4018− , nodeNetTCPInSegs :: Int
4019− , nodeNetTCPCurrEstab :: Int
4020− , nodeNetTCPPassiveOpens :: Int
4021− , nodeNetTCPActiveOpens :: Int
4022− } deriving (Eq, Show, Generic, Typeable)
4023−
4024−data NodeThreadPoolsStats = NodeThreadPoolsStats {
4025− nodeThreadPoolsStatsSnapshot :: NodeThreadPoolStats
4026− , nodeThreadPoolsStatsBulk :: NodeThreadPoolStats
4027− , nodeThreadPoolsStatsMerge :: NodeThreadPoolStats
4028− , nodeThreadPoolsStatsGet :: NodeThreadPoolStats
4029− , nodeThreadPoolsStatsManagement :: NodeThreadPoolStats
4030− , nodeThreadPoolsStatsFetchShardStore :: Maybe NodeThreadPoolStats
4031− , nodeThreadPoolsStatsOptimize :: NodeThreadPoolStats
4032− , nodeThreadPoolsStatsFlush :: NodeThreadPoolStats
4033− , nodeThreadPoolsStatsSearch :: NodeThreadPoolStats
4034− , nodeThreadPoolsStatsWarmer :: NodeThreadPoolStats
4035− , nodeThreadPoolsStatsGeneric :: NodeThreadPoolStats
4036− , nodeThreadPoolsStatsSuggest :: NodeThreadPoolStats
4037− , nodeThreadPoolsStatsRefresh :: NodeThreadPoolStats
4038− , nodeThreadPoolsStatsIndex :: NodeThreadPoolStats
4039− , nodeThreadPoolsStatsListener :: Maybe NodeThreadPoolStats
4040− , nodeThreadPoolsStatsFetchShardStarted :: Maybe NodeThreadPoolStats
4041− , nodeThreadPoolsStatsPercolate :: NodeThreadPoolStats
4042− } deriving (Eq, Show, Generic, Typeable)
4043−
4044−data NodeThreadPoolStats = NodeThreadPoolStats {
4045− nodeThreadPoolCompleted :: Int
4046− , nodeThreadPoolLargest :: Int
4047− , nodeThreadPoolRejected :: Int
4048− , nodeThreadPoolActive :: Int
4049− , nodeThreadPoolQueue :: Int
4050− , nodeThreadPoolThreads :: Int
4051− } deriving (Eq, Show, Generic, Typeable)
4052−
4053−data NodeJVMStats = NodeJVMStats {
4054− nodeJVMStatsMappedBufferPool :: JVMBufferPoolStats
4055− , nodeJVMStatsDirectBufferPool :: JVMBufferPoolStats
4056− , nodeJVMStatsGCOldCollector :: JVMGCStats
4057− , nodeJVMStatsGCYoungCollector :: JVMGCStats
4058− , nodeJVMStatsPeakThreadsCount :: Int
4059− , nodeJVMStatsThreadsCount :: Int
4060− , nodeJVMStatsOldPool :: JVMPoolStats
4061− , nodeJVMStatsSurvivorPool :: JVMPoolStats
4062− , nodeJVMStatsYoungPool :: JVMPoolStats
4063− , nodeJVMStatsNonHeapCommitted :: Bytes
4064− , nodeJVMStatsNonHeapUsed :: Bytes
4065− , nodeJVMStatsHeapMax :: Bytes
4066− , nodeJVMStatsHeapCommitted :: Bytes
4067− , nodeJVMStatsHeapUsedPercent :: Int
4068− , nodeJVMStatsHeapUsed :: Bytes
4069− , nodeJVMStatsUptime :: NominalDiffTime
4070− , nodeJVMStatsTimestamp :: UTCTime
4071− } deriving (Eq, Show, Generic, Typeable)
4072−
4073−data JVMBufferPoolStats = JVMBufferPoolStats {
4074− jvmBufferPoolStatsTotalCapacity :: Bytes
4075− , jvmBufferPoolStatsUsed :: Bytes
4076− , jvmBufferPoolStatsCount :: Int
4077− } deriving (Eq, Show, Generic, Typeable)
4078−
4079−data JVMGCStats = JVMGCStats {
4080− jvmGCStatsCollectionTime :: NominalDiffTime
4081− , jvmGCStatsCollectionCount :: Int
4082− } deriving (Eq, Show, Generic, Typeable)
4083−
4084−data JVMPoolStats = JVMPoolStats {
4085− jvmPoolStatsPeakMax :: Bytes
4086− , jvmPoolStatsPeakUsed :: Bytes
4087− , jvmPoolStatsMax :: Bytes
4088− , jvmPoolStatsUsed :: Bytes
4089− } deriving (Eq, Show, Generic, Typeable)
4090−
4091−data NodeProcessStats = NodeProcessStats {
4092− nodeProcessMemTotalVirtual :: Bytes
4093− , nodeProcessMemShare :: Bytes
4094− , nodeProcessMemResident :: Bytes
4095− , nodeProcessCPUTotal :: NominalDiffTime
4096− , nodeProcessCPUUser :: NominalDiffTime
4097− , nodeProcessCPUSys :: NominalDiffTime
4098− , nodeProcessCPUPercent :: Int
4099− , nodeProcessOpenFDs :: Int
4100− , nodeProcessTimestamp :: UTCTime
4101− } deriving (Eq, Show, Generic, Typeable)
4102−
4103−data NodeOSStats = NodeOSStats {
4104− nodeOSSwapFree :: Bytes
4105− , nodeOSSwapUsed :: Bytes
4106− , nodeOSMemActualUsed :: Bytes
4107− , nodeOSMemActualFree :: Bytes
4108− , nodeOSMemUsedPercent :: Int
4109− , nodeOSMemFreePercent :: Int
4110− , nodeOSMemUsed :: Bytes
4111− , nodeOSMemFree :: Bytes
4112− , nodeOSCPUStolen :: Int
4113− , nodeOSCPUUsage :: Int
4114− , nodeOSCPUIdle :: Int
4115− , nodeOSCPUUser :: Int
4116− , nodeOSCPUSys :: Int
4117− , nodeOSLoad :: Maybe LoadAvgs
4118− , nodeOSUptime :: NominalDiffTime
4119− , nodeOSTimestamp :: UTCTime
4120− } deriving (Eq, Show, Generic, Typeable)
4121−
4122−data LoadAvgs = LoadAvgs {
4123− loadAvg1Min :: Double
4124− , loadAvg5Min :: Double
4125− , loadAvg15Min :: Double
4126− } deriving (Eq, Show, Generic, Typeable)
4127−
4128−data NodeIndicesStats = NodeIndicesStats {
4129− nodeIndicesStatsRecoveryThrottleTime :: Maybe NominalDiffTime
4130− , nodeIndicesStatsRecoveryCurrentAsTarget :: Maybe Int
4131− , nodeIndicesStatsRecoveryCurrentAsSource :: Maybe Int
4132− , nodeIndicesStatsQueryCacheMisses :: Maybe Int
4133− , nodeIndicesStatsQueryCacheHits :: Maybe Int
4134− , nodeIndicesStatsQueryCacheEvictions :: Maybe Int
4135− , nodeIndicesStatsQueryCacheSize :: Maybe Bytes
4136− , nodeIndicesStatsSuggestCurrent :: Int
4137− , nodeIndicesStatsSuggestTime :: NominalDiffTime
4138− , nodeIndicesStatsSuggestTotal :: Int
4139− , nodeIndicesStatsTranslogSize :: Bytes
4140− , nodeIndicesStatsTranslogOps :: Int
4141− , nodeIndicesStatsSegFixedBitSetMemory :: Maybe Bytes
4142− , nodeIndicesStatsSegVersionMapMemory :: Bytes
4143− , nodeIndicesStatsSegIndexWriterMaxMemory :: Maybe Bytes
4144− , nodeIndicesStatsSegIndexWriterMemory :: Bytes
4145− , nodeIndicesStatsSegMemory :: Bytes
4146− , nodeIndicesStatsSegCount :: Int
4147− , nodeIndicesStatsCompletionSize :: Bytes
4148− , nodeIndicesStatsPercolateQueries :: Int
4149− , nodeIndicesStatsPercolateMemory :: Bytes
4150− , nodeIndicesStatsPercolateCurrent :: Int
4151− , nodeIndicesStatsPercolateTime :: NominalDiffTime
4152− , nodeIndicesStatsPercolateTotal :: Int
4153− , nodeIndicesStatsFieldDataEvictions :: Int
4154− , nodeIndicesStatsFieldDataMemory :: Bytes
4155− , nodeIndicesStatsIDCacheMemory :: Bytes
4156− , nodeIndicesStatsFilterCacheEvictions :: Int
4157− , nodeIndicesStatsFilterCacheMemory :: Bytes
4158− , nodeIndicesStatsWarmerTotalTime :: NominalDiffTime
4159− , nodeIndicesStatsWarmerTotal :: Int
4160− , nodeIndicesStatsWarmerCurrent :: Int
4161− , nodeIndicesStatsFlushTotalTime :: NominalDiffTime
4162− , nodeIndicesStatsFlushTotal :: Int
4163− , nodeIndicesStatsRefreshTotalTime :: NominalDiffTime
4164− , nodeIndicesStatsRefreshTotal :: Int
4165− , nodeIndicesStatsMergesTotalSize :: Bytes
4166− , nodeIndicesStatsMergesTotalDocs :: Int
4167− , nodeIndicesStatsMergesTotalTime :: NominalDiffTime
4168− , nodeIndicesStatsMergesTotal :: Int
4169− , nodeIndicesStatsMergesCurrentSize :: Bytes
4170− , nodeIndicesStatsMergesCurrentDocs :: Int
4171− , nodeIndicesStatsMergesCurrent :: Int
4172− , nodeIndicesStatsSearchFetchCurrent :: Int
4173− , nodeIndicesStatsSearchFetchTime :: NominalDiffTime
4174− , nodeIndicesStatsSearchFetchTotal :: Int
4175− , nodeIndicesStatsSearchQueryCurrent :: Int
4176− , nodeIndicesStatsSearchQueryTime :: NominalDiffTime
4177− , nodeIndicesStatsSearchQueryTotal :: Int
4178− , nodeIndicesStatsSearchOpenContexts :: Int
4179− , nodeIndicesStatsGetCurrent :: Int
4180− , nodeIndicesStatsGetMissingTime :: NominalDiffTime
4181− , nodeIndicesStatsGetMissingTotal :: Int
4182− , nodeIndicesStatsGetExistsTime :: NominalDiffTime
4183− , nodeIndicesStatsGetExistsTotal :: Int
4184− , nodeIndicesStatsGetTime :: NominalDiffTime
4185− , nodeIndicesStatsGetTotal :: Int
4186− , nodeIndicesStatsIndexingThrottleTime :: Maybe NominalDiffTime
4187− , nodeIndicesStatsIndexingIsThrottled :: Maybe Bool
4188− , nodeIndicesStatsIndexingNoopUpdateTotal :: Maybe Int
4189− , nodeIndicesStatsIndexingDeleteCurrent :: Int
4190− , nodeIndicesStatsIndexingDeleteTime :: NominalDiffTime
4191− , nodeIndicesStatsIndexingDeleteTotal :: Int
4192− , nodeIndicesStatsIndexingIndexCurrent :: Int
4193− , nodeIndicesStatsIndexingIndexTime :: NominalDiffTime
4194− , nodeIndicesStatsIndexingTotal :: Int
4195− , nodeIndicesStatsStoreThrottleTime :: NominalDiffTime
4196− , nodeIndicesStatsStoreSize :: Bytes
4197− , nodeIndicesStatsDocsDeleted :: Int
4198− , nodeIndicesStatsDocsCount :: Int
4199− } deriving (Eq, Show, Generic, Typeable)
4200−
4201−-- | A quirky address format used throughout ElasticSearch. An example
4202−-- would be inet[/1.1.1.1:9200]. inet may be a placeholder for a
4203−-- <https://en.wikipedia.org/wiki/Fully_qualified_domain_name FQDN>.
4204−newtype EsAddress = EsAddress { esAddress :: Text }
4205− deriving (Eq, Ord, Generic, Show, Typeable, FromJSON)
4206−
4207−-- | Typically a 7 character hex string.
4208−newtype BuildHash = BuildHash { buildHash :: Text }
4209− deriving (Eq, Ord, Generic, Read, Show, Typeable, FromJSON, ToJSON)
4210−
4211−newtype PluginName = PluginName { pluginName :: Text }
4212− deriving (Eq, Ord, Generic, Show, Typeable, FromJSON)
4213−
4214−data NodeInfo = NodeInfo {
4215− nodeInfoHTTPAddress :: EsAddress
4216− , nodeInfoBuild :: BuildHash
4217− , nodeInfoESVersion :: VersionNumber
4218− , nodeInfoIP :: Server
4219− , nodeInfoHost :: Server
4220− , nodeInfoTransportAddress :: EsAddress
4221− , nodeInfoName :: NodeName
4222− , nodeInfoFullId :: FullNodeId
4223− , nodeInfoPlugins :: [NodePluginInfo]
4224− , nodeInfoHTTP :: NodeHTTPInfo
4225− , nodeInfoTransport :: NodeTransportInfo
4226− , nodeInfoNetwork :: NodeNetworkInfo
4227− , nodeInfoThreadPool :: NodeThreadPoolsInfo
4228− , nodeInfoJVM :: NodeJVMInfo
4229− , nodeInfoProcess :: NodeProcessInfo
4230− , nodeInfoOS :: NodeOSInfo
4231− , nodeInfoSettings :: Object
4232− -- ^ The members of the settings objects are not consistent,
4233− -- dependent on plugins, etc.
4234− } deriving (Eq, Show, Generic, Typeable)
4235−
4236−data NodePluginInfo = NodePluginInfo {
4237− nodePluginSite :: Bool
4238− -- ^ Is this a site plugin?
4239− , nodePluginJVM :: Bool
4240− -- ^ Is this plugin running on the JVM
4241− , nodePluginDescription :: Text
4242− , nodePluginVersion :: MaybeNA VersionNumber
4243− , nodePluginName :: PluginName
4244− } deriving (Eq, Show, Generic, Typeable)
4245−
4246−data NodeHTTPInfo = NodeHTTPInfo {
4247− nodeHTTPMaxContentLength :: Bytes
4248− , nodeHTTPTransportAddress :: BoundTransportAddress
4249− } deriving (Eq, Show, Generic, Typeable)
4250−
4251−data NodeTransportInfo = NodeTransportInfo {
4252− nodeTransportProfiles :: [BoundTransportAddress]
4253− , nodeTransportAddress :: BoundTransportAddress
4254− } deriving (Eq, Show, Generic, Typeable)
4255−
4256−data BoundTransportAddress = BoundTransportAddress {
4257− publishAddress :: EsAddress
4258− , boundAddress :: EsAddress
4259− } deriving (Eq, Show, Generic, Typeable)
4260−
4261−data NodeNetworkInfo = NodeNetworkInfo {
4262− nodeNetworkPrimaryInterface :: NodeNetworkInterface
4263− , nodeNetworkRefreshInterval :: NominalDiffTime
4264− } deriving (Eq, Show, Generic, Typeable)
4265−
4266−newtype MacAddress = MacAddress { macAddress :: Text }
4267− deriving (Eq, Ord, Generic, Show, Typeable, FromJSON)
4268−
4269−newtype NetworkInterfaceName = NetworkInterfaceName { networkInterfaceName :: Text }
4270− deriving (Eq, Ord, Generic, Show, Typeable, FromJSON)
4271−
4272−data NodeNetworkInterface = NodeNetworkInterface {
4273− nodeNetIfaceMacAddress :: MacAddress
4274− , nodeNetIfaceName :: NetworkInterfaceName
4275− , nodeNetIfaceAddress :: Server
4276− } deriving (Eq, Show, Generic, Typeable)
4277−
4278−data NodeThreadPoolsInfo = NodeThreadPoolsInfo {
4279− nodeThreadPoolsRefresh :: NodeThreadPoolInfo
4280− , nodeThreadPoolsManagement :: NodeThreadPoolInfo
4281− , nodeThreadPoolsPercolate :: NodeThreadPoolInfo
4282− , nodeThreadPoolsListener :: Maybe NodeThreadPoolInfo
4283− , nodeThreadPoolsFetchShardStarted :: Maybe NodeThreadPoolInfo
4284− , nodeThreadPoolsSearch :: NodeThreadPoolInfo
4285− , nodeThreadPoolsFlush :: NodeThreadPoolInfo
4286− , nodeThreadPoolsWarmer :: NodeThreadPoolInfo
4287− , nodeThreadPoolsOptimize :: NodeThreadPoolInfo
4288− , nodeThreadPoolsBulk :: NodeThreadPoolInfo
4289− , nodeThreadPoolsSuggest :: NodeThreadPoolInfo
4290− , nodeThreadPoolsMerge :: NodeThreadPoolInfo
4291− , nodeThreadPoolsSnapshot :: NodeThreadPoolInfo
4292− , nodeThreadPoolsGet :: NodeThreadPoolInfo
4293− , nodeThreadPoolsFetchShardStore :: Maybe NodeThreadPoolInfo
4294− , nodeThreadPoolsIndex :: NodeThreadPoolInfo
4295− , nodeThreadPoolsGeneric :: NodeThreadPoolInfo
4296− } deriving (Eq, Show, Generic, Typeable)
4297−
4298−data NodeThreadPoolInfo = NodeThreadPoolInfo {
4299− nodeThreadPoolQueueSize :: ThreadPoolSize
4300− , nodeThreadPoolKeepalive :: Maybe NominalDiffTime
4301− , nodeThreadPoolMin :: Maybe Int
4302− , nodeThreadPoolMax :: Maybe Int
4303− , nodeThreadPoolType :: ThreadPoolType
4304− } deriving (Eq, Show, Generic, Typeable)
4305−
4306−data ThreadPoolSize = ThreadPoolBounded Int
4307− | ThreadPoolUnbounded
4308− deriving (Eq, Show, Generic, Typeable)
4309−
4310−data ThreadPoolType = ThreadPoolScaling
4311− | ThreadPoolFixed
4312− | ThreadPoolCached
4313− deriving (Eq, Show, Generic, Typeable)
4314−
4315−data NodeJVMInfo = NodeJVMInfo {
4316− nodeJVMInfoMemoryPools :: [JVMMemoryPool]
4317− , nodeJVMInfoMemoryPoolsGCCollectors :: [JVMGCCollector]
4318− , nodeJVMInfoMemoryInfo :: JVMMemoryInfo
4319− , nodeJVMInfoStartTime :: UTCTime
4320− , nodeJVMInfoVMVendor :: Text
4321− , nodeJVMVMVersion :: VersionNumber
4322− -- ^ JVM doesn't seme to follow normal version conventions
4323− , nodeJVMVMName :: Text
4324− , nodeJVMVersion :: VersionNumber
4325− , nodeJVMPID :: PID
4326− } deriving (Eq, Show, Generic, Typeable)
4327−
4328−-- | Handles quirks in the way JVM versions are rendered (1.7.0_101 -> 1.7.0.101)
4329−newtype JVMVersion = JVMVersion { unJVMVersion :: VersionNumber }
4330−
4331−data JVMMemoryInfo = JVMMemoryInfo {
4332− jvmMemoryInfoDirectMax :: Bytes
4333− , jvmMemoryInfoNonHeapMax :: Bytes
4334− , jvmMemoryInfoNonHeapInit :: Bytes
4335− , jvmMemoryInfoHeapMax :: Bytes
4336− , jvmMemoryInfoHeapInit :: Bytes
4337− } deriving (Eq, Show, Generic, Typeable)
4338−
4339−newtype JVMMemoryPool = JVMMemoryPool {
4340− jvmMemoryPool :: Text
4341− } deriving (Eq, Show, Generic, Typeable, FromJSON)
4342−
4343−newtype JVMGCCollector = JVMGCCollector {
4344− jvmGCCollector :: Text
4345− } deriving (Eq, Show, Generic, Typeable, FromJSON)
4346−
4347−newtype PID = PID {
4348− pid :: Int
4349− } deriving (Eq, Show, Generic, Typeable, FromJSON)
4350−
4351−data NodeOSInfo = NodeOSInfo {
4352− nodeOSSwap :: Bytes
4353− , nodeOSMem :: Bytes
4354− , nodeOSCPUInfo :: CPUInfo
4355− , nodeOSAvailableProcessors :: Int
4356− , nodeOSRefreshInterval :: NominalDiffTime
4357− } deriving (Eq, Show, Generic, Typeable)
4358−
4359−data CPUInfo = CPUInfo {
4360− cpuCacheSize :: Bytes
4361− , cpuCoresPerSocket :: Int
4362− , cpuTotalSockets :: Int
4363− , cpuTotalCores :: Int
4364− , cpuMHZ :: Int
4365− , cpuModel :: Text
4366− , cpuVendor :: Text
4367− } deriving (Eq, Show, Generic, Typeable)
4368−
4369−data NodeProcessInfo = NodeProcessInfo {
4370− nodeProcessMLockAll :: Bool
4371− -- ^ See <https://www.elastic.co/guide/en/elasticsearch/reference/current/setup-configuration.html>
4372− , nodeProcessMaxFileDescriptors :: Int
4373− , nodeProcessId :: PID
4374− , nodeProcessRefreshInterval :: NominalDiffTime
4375− } deriving (Eq, Show, Generic, Typeable)
4376−
4377−data SnapshotRepoUpdateSettings = SnapshotRepoUpdateSettings {
4378− repoUpdateVerify :: Bool
4379− -- ^ After creation/update, synchronously check that nodes can
4380− -- write to this repo. Defaults to True. You may use False if you
4381− -- need a faster response and plan on verifying manually later
4382− -- with 'verifySnapshotRepo'.
4383− } deriving (Eq, Show, Generic, Typeable)
4384−
4385−
4386−-- | Reasonable defaults for repo creation/update
4387−--
4388−-- * repoUpdateVerify True
4389−defaultSnapshotRepoUpdateSettings :: SnapshotRepoUpdateSettings
4390−defaultSnapshotRepoUpdateSettings = SnapshotRepoUpdateSettings True
4391−
4392−
4393−-- | A filesystem-based snapshot repo that ships with
4394−-- ElasticSearch. This is an instance of 'SnapshotRepo' so it can be
4395−-- used with 'updateSnapshotRepo'
4396−data FsSnapshotRepo = FsSnapshotRepo {
4397− fsrName :: SnapshotRepoName
4398− , fsrLocation :: FilePath
4399− , fsrCompressMetadata :: Bool
4400− , fsrChunkSize :: Maybe Bytes
4401− -- ^ Size by which to split large files during snapshotting.
4402− , fsrMaxRestoreBytesPerSec :: Maybe Bytes
4403− -- ^ Throttle node restore rate. If not supplied, defaults to 40mb/sec
4404− , fsrMaxSnapshotBytesPerSec :: Maybe Bytes
4405− -- ^ Throttle node snapshot rate. If not supplied, defaults to 40mb/sec
4406− } deriving (Eq, Generic, Show, Typeable)
4407−
4408−
4409−instance SnapshotRepo FsSnapshotRepo where
4410− toGSnapshotRepo FsSnapshotRepo {..} =
4411− GenericSnapshotRepo fsrName fsRepoType (GenericSnapshotRepoSettings settings)
4412− where
4413− Object settings = object $ [ "location" .= fsrLocation
4414− , "compress" .= fsrCompressMetadata
4415− ] ++ optionalPairs
4416− optionalPairs = catMaybes [ ("chunk_size" .=) <$> fsrChunkSize
4417− , ("max_restore_bytes_per_sec" .=) <$> fsrMaxRestoreBytesPerSec
4418− , ("max_snapshot_bytes_per_sec" .=) <$> fsrMaxSnapshotBytesPerSec
4419− ]
4420− fromGSnapshotRepo GenericSnapshotRepo {..}
4421− | gSnapshotRepoType == fsRepoType = do
4422− let o = gSnapshotRepoSettingsObject gSnapshotRepoSettings
4423− parseRepo $ do
4424− FsSnapshotRepo gSnapshotRepoName <$> o .: "location"
4425− <*> o .:? "compress" .!= False
4426− <*> o .:? "chunk_size"
4427− <*> o .:? "max_restore_bytes_per_sec"
4428− <*> o .:? "max_snapshot_bytes_per_sec"
4429− | otherwise = Left (RepoTypeMismatch fsRepoType gSnapshotRepoType)
4430−
4431−
4432−parseRepo :: Parser a -> Either SnapshotRepoConversionError a
4433−parseRepo parser = case parseEither (const parser) () of
4434− Left e -> Left (OtherRepoConversionError (T.pack e))
4435− Right a -> Right a
4436−
4437−
4438−fsRepoType :: SnapshotRepoType
4439−fsRepoType = SnapshotRepoType "fs"
4440−
4441−-- | Law: fromGSnapshotRepo (toGSnapshotRepo r) == Right r
4442−class SnapshotRepo r where
4443− toGSnapshotRepo :: r -> GenericSnapshotRepo
4444− fromGSnapshotRepo :: GenericSnapshotRepo -> Either SnapshotRepoConversionError r
4445−
4446−
4447−data SnapshotRepoConversionError = RepoTypeMismatch SnapshotRepoType SnapshotRepoType
4448− -- ^ Expected type and actual type
4449− | OtherRepoConversionError Text
4450− deriving (Show, Eq, Generic, Typeable)
4451−
4452−
4453−instance Exception SnapshotRepoConversionError
4454−
4455−
4456−data SnapshotCreateSettings = SnapshotCreateSettings {
4457− snapWaitForCompletion :: Bool
4458− -- ^ Should the API call return immediately after initializing
4459− -- the snapshot or wait until completed? Note that if this is
4460− -- enabled it could wait a long time, so you should adjust your
4461− -- 'ManagerSettings' accordingly to set long timeouts or
4462− -- explicitly handle timeouts.
4463− , snapIndices :: Maybe IndexSelection
4464− -- ^ Nothing will snapshot all indices. Just [] is permissable and
4465− -- will essentially be a no-op snapshot.
4466− , snapIgnoreUnavailable :: Bool
4467− -- ^ If set to True, any matched indices that don't exist will be
4468− -- ignored. Otherwise it will be an error and fail.
4469− , snapIncludeGlobalState :: Bool
4470− , snapPartial :: Bool
4471− -- ^ If some indices failed to snapshot (e.g. if not all primary
4472− -- shards are available), should the process proceed?
4473− } deriving (Eq, Generic, Show, Typeable)
4474−
4475−
4476−-- | Reasonable defaults for snapshot creation
4477−--
4478−-- * snapWaitForCompletion False
4479−-- * snapIndices Nothing
4480−-- * snapIgnoreUnavailable False
4481−-- * snapIncludeGlobalState True
4482−-- * snapPartial False
4483−defaultSnapshotCreateSettings :: SnapshotCreateSettings
4484−defaultSnapshotCreateSettings = SnapshotCreateSettings {
4485− snapWaitForCompletion = False
4486− , snapIndices = Nothing
4487− , snapIgnoreUnavailable = False
4488− , snapIncludeGlobalState = True
4489− , snapPartial = False
4490− }
4491−
4492−
4493−data SnapshotSelection = SnapshotList (NonEmpty SnapshotPattern)
4494− | AllSnapshots deriving (Eq, Generic, Show, Typeable)
4495−
4496−
4497−-- | Either specifies an exact snapshot name or one with globs in it,
4498−-- e.g. @SnapPattern "foo*"@ __NOTE__: Patterns are not supported on
4499−-- ES < 1.7
4500−data SnapshotPattern = ExactSnap SnapshotName
4501− | SnapPattern Text
4502− deriving (Eq, Generic, Show, Typeable)
4503−
4504−
4505−-- | General information about the state of a snapshot. Has some
4506−-- redundancies with 'SnapshotStatus'
4507−data SnapshotInfo = SnapshotInfo {
4508− snapInfoShards :: ShardResult
4509− , snapInfoFailures :: [SnapshotShardFailure]
4510− , snapInfoDuration :: NominalDiffTime
4511− , snapInfoEndTime :: UTCTime
4512− , snapInfoStartTime :: UTCTime
4513− , snapInfoState :: SnapshotState
4514− , snapInfoIndices :: [IndexName]
4515− , snapInfoName :: SnapshotName
4516− } deriving (Eq, Generic, Show, Typeable)
4517−
4518−
4519−instance FromJSON SnapshotInfo where
4520− parseJSON = withObject "SnapshotInfo" parse
4521− where
4522− parse o = SnapshotInfo <$> o .: "shards"
4523− <*> o .: "failures"
4524− <*> (unMS <$> o .: "duration_in_millis")
4525− <*> (posixMS <$> o .: "end_time_in_millis")
4526− <*> (posixMS <$> o .: "start_time_in_millis")
4527− <*> o .: "state"
4528− <*> o .: "indices"
4529− <*> o .: "snapshot"
4530−
4531−data SnapshotShardFailure = SnapshotShardFailure {
4532− snapShardFailureIndex :: IndexName
4533− , snapShardFailureNodeId :: Maybe NodeName -- I'm not 100% sure this isn't actually 'FullNodeId'
4534− , snapShardFailureReason :: Text
4535− , snapShardFailureShardId :: ShardId
4536− } deriving (Eq, Show, Generic, Typeable)
4537−
4538−
4539−instance FromJSON SnapshotShardFailure where
4540− parseJSON = withObject "SnapshotShardFailure" parse
4541− where
4542− parse o = SnapshotShardFailure <$> o .: "index"
4543− <*> o .:? "node_id"
4544− <*> o .: "reason"
4545− <*> o .: "shard_id"
4546−
4547−
4548−newtype ShardId = ShardId { shardId :: Int }
4549− deriving (Eq, Show, Generic, Typeable, FromJSON)
4550−
4551−-- | Milliseconds
4552−newtype MS = MS NominalDiffTime
4553−
4554−
4555−-- keeps the unexported constructor warnings at bay
4556−unMS :: MS -> NominalDiffTime
4557−unMS (MS t) = t
4558−
4559−
4560−instance FromJSON MS where
4561− parseJSON = withScientific "MS" (return . MS . parse)
4562− where
4563− parse n = fromInteger ((truncate n) * 1000)
4564−
4565−
4566−data SnapshotState = SnapshotInit
4567− | SnapshotStarted
4568− | SnapshotSuccess
4569− | SnapshotFailed
4570− | SnapshotAborted
4571− | SnapshotMissing
4572− | SnapshotWaiting
4573− deriving (Show, Eq, Generic, Typeable)
4574−
4575−instance FromJSON SnapshotState where
4576− parseJSON = withText "SnapshotState" parse
4577− where
4578− parse "INIT" = return SnapshotInit
4579− parse "STARTED" = return SnapshotStarted
4580− parse "SUCCESS" = return SnapshotSuccess
4581− parse "FAILED" = return SnapshotFailed
4582− parse "ABORTED" = return SnapshotAborted
4583− parse "MISSING" = return SnapshotMissing
4584− parse "WAITING" = return SnapshotWaiting
4585− parse t = fail ("Invalid snapshot state " <> T.unpack t)
4586−
4587−
4588−newtype SnapshotName = SnapshotName { snapshotName :: Text }
4589− deriving (Show, Eq, Ord, Generic, Typeable, ToJSON, FromJSON)
4590−
4591−
4592−data SnapshotRestoreSettings = SnapshotRestoreSettings {
4593− snapRestoreWaitForCompletion :: Bool
4594− -- ^ Should the API call return immediately after initializing
4595− -- the restore or wait until completed? Note that if this is
4596− -- enabled, it could wait a long time, so you should adjust your
4597− -- 'ManagerSettings' accordingly to set long timeouts or
4598− -- explicitly handle timeouts.
4599− , snapRestoreIndices :: Maybe IndexSelection
4600− -- ^ Nothing will restore all indices in the snapshot. Just [] is
4601− -- permissable and will essentially be a no-op restore.
4602− , snapRestoreIgnoreUnavailable :: Bool
4603− -- ^ If set to True, any indices that do not exist will be ignored
4604− -- during snapshot rather than failing the restore.
4605− , snapRestoreIncludeGlobalState :: Bool
4606− -- ^ If set to false, will ignore any global state in the snapshot
4607− -- and will not restore it.
4608− , snapRestoreRenamePattern :: Maybe RestoreRenamePattern
4609− -- ^ A regex pattern for matching indices. Used with
4610− -- 'snapRestoreRenameReplacement', the restore can reference the
4611− -- matched index and create a new index name upon restore.
4612− , snapRestoreRenameReplacement :: Maybe (NonEmpty RestoreRenameToken)
4613− -- ^ Expression of how index renames should be constructed.
4614− , snapRestorePartial :: Bool
4615− -- ^ If some indices fail to restore, should the process proceed?
4616− , snapRestoreIncludeAliases :: Bool
4617− -- ^ Should the restore also restore the aliases captured in the
4618− -- snapshot.
4619− , snapRestoreIndexSettingsOverrides :: Maybe RestoreIndexSettings
4620− -- ^ Settings to apply during the restore process. __NOTE:__ This
4621− -- option is not supported in ES < 1.5 and should be set to
4622− -- Nothing in that case.
4623− , snapRestoreIgnoreIndexSettings :: Maybe (NonEmpty Text)
4624− -- ^ This type could be more rich but it isn't clear which
4625− -- settings are allowed to be ignored during restore, so we're
4626− -- going with including this feature in a basic form rather than
4627− -- omitting it. One example here would be
4628− -- "index.refresh_interval". Any setting specified here will
4629− -- revert back to the server default during the restore process.
4630− } deriving (Eq, Generic, Show, Typeable)
4631−
4632−-- | Regex-stype pattern, e.g. "index_(.+)" to match index names
4633−newtype RestoreRenamePattern = RestoreRenamePattern { rrPattern :: Text }
4634− deriving (Show, Eq, Generic, Typeable, Ord, ToJSON)
4635−
4636−
4637−-- | A single token in a index renaming scheme for a restore. These
4638−-- are concatenated into a string before being sent to
4639−-- ElasticSearch. Check out these Java
4640−-- <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.
4641−data RestoreRenameToken = RRTLit Text
4642− -- ^ Just a literal string of characters
4643− | RRSubWholeMatch
4644− -- ^ Equivalent to $0. The entire matched pattern, not any subgroup
4645− | RRSubGroup RRGroupRefNum
4646− -- ^ A specific reference to a group number
4647− deriving (Show, Eq, Generic, Typeable)
4648−
4649−
4650−-- | A group number for regex matching. Only values from 1-9 are
4651−-- supported. Construct with 'mkRRGroupRefNum'
4652−newtype RRGroupRefNum = RRGroupRefNum { rrGroupRefNum :: Int }
4653− deriving (Show, Eq, Generic, Typeable, Ord)
4654−
4655−instance Bounded RRGroupRefNum where
4656− minBound = RRGroupRefNum 1
4657− maxBound = RRGroupRefNum 9
4658−
4659−
4660−-- | Only allows valid group number references (1-9).
4661−mkRRGroupRefNum :: Int -> Maybe RRGroupRefNum
4662−mkRRGroupRefNum i
4663− | i >= (rrGroupRefNum minBound) && i <= (rrGroupRefNum maxBound) =
4664− Just $ RRGroupRefNum i
4665− | otherwise = Nothing
4666−
4667−
4668−-- | Reasonable defaults for snapshot restores
4669−--
4670−-- * snapRestoreWaitForCompletion False
4671−-- * snapRestoreIndices Nothing
4672−-- * snapRestoreIgnoreUnavailable False
4673−-- * snapRestoreIncludeGlobalState True
4674−-- * snapRestoreRenamePattern Nothing
4675−-- * snapRestoreRenameReplacement Nothing
4676−-- * snapRestorePartial False
4677−-- * snapRestoreIncludeAliases True
4678−-- * snapRestoreIndexSettingsOverrides Nothing
4679−-- * snapRestoreIgnoreIndexSettings Nothing
4680−defaultSnapshotRestoreSettings :: SnapshotRestoreSettings
4681−defaultSnapshotRestoreSettings = SnapshotRestoreSettings {
4682− snapRestoreWaitForCompletion = False
4683− , snapRestoreIndices = Nothing
4684− , snapRestoreIgnoreUnavailable = False
4685− , snapRestoreIncludeGlobalState = True
4686− , snapRestoreRenamePattern = Nothing
4687− , snapRestoreRenameReplacement = Nothing
4688− , snapRestorePartial = False
4689− , snapRestoreIncludeAliases = True
4690− , snapRestoreIndexSettingsOverrides = Nothing
4691− , snapRestoreIgnoreIndexSettings = Nothing
4692− }
4693−
4694−
4695−-- | Index settings that can be overridden. The docs only mention you
4696−-- can update number of replicas, but there may be more. You
4697−-- definitely cannot override shard count.
4698−data RestoreIndexSettings = RestoreIndexSettings {
4699− restoreOverrideReplicas :: Maybe ReplicaCount
4700− } deriving (Show, Eq, Generic, Typeable)
4701−
4702−
4703−instance ToJSON RestoreIndexSettings where
4704− toJSON RestoreIndexSettings {..} = object prs
4705− where
4706− prs = catMaybes [("index.number_of_replicas" .=) <$> restoreOverrideReplicas]
4707−
4708−
4709−instance FromJSON NodesInfo where
4710− parseJSON = withObject "NodesInfo" parse
4711− where
4712− parse o = do
4713− nodes <- o .: "nodes"
4714− infos <- forM (HM.toList nodes) $ \(fullNID, v) -> do
4715− node <- parseJSON v
4716− parseNodeInfo (FullNodeId fullNID) node
4717− cn <- o .: "cluster_name"
4718− return (NodesInfo infos cn)
4719−
4720−instance FromJSON NodesStats where
4721− parseJSON = withObject "NodesStats" parse
4722− where
4723− parse o = do
4724− nodes <- o .: "nodes"
4725− stats <- forM (HM.toList nodes) $ \(fullNID, v) -> do
4726− node <- parseJSON v
4727− parseNodeStats (FullNodeId fullNID) node
4728− cn <- o .: "cluster_name"
4729− return (NodesStats stats cn)
4730−
4731−instance FromJSON NodeBreakerStats where
4732− parseJSON = withObject "NodeBreakerStats" parse
4733− where
4734− parse o = NodeBreakerStats <$> o .: "tripped"
4735− <*> o .: "overhead"
4736− <*> o .: "estimated_size_in_bytes"
4737− <*> o .: "limit_size_in_bytes"
4738−
4739−instance FromJSON NodeHTTPStats where
4740− parseJSON = withObject "NodeHTTPStats" parse
4741− where
4742− parse o = NodeHTTPStats <$> o .: "total_opened"
4743− <*> o .: "current_open"
4744−
4745−instance FromJSON NodeTransportStats where
4746− parseJSON = withObject "NodeTransportStats" parse
4747− where
4748− parse o = NodeTransportStats <$> o .: "tx_size_in_bytes"
4749− <*> o .: "tx_count"
4750− <*> o .: "rx_size_in_bytes"
4751− <*> o .: "rx_count"
4752− <*> o .: "server_open"
4753−
4754−instance FromJSON NodeFSStats where
4755− parseJSON = withObject "NodeFSStats" parse
4756− where
4757− parse o = NodeFSStats <$> o .: "data"
4758− <*> o .: "total"
4759− <*> (posixMS <$> o .: "timestamp")
4760−
4761−instance FromJSON NodeDataPathStats where
4762− parseJSON = withObject "NodeDataPathStats" parse
4763− where
4764− parse o =
4765− NodeDataPathStats <$> (fmap unStringlyTypedDouble <$> o .:? "disk_service_time")
4766− <*> (fmap unStringlyTypedDouble <$> o .:? "disk_queue")
4767− <*> o .:? "disk_io_size_in_bytes"
4768− <*> o .:? "disk_write_size_in_bytes"
4769− <*> o .:? "disk_read_size_in_bytes"
4770− <*> o .:? "disk_io_op"
4771− <*> o .:? "disk_writes"
4772− <*> o .:? "disk_reads"
4773− <*> o .: "available_in_bytes"
4774− <*> o .: "free_in_bytes"
4775− <*> o .: "total_in_bytes"
4776− <*> o .:? "type"
4777− <*> o .: "dev"
4778− <*> o .: "mount"
4779− <*> o .: "path"
4780−
4781−newtype StringlyTypedDouble = StringlyTypedDouble { unStringlyTypedDouble :: Double }
4782−
4783−
4784−instance FromJSON StringlyTypedDouble where
4785− parseJSON = fmap StringlyTypedDouble . parseJSON . unStringlyTypeJSON
4786−
4787−
4788−instance FromJSON NodeFSTotalStats where
4789− parseJSON = withObject "NodeFSTotalStats" parse
4790− where
4791− parse o = NodeFSTotalStats <$> (fmap unStringlyTypedDouble <$> o .:? "disk_service_time")
4792− <*> (fmap unStringlyTypedDouble <$> o .:? "disk_queue")
4793− <*> o .:? "disk_io_size_in_bytes"
4794− <*> o .:? "disk_write_size_in_bytes"
4795− <*> o .:? "disk_read_size_in_bytes"
4796− <*> o .:? "disk_io_op"
4797− <*> o .:? "disk_writes"
4798− <*> o .:? "disk_reads"
4799− <*> o .: "available_in_bytes"
4800− <*> o .: "free_in_bytes"
4801− <*> o .: "total_in_bytes"
4802−
4803−instance FromJSON NodeNetworkStats where
4804− parseJSON = withObject "NodeNetworkStats" parse
4805− where
4806− parse o = do
4807− tcp <- o .: "tcp"
4808− NodeNetworkStats <$> tcp .: "out_rsts"
4809− <*> tcp .: "in_errs"
4810− <*> tcp .: "attempt_fails"
4811− <*> tcp .: "estab_resets"
4812− <*> tcp .: "retrans_segs"
4813− <*> tcp .: "out_segs"
4814− <*> tcp .: "in_segs"
4815− <*> tcp .: "curr_estab"
4816− <*> tcp .: "passive_opens"
4817− <*> tcp .: "active_opens"
4818−
4819−instance FromJSON NodeThreadPoolsStats where
4820− parseJSON = withObject "NodeThreadPoolsStats" parse
4821− where
4822− parse o = NodeThreadPoolsStats <$> o .: "snapshot"
4823− <*> o .: "bulk"
4824− <*> o .: "merge"
4825− <*> o .: "get"
4826− <*> o .: "management"
4827− <*> o .:? "fetch_shard_store"
4828− <*> o .: "optimize"
4829− <*> o .: "flush"
4830− <*> o .: "search"
4831− <*> o .: "warmer"
4832− <*> o .: "generic"
4833− <*> o .: "suggest"
4834− <*> o .: "refresh"
4835− <*> o .: "index"
4836− <*> o .:? "listener"
4837− <*> o .:? "fetch_shard_started"
4838− <*> o .: "percolate"
4839−instance FromJSON NodeThreadPoolStats where
4840− parseJSON = withObject "NodeThreadPoolStats" parse
4841− where
4842− parse o = NodeThreadPoolStats <$> o .: "completed"
4843− <*> o .: "largest"
4844− <*> o .: "rejected"
4845− <*> o .: "active"
4846− <*> o .: "queue"
4847− <*> o .: "threads"
4848−
4849−instance FromJSON NodeJVMStats where
4850− parseJSON = withObject "NodeJVMStats" parse
4851− where
4852− parse o = do
4853− bufferPools <- o .: "buffer_pools"
4854− mapped <- bufferPools .: "mapped"
4855− direct <- bufferPools .: "direct"
4856− gc <- o .: "gc"
4857− collectors <- gc .: "collectors"
4858− oldC <- collectors .: "old"
4859− youngC <- collectors .: "young"
4860− threads <- o .: "threads"
4861− mem <- o .: "mem"
4862− pools <- mem .: "pools"
4863− oldM <- pools .: "old"
4864− survivorM <- pools .: "survivor"
4865− youngM <- pools .: "young"
4866− NodeJVMStats <$> pure mapped
4867− <*> pure direct
4868− <*> pure oldC
4869− <*> pure youngC
4870− <*> threads .: "peak_count"
4871− <*> threads .: "count"
4872− <*> pure oldM
4873− <*> pure survivorM
4874− <*> pure youngM
4875− <*> mem .: "non_heap_committed_in_bytes"
4876− <*> mem .: "non_heap_used_in_bytes"
4877− <*> mem .: "heap_max_in_bytes"
4878− <*> mem .: "heap_committed_in_bytes"
4879− <*> mem .: "heap_used_percent"
4880− <*> mem .: "heap_used_in_bytes"
4881− <*> (unMS <$> o .: "uptime_in_millis")
4882− <*> (posixMS <$> o .: "timestamp")
4883−
4884−instance FromJSON JVMBufferPoolStats where
4885− parseJSON = withObject "JVMBufferPoolStats" parse
4886− where
4887− parse o = JVMBufferPoolStats <$> o .: "total_capacity_in_bytes"
4888− <*> o .: "used_in_bytes"
4889− <*> o .: "count"
4890−
4891−instance FromJSON JVMGCStats where
4892− parseJSON = withObject "JVMGCStats" parse
4893− where
4894− parse o = JVMGCStats <$> (unMS <$> o .: "collection_time_in_millis")
4895− <*> o .: "collection_count"
4896−
4897−instance FromJSON JVMPoolStats where
4898− parseJSON = withObject "JVMPoolStats" parse
4899− where
4900− parse o = JVMPoolStats <$> o .: "peak_max_in_bytes"
4901− <*> o .: "peak_used_in_bytes"
4902− <*> o .: "max_in_bytes"
4903− <*> o .: "used_in_bytes"
4904−
4905−instance FromJSON NodeProcessStats where
4906− parseJSON = withObject "NodeProcessStats" parse
4907− where
4908− parse o = do
4909− mem <- o .: "mem"
4910− cpu <- o .: "cpu"
4911− NodeProcessStats <$> mem .: "total_virtual_in_bytes"
4912− <*> mem .: "share_in_bytes"
4913− <*> mem .: "resident_in_bytes"
4914− <*> (unMS <$> cpu .: "total_in_millis")
4915− <*> (unMS <$> cpu .: "user_in_millis")
4916− <*> (unMS <$> cpu .: "sys_in_millis")
4917− <*> cpu .: "percent"
4918− <*> o .: "open_file_descriptors"
4919− <*> (posixMS <$> o .: "timestamp")
4920−
4921−instance FromJSON NodeOSStats where
4922− parseJSON = withObject "NodeOSStats" parse
4923− where
4924− parse o = do
4925− swap <- o .: "swap"
4926− mem <- o .: "mem"
4927− cpu <- o .: "cpu"
4928− load <- o .:? "load_average"
4929− NodeOSStats <$> swap .: "free_in_bytes"
4930− <*> swap .: "used_in_bytes"
4931− <*> mem .: "actual_used_in_bytes"
4932− <*> mem .: "actual_free_in_bytes"
4933− <*> mem .: "used_percent"
4934− <*> mem .: "free_percent"
4935− <*> mem .: "used_in_bytes"
4936− <*> mem .: "free_in_bytes"
4937− <*> cpu .: "stolen"
4938− <*> cpu .: "usage"
4939− <*> cpu .: "idle"
4940− <*> cpu .: "user"
4941− <*> cpu .: "sys"
4942− <*> pure load
4943− <*> (unMS <$> o .: "uptime_in_millis")
4944− <*> (posixMS <$> o .: "timestamp")
4945−
4946−instance FromJSON LoadAvgs where
4947− parseJSON = withArray "LoadAvgs" parse
4948− where
4949− parse v = case V.toList v of
4950− [one, five, fifteen] -> LoadAvgs <$> parseJSON one
4951− <*> parseJSON five
4952− <*> parseJSON fifteen
4953− _ -> fail "Expecting a triple of Doubles"
4954−
4955−instance FromJSON NodeIndicesStats where
4956− parseJSON = withObject "NodeIndicesStats" parse
4957− where
4958− parse o = do
4959− let (.::) mv k = case mv of
4960− Just v -> Just <$> v .: k
4961− Nothing -> pure Nothing
4962− mRecovery <- o .:? "recovery"
4963− mQueryCache <- o .:? "query_cache"
4964− suggest <- o .: "suggest"
4965− translog <- o .: "translog"
4966− segments <- o .: "segments"
4967− completion <- o .: "completion"
4968− percolate <- o .: "percolate"
4969− fielddata <- o .: "fielddata"
4970− idCache <- o .: "id_cache"
4971− filterCache <- o .: "filter_cache"
4972− warmer <- o .: "warmer"
4973− flush <- o .: "flush"
4974− refresh <- o .: "refresh"
4975− merges <- o .: "merges"
4976− search <- o .: "search"
4977− getStats <- o .: "get"
4978− indexing <- o .: "indexing"
4979− store <- o .: "store"
4980− docs <- o .: "docs"
4981− NodeIndicesStats <$> (fmap unMS <$> mRecovery .:: "throttle_time_in_millis")
4982− <*> mRecovery .:: "current_as_target"
4983− <*> mRecovery .:: "current_as_source"
4984− <*> mQueryCache .:: "miss_count"
4985− <*> mQueryCache .:: "hit_count"
4986− <*> mQueryCache .:: "evictions"
4987− <*> mQueryCache .:: "memory_size_in_bytes"
4988− <*> suggest .: "current"
4989− <*> (unMS <$> suggest .: "time_in_millis")
4990− <*> suggest .: "total"
4991− <*> translog .: "size_in_bytes"
4992− <*> translog .: "operations"
4993− <*> segments .:? "fixed_bit_set_memory_in_bytes"
4994− <*> segments .: "version_map_memory_in_bytes"
4995− <*> segments .:? "index_writer_max_memory_in_bytes"
4996− <*> segments .: "index_writer_memory_in_bytes"
4997− <*> segments .: "memory_in_bytes"
4998− <*> segments .: "count"
4999− <*> completion .: "size_in_bytes"
5000− <*> percolate .: "queries"
5001− <*> percolate .: "memory_size_in_bytes"
5002− <*> percolate .: "current"
5003− <*> (unMS <$> percolate .: "time_in_millis")
5004− <*> percolate .: "total"
5005− <*> fielddata .: "evictions"
5006− <*> fielddata .: "memory_size_in_bytes"
5007− <*> idCache .: "memory_size_in_bytes"
5008− <*> filterCache .: "evictions"
5009− <*> filterCache .: "memory_size_in_bytes"
5010− <*> (unMS <$> warmer .: "total_time_in_millis")
5011− <*> warmer .: "total"
5012− <*> warmer .: "current"
5013− <*> (unMS <$> flush .: "total_time_in_millis")
5014− <*> flush .: "total"
5015− <*> (unMS <$> refresh .: "total_time_in_millis")
5016− <*> refresh .: "total"
5017− <*> merges .: "total_size_in_bytes"
5018− <*> merges .: "total_docs"
5019− <*> (unMS <$> merges .: "total_time_in_millis")
5020− <*> merges .: "total"
5021− <*> merges .: "current_size_in_bytes"
5022− <*> merges .: "current_docs"
5023− <*> merges .: "current"
5024− <*> search .: "fetch_current"
5025− <*> (unMS <$> search .: "fetch_time_in_millis")
5026− <*> search .: "fetch_total"
5027− <*> search .: "query_current"
5028− <*> (unMS <$> search .: "query_time_in_millis")
5029− <*> search .: "query_total"
5030− <*> search .: "open_contexts"
5031− <*> getStats .: "current"
5032− <*> (unMS <$> getStats .: "missing_time_in_millis")
5033− <*> getStats .: "missing_total"
5034− <*> (unMS <$> getStats .: "exists_time_in_millis")
5035− <*> getStats .: "exists_total"
5036− <*> (unMS <$> getStats .: "time_in_millis")
5037− <*> getStats .: "total"
5038− <*> (fmap unMS <$> indexing .:? "throttle_time_in_millis")
5039− <*> indexing .:? "is_throttled"
5040− <*> indexing .:? "noop_update_total"
5041− <*> indexing .: "delete_current"
5042− <*> (unMS <$> indexing .: "delete_time_in_millis")
5043− <*> indexing .: "delete_total"
5044− <*> indexing .: "index_current"
5045− <*> (unMS <$> indexing .: "index_time_in_millis")
5046− <*> indexing .: "index_total"
5047− <*> (unMS <$> store .: "throttle_time_in_millis")
5048− <*> store .: "size_in_bytes"
5049− <*> docs .: "deleted"
5050− <*> docs .: "count"
5051−
5052−instance FromJSON NodeBreakersStats where
5053− parseJSON = withObject "NodeBreakersStats" parse
5054− where
5055− parse o = NodeBreakersStats <$> o .: "parent"
5056− <*> o .: "request"
5057− <*> o .: "fielddata"
5058−
5059−parseNodeStats :: FullNodeId -> Object -> Parser NodeStats
5060−parseNodeStats fnid o = do
5061− NodeStats <$> o .: "name"
5062− <*> pure fnid
5063− <*> o .:? "breakers"
5064− <*> o .: "http"
5065− <*> o .: "transport"
5066− <*> o .: "fs"
5067− <*> o .: "network"
5068− <*> o .: "thread_pool"
5069− <*> o .: "jvm"
5070− <*> o .: "process"
5071− <*> o .: "os"
5072− <*> o .: "indices"
5073−
5074−parseNodeInfo :: FullNodeId -> Object -> Parser NodeInfo
5075−parseNodeInfo nid o =
5076− NodeInfo <$> o .: "http_address"
5077− <*> o .: "build"
5078− <*> o .: "version"
5079− <*> o .: "ip"
5080− <*> o .: "host"
5081− <*> o .: "transport_address"
5082− <*> o .: "name"
5083− <*> pure nid
5084− <*> o .: "plugins"
5085− <*> o .: "http"
5086− <*> o .: "transport"
5087− <*> o .: "network"
5088− <*> o .: "thread_pool"
5089− <*> o .: "jvm"
5090− <*> o .: "process"
5091− <*> o .: "os"
5092− <*> o .: "settings"
5093−
5094−instance FromJSON NodePluginInfo where
5095− parseJSON = withObject "NodePluginInfo" parse
5096− where
5097− parse o = NodePluginInfo <$> o .: "site"
5098− <*> o .: "jvm"
5099− <*> o .: "description"
5100− <*> o .: "version"
5101− <*> o .: "name"
5102−
5103−instance FromJSON NodeHTTPInfo where
5104− parseJSON = withObject "NodeHTTPInfo" parse
5105− where
5106− parse o = NodeHTTPInfo <$> o .: "max_content_length_in_bytes"
5107− <*> parseJSON (Object o)
5108−
5109−instance FromJSON BoundTransportAddress where
5110− parseJSON = withObject "BoundTransportAddress" parse
5111− where
5112− parse o = BoundTransportAddress <$> o .: "publish_address"
5113− <*> o .: "bound_address"
5114−
5115−instance FromJSON NodeOSInfo where
5116− parseJSON = withObject "NodeOSInfo" parse
5117− where
5118− parse o = do
5119− swap <- o .: "swap"
5120− mem <- o .: "mem"
5121− NodeOSInfo <$> swap .: "total_in_bytes"
5122− <*> mem .: "total_in_bytes"
5123− <*> o .: "cpu"
5124− <*> o .: "available_processors"
5125− <*> (unMS <$> o .: "refresh_interval_in_millis")
5126−
5127−
5128−instance FromJSON CPUInfo where
5129− parseJSON = withObject "CPUInfo" parse
5130− where
5131− parse o = CPUInfo <$> o .: "cache_size_in_bytes"
5132− <*> o .: "cores_per_socket"
5133− <*> o .: "total_sockets"
5134− <*> o .: "total_cores"
5135− <*> o .: "mhz"
5136− <*> o .: "model"
5137− <*> o .: "vendor"
5138−
5139−instance FromJSON NodeProcessInfo where
5140− parseJSON = withObject "NodeProcessInfo" parse
5141− where
5142− parse o = NodeProcessInfo <$> o .: "mlockall"
5143− <*> o .: "max_file_descriptors"
5144− <*> o .: "id"
5145− <*> (unMS <$> o .: "refresh_interval_in_millis")
5146−
5147−instance FromJSON NodeJVMInfo where
5148− parseJSON = withObject "NodeJVMInfo" parse
5149− where
5150− parse o = NodeJVMInfo <$> o .: "memory_pools"
5151− <*> o .: "gc_collectors"
5152− <*> o .: "mem"
5153− <*> (posixMS <$> o .: "start_time_in_millis")
5154− <*> o .: "vm_vendor"
5155− <*> o .: "vm_version"
5156− <*> o .: "vm_name"
5157− <*> (unJVMVersion <$> o .: "version")
5158− <*> o .: "pid"
5159−
5160−instance FromJSON JVMVersion where
5161− parseJSON (String t) =
5162− JVMVersion <$> parseJSON (String (T.replace "_" "." t))
5163− parseJSON v = JVMVersion <$> parseJSON v
5164−
5165−instance FromJSON JVMMemoryInfo where
5166− parseJSON = withObject "JVMMemoryInfo" parse
5167− where
5168− parse o = JVMMemoryInfo <$> o .: "direct_max_in_bytes"
5169− <*> o .: "non_heap_max_in_bytes"
5170− <*> o .: "non_heap_init_in_bytes"
5171− <*> o .: "heap_max_in_bytes"
5172− <*> o .: "heap_init_in_bytes"
5173−
5174−instance FromJSON NodeThreadPoolsInfo where
5175− parseJSON = withObject "NodeThreadPoolsInfo" parse
5176− where
5177− parse o = NodeThreadPoolsInfo <$> o .: "refresh"
5178− <*> o .: "management"
5179− <*> o .: "percolate"
5180− <*> o .:? "listener"
5181− <*> o .:? "fetch_shard_started"
5182− <*> o .: "search"
5183− <*> o .: "flush"
5184− <*> o .: "warmer"
5185− <*> o .: "optimize"
5186− <*> o .: "bulk"
5187− <*> o .: "suggest"
5188− <*> o .: "merge"
5189− <*> o .: "snapshot"
5190− <*> o .: "get"
5191− <*> o .:? "fetch_shard_store"
5192− <*> o .: "index"
5193− <*> o .: "generic"
5194−
5195−instance FromJSON NodeThreadPoolInfo where
5196− parseJSON = withObject "NodeThreadPoolInfo" parse
5197− where
5198− parse o = do
5199− ka <- maybe (return Nothing) (fmap Just . parseStringInterval) =<< o .:? "keep_alive"
5200− NodeThreadPoolInfo <$> (parseJSON . unStringlyTypeJSON =<< o .: "queue_size")
5201− <*> pure ka
5202− <*> o .:? "min"
5203− <*> o .:? "max"
5204− <*> o .: "type"
5205−
5206−parseStringInterval :: (Monad m) => String -> m NominalDiffTime
5207−parseStringInterval s = case span isNumber s of
5208− ("", _) -> fail "Invalid interval"
5209− (nS, unitS) -> case (readMay nS, readMay unitS) of
5210− (Just n, Just unit) -> return (fromInteger (n * unitNDT unit))
5211− (Nothing, _) -> fail "Invalid interval number"
5212− (_, Nothing) -> fail "Invalid interval unit"
5213− where
5214− unitNDT Seconds = 1
5215− unitNDT Minutes = 60
5216− unitNDT Hours = 60 * 60
5217− unitNDT Days = 24 * 60 * 60
5218− unitNDT Weeks = 7 * 24 * 60 * 60
5219−
5220−instance FromJSON ThreadPoolSize where
5221− parseJSON v = parseAsNumber v <|> parseAsString v
5222− where
5223− parseAsNumber = parseAsInt <=< parseJSON
5224− parseAsInt (-1) = return ThreadPoolUnbounded
5225− parseAsInt n
5226− | n >= 0 = return (ThreadPoolBounded n)
5227− | otherwise = fail "Thread pool size must be >= -1."
5228− parseAsString = withText "ThreadPoolSize" $ \t ->
5229− case first (readMay . T.unpack) (T.span isNumber t) of
5230− (Just n, "k") -> return (ThreadPoolBounded (n * 1000))
5231− (Just n, "") -> return (ThreadPoolBounded n)
5232− _ -> fail ("Invalid thread pool size " <> T.unpack t)
5233−
5234−instance FromJSON ThreadPoolType where
5235− parseJSON = withText "ThreadPoolType" parse
5236− where
5237− parse "scaling" = return ThreadPoolScaling
5238− parse "fixed" = return ThreadPoolFixed
5239− parse "cached" = return ThreadPoolCached
5240− parse e = fail ("Unexpected thread pool type" <> T.unpack e)
5241−
5242−instance FromJSON NodeTransportInfo where
5243− parseJSON = withObject "NodeTransportInfo" parse
5244− where
5245− parse o = NodeTransportInfo <$> (maybe (return mempty) parseProfiles =<< o .:? "profiles")
5246− <*> parseJSON (Object o)
5247− parseProfiles (Object o) | HM.null o = return []
5248− parseProfiles v@(Array _) = parseJSON v
5249− parseProfiles Null = return []
5250− parseProfiles _ = fail "Could not parse profiles"
5251−
5252−instance FromJSON NodeNetworkInfo where
5253− parseJSON = withObject "NodeNetworkInfo" parse
5254− where
5255− parse o = NodeNetworkInfo <$> o .: "primary_interface"
5256− <*> (unMS <$> o .: "refresh_interval_in_millis")
5257−
5258−
5259−instance FromJSON NodeNetworkInterface where
5260− parseJSON = withObject "NodeNetworkInterface" parse
5261− where
5262− parse o = NodeNetworkInterface <$> o .: "mac_address"
5263− <*> o .: "name"
5264− <*> o .: "address"
5265−
5266−newtype MaybeNA a = MaybeNA { unMaybeNA :: Maybe a }
5267− deriving (Show, Eq)
5268−
5269−instance FromJSON a => FromJSON (MaybeNA a) where
5270− parseJSON (String "NA") = pure $ MaybeNA Nothing
5271− parseJSON o = MaybeNA . Just <$> parseJSON o
src/Database/V1/Bloodhound/Types/Class.hsdeleted−17
@@ -1,17 +0,0 @@
1−{-# LANGUAGE CPP #-}
2−module Database.V1.Bloodhound.Types.Class
3− ( Seminearring(..) )
4− where
5−
6−#if !MIN_VERSION_base(4,8,0)
7−import Data.Monoid
8−#endif
9−
10−class Monoid a => Seminearring a where
11− -- 0, +, *
12− (<||>) :: a -> a -> a
13− (<&&>) :: a -> a -> a
14− (<&&>) = mappend
15−
16−infixr 5 <||>
17−infixr 5 <&&>
src/Database/V1/Bloodhound/Types/Internal.hsdeleted−57
@@ -1,57 +0,0 @@
1−{-# LANGUAGE DeriveDataTypeable #-}
2−{-# LANGUAGE DeriveGeneric #-}
3−{-# LANGUAGE FlexibleInstances #-}
4−{-# LANGUAGE GeneralizedNewtypeDeriving #-}
5−
6−-------------------------------------------------------------------------------
7−-- |
8−-- Module : Database.Bloodhound.Types.Internal
9−-- Copyright : (C) 2014 Chris Allen
10−-- License : BSD-style (see the file LICENSE)
11−-- Maintainer : Chris Allen <cma@bitemyapp.com>
12−-- Stability : provisional
13−-- Portability : DeriveGeneric, RecordWildCards
14−--
15−-- Internal data types for Bloodhound. These types may change without
16−-- notice so import at your own risk.
17−-------------------------------------------------------------------------------
18−module Database.V1.Bloodhound.Types.Internal
19− ( BHEnv(..)
20− , Server(..)
21− , MonadBH(..)
22− ) where
23−
24−
25−import Control.Applicative as A
26−import Control.Monad.Reader
27−import Data.Aeson
28−import Data.Text (Text)
29−import Data.Typeable (Typeable)
30−import GHC.Generics (Generic)
31−import Network.HTTP.Client
32−
33−{-| Common environment for Elasticsearch calls. Connections will be
34− pipelined according to the provided HTTP connection manager.
35−-}
36−data BHEnv = BHEnv { bhServer :: Server
37− , bhManager :: Manager
38− , bhRequestHook :: Request -> IO Request
39− -- ^ Low-level hook that is run before every request is sent. Used to implement custom authentication strategies. Defaults to 'return' with 'mkBHEnv'.
40− }
41−
42−instance (Functor m, Applicative m, MonadIO m) => MonadBH (ReaderT BHEnv m) where
43− getBHEnv = ask
44−
45−{-| 'Server' is used with the client functions to point at the ES instance
46−-}
47−newtype Server = Server Text deriving (Eq, Show, Generic, Typeable, FromJSON)
48−
49−{-| All API calls to Elasticsearch operate within
50− MonadBH
51− . The idea is that it can be easily embedded in your
52− own monad transformer stack. A default instance for a ReaderT and
53− alias 'BH' is provided for the simple case.
54−-}
55−class (Functor m, A.Applicative m, MonadIO m) => MonadBH m where
56− getBHEnv :: m BHEnv
57−
src/Database/V5/Bloodhound.hsdeleted−10
@@ -1,10 +0,0 @@
1−module Database.V5.Bloodhound
2− ( -- module Data.Aeson.Types
3− -- ,
4− module Database.V5.Bloodhound.Client
5− , module Database.V5.Bloodhound.Types
6− ) where
7−
8−-- import Data.Aeson.Types
9−import Database.V5.Bloodhound.Client
10−import Database.V5.Bloodhound.Types
src/Database/V5/Bloodhound/Types.hsdeleted−5028

This diff is too big to show here.

src/Database/V5/Bloodhound/Types/Class.hsdeleted−17

This diff is too big to show here.

src/Database/V5/Bloodhound/Types/Internal.hsdeleted−57

This diff is too big to show here.

stack-7.10.yamldeleted−15

This diff is too big to show here.

stack-7.8.yamldeleted−19

This diff is too big to show here.

stack-8.0.yaml+9−12

This diff is too big to show here.

stack-8.2.yamlnew file+15

This diff is too big to show here.

stack-8.2.yaml.locknew file+40

This diff is too big to show here.

stack-8.4.yamlnew file+15

This diff is too big to show here.

stack-8.4.yaml.locknew file+12

This diff is too big to show here.

stack-8.6.yamlnew file+14

This diff is too big to show here.

stack-8.6.yaml.locknew file+33

This diff is too big to show here.

stack.yaml+1−6

This diff is too big to show here.

stack.yaml.locknew file+12

This diff is too big to show here.

tests/Test/Aggregation.hsnew file+147

This diff is too big to show here.

tests/Test/ApproxEq.hsnew file+63

This diff is too big to show here.

tests/Test/BulkAPI.hsnew file+95

This diff is too big to show here.

tests/Test/Common.hsnew file+292

This diff is too big to show here.

tests/Test/Documents.hsnew file+51

This diff is too big to show here.

tests/Test/Generators.hsnew file+563

This diff is too big to show here.

tests/Test/Highlights.hsnew file+32

This diff is too big to show here.

tests/Test/Import.hsnew file+58

This diff is too big to show here.

tests/Test/Indices.hsnew file+173

This diff is too big to show here.

tests/Test/JSON.hsnew file+213

This diff is too big to show here.

tests/Test/Query.hsnew file+132

This diff is too big to show here.

tests/Test/Script.hsnew file+36

This diff is too big to show here.

tests/Test/Snapshots.hsnew file+201

This diff is too big to show here.

tests/Test/Sorting.hsnew file+22

This diff is too big to show here.

tests/Test/SourceFiltering.hsnew file+38

This diff is too big to show here.

tests/Test/Suggest.hsnew file+23

This diff is too big to show here.

tests/Test/Templates.hsnew file+26

This diff is too big to show here.

tests/V1/doctests.hsdeleted−4

This diff is too big to show here.

tests/V1/tests.hsdeleted−1880

This diff is too big to show here.

tests/V5/doctests.hsdeleted−4

This diff is too big to show here.

tests/V5/tests.hsdeleted−1649

This diff is too big to show here.

tests/tests.hsnew file+136

This diff is too big to show here.