git.iko.soy/typeable/bloodhound
on master help sign in
.gitignore+9
since splitsnapshots
unifiedsplit
@@ -1,9 +1,11 @@
1cabal.sandbox.config
1cabal.sandbox.config
2.cabal-sandbox/
2.cabal-sandbox/
3dist/
3dist/
4+dist-newstyle/
4.project
5.project
5.dist-buildwrapper/
6.dist-buildwrapper/
6.DS_Store
7.DS_Store
8+TAGS
7*.hi
9*.hi
8*.o
10*.o
9bloodhound-*-docs/
11bloodhound-*-docs/
@@ -11,3 +13,10 @@ bloodhound-*-docs.tar.gz
11bloodhound.iml
13bloodhound.iml
12.idea/
14.idea/
13.stack-work/
15.stack-work/
16+.hg/00changelog.i
17+.hg
18+.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+19−20
@@ -1,44 +1,43 @@
1sudo: false
1sudo: false
2+language: generic
3+
4+jdk:
5+ - oraclejdk11
2
6
3addons:
7addons:
4 apt:
8 apt:
5 packages:
9 packages:
6 - libgmp-dev
10 - libgmp-dev
7− - openjdk-6-jre
8
11
9env:
12env:
10− # - GHCVER=7.6.3 ESVER=1.6.0 # Deprecated
13+ matrix:
11− # - GHCVER=7.8.3 ESVER=1.0.3 # Deprecated
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"
12− # - GHCVER=7.8.3 ESVER=1.1.2 # Deprecated
13− # - GHCVER=7.8 ESVER=1.2.4 # deprecated
14− - GHCVER=7.8 ESVER=1.3.6
15− - GHCVER=7.8 ESVER=1.4.1
16− - GHCVER=7.10 ESVER=1.5.2
17− - GHCVER=7.10 ESVER=1.6.0
18− - GHCVER=7.10 ESVER=1.7.2
19
15
20install:
16install:
21 # stack
17 # stack
22− - export STACK_YAML=stack-$GHCVER.yaml
23 - mkdir -p ~/.local/bin
18 - mkdir -p ~/.local/bin
24− - travis_retry curl -L https://github.com/commercialhaskell/stack/releases/download/v0.1.4.0/stack-0.1.4.0-x86_64-linux.tar.gz | tar -xvzf -
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'
25− - mv stack ~/.local/bin
26 - export PATH=~/.local/bin:$PATH
20 - export PATH=~/.local/bin:$PATH
27− - stack --version
21+ - stack --no-terminal --version
28−
29 # elasticsearch
22 # elasticsearch
30− - wget --no-check-certificate https://download.elastic.co/elasticsearch/elasticsearch/elasticsearch-$ESVER.tar.gz
23+ - wget --no-check-certificate $DLINK-$ESVER.tar.gz
31 - tar xzf elasticsearch-$ESVER.tar.gz
24 - tar xzf elasticsearch-$ESVER.tar.gz
32 # set up a repo for snapshot testing. Required in ES >= 1.6
25 # set up a repo for snapshot testing. Required in ES >= 1.6
33 - echo "path.repo = [\"/tmp\"]" >> ./elasticsearch-$ESVER/elasticsearch.yml
26 - echo "path.repo = [\"/tmp\"]" >> ./elasticsearch-$ESVER/elasticsearch.yml
34 - ./elasticsearch-$ESVER/bin/elasticsearch &
27 - ./elasticsearch-$ESVER/bin/elasticsearch &
35
28
36script:
29script:
37− - stack setup
30+ - stack setup --no-terminal
38− - stack update
31+ - stack update --no-terminal
39− - stack build
32+ - stack build -j2 --fast --no-terminal
40− - stack test
33+ - travis_wait 60 sleep 1800 &
34+ - stack test --fast --no-terminal bloodhound:bloodhound-tests --test-arguments="--qc-max-success 500"
41
35
42cache:
36cache:
37+ timeout: 1500
43 directories:
38 directories:
39+ - $HOME/.cabal
40+ - $HOME/.ghc
44 - $HOME/.stack
41 - $HOME/.stack
42+ - .stack-work/
43+ apt: true
DSL.org+1−1
@@ -1,4 +1,4 @@
1−* ElasticSearch DSL
1+* Elasticsearch DSL
2
2
3** Grouping
3** Grouping
4
4
Makefile+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
1build:
20build:
2− stack build
21+ $(stack) $(build)
3
22
4−echo-warn:
23+## build with validation options (Wall, Werror)
5− echo "Make certain you have an elasticsearch instance on localhost:9200 !"
24+build-validate:
25+ $(stack) build --fast --ghc-options '-Wall -Werror +RTS -A128M -RTS'
26+
27+## run ghci
28+ghci:
29+ $(stack) $(ghci)
6
30
31+## run tests
7test: echo-warn
32test: echo-warn
8− stack test
33+ $(stack) $(test)
9
34
10−7.8-build:
35+## run tests with forced re-run via "-r"
11− STACK_YAML="stack-7.8.yaml" stack build
36+test-rerun: echo-warn
37+ $(stack) $(test) --test-arguments "-r"
12
38
13−7.8-test: echo-warn
39+## run ghci with test stanza
14− STACK_YAML="stack-7.8.yaml" stack test
40+test-ghci:
41+ $(stack) $(ghci) bloodhound:test:bloodhound-tests
15
42
16−8.0-build:
43+## run ghcid
17− STACK_YAML="stack-8.0.yaml" stack build
44+ghcid:
45+ ghcid -c "$(stack) ghci bloodhound:lib --test --ghci-options='-fobject-code -fno-warn-unused-do-bind' --main-is bloodhound:test:bloodhound-tests"
18
46
19−8.0-test: echo-warn
47+## run ghcid with validate options (Werror, etc.)
20− STACK_YAML="stack-8.0.yaml" stack test
48+ghcid-validate:
49+ ghcid -c "$(stack) ghci bloodhound:lib --test --ghci-options='-Werror -fobject-code -fno-warn-unused-do-bind' --main-is bloodhound:test:bloodhound-tests"
21
50
22−ghci:
51+## run weeder
23− stack ghci
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 !"
24
68
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
25upload:
94upload:
26 stack upload --no-signature .
95 stack upload --no-signature .
96+
97+# Create ES5 instance
98+
99+## Run test environment
100+compose-ES5:
101+ @LOCAL_USER_ID=${LOCAL_USER_ID} docker-compose -f docker-compose.yml --project-directory $(elasticsearch_directory) up
102+
103+## Run test environment in detach mode
104+compose-ES5-detach-up:
105+ @LOCAL_USER_ID=${LOCAL_USER_ID} docker-compose -f docker-compose.yml --project-directory $(elasticsearch_directory) up -d
106+
107+## Close test environment if run on detach mode
108+compose-ES5-detach-down:
109+ @LOCAL_USER_ID=${LOCAL_USER_ID} docker-compose -f docker-compose.yml --project-directory $(elasticsearch_directory) down
110+
111+## build the docker compose images
112+compose-build:
113+ @LOCAL_USER_ID=${LOCAL_USER_ID} docker-compose -f docker-compose.yml --project-directory $(elasticsearch_directory) build
114+
115+## Spawn bash shell in ES5 test container
116+ES5-shell:
117+ @LOCAL_USER_ID=${LOCAL_USER_ID} docker-compose -f docker-compose.yml --project-directory $(elasticsearch_directory) exec elasticsearch1 bash
118+
119+help:
120+ @echo "Please use \`make <target>' where <target> is one of\n\n"
121+ @awk '/^[a-zA-Z\-\_0-9]+:/ { \
122+ helpMessage = match(lastLine, /^## (.*)/); \
123+ if (helpMessage) { \
124+ helpCommand = substr($$1, 0, index($$1, ":")); \
125+ helpMessage = substr(lastLine, RSTART + 3, RLENGTH); \
126+ printf "%-30s %s\n", helpCommand, helpMessage; \
127+ } \
128+ } \
129+ { lastLine = $$0 }' $(MAKEFILE_LIST)
README.md+17−838
@@ -21,9 +21,19 @@ Endorsements
21Version compatibility
21Version compatibility
22---------------------
22---------------------
23
23
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.
25
36
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.
27
37
28Stability
38Stability
29---------
39---------
@@ -33,15 +43,15 @@ Bloodhound is stable for production use. I will strive to avoid breaking API com
33Testing
43Testing
34---------
44---------
35
45
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.
37
47
38Steps to run the tests locally:
48Steps 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.
40 2. Install [Stack] (http://docs.haskellstack.org/en/stable/README.html#how-to-install)
50 2. Install [Stack] (http://docs.haskellstack.org/en/stable/README.html#how-to-install)
41 3. In your local Bloodhound directory, run `stack setup && stack build`
51 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.
43 5. Run `stack test` in your local Bloodhound directory.
53 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`.
45
55
46
56
47Hackage page and Haddock documentation
57Hackage page and Haddock documentation
@@ -57,838 +67,7 @@ It's not using Bloodhound, but if you need an introduction to or overview of Ela
57Examples
67Examples
58========
68========
59
69
60−Index Operations
70+See the [examples](htts://github.com/bitemyapp/bloodhound/tree/master/examples) directory for example code.
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 ["tweet" .=
185− object ["properties" .=
186− object ["location" .=
187− object ["type" .= ("geo_point" :: Text)]]]]
188−:}
189−
190−resp <- withBH' $ putMapping testIndex testMapping TweetMapping
191−
192−```
193−
194−### Delete Mapping
195−
196−``` {.haskell}
197−
198−resp <- withBH' $ deleteMapping testIndex testMapping
199−
200−```
201−
202−Document Operations
203−-------------------
204−
205−### Indexing Documents
206−
207−``` {.haskell}
208−
209−-- don't forget the imports and derive generic setting for ghci
210−-- at the beginning of the examples.
211−
212−:{
213−data Location = Location { lat :: Double
214− , lon :: Double } deriving (Eq, Generic, Show)
215−
216−data Tweet = Tweet { user :: Text
217− , postDate :: UTCTime
218− , message :: Text
219− , age :: Int
220− , location :: Location } deriving (Eq, Generic, Show)
221−
222−exampleTweet = Tweet { user = "bitemyapp"
223− , postDate = UTCTime
224− (ModifiedJulianDay 55000)
225− (secondsToDiffTime 10)
226− , message = "Use haskell!"
227− , age = 10000
228− , location = Location 40.12 (-71.34) }
229−
230−-- automagic (generic) derivation of instances because we're lazy.
231−instance ToJSON Tweet
232−instance FromJSON Tweet
233−instance ToJSON Location
234−instance FromJSON Location
235−:}
236−
237−-- Should be able to toJSON and encode the data structures like this:
238−-- λ> toJSON $ Location 10.0 10.0
239−-- Object fromList [("lat",Number 10.0),("lon",Number 10.0)]
240−-- λ> encode $ Location 10.0 10.0
241−-- "{\"lat\":10,\"lon\":10}"
242−
243−resp <- withBH' $ indexDocument testIndex testMapping defaultIndexDocumentSettings exampleTweet (DocId "1")
244−
245−```
246−
247−#### Example Response
248−
249−``` {.haskell}
250−
251−Response {responseStatus =
252− Status {statusCode = 200, statusMessage = "OK"}
253− , responseVersion = HTTP/1.1, responseHeaders =
254− [("Content-Type","application/json; charset=UTF-8"),
255− ("Content-Length","75")]
256− , responseBody = "{\"_index\":\"twitter\",\"_type\":\"tweet\",\"_id\":\"1\",\"_version\":2,\"created\":false}"
257− , responseCookieJar = CJ {expose = []}, responseClose' = ResponseClose}
258−
259−```
260−
261−### Deleting Documents
262−
263−``` {.haskell}
264−
265−resp <- withBH' $ deleteDocument testIndex testMapping (DocId "1")
266−
267−```
268−
269−### Getting Documents
270−
271−``` {.haskell}
272−
273−-- n.b., you'll need the earlier imports. responseBody is from http-conduit
274−
275−resp <- withBH' $ getDocument testIndex testMapping (DocId "1")
276−
277−-- responseBody :: Response body -> body
278−let body = responseBody resp
279−
280−-- you have two options, you use decode and just get Maybe (EsResult Tweet)
281−-- or you can use eitherDecode and get Either String (EsResult Tweet)
282−
283−let maybeResult = decode body :: Maybe (EsResult Tweet)
284−-- the explicit typing is so Aeson knows how to parse the JSON.
285−
286−-- use either if you want to know why something failed to parse.
287−-- (string errors, sadly)
288−let eitherResult = eitherDecode body :: Either String (EsResult Tweet)
289−
290−-- print eitherResult should look like:
291−Right (EsResult {_index = "twitter"
292− , _type = "tweet"
293− , _id = "1"
294− , foundResult = Just (EsResultFound { _version = 2
295− , _source = Tweet {user = "bitemyapp"
296− , postDate = 2009-06-18 00:00:10 UTC
297− , message = "Use haskell!"
298− , age = 10000
299− , location = Location {lat = 40.12, lon = -71.34}}})})
300−
301−-- _source in EsResultFound is parametric, we dispatch the type by passing in what we expect (Tweet) as a parameter to EsResult.
302−
303−-- use the _source record accessor to get at your document
304−fmap (fmap _source . foundResult) eitherResult
305−Right (Just (Tweet {user = "bitemyapp"
306− , postDate = 2009-06-18 00:00:10 UTC
307− , message = "Use haskell!"
308− , age = 10000
309− , location = Location {lat = 40.12, lon = -71.34}}))
310−
311−```
312−
313−Bulk Operations
314−---------------
315−
316−### Bulk create, index
317−
318−``` {.haskell}
319−
320−-- don't forget the imports and derive generic setting for ghci
321−-- at the beginning of the examples.
322−
323−:{
324−-- Using the earlier Tweet datatype and exampleTweet data
325−
326−-- just changing up the data a bit.
327−let bulkTest = exampleTweet { user = "blah" }
328−let bulkTestTwo = exampleTweet { message = "woohoo!" }
329−
330−-- create only bulk operation
331−-- BulkCreate :: IndexName -> MappingName -> DocId -> Value -> BulkOperation
332−let firstOp = BulkCreate testIndex
333− testMapping (DocId "3") (toJSON bulkTest)
334−
335−-- index operation "create or update"
336−let sndOp = BulkIndex testIndex
337− testMapping (DocId "4") (toJSON bulkTestTwo)
338−
339−-- Some explanation, the final "Value" type that BulkIndex,
340−-- BulkCreate, and BulkUpdate accept is the actual document
341−-- data that your operation applies to. BulkDelete doesn't
342−-- take a value because it's just deleting whatever DocId
343−-- you pass.
344−
345−-- list of bulk operations
346−let stream = [firstDoc, secondDoc]
347−
348−-- Fire off the actual bulk request
349−-- bulk :: Vector BulkOperation -> IO Reply
350−resp <- withBH' $ bulk stream
351−:}
352−
353−```
354−
355−### Encoding individual bulk API operations
356−
357−``` {.haskell}
358−-- the following functions are exported in Bloodhound so
359−-- you can build up bulk operations yourself
360−encodeBulkOperations :: V.Vector BulkOperation -> L.ByteString
361−encodeBulkOperation :: BulkOperation -> L.ByteString
362−
363−-- How to use the above:
364−data BulkTest = BulkTest { name :: Text } deriving (Eq, Generic, Show)
365−instance FromJSON BulkTest
366−instance ToJSON BulkTest
367−
368−_ <- insertData
369−let firstTest = BulkTest "blah"
370−let secondTest = BulkTest "bloo"
371−let firstDoc = BulkIndex testIndex
372− testMapping (DocId "2") (toJSON firstTest)
373−let secondDoc = BulkCreate testIndex
374− testMapping (DocId "3") (toJSON secondTest)
375−let stream = V.fromList [firstDoc, secondDoc] :: V.Vector BulkOperation
376−
377−-- to encode yourself
378−let firstDocEncoded = encode firstDoc :: L.ByteString
379−
380−-- to encode a vector of bulk operations
381−let encodedOperations = encodeBulkOperations stream
382−
383−-- to insert into a particular server
384−-- bulk :: V.Vector BulkOperation -> IO Reply
385−_ <- withBH' $ bulk streamp
386−
387−```
388−
389−Search
390−------
391−
392−### Querying
393−
394−#### Term Query
395−
396−``` {.haskell}
397−
398−-- exported by the Client module, just defaults some stuff.
399−-- mkSearch :: Maybe Query -> Maybe Filter -> Search
400−-- mkSearch query filter = Search query filter Nothing False (From 0) (Size 10) Nothing
401−
402−let query = TermQuery (Term "user" "bitemyapp") Nothing
403−
404−-- AND'ing identity filter with itself and then tacking it onto a query
405−-- search should be a null-operation. I include it for the sake of example.
406−-- <||> (or/plus) should make it into a search that returns everything.
407−
408−let filter = IdentityFilter <&&> IdentityFilter
409−
410−-- constructing the search object the searchByIndex function dispatches on.
411−let search = mkSearch (Just query) (Just filter)
412−
413−-- you can also searchByType and specify the mapping name.
414−reply <- withBH' $ searchByIndex testIndex search
415−
416−let result = eitherDecode (responseBody reply) :: Either String (SearchResult Tweet)
417−
418−λ> fmap (hits . searchHits) result
419−Right [Hit {hitIndex = IndexName "twitter"
420− , hitType = MappingName "tweet"
421− , hitDocId = DocId "1"
422− , hitScore = 0.30685282
423− , hitSource = Tweet {user = "bitemyapp"
424− , postDate = 2009-06-18 00:00:10 UTC
425− , message = "Use haskell!"
426− , age = 10000
427− , location = Location {lat = 40.12, lon = -71.34}}}]
428−
429−```
430−
431−#### Match Query
432−
433−``` {.haskell}
434−
435−let query = QueryMatchQuery $ mkMatchQuery (FieldName "user") (QueryString "bitemyapp")
436−let search = mkSearch (Just query) Nothing
437−
438−```
439−
440−#### Multi-Match Query
441−
442−``` {.haskell}
443−
444−let fields = [FieldName "user", FieldName "message"]
445−let query = QueryMultiMatchQuery $ mkMultiMatchQuery fields (QueryString "bitemyapp")
446−let search = mkSearch (Just query) Nothing
447−
448−```
449−
450−#### Bool Query
451−
452−``` {.haskell}
453−
454−let innerQuery = QueryMatchQuery $
455− mkMatchQuery (FieldName "user") (QueryString "bitemyapp")
456−let query = QueryBoolQuery $
457− mkBoolQuery [innerQuery] [] []
458−let search = mkSearch (Just query) Nothing
459−
460−```
461−
462−#### Boosting Query
463−
464−``` {.haskell}
465−
466−let posQuery = QueryMatchQuery $
467− mkMatchQuery (FieldName "user") (QueryString "bitemyapp")
468−let negQuery = QueryMatchQuery $
469− mkMatchQuery (FieldName "user") (QueryString "notmyapp")
470−let query = QueryBoostingQuery $
471− BoostingQuery posQuery negQuery (Boost 0.2)
472−
473−```
474−
475−#### Rest of the query/filter types
476−
477−Just follow the pattern you've seen here and check the Hackage API documentation.
478−
479−### Sorting
480−
481−``` {.haskell}
482−
483−let sortSpec = DefaultSortSpec $ mkSort (FieldName "age") Ascending
484−
485−-- mkSort is a shortcut function that takes a FieldName and a SortOrder
486−-- to generate a vanilla DefaultSort.
487−-- checkt the DefaultSort type for the full list of customizable options.
488−
489−-- From and size are integers for pagination.
490−
491−-- When sorting on a field, scores are not computed. By setting TrackSortScores to true, scores will still be computed and tracked.
492−
493−-- type Sort = [SortSpec]
494−-- type TrackSortScores = Bool
495−-- type From = Int
496−-- type Size = Int
497−
498−-- Search takes Maybe Query
499−-- -> Maybe Filter
500−-- -> Maybe Sort
501−-- -> TrackSortScores
502−-- -> From -> Size
503−-- -> Maybe [FieldName]
504−
505−-- just add more sortspecs to the list if you want tie-breakers.
506−let search = Search Nothing (Just IdentityFilter) (Just [sortSpec]) False (From 0) (Size 10) Nothing
507−
508−```
509−
510−### Field selection
511−
512−If you only want certain fields from the source document returned, you can
513−set the "fields" field of the Search record.
514−
515−``` {.haskell}
516−
517−let search' = mkSearch (Just (MatchAllQuery Nothing)) Nothing
518− search = search' { fields = Just [FieldName "updated"] }
519−
520−```
521−
522−### Filtering
523−
524−#### And, Not, and Or filters
525−
526−Filters form a monoid and seminearring.
527−
528−``` {.haskell}
529−
530−instance Monoid Filter where
531− mempty = IdentityFilter
532− mappend a b = AndFilter [a, b] defaultCache
533−
534−instance Seminearring Filter where
535− a <||> b = OrFilter [a, b] defaultCache
536−
537−-- AndFilter and OrFilter take [Filter] as an argument.
538−
539−-- This will return anything, because IdentityFilter returns everything
540−OrFilter [IdentityFilter, someOtherFilter] False
541−
542−-- This will return exactly what someOtherFilter returns
543−AndFilter [IdentityFilter, someOtherFilter] False
544−
545−-- Thanks to the seminearring and monoid, the above can be expressed as:
546−
547−-- "and"
548−IdentityFilter <&&> someOtherFilter
549−
550−-- "or"
551−IdentityFilter <||> someOtherFilter
552−
553−-- Also there is a NotFilter, it only accepts a single filter, not a list.
554−
555−NotFilter someOtherFilter False
556−
557−```
558−
559−#### Identity Filter
560−
561−``` {.haskell}
562−
563−-- And'ing two Identity
564−let queryFilter = IdentityFilter <&&> IdentityFilter
565−
566−let search = mkSearch Nothing (Just queryFilter)
567−
568−reply <- withBH' $ searchByType testIndex testMapping search
569−
570−```
571−
572−#### Boolean Filter
573−
574−Similar to boolean queries.
575−
576−``` {.haskell}
577−
578−-- Will return only items whose "user" field contains the term "bitemyapp"
579−let queryFilter = BoolFilter (MustMatch (Term "user" "bitemyapp") False)
580−
581−-- Will return only items whose "user" field does not contain the term "bitemyapp"
582−let queryFilter = BoolFilter (MustNotMatch (Term "user" "bitemyapp") False)
583−
584−-- The clause (query) should appear in the matching document.
585−-- In a boolean query with no must clauses, one or more should
586−-- clauses must match a document. The minimum number of should
587−-- clauses to match can be set using the minimum_should_match parameter.
588−let queryFilter = BoolFilter (ShouldMatch [(Term "user" "bitemyapp")] False)
589−
590−```
591−
592−#### Exists Filter
593−
594−``` {.haskell}
595−
596−-- Will filter for documents that have the field "user"
597−let existsFilter = ExistsFilter (FieldName "user")
598−
599−```
600−
601−#### Geo BoundingBox Filter
602−
603−``` {.haskell}
604−
605−-- topLeft and bottomRight
606−let box = GeoBoundingBox (LatLon 40.73 (-74.1)) (LatLon 40.10 (-71.12))
607−
608−let constraint = GeoBoundingBoxConstraint (FieldName "tweet.location") box False GeoFilterMemory
609−
610−```
611−
612−#### Geo Distance Filter
613−
614−``` {.haskell}
615−
616−let geoPoint = GeoPoint (FieldName "tweet.location") (LatLon 40.12 (-71.34))
617−
618−-- coefficient and units
619−let distance = Distance 10.0 Miles
620−
621−-- GeoFilterType or NoOptimizeBbox
622−let optimizeBbox = OptimizeGeoFilterType GeoFilterMemory
623−
624−-- SloppyArc is the usual/default optimization in Elasticsearch today
625−-- but pre-1.0 versions will need to pick Arc or Plane.
626−
627−let geoFilter = GeoDistanceFilter geoPoint distance SloppyArc optimizeBbox False
628−
629−```
630−
631−#### Geo Distance Range Filter
632−
633−Think of a donut and you won't be far off.
634−
635−``` {.haskell}
636−
637−let geoPoint = GeoPoint (FieldName "tweet.location") (LatLon 40.12 (-71.34))
638−
639−let distanceRange = DistanceRange (Distance 0.0 Miles) (Distance 10.0 Miles)
640−
641−let geoFilter = GeoDistanceRangeFilter geoPoint distanceRange
642−
643−```
644−
645−#### Geo Polygon Filter
646−
647−``` {.haskell}
648−
649−-- I think I drew a square here.
650−let points = [LatLon 40.0 (-70.00),
651− LatLon 40.0 (-72.00),
652− LatLon 41.0 (-70.00),
653− LatLon 41.0 (-72.00)]
654−
655−let geoFilter = GeoPolygonFilter (FieldName "tweet.location") points
656−
657−```
658−
659−#### Document IDs filter
660−
661−``` {.haskell}
662−
663−-- takes a mapping name and a list of DocIds
664−IdsFilter (MappingName "tweet") [DocId "1"]
665−
666−```
667−
668−#### Range Filter
669−
670−``` {.haskell}
671−
672−-- RangeFilter :: FieldName
673−-- -> RangeValue
674−-- -> RangeExecution
675−-- -> Cache -> Filter
676−
677−let filter = RangeFilter (FieldName "age")
678− (RangeGtLt (GreaterThan 1000.0) (LessThan 100000.0))
679− RangeExecutionIndex False
680−
681−```
682−
683−``` {.haskell}
684−
685−let filter = RangeFilter (FieldName "age")
686− (RangeLte (LessThanEq 100000.0))
687− RangeExecutionIndex False
688−
689−```
690−
691−##### Date Ranges
692−
693−Date ranges are expressed in UTCTime. Date ranges use the same range bound constructors as numerics, except that they end in "D".
694−
695−Note that compatibility with ES is tested only down to seconds.
696−
697−``` {.haskell}
698−
699−let filter = RangeFilter (FieldName "postDate")
700− (RangeDateGtLte
701− (GreaterThanD (UTCTime
702− (ModifiedJulianDay 55000)
703− (secondsToDiffTime 9)))
704− (LessThanEqD (UTCTime
705− (ModifiedJulianDay 55000)
706− (secondsToDiffTime 11))))
707− RangeExecutionIndex False
708−```
709−
710−#### Regexp Filter
711−
712−``` {.haskell}
713−
714−-- RegexpFilter
715−-- :: FieldName
716−-- -> Regexp
717−-- -> RegexpFlags
718−-- -> CacheName
719−-- -> Cache
720−-- -> CacheKey
721−-- -> Filter
722−let filter = RegexpFilter (FieldName "user") (Regexp "bite.*app")
723− AllRegexpFlags (CacheName "test") False (CacheKey "key")
724−
725−-- n.b.
726−-- data RegexpFlags = AllRegexpFlags
727−-- | NoRegexpFlags
728−-- | SomeRegexpFlags (NonEmpty RegexpFlag) deriving (Eq, Show)
729−
730−-- data RegexpFlag = AnyString
731−-- | Automaton
732−-- | Complement
733−-- | Empty
734−-- | Intersection
735−-- | Interval deriving (Eq, Show)
736−
737−```
738−
739−### Aggregations
740−
741−#### Adding aggregations to search
742−
743−Aggregations can now be added to search queries, or made on their own.
744−
745−``` {.haskell}
746−type Aggregations = M.Map Text Aggregation
747−data Aggregation
748− = TermsAgg TermsAggregation
749− | DateHistogramAgg DateHistogramAggregation
750−```
751−
752−For convenience, \`\`\`mkAggregations\`\`\` exists, that will create an \`\`\`Aggregations\`\`\` with the aggregation provided.
753−
754−For example:
755−
756−``` {.haskell}
757− let a = mkAggregations "users" $ TermsAgg $ mkTermsAggregation "user"
758− let search = mkAggregateSearch Nothing a
759−```
760−
761−Aggregations can be added to an existing search, using the \`\`\`aggBody\`\`\` field
762−
763−``` {.haskell}
764− let search = mkSearch (Just (MatchAllQuery Nothing)) Nothing
765− let search' = search {aggBody = Just a}
766−```
767−
768−Since the \`\`\`Aggregations\`\`\` structure is just a Map Text Aggregation, M.insert can be used to add additional aggregations.
769−
770−``` {.haskell}
771− let a' = M.insert "age" (TermsAgg $ mkTermsAggregation "age") a
772−```
773−
774−#### Extracting aggregations from results
775−
776−Aggregations are part of the reply structure of every search, in the
777−form of `Maybe AggregationResults`
778−
779−``` {.haskell}
780−-- Lift decode and response body to be in the IO monad.
781−let decode' = liftM decode
782−let responseBody' = liftM responseBody
783−let reply = withBH' $ searchByIndex testIndex search
784−let response = decode' $ responseBody' reply :: IO (Maybe (SearchResult Tweet))
785−
786−-- Now that we have our response, we can extract our terms aggregation result -- which is a list of buckets.
787−
788−let terms = do { response' <- response; return $ response' >>= aggregations >>= toTerms "users" }
789−terms
790−Just (Bucket {buckets = [TermsResult {termKey = "bitemyapp", termsDocCount = 1, termsAggs = Nothing}]})
791−```
792−
793−Note that bucket aggregation results, such as the TermsResult is a member of the type class `BucketAggregation`:
794−
795−``` {.haskell}
796−class BucketAggregation a where
797− key :: a -> Text
798− docCount :: a -> Int
799− aggs :: a -> Maybe AggregationResults
800−```
801−
802−You can use the `aggs` function to get any nested results, if there
803−were any. For example, if there were a nested terms aggregation keyed
804−to "age" in a TermsResult named `termresult` , you would call `aggs
805−termresult >>= toTerms "age"`
806−
807−#### Terms Aggregation
808−
809−``` {.haskell}
810−data TermsAggregation
811− = TermsAggregation {term :: Either Text Text,
812− termInclude :: Maybe TermInclusion,
813− termExclude :: Maybe TermInclusion,
814− termOrder :: Maybe TermOrder,
815− termMinDocCount :: Maybe Int,
816− termSize :: Maybe Int,
817− termShardSize :: Maybe Int,
818− termCollectMode :: Maybe CollectionMode,
819− termExecutionHint :: Maybe ExecutionHint,
820− termAggs :: Maybe Aggregations}
821−```
822−
823−Term Aggregations have two factory functions, `mkTermsAggregation`, and
824−`mkTermsScriptAggregation`, and can be used as follows:
825−
826−``` {.haskell}
827−let ta = TermsAgg $ mkTermsAggregation "user"
828−```
829−
830−There are of course other options that can be added to a Terms Aggregation, such as the collection mode:
831−
832−``` {.haskell}
833−let ta = mkTermsAggregation "user"
834−let ta' = ta { termCollectMode = Just BreadthFirst }
835−let ta'' = TermsAgg ta'
836−```
837−
838−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>
839−
840−#### Date Histogram Aggregation
841−
842−``` {.haskell}
843−data DateHistogramAggregation
844− = DateHistogramAggregation {dateField :: FieldName,
845− dateInterval :: Interval,
846− dateFormat :: Maybe Text,
847− datePreZone :: Maybe Text,
848− datePostZone :: Maybe Text,
849− datePreOffset :: Maybe Text,
850− datePostOffset :: Maybe Text,
851− dateAggs :: Maybe Aggregations}
852−```
853−
854−The Date Histogram Aggregation works much the same as the Terms Aggregation.
855−
856−Relevant functions include `mkDateHistogram`, and `toDateHistogram`
857−
858−``` {.haskell}
859−let dh = DateHistogramAgg (mkDateHistogram (FieldName "postDate") Minute)
860−```
861−
862−Date histograms also accept a `FractionalInterval`:
863−
864−``` {.haskell}
865−FractionalInterval :: Float -> TimeInterval -> Interval
866−-- TimeInterval is the following:
867−data TimeInterval = Weeks | Days | Hours | Minutes | Seconds
868−```
869−
870−It can be used as follows:
871−
872−``` {.haskell}
873−let dh = DateHistogramAgg (mkDateHistogram (FieldName "postDate") (FractionalInterval 1.5 Minutes))
874−```
875−
876−The `DateHistogramResult` is defined as:
877−
878−``` {.haskell}
879−data DateHistogramResult
880− = DateHistogramResult {dateKey :: Int,
881− dateKeyStr :: Maybe Text,
882− dateDocCount :: Int,
883− dateHistogramAggs :: Maybe AggregationResults}
884−```
885−
886−It is an instance of `BucketAggregation`, and can have nested aggregations in each bucket.
887−
888−Buckets can be extracted from an `AggregationResult` using
889−`toDateHistogram name`
890−
891−For more information on the Date Histogram Aggregation, see: <https://www.elastic.co/guide/en/elasticsearch/reference/current/search-aggregations-bucket-datehistogram-aggregation.html>
892
71
893
72
894Contributors
73Contributors
bloodhound.cabaldeleted−102
@@ -1,102 +0,0 @@
1−name: bloodhound
2−version: 0.11.1.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: Custom
13−cabal-version: >=1.10
14−
15−extra-source-files:
16− README.md
17− changelog.md
18−
19−
20−source-repository head
21− type: git
22− location: https://github.com/bitemyapp/bloodhound.git
23−
24−library
25− ghc-options: -Wall
26− exposed-modules: Database.Bloodhound
27− Database.Bloodhound.Client
28− Database.Bloodhound.Types
29− Database.Bloodhound.Types.Class
30− Database.Bloodhound.Types.Internal
31− hs-source-dirs: src
32− build-depends: base >= 4.3 && <5,
33− bytestring >= 0.10.0 && <0.11,
34− containers >= 0.5.0.0 && <0.6,
35− aeson >= 0.11.1 && <0.12,
36− http-client >= 0.4.30 && <0.6,
37− network-uri >= 2.6 && <2.7,
38− semigroups >= 0.15 && <0.19,
39− time >= 1.4 && <1.7,
40− text >= 0.11 && <1.3,
41− mtl >= 1.0 && <2.3,
42− transformers >= 0.2 && <0.6,
43− http-types >= 0.8 && <0.10,
44− vector >= 0.10.9 && <0.12,
45− scientific >= 0.3.0.0 && <0.4.0.0,
46− exceptions,
47− data-default-class,
48− blaze-builder,
49− unordered-containers,
50− mtl-compat,
51− hashable
52− default-language: Haskell2010
53−
54−test-suite tests
55− ghc-options: -Wall -fno-warn-orphans
56− type: exitcode-stdio-1.0
57− main-is: tests.hs
58− hs-source-dirs: tests
59− build-depends: base,
60− bloodhound,
61− bytestring,
62− http-client,
63− http-types,
64− containers,
65− hspec >= 1.8 && <2.3,
66− text,
67− time,
68− aeson,
69− semigroups,
70− QuickCheck,
71− vector,
72− unordered-containers >= 0.2.5.0 && <0.3,
73− mtl,
74− quickcheck-properties,
75− derive,
76− errors,
77− exceptions,
78− temporary,
79− unix,
80− network-uri
81− default-language: Haskell2010
82−
83−test-suite doctests
84− ghc-options: -threaded -Wall
85− default-language: Haskell2010
86− type: exitcode-stdio-1.0
87− main-is: doctests.hs
88− hs-source-dirs: tests, src
89− if impl(ghc >= 7.8)
90− build-depends: base,
91− aeson,
92− bloodhound,
93− directory,
94− doctest >= 0.10.1,
95− doctest-prop,
96− filepath
97− else
98− buildable: False
99−
100−Source-Repository head
101− Type: git
102− Location: git://github.com/bitemyapp/bloodhound.git
changelog.md+156−2
@@ -1,3 +1,157 @@
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+
108+0.12.1.0
109+===================
110+* @michaelxavier
111+ - #162 Allow Aeson 1.1
112+* @bermanjosh
113+ - #159 Fix bug with tie breaker json instance for MultiMatchQuery
114+
115+0.12.0.0
116+===================
117+This release contains several new APIs, documentation fixes, and some minor type updates, and steps towards ES 2.0 support. Thanks to all of our contributors!
118+
119+* @bermanjosh
120+ - #139 Make `nodeOSLoad` record a `Maybe` for Windows compatibility
121+ - #138 Change the `nodePluginVersion` record to deal with plugins which report `NA` as their version.
122+* @phadej
123+ - #155 Shed `derive` dependency in test.
124+ - #154 Switch to `Simple` build type.
125+ - #153 Loosen deps on aeson, hspec.
126+* @andrewthad
127+ - #151 Add `waitForYellowIndex`
128+* @michaelxavier
129+ - #150 Fix some failing QuickCheck tests.
130+ - #147 Drop dependency on deprecated doctest-prop.
131+ - #137 Add node stats API.
132+ - #128 Add nodes API.
133+ - #127 Add haddock sections to break up API.
134+ - #126 Add snapshot/restore API.
135+ - #125 Set lower bound for http-client
136+ - #123 Allow replica count of 0 in smart constructor.
137+* @23Skidoo
138+ - #143 Fix an example.
139+ - #142 Docs cleanup.
140+* @alistair
141+ - #135 Changes date formatting to have leading zeroes to bring us closer to ES 2.0 support.
142+ - #133 Fix parent child tests for ES 2.0.
143+ - #132 Parse status API from ES 2.0.
144+ - #131 Add cardinality aggregations.
145+* @dinnu93
146+ - #130 Add OverloadedStrings to first example.
147+* @MaxGabriel
148+ - #117 Fix haddocks italicizing forward slashes.
149+
150+0.11.1.0
151+===================
152+* @bitemyapp
153+ - Add http-client-0.5.0 support
154+
10.11.0.0
1550.11.0.0
2===================
156===================
3
157
@@ -79,7 +233,7 @@ Thanks to the following people, Bloodhound 0.8.0.0 is being released!
79 - #61: Filter aggregation support
233 - #61: Filter aggregation support
80 - #60: Add value_count aggregation support
234 - #60: Add value_count aggregation support
81 - #58: Eliminate partiality in EsResult
235 - #58: Eliminate partiality in EsResult
82−
236+
83* @centromere
237* @centromere
84 - #59: Fixed bug with IndexSettings serialization
238 - #59: Fixed bug with IndexSettings serialization
85 - #56: Added fields support to Search
239 - #56: Added fields support to Search
@@ -88,7 +242,7 @@ Thanks to the following people, Bloodhound 0.8.0.0 is being released!
88 - #52: Added ability to manipulate templates
242 - #52: Added ability to manipulate templates
89 - #51: Fixed mapping API
243 - #51: Fixed mapping API
90 - #50: Fixed problem with put sending POST
244 - #50: Fixed problem with put sending POST
91−
245+
92* @bermanjosh
246* @bermanjosh
93 - #63: Url query encoding bug
247 - #63: Url query encoding bug
94 - #53: Scan type
248 - #53: Scan type
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/Client.hs+228−110
@@ -5,9 +5,9 @@
5-------------------------------------------------------------------------------
5-------------------------------------------------------------------------------
6-- |
6-- |
7-- Module : Database.Bloodhound.Client
7-- Module : Database.Bloodhound.Client
8−-- Copyright : (C) 2014 Chris Allen
8+-- Copyright : (C) 2014, 2018 Chris Allen
9-- License : BSD-style (see the file LICENSE)
9-- License : BSD-style (see the file LICENSE)
10−-- Maintainer : Chris Allen <cma@bitemyapp.com
10+-- Maintainer : Chris Allen <cma@bitemyapp.com>
11-- Stability : provisional
11-- Stability : provisional
12-- Portability : OverloadedStrings
12-- Portability : OverloadedStrings
13--
13--
@@ -25,24 +25,27 @@ module Database.Bloodhound.Client
25 withBH
25 withBH
26 -- ** Indices
26 -- ** Indices
27 , createIndex
27 , createIndex
28+ , createIndexWith
29+ , flushIndex
28 , deleteIndex
30 , deleteIndex
29 , updateIndexSettings
31 , updateIndexSettings
30 , getIndexSettings
32 , getIndexSettings
31− , optimizeIndex
33+ , forceMergeIndex
32 , indexExists
34 , indexExists
33 , openIndex
35 , openIndex
34 , closeIndex
36 , closeIndex
35 , listIndices
37 , listIndices
38+ , waitForYellowIndex
36 -- *** Index Aliases
39 -- *** Index Aliases
37 , updateIndexAliases
40 , updateIndexAliases
38 , getIndexAliases
41 , getIndexAliases
42+ , deleteIndexAlias
39 -- *** Index Templates
43 -- *** Index Templates
40 , putTemplate
44 , putTemplate
41 , templateExists
45 , templateExists
42 , deleteTemplate
46 , deleteTemplate
43 -- ** Mapping
47 -- ** Mapping
44 , putMapping
48 , putMapping
45− , deleteMapping
46 -- ** Documents
49 -- ** Documents
47 , indexDocument
50 , indexDocument
48 , updateDocument
51 , updateDocument
@@ -52,9 +55,11 @@ module Database.Bloodhound.Client
52 -- ** Searching
55 -- ** Searching
53 , searchAll
56 , searchAll
54 , searchByIndex
57 , searchByIndex
58+ , searchByIndices
55 , searchByType
59 , searchByType
56 , scanSearch
60 , scanSearch
57 , getInitialScroll
61 , getInitialScroll
62+ , getInitialSortedScroll
58 , advanceScroll
63 , advanceScroll
59 , refreshIndex
64 , refreshIndex
60 , mkSearch
65 , mkSearch
@@ -126,24 +131,24 @@ import Database.Bloodhound.Types
126-- >>> :set -XOverloadedStrings
131-- >>> :set -XOverloadedStrings
127-- >>> :set -XDeriveGeneric
132-- >>> :set -XDeriveGeneric
128-- >>> import Database.Bloodhound
133-- >>> import Database.Bloodhound
129−-- >>> import Test.DocTest.Prop (assert)
134+-- >>> import Network.HTTP.Client
130-- >>> let testServer = (Server "http://localhost:9200")
135-- >>> let testServer = (Server "http://localhost:9200")
131-- >>> let runBH' = withBH defaultManagerSettings testServer
136-- >>> let runBH' = withBH defaultManagerSettings testServer
132-- >>> let testIndex = IndexName "twitter"
137-- >>> let testIndex = IndexName "twitter"
133-- >>> let testMapping = MappingName "tweet"
138-- >>> let testMapping = MappingName "tweet"
134-- >>> let defaultIndexSettings = IndexSettings (ShardCount 1) (ReplicaCount 0)
139-- >>> let defaultIndexSettings = IndexSettings (ShardCount 1) (ReplicaCount 0)
135-- >>> data TweetMapping = TweetMapping deriving (Eq, Show)
140-- >>> data TweetMapping = TweetMapping deriving (Eq, Show)
136−-- >>> _ <- runBH' $ deleteIndex testIndex >> deleteMapping testIndex testMapping
141+-- >>> _ <- runBH' $ deleteIndex testIndex
142+-- >>> _ <- runBH' $ deleteIndex (IndexName "didimakeanindex")
137-- >>> import GHC.Generics
143-- >>> import GHC.Generics
138-- >>> import Data.Time.Calendar (Day (..))
144-- >>> import Data.Time.Calendar (Day (..))
139-- >>> import Data.Time.Clock (UTCTime (..), secondsToDiffTime)
145-- >>> import Data.Time.Clock (UTCTime (..), secondsToDiffTime)
140-- >>> :{
146-- >>> :{
141--instance ToJSON TweetMapping where
147--instance ToJSON TweetMapping where
142-- toJSON TweetMapping =
148-- toJSON TweetMapping =
143−-- object ["tweet" .=
149+-- object ["properties" .=
144−-- object ["properties" .=
150+-- object ["location" .=
145−-- object ["location" .=
146−-- object ["type" .= ("geo_point" :: Text)]]]]
151+-- object ["type" .= ("geo_point" :: Text)]]]
147--data Location = Location { lat :: Double
152--data Location = Location { lat :: Double
148-- , lon :: Double } deriving (Eq, Generic, Show)
153-- , lon :: Double } deriving (Eq, Generic, Show)
149--data Tweet = Tweet { user :: Text
154--data Tweet = Tweet { user :: Text
@@ -207,8 +212,16 @@ dispatch dMethod url body = do
207 initReq <- liftIO $ parseUrl' url
212 initReq <- liftIO $ parseUrl' url
208 reqHook <- bhRequestHook A.<$> getBHEnv
213 reqHook <- bhRequestHook A.<$> getBHEnv
209 let reqBody = RequestBodyLBS $ fromMaybe emptyBody body
214 let reqBody = RequestBodyLBS $ fromMaybe emptyBody body
215+ req <- liftIO
216+ $ reqHook
217+ $ setRequestIgnoreStatus
218+ $ initReq { method = dMethod
219+ , requestHeaders =
220+ -- "application/x-ndjson" for bulk
221+ ("Content-Type", "application/json") : requestHeaders initReq
222+ , requestBody = reqBody }
210− req <- liftIO $ reqHook $ setRequestIgnoreStatus $ initReq { method = dMethod
223+ -- req <- liftIO $ reqHook $ setRequestIgnoreStatus $ initReq { method = dMethod
211− , requestBody = reqBody }
224+ -- , requestBody = reqBody }
212 mgr <- bhManager <$> getBHEnv
225 mgr <- bhManager <$> getBHEnv
213 liftIO $ httpLbs req mgr
226 liftIO $ httpLbs req mgr
214
227
@@ -225,12 +238,8 @@ appendSearchTypeParam originalUrl st = addQuery params originalUrl
225 where stText = "search_type"
238 where stText = "search_type"
226 params
239 params
227 | st == SearchTypeDfsQueryThenFetch = [(stText, Just "dfs_query_then_fetch")]
240 | st == SearchTypeDfsQueryThenFetch = [(stText, Just "dfs_query_then_fetch")]
228− | st == SearchTypeCount = [(stText, Just "count")]
229− | st == SearchTypeScan = [(stText, Just "scan"), ("scroll", Just "1m")]
230− | st == SearchTypeQueryAndFetch = [(stText, Just "query_and_fetch")]
231− | st == SearchTypeDfsQueryAndFetch = [(stText, Just "dfs_query_and_fetch")]
232 -- used to catch 'SearchTypeQueryThenFetch', which is also the default
241 -- used to catch 'SearchTypeQueryThenFetch', which is also the default
233− | otherwise = [(stText, Just "query_then_fetch")]
242+ | otherwise = []
234
243
235-- | Severely dumbed down query renderer. Assumes your data doesn't
244-- | Severely dumbed down query renderer. Assumes your data doesn't
236-- need any encoding
245-- need any encoding
@@ -274,8 +283,8 @@ post = dispatch NHTM.methodPost
274-- | 'getStatus' fetches the 'Status' of a 'Server'
283-- | 'getStatus' fetches the 'Status' of a 'Server'
275--
284--
276-- >>> serverStatus <- runBH' getStatus
285-- >>> serverStatus <- runBH' getStatus
277−-- >>> fmap status (serverStatus)
286+-- >>> fmap tagline (serverStatus)
278−-- Just 200
287+-- Just "You Know, for Search"
279getStatus :: MonadBH m => m (Maybe Status)
288getStatus :: MonadBH m => m (Maybe Status)
280getStatus = do
289getStatus = do
281 response <- get =<< url
290 response <- get =<< url
@@ -309,7 +318,7 @@ instance FromJSON GSRs where
309 parseJSON = withObject "Collection of GenericSnapshotRepo" parse
318 parseJSON = withObject "Collection of GenericSnapshotRepo" parse
310 where
319 where
311 parse = fmap GSRs . mapM (uncurry go) . HM.toList
320 parse = fmap GSRs . mapM (uncurry go) . HM.toList
312− go rawName = withObject "GenericSnapshotRepo" $ \o -> do
321+ go rawName = withObject "GenericSnapshotRepo" $ \o ->
313 GenericSnapshotRepo (SnapshotRepoName rawName) <$> o .: "type"
322 GenericSnapshotRepo (SnapshotRepoName rawName) <$> o .: "type"
314 <*> o .: "settings"
323 <*> o .: "settings"
315
324
@@ -338,7 +347,7 @@ updateSnapshotRepo SnapshotRepoUpdateSettings {..} repo =
338
347
339
348
340-- | Verify if a snapshot repo is working. __NOTE:__ this API did not
349-- | Verify if a snapshot repo is working. __NOTE:__ this API did not
341−-- 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,
342-- you will get an error here.
351-- you will get an error here.
343verifySnapshotRepo
352verifySnapshotRepo
344 :: ( MonadBH m
353 :: ( MonadBH m
@@ -507,14 +516,38 @@ createIndex indexSettings (IndexName indexName) =
507 where url = joinPath [indexName]
516 where url = joinPath [indexName]
508 body = Just $ encode indexSettings
517 body = Just $ encode indexSettings
509
518
510−
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+
511−-- | 'deleteIndex' will delete an index given a 'Server', and an 'IndexName'.
544+-- | 'deleteIndex' will delete an index given a 'Server' and an 'IndexName'.
512--
545--
513-- >>> _ <- runBH' $ createIndex defaultIndexSettings (IndexName "didimakeanindex")
546-- >>> _ <- runBH' $ createIndex defaultIndexSettings (IndexName "didimakeanindex")
514-- >>> response <- runBH' $ deleteIndex (IndexName "didimakeanindex")
547-- >>> response <- runBH' $ deleteIndex (IndexName "didimakeanindex")
515-- >>> respIsTwoHunna response
548-- >>> respIsTwoHunna response
516-- True
549-- True
517−-- >>> runBH' $ indexExists testIndex
550+-- >>> runBH' $ indexExists (IndexName "didimakeanindex")
518-- False
551-- False
519deleteIndex :: MonadBH m => IndexName -> m Reply
552deleteIndex :: MonadBH m => IndexName -> m Reply
520deleteIndex (IndexName indexName) =
553deleteIndex (IndexName indexName) =
@@ -529,45 +562,49 @@ deleteIndex (IndexName indexName) =
529updateIndexSettings :: MonadBH m => NonEmpty UpdatableIndexSetting -> IndexName -> m Reply
562updateIndexSettings :: MonadBH m => NonEmpty UpdatableIndexSetting -> IndexName -> m Reply
530updateIndexSettings updates (IndexName indexName) =
563updateIndexSettings updates (IndexName indexName) =
531 bindM2 put url (return body)
564 bindM2 put url (return body)
565+ where
532− where url = joinPath [indexName, "_settings"]
566+ url = joinPath [indexName, "_settings"]
533− body = Just (encode jsonBody)
567+ body = Just (encode jsonBody)
534− jsonBody = Object (deepMerge [u | Object u <- toJSON <$> toList updates])
568+ jsonBody = Object (deepMerge [u | Object u <- toJSON <$> toList updates])
535
569
536
570
537getIndexSettings :: (MonadBH m, MonadThrow m) => IndexName
571getIndexSettings :: (MonadBH m, MonadThrow m) => IndexName
538 -> m (Either EsError IndexSettingsSummary)
572 -> m (Either EsError IndexSettingsSummary)
539−getIndexSettings (IndexName indexName) = do
573+getIndexSettings (IndexName indexName) =
540 parseEsResponse =<< get =<< url
574 parseEsResponse =<< get =<< url
575+ where
541− where url = joinPath [indexName, "_settings"]
576+ url = joinPath [indexName, "_settings"]
542
577
578+-- | 'forceMergeIndex'
579+--
580+-- The force merge API allows to force merging of one or more indices through
581+-- an API. The merge relates to the number of segments a Lucene index holds
582+-- within each shard. The force merge operation allows to reduce the number of
583+-- segments by merging them.
584+--
585+-- This call will block until the merge is complete. If the http connection is
586+-- lost, the request will continue in the background, and any new requests will
587+-- block until the previous force merge is complete.
543
588
544−-- | 'optimizeIndex' will optimize a single index, list of indexes or
545−-- all indexes. Note that this call will block until finishing but
546−-- will continue even if the request times out. Concurrent requests to
547−-- optimize an index while another is performing will block until the
548−-- previous one finishes. For more information see
589+-- For more information see
549−-- <https://www.elastic.co/guide/en/elasticsearch/reference/1.7/indices-optimize.html>. Nothing
590+-- <https://www.elastic.co/guide/en/elasticsearch/reference/current/indices-forcemerge.html#indices-forcemerge>.
591+-- Nothing
550-- worthwhile comes back in the reply body, so matching on the status
592-- worthwhile comes back in the reply body, so matching on the status
551-- should suffice.
593-- should suffice.
552--
594--
553−-- 'optimizeIndex' with a maxNumSegments of 1 and onlyExpungeDeletes
595+-- 'forceMergeIndex' with a maxNumSegments of 1 and onlyExpungeDeletes
554-- to True is the main way to release disk space back to the OS being
596-- to True is the main way to release disk space back to the OS being
555-- held by deleted documents.
597-- held by deleted documents.
556--
598--
557−-- Note that this API was deprecated in ElasticSearch 2.1 for the
558−-- almost completely identical forcemerge API. Adding support to that
559−-- API would be trivial but due to the significant breaking changes,
560−-- this library cannot currently be used with >= 2.0, so that feature was omitted.
561−--
562-- >>> let ixn = IndexName "unoptimizedindex"
599-- >>> let ixn = IndexName "unoptimizedindex"
563-- >>> _ <- runBH' $ deleteIndex ixn >> createIndex defaultIndexSettings ixn
600-- >>> _ <- runBH' $ deleteIndex ixn >> createIndex defaultIndexSettings ixn
564−-- >>> response <- runBH' $ optimizeIndex (IndexList (ixn :| [])) (defaultIndexOptimizationSettings { maxNumSegments = Just 1, onlyExpungeDeletes = True })
601+-- >>> response <- runBH' $ forceMergeIndex (IndexList (ixn :| [])) (defaultIndexOptimizationSettings { maxNumSegments = Just 1, onlyExpungeDeletes = True })
565-- >>> respIsTwoHunna response
602-- >>> respIsTwoHunna response
566-- True
603-- True
567−optimizeIndex :: MonadBH m => IndexSelection -> IndexOptimizationSettings -> m Reply
604+forceMergeIndex :: MonadBH m => IndexSelection -> ForceMergeIndexSettings -> m Reply
568−optimizeIndex ixs IndexOptimizationSettings {..} =
605+forceMergeIndex ixs ForceMergeIndexSettings {..} =
569 bindM2 post url (return body)
606 bindM2 post url (return body)
570− where url = addQuery params <$> joinPath [indexName, "_optimize"]
607+ where url = addQuery params <$> joinPath [indexName, "_forcemerge"]
571 params = catMaybes [ ("max_num_segments",) . Just . showText <$> maxNumSegments
608 params = catMaybes [ ("max_num_segments",) . Just . showText <$> maxNumSegments
572 , Just ("only_expunge_deletes", Just (boolQP onlyExpungeDeletes))
609 , Just ("only_expunge_deletes", Just (boolQP onlyExpungeDeletes))
573 , Just ("flush", Just (boolQP flushAfterOptimize))
610 , Just ("flush", Just (boolQP flushAfterOptimize))
@@ -601,20 +638,25 @@ existentialQuery url = do
601-- responses from elasticsearch should fall into these two
638-- responses from elasticsearch should fall into these two
602-- categories. If they don't, a 'EsProtocolException' will be
639-- categories. If they don't, a 'EsProtocolException' will be
603-- thrown. If you encounter this, please report the full body it
640-- thrown. If you encounter this, please report the full body it
604−-- reports along with your ElasticSearch verison.
641+-- reports along with your Elasticsearch verison.
605−parseEsResponse :: (MonadThrow m, FromJSON a) => Reply
642+parseEsResponse :: ( MonadThrow m
643+ , FromJSON a
644+ )
645+ => Reply
606 -> m (Either EsError a)
646 -> m (Either EsError a)
607parseEsResponse reply
647parseEsResponse reply
608 | respIsTwoHunna reply = case eitherDecode body of
648 | respIsTwoHunna reply = case eitherDecode body of
609 Right a -> return (Right a)
649 Right a -> return (Right a)
650+ Left err ->
610− Left _ -> tryParseError
651+ tryParseError err
611− | otherwise = tryParseError
652+ | otherwise = tryParseError "Non-200 status code"
612 where body = responseBody reply
653 where body = responseBody reply
654+ tryParseError originalError
613− tryParseError = case eitherDecode body of
655+ = case eitherDecode body of
614− Right e -> return (Left e)
656+ Right e -> return (Left e)
615− -- this case should not be possible
657+ -- Failed to parse the error message.
616− Left _ -> explode
658+ Left err -> explode ("Original error was: " <> originalError <> " Error parse failure was: " <> err)
617− explode = throwM (EsProtocolException body)
659+ explode errorMsg = throwM (EsProtocolException (T.pack errorMsg) body)
618
660
619-- | 'indexExists' enables you to check if an index exists. Returns 'Bool'
661-- | 'indexExists' enables you to check if an index exists. Returns 'Bool'
620-- in IO
662-- in IO
@@ -635,6 +677,14 @@ refreshIndex (IndexName indexName) =
635 bindM2 post url (return Nothing)
677 bindM2 post url (return Nothing)
636 where url = joinPath [indexName, "_refresh"]
678 where url = joinPath [indexName, "_refresh"]
637
679
680+-- | Block until the index becomes available for indexing
681+-- documents. This is useful for integration tests in which
682+-- indices are rapidly created and deleted.
683+waitForYellowIndex :: MonadBH m => IndexName -> m Reply
684+waitForYellowIndex (IndexName indexName) = get =<< url
685+ where url = addQuery q <$> joinPath ["_cluster","health",indexName]
686+ q = [("wait_for_status",Just "yellow"),("timeout",Just "10s")]
687+
638stringifyOCIndex :: OpenCloseIndex -> Text
688stringifyOCIndex :: OpenCloseIndex -> Text
639stringifyOCIndex oci = case oci of
689stringifyOCIndex oci = case oci of
640 OpenIndex -> "_open"
690 OpenIndex -> "_open"
@@ -665,14 +715,16 @@ listIndices :: (MonadThrow m, MonadBH m) => m [IndexName]
665listIndices =
715listIndices =
666 parse . responseBody =<< get =<< url
716 parse . responseBody =<< get =<< url
667 where
717 where
668− url = joinPath ["_cat/indices?v"]
718+ url = joinPath ["_cat/indices?format=json"]
669− -- parses the tabular format the indices api provides
719+ parse body = either (\msg -> (throwM (EsProtocolException (T.pack msg) body))) return $ do
670− parse body = case T.lines (T.decodeUtf8 (L.toStrict body)) of
720+ vals <- eitherDecode body
671− (hdr:rows) -> let ks = T.words hdr
721+ forM vals $ \val ->
672− keyedRows = [ HM.fromList (zip ks (T.words row)) | row <- rows ]
722+ case val of
723+ Object obj ->
673− names = catMaybes (HM.lookup "index" <$> keyedRows)
724+ case HM.lookup "index" obj of
674− in return (IndexName <$> names)
725+ (Just (String txt)) -> Right (IndexName txt)
675− [] -> throwM (EsProtocolException body)
726+ v -> Left $ "indexVal in listIndices failed on non-string, was: " <> show v
727+ v -> Left $ "One of the values parsed in listIndices wasn't an object, it was: " <> show v
676
728
677-- | 'updateIndexAliases' updates the server's index alias
729-- | 'updateIndexAliases' updates the server's index alias
678-- table. Operations are atomic. Explained in further detail at
730-- table. Operations are atomic. Explained in further detail at
@@ -703,6 +755,12 @@ getIndexAliases :: (MonadBH m, MonadThrow m)
703getIndexAliases = parseEsResponse =<< get =<< url
755getIndexAliases = parseEsResponse =<< get =<< url
704 where url = joinPath ["_aliases"]
756 where url = joinPath ["_aliases"]
705
757
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+
706-- | 'putTemplate' creates a template given an 'IndexTemplate' and a 'TemplateName'.
764-- | 'putTemplate' creates a template given an 'IndexTemplate' and a 'TemplateName'.
707-- Explained in further detail at
765-- Explained in further detail at
708-- <https://www.elastic.co/guide/en/elasticsearch/reference/1.7/indices-templates.html>
766-- <https://www.elastic.co/guide/en/elasticsearch/reference/1.7/indices-templates.html>
@@ -738,7 +796,7 @@ deleteTemplate (TemplateName templateName) =
738-- >>> _ <- runBH' $ createIndex defaultIndexSettings testIndex
796-- >>> _ <- runBH' $ createIndex defaultIndexSettings testIndex
739-- >>> resp <- runBH' $ putMapping testIndex testMapping TweetMapping
797-- >>> resp <- runBH' $ putMapping testIndex testMapping TweetMapping
740-- >>> print resp
798-- >>> print resp
741−-- 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}
799+-- Response {responseStatus = Status {statusCode = 200, statusMessage = "OK"}, responseVersion = HTTP/1.1, responseHeaders = [("content-type","application/json; charset=UTF-8"),("content-encoding","gzip"),("transfer-encoding","chunked")], responseBody = "{\"acknowledged\":true}", responseCookieJar = CJ {expose = []}, responseClose' = ResponseClose}
742putMapping :: (MonadBH m, ToJSON a) => IndexName
800putMapping :: (MonadBH m, ToJSON a) => IndexName
743 -> MappingName -> a -> m Reply
801 -> MappingName -> a -> m Reply
744putMapping (IndexName indexName) (MappingName mappingName) mapping =
802putMapping (IndexName indexName) (MappingName mappingName) mapping =
@@ -748,21 +806,6 @@ putMapping (IndexName indexName) (MappingName mappingName) mapping =
748 -- erroneously. The correct API call is: "/INDEX/_mapping/MAPPING_NAME"
806 -- erroneously. The correct API call is: "/INDEX/_mapping/MAPPING_NAME"
749 body = Just $ encode mapping
807 body = Just $ encode mapping
750
808
751−-- | 'deleteMapping' is an HTTP DELETE and deletes a mapping for a given index.
752−-- Mappings are schemas for documents in indexes.
753−--
754−-- >>> _ <- runBH' $ createIndex defaultIndexSettings testIndex
755−-- >>> _ <- runBH' $ putMapping testIndex testMapping TweetMapping
756−-- >>> resp <- runBH' $ deleteMapping testIndex testMapping
757−-- >>> print resp
758−-- 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}
759−deleteMapping :: MonadBH m => IndexName -> MappingName -> m Reply
760−deleteMapping (IndexName indexName)
761− (MappingName mappingName) =
762− -- "_mapping" and mappingName below were originally transposed
763− -- erroneously. The correct API call is: "/INDEX/_mapping/MAPPING_NAME"
764− delete =<< joinPath [indexName, "_mapping", mappingName]
765−
766versionCtlParams :: IndexDocumentSettings -> [(Text, Maybe Text)]
809versionCtlParams :: IndexDocumentSettings -> [(Text, Maybe Text)]
767versionCtlParams cfg =
810versionCtlParams cfg =
768 case idsVersionControl cfg of
811 case idsVersionControl cfg of
@@ -780,11 +823,14 @@ versionCtlParams cfg =
780-- | 'indexDocument' is the primary way to save a single document in
823-- | 'indexDocument' is the primary way to save a single document in
781-- Elasticsearch. The document itself is simply something we can
824-- Elasticsearch. The document itself is simply something we can
782-- convert into a JSON 'Value'. The 'DocId' will function as the
825-- convert into a JSON 'Value'. The 'DocId' will function as the
783−-- 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
784--
830--
785-- >>> resp <- runBH' $ indexDocument testIndex testMapping defaultIndexDocumentSettings exampleTweet (DocId "1")
831-- >>> resp <- runBH' $ indexDocument testIndex testMapping defaultIndexDocumentSettings exampleTweet (DocId "1")
786-- >>> print resp
832-- >>> print resp
787−-- 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}
833+-- Response {responseStatus = Status {statusCode = 201, statusMessage = "Created"}, responseVersion = HTTP/1.1, responseHeaders = [("Location","/twitter/tweet/1"),("content-type","application/json; charset=UTF-8"),("content-encoding","gzip"),("transfer-encoding","chunked")], responseBody = "{\"_index\":\"twitter\",\"_type\":\"tweet\",\"_id\":\"1\",\"_version\":1,\"result\":\"created\",\"_shards\":{\"total\":2,\"successful\":1,\"failed\":0},\"created\":true}", responseCookieJar = CJ {expose = []}, responseClose' = ResponseClose}
788indexDocument :: (ToJSON doc, MonadBH m) => IndexName -> MappingName
834indexDocument :: (ToJSON doc, MonadBH m) => IndexName -> MappingName
789 -> IndexDocumentSettings -> doc -> DocId -> m Reply
835 -> IndexDocumentSettings -> doc -> DocId -> m Reply
790indexDocument (IndexName indexName)
836indexDocument (IndexName indexName)
@@ -828,9 +874,11 @@ deleteDocument (IndexName indexName)
828-- >>> _ <- runBH' $ bulk stream
874-- >>> _ <- runBH' $ bulk stream
829-- >>> _ <- runBH' $ refreshIndex testIndex
875-- >>> _ <- runBH' $ refreshIndex testIndex
830bulk :: MonadBH m => V.Vector BulkOperation -> m Reply
876bulk :: MonadBH m => V.Vector BulkOperation -> m Reply
877+bulk bulkOps =
831−bulk bulkOps = bindM2 post url (return body)
878+ bindM2 post url (return body)
879+ where
832− where url = joinPath ["_bulk"]
880+ url = joinPath ["_bulk"]
833− body = Just $ encodeBulkOperations bulkOps
881+ body = Just $ encodeBulkOperations bulkOps
834
882
835-- | 'encodeBulkOperations' is a convenience function for dumping a vector of 'BulkOperation'
883-- | 'encodeBulkOperations' is a convenience function for dumping a vector of 'BulkOperation'
836-- into an 'L.ByteString'
884-- into an 'L.ByteString'
@@ -840,12 +888,15 @@ bulk bulkOps = bindM2 post url (return body)
840-- "\n{\"index\":{\"_type\":\"tweet\",\"_id\":\"2\",\"_index\":\"twitter\"}}\n{\"name\":\"blah\"}\n"
888-- "\n{\"index\":{\"_type\":\"tweet\",\"_id\":\"2\",\"_index\":\"twitter\"}}\n{\"name\":\"blah\"}\n"
841encodeBulkOperations :: V.Vector BulkOperation -> L.ByteString
889encodeBulkOperations :: V.Vector BulkOperation -> L.ByteString
842encodeBulkOperations stream = collapsed where
890encodeBulkOperations stream = collapsed where
891+ blobs =
843− blobs = fmap encodeBulkOperation stream
892+ fmap encodeBulkOperation stream
893+ mashedTaters =
844− mashedTaters = mash (mempty :: Builder) blobs
894+ mash (mempty :: Builder) blobs
895+ collapsed =
845− collapsed = toLazyByteString $ mappend mashedTaters (byteString "\n")
896+ toLazyByteString $ mappend mashedTaters (byteString "\n")
846
897
847mash :: Builder -> V.Vector L.ByteString -> Builder
898mash :: Builder -> V.Vector L.ByteString -> Builder
848−mash = V.foldl' (\b x -> b `mappend` (byteString "\n") `mappend` (lazyByteString x))
899+mash = V.foldl' (\b x -> b <> byteString "\n" <> lazyByteString x)
849
900
850mkBulkStreamValue :: Text -> Text -> Text -> Text -> Value
901mkBulkStreamValue :: Text -> Text -> Text -> Text -> Value
851mkBulkStreamValue operation indexName mappingName docId =
902mkBulkStreamValue operation indexName mappingName docId =
@@ -854,6 +905,12 @@ mkBulkStreamValue operation indexName mappingName docId =
854 , "_type" .= mappingName
905 , "_type" .= mappingName
855 , "_id" .= docId]]
906 , "_id" .= docId]]
856
907
908+mkBulkStreamValueAuto :: Text -> Text -> Text -> Value
909+mkBulkStreamValueAuto operation indexName mappingName =
910+ object [operation .=
911+ object [ "_index" .= indexName
912+ , "_type" .= mappingName]]
913+
857-- | 'encodeBulkOperation' is a convenience function for dumping a single 'BulkOperation'
914-- | 'encodeBulkOperation' is a convenience function for dumping a single 'BulkOperation'
858-- into an 'L.ByteString'
915-- into an 'L.ByteString'
859--
916--
@@ -867,6 +924,18 @@ encodeBulkOperation (BulkIndex (IndexName indexName)
867 where metadata = mkBulkStreamValue "index" indexName mappingName docId
924 where metadata = mkBulkStreamValue "index" indexName mappingName docId
868 blob = encode metadata `mappend` "\n" `mappend` encode value
925 blob = encode metadata `mappend` "\n" `mappend` encode value
869
926
927+encodeBulkOperation (BulkIndexAuto (IndexName indexName)
928+ (MappingName mappingName)
929+ value) = blob
930+ where metadata = mkBulkStreamValueAuto "index" indexName mappingName
931+ blob = encode metadata `mappend` "\n" `mappend` encode value
932+
933+encodeBulkOperation (BulkIndexEncodingAuto (IndexName indexName)
934+ (MappingName mappingName)
935+ encoding) = toLazyByteString blob
936+ where metadata = toEncoding (mkBulkStreamValueAuto "index" indexName mappingName)
937+ blob = fromEncoding metadata <> "\n" <> fromEncoding encoding
938+
870encodeBulkOperation (BulkCreate (IndexName indexName)
939encodeBulkOperation (BulkCreate (IndexName indexName)
871 (MappingName mappingName)
940 (MappingName mappingName)
872 (DocId docId) value) = blob
941 (DocId docId) value) = blob
@@ -886,6 +955,12 @@ encodeBulkOperation (BulkUpdate (IndexName indexName)
886 doc = object ["doc" .= value]
955 doc = object ["doc" .= value]
887 blob = encode metadata `mappend` "\n" `mappend` encode doc
956 blob = encode metadata `mappend` "\n" `mappend` encode doc
888
957
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+
889-- | 'getDocument' is a straight-forward way to fetch a single document from
964-- | 'getDocument' is a straight-forward way to fetch a single document from
890-- Elasticsearch using a 'Server', 'IndexName', 'MappingName', and a 'DocId'.
965-- Elasticsearch using a 'Server', 'IndexName', 'MappingName', and a 'DocId'.
891-- The 'DocId' is the primary key for your Elasticsearch document.
966-- The 'DocId' is the primary key for your Elasticsearch document.
@@ -935,6 +1010,15 @@ searchByIndex :: MonadBH m => IndexName -> Search -> m Reply
935searchByIndex (IndexName indexName) = bindM2 dispatchSearch url . return
1010searchByIndex (IndexName indexName) = bindM2 dispatchSearch url . return
936 where url = joinPath [indexName, "_search"]
1011 where url = joinPath [indexName, "_search"]
937
1012
1013+-- | 'searchByIndices' is a variant of 'searchByIndex' that executes a
1014+-- 'Search' over many indices. This is much faster than using
1015+-- 'mapM' to 'searchByIndex' over a collection since it only
1016+-- causes a single HTTP request to be emitted.
1017+searchByIndices :: MonadBH m => NonEmpty IndexName -> Search -> m Reply
1018+searchByIndices ixs = bindM2 dispatchSearch url . return
1019+ where url = joinPath [renderedIxs, "_search"]
1020+ renderedIxs = T.intercalate (T.singleton ',') (map (\(IndexName t) -> t) (toList ixs))
1021+
938-- | 'searchByType', given a 'Search', 'IndexName', and 'MappingName', will perform that
1022-- | 'searchByType', given a 'Search', 'IndexName', and 'MappingName', will perform that
939-- search against a specific mapping within an index on an Elasticsearch server.
1023-- search against a specific mapping within an index on an Elasticsearch server.
940--
1024--
@@ -947,20 +1031,40 @@ searchByType (IndexName indexName)
947 (MappingName mappingName) = bindM2 dispatchSearch url . return
1031 (MappingName mappingName) = bindM2 dispatchSearch url . return
948 where url = joinPath [indexName, mappingName, "_search"]
1032 where url = joinPath [indexName, mappingName, "_search"]
949
1033
950−-- | For a given scearch, request a scroll for efficient streaming of
1034+-- | For a given search, request a scroll for efficient streaming of
951-- search results. Note that the search is put into 'SearchTypeScan'
1035-- search results. Note that the search is put into 'SearchTypeScan'
952-- mode and thus results will not be sorted. Combine this with
1036-- mode and thus results will not be sorted. Combine this with
953-- 'advanceScroll' to efficiently stream through the full result set
1037-- 'advanceScroll' to efficiently stream through the full result set
954−getInitialScroll :: MonadBH m => IndexName -> MappingName -> Search -> m (Maybe ScrollId)
1038+getInitialScroll ::
1039+ (FromJSON a, MonadThrow m, MonadBH m) => IndexName ->
1040+ MappingName ->
1041+ Search ->
1042+ m (Either EsError (SearchResult a))
955−getInitialScroll (IndexName indexName) (MappingName mappingName) search = do
1043+getInitialScroll (IndexName indexName) (MappingName mappingName) search' = do
956− let url = joinPath [indexName, mappingName, "_search"]
1044+ let url = addQuery params <$> joinPath [indexName, mappingName, "_search"]
957− search' = search { searchType = SearchTypeScan }
1045+ params = [("scroll", Just "1m")]
1046+ sorting = Just [DefaultSortSpec $ mkSort (FieldName "_doc") Descending]
1047+ search = search' { sortBody = sorting }
958− resp' <- bindM2 dispatchSearch url (return search')
1048+ resp' <- bindM2 dispatchSearch url (return search)
959− let msr = decode' $ responseBody resp' :: Maybe (SearchResult ())
1049+ parseEsResponse resp'
960− msid = maybe Nothing scrollId msr
1050+
961− return msid
1051+-- | For a given search, request a scroll for efficient streaming of
962−
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+
963−scroll' :: (FromJSON a, MonadBH m, MonadThrow m) => Maybe ScrollId -> m ([Hit a], Maybe ScrollId)
1066+scroll' :: (FromJSON a, MonadBH m, MonadThrow m) => Maybe ScrollId ->
1067+ m ([Hit a], Maybe ScrollId)
964scroll' Nothing = return ([], Nothing)
1068scroll' Nothing = return ([], Nothing)
965scroll' (Just sid) = do
1069scroll' (Just sid) = do
966 res <- advanceScroll sid 60
1070 res <- advanceScroll sid 60
@@ -980,20 +1084,29 @@ advanceScroll
980 -- ^ 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.
1084 -- ^ 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.
981 -> m (Either EsError (SearchResult a))
1085 -> m (Either EsError (SearchResult a))
982advanceScroll (ScrollId sid) scroll = do
1086advanceScroll (ScrollId sid) scroll = do
983− url <- joinPath ["_search/scroll?scroll=" <> scrollTime]
1087+ url <- joinPath ["_search", "scroll"]
984− parseEsResponse =<< post url (Just . L.fromStrict $ T.encodeUtf8 sid)
1088+ resp <- post url (Just $ encode scrollObject)
1089+ parseEsResponse resp
985 where scrollTime = showText secs <> "s"
1090 where scrollTime = showText secs <> "s"
986 secs :: Integer
1091 secs :: Integer
987 secs = round scroll
1092 secs = round scroll
988
1093
1094+ scrollObject = object [ "scroll" .= scrollTime
1095+ , "scroll_id" .= sid
1096+ ]
1097+
1098+simpleAccumulator ::
989−simpleAccumulator :: (FromJSON a, MonadBH m, MonadThrow m) => [Hit a] -> ([Hit a], Maybe ScrollId) -> m ([Hit a], Maybe ScrollId)
1099+ (FromJSON a, MonadBH m, MonadThrow m) =>
1100+ [Hit a] ->
1101+ ([Hit a], Maybe ScrollId) ->
1102+ m ([Hit a], Maybe ScrollId)
990simpleAccumulator oldHits (newHits, Nothing) = return (oldHits ++ newHits, Nothing)
1103simpleAccumulator oldHits (newHits, Nothing) = return (oldHits ++ newHits, Nothing)
991simpleAccumulator oldHits ([], _) = return (oldHits, Nothing)
1104simpleAccumulator oldHits ([], _) = return (oldHits, Nothing)
992simpleAccumulator oldHits (newHits, msid) = do
1105simpleAccumulator oldHits (newHits, msid) = do
993 (newHits', msid') <- scroll' msid
1106 (newHits', msid') <- scroll' msid
994 simpleAccumulator (oldHits ++ newHits) (newHits', msid')
1107 simpleAccumulator (oldHits ++ newHits) (newHits', msid')
995
1108
996−-- | 'scanSearch' uses the 'scan&scroll' API of elastic,
1109+-- | 'scanSearch' uses the 'scroll' API of elastic,
997-- for a given 'IndexName' and 'MappingName'. Note that this will
1110-- for a given 'IndexName' and 'MappingName'. Note that this will
998-- consume the entire search result set and will be doing O(n) list
1111-- consume the entire search result set and will be doing O(n) list
999-- appends so this may not be suitable for large result sets. In that
1112-- appends so this may not be suitable for large result sets. In that
@@ -1002,11 +1115,16 @@ simpleAccumulator oldHits (newHits, msid) = do
1002-- pipes, or your favorite streaming IO abstraction of choice. Note
1115-- pipes, or your favorite streaming IO abstraction of choice. Note
1003-- that ordering on the search would destroy performance and thus is
1116-- that ordering on the search would destroy performance and thus is
1004-- ignored.
1117-- ignored.
1005−scanSearch :: (FromJSON a, MonadBH m, MonadThrow m) => IndexName -> MappingName -> Search -> m [Hit a]
1118+scanSearch :: (FromJSON a, MonadBH m, MonadThrow m) => IndexName
1119+ -> MappingName
1120+ -> Search
1121+ -> m [Hit a]
1006scanSearch indexName mappingName search = do
1122scanSearch indexName mappingName search = do
1007− msid <- getInitialScroll indexName mappingName search
1123+ initialSearchResult <- getInitialScroll indexName mappingName search
1008− (hits, msid') <- scroll' msid
1124+ let (hits', josh) = case initialSearchResult of
1125+ Right SearchResult {..} -> (hits searchHits, scrollId)
1126+ Left _ -> ([], Nothing)
1009− (totalHits, _) <- simpleAccumulator [] (hits, msid')
1127+ (totalHits, _) <- simpleAccumulator [] (hits', josh)
1010 return totalHits
1128 return totalHits
1011
1129
1012-- | 'mkSearch' is a helper function for defaulting additional fields of a 'Search'
1130-- | 'mkSearch' is a helper function for defaulting additional fields of a 'Search'
@@ -1016,9 +1134,9 @@ scanSearch indexName mappingName search = do
1016--
1134--
1017-- >>> let query = TermQuery (Term "user" "bitemyapp") Nothing
1135-- >>> let query = TermQuery (Term "user" "bitemyapp") Nothing
1018-- >>> mkSearch (Just query) Nothing
1136-- >>> mkSearch (Just query) Nothing
1019−-- 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}
1020mkSearch :: Maybe Query -> Maybe Filter -> Search
1138mkSearch :: Maybe Query -> Maybe Filter -> Search
1021−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
1022
1140
1023-- | 'mkAggregateSearch' is a helper function that defaults everything in a 'Search' except for
1141-- | 'mkAggregateSearch' is a helper function that defaults everything in a 'Search' except for
1024-- the 'Query' and the 'Aggregation'.
1142-- the 'Query' and the 'Aggregation'.
@@ -1028,7 +1146,7 @@ mkSearch query filter = Search query filter Nothing Nothing Nothing False (From
1028-- TermsAgg (TermsAggregation {term = Left "user", termInclude = Nothing, termExclude = Nothing, termOrder = Nothing, termMinDocCount = Nothing, termSize = Nothing, termShardSize = Nothing, termCollectMode = Just BreadthFirst, termExecutionHint = Nothing, termAggs = Nothing})
1146-- TermsAgg (TermsAggregation {term = Left "user", termInclude = Nothing, termExclude = Nothing, termOrder = Nothing, termMinDocCount = Nothing, termSize = Nothing, termShardSize = Nothing, termCollectMode = Just BreadthFirst, termExecutionHint = Nothing, termAggs = Nothing})
1029-- >>> let myAggregation = mkAggregateSearch Nothing $ mkAggregations "users" terms
1147-- >>> let myAggregation = mkAggregateSearch Nothing $ mkAggregations "users" terms
1030mkAggregateSearch :: Maybe Query -> Aggregations -> Search
1148mkAggregateSearch :: Maybe Query -> Aggregations -> Search
1031−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
1032
1150
1033-- | 'mkHighlightSearch' is a helper function that defaults everything in a 'Search' except for
1151-- | 'mkHighlightSearch' is a helper function that defaults everything in a 'Search' except for
1034-- the 'Query' and the 'Aggregation'.
1152-- the 'Query' and the 'Aggregation'.
@@ -1037,7 +1155,7 @@ mkAggregateSearch query mkSearchAggs = Search query Nothing Nothing (Just mkSear
1037-- >>> let testHighlight = Highlights Nothing [FieldHighlight (FieldName "message") Nothing]
1155-- >>> let testHighlight = Highlights Nothing [FieldHighlight (FieldName "message") Nothing]
1038-- >>> let search = mkHighlightSearch (Just query) testHighlight
1156-- >>> let search = mkHighlightSearch (Just query) testHighlight
1039mkHighlightSearch :: Maybe Query -> Highlights -> Search
1157mkHighlightSearch :: Maybe Query -> Highlights -> Search
1040−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
1041
1159
1042-- | 'pageSearch' is a helper function that takes a search and assigns the from
1160-- | 'pageSearch' is a helper function that takes a search and assigns the from
1043-- and size fields for the search. The from parameter defines the offset
1161-- and size fields for the search. The from parameter defines the offset
src/Database/Bloodhound/Common/Script.hsnew file+220
@@ -0,0 +1,220 @@
1+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
2+{-# LANGUAGE OverloadedStrings #-}
3+
4+module Database.Bloodhound.Common.Script where
5+
6+import Bloodhound.Import
7+
8+import qualified Data.HashMap.Strict as HM
9+
10+import Database.Bloodhound.Internal.Newtypes
11+
12+newtype ScriptFields =
13+ ScriptFields (HM.HashMap ScriptFieldName ScriptFieldValue)
14+ deriving (Eq, Show)
15+
16+type ScriptFieldName = Text
17+type ScriptFieldValue = Value
18+
19+data Script =
20+ Script { scriptLanguage :: Maybe ScriptLanguage
21+ , scriptInline :: Maybe ScriptInline
22+ , scriptStored :: Maybe ScriptId
23+ , scriptParams :: Maybe ScriptParams
24+ } deriving (Eq, Show)
25+
26+newtype ScriptLanguage =
27+ ScriptLanguage Text deriving (Eq, Show, FromJSON, ToJSON)
28+
29+newtype ScriptInline =
30+ ScriptInline Text deriving (Eq, Show, FromJSON, ToJSON)
31+
32+newtype ScriptId =
33+ ScriptId Text deriving (Eq, Show, FromJSON, ToJSON)
34+
35+newtype ScriptParams =
36+ ScriptParams (HM.HashMap ScriptParamName ScriptParamValue)
37+ deriving (Eq, Show)
38+
39+type ScriptParamName = Text
40+type ScriptParamValue = Value
41+
42+data BoostMode =
43+ BoostModeMultiply
44+ | BoostModeReplace
45+ | BoostModeSum
46+ | BoostModeAvg
47+ | BoostModeMax
48+ | BoostModeMin deriving (Eq, Show)
49+
50+data ScoreMode =
51+ ScoreModeMultiply
52+ | ScoreModeSum
53+ | ScoreModeAvg
54+ | ScoreModeFirst
55+ | ScoreModeMax
56+ | ScoreModeMin deriving (Eq, Show)
57+
58+data FunctionScoreFunction =
59+ FunctionScoreFunctionScript Script
60+ | FunctionScoreFunctionRandom Seed
61+ | FunctionScoreFunctionFieldValueFactor FieldValueFactor
62+ deriving (Eq, Show)
63+
64+newtype Weight =
65+ Weight Float deriving (Eq, Show, FromJSON, ToJSON)
66+
67+newtype Seed =
68+ Seed Float deriving (Eq, Show, FromJSON, ToJSON)
69+
70+data FieldValueFactor =
71+ FieldValueFactor { fieldValueFactorField :: FieldName
72+ , fieldValueFactor :: Maybe Factor
73+ , fieldValueFactorModifier :: Maybe FactorModifier
74+ , fieldValueFactorMissing :: Maybe FactorMissingFieldValue
75+ } deriving (Eq, Show)
76+
77+newtype Factor =
78+ Factor Float deriving (Eq, Show, FromJSON, ToJSON)
79+
80+data FactorModifier =
81+ FactorModifierNone
82+ | FactorModifierLog
83+ | FactorModifierLog1p
84+ | FactorModifierLog2p
85+ | FactorModifierLn
86+ | FactorModifierLn1p
87+ | FactorModifierLn2p
88+ | FactorModifierSquare
89+ | FactorModifierSqrt
90+ | FactorModifierReciprocal deriving (Eq, Show)
91+
92+newtype FactorMissingFieldValue =
93+ FactorMissingFieldValue Float deriving (Eq, Show, FromJSON, ToJSON)
94+
95+instance ToJSON BoostMode where
96+ toJSON BoostModeMultiply = "multiply"
97+ toJSON BoostModeReplace = "replace"
98+ toJSON BoostModeSum = "sum"
99+ toJSON BoostModeAvg = "avg"
100+ toJSON BoostModeMax = "max"
101+ toJSON BoostModeMin = "min"
102+
103+instance FromJSON BoostMode where
104+ parseJSON = withText "BoostMode" parse
105+ where parse "multiply" = pure BoostModeMultiply
106+ parse "replace" = pure BoostModeReplace
107+ parse "sum" = pure BoostModeSum
108+ parse "avg" = pure BoostModeAvg
109+ parse "max" = pure BoostModeMax
110+ parse "min" = pure BoostModeMin
111+ parse bm = fail ("Unexpected BoostMode: " <> show bm)
112+
113+instance ToJSON ScoreMode where
114+ toJSON ScoreModeMultiply = "multiply"
115+ toJSON ScoreModeSum = "sum"
116+ toJSON ScoreModeFirst = "first"
117+ toJSON ScoreModeAvg = "avg"
118+ toJSON ScoreModeMax = "max"
119+ toJSON ScoreModeMin = "min"
120+
121+instance FromJSON ScoreMode where
122+ parseJSON = withText "ScoreMode" parse
123+ where parse "multiply" = pure ScoreModeMultiply
124+ parse "sum" = pure ScoreModeSum
125+ parse "first" = pure ScoreModeFirst
126+ parse "avg" = pure ScoreModeAvg
127+ parse "max" = pure ScoreModeMax
128+ parse "min" = pure ScoreModeMin
129+ parse sm = fail ("Unexpected ScoreMode: " <> show sm)
130+
131+functionScoreFunctionPair :: FunctionScoreFunction -> (Text, Value)
132+functionScoreFunctionPair (FunctionScoreFunctionScript functionScoreScript) =
133+ ("script_score", toJSON functionScoreScript)
134+functionScoreFunctionPair (FunctionScoreFunctionRandom seed) =
135+ ("random_score", omitNulls [ "seed" .= seed ])
136+functionScoreFunctionPair (FunctionScoreFunctionFieldValueFactor fvf) =
137+ ("field_value_factor", toJSON fvf)
138+
139+parseFunctionScoreFunction :: Object -> Parser FunctionScoreFunction
140+parseFunctionScoreFunction o =
141+ singleScript `taggedWith` "script_score"
142+ <|> singleRandom `taggedWith` "random_score"
143+ <|> singleFieldValueFactor `taggedWith` "field_value_factor"
144+ where taggedWith parser k = parser =<< o .: k
145+ singleScript = pure . FunctionScoreFunctionScript
146+ singleRandom o' = FunctionScoreFunctionRandom <$> o' .: "seed"
147+ singleFieldValueFactor = pure . FunctionScoreFunctionFieldValueFactor
148+
149+instance ToJSON ScriptFields where
150+ toJSON (ScriptFields x) = Object x
151+
152+instance FromJSON ScriptFields where
153+ parseJSON (Object o) = pure (ScriptFields o)
154+ parseJSON _ = fail "error parsing ScriptFields"
155+
156+instance ToJSON Script where
157+ toJSON (Script lang inline stored params) =
158+ object [ "script" .= omitNulls base ]
159+ where base = [ "lang" .= lang
160+ , "inline" .= inline
161+ , "stored" .= stored
162+ , "params" .= params ]
163+
164+instance FromJSON Script where
165+ parseJSON = withObject "Script" parse
166+ where parse o = o .: "script" >>= \o' ->
167+ Script
168+ <$> o' .:? "lang"
169+ <*> o' .:? "inline"
170+ <*> o' .:? "stored"
171+ <*> o' .:? "params"
172+
173+instance ToJSON ScriptParams where
174+ toJSON (ScriptParams x) = Object x
175+
176+instance FromJSON ScriptParams where
177+ parseJSON (Object o) = pure (ScriptParams o)
178+ parseJSON _ = fail "error parsing ScriptParams"
179+
180+instance ToJSON FieldValueFactor where
181+ toJSON (FieldValueFactor field factor modifier missing) =
182+ omitNulls base
183+ where base = [ "field" .= field
184+ , "factor" .= factor
185+ , "modifier" .= modifier
186+ , "missing" .= missing ]
187+
188+instance FromJSON FieldValueFactor where
189+ parseJSON = withObject "FieldValueFactor" parse
190+ where parse o = FieldValueFactor
191+ <$> o .: "field"
192+ <*> o .:? "factor"
193+ <*> o .:? "modifier"
194+ <*> o .:? "missing"
195+
196+instance ToJSON FactorModifier where
197+ toJSON FactorModifierNone = "none"
198+ toJSON FactorModifierLog = "log"
199+ toJSON FactorModifierLog1p = "log1p"
200+ toJSON FactorModifierLog2p = "log2p"
201+ toJSON FactorModifierLn = "ln"
202+ toJSON FactorModifierLn1p = "ln1p"
203+ toJSON FactorModifierLn2p = "ln2p"
204+ toJSON FactorModifierSquare = "square"
205+ toJSON FactorModifierSqrt = "sqrt"
206+ toJSON FactorModifierReciprocal = "reciprocal"
207+
208+instance FromJSON FactorModifier where
209+ parseJSON = withText "FactorModifier" parse
210+ where parse "none" = pure FactorModifierNone
211+ parse "log" = pure FactorModifierLog
212+ parse "log1p" = pure FactorModifierLog1p
213+ parse "log2p" = pure FactorModifierLog2p
214+ parse "ln" = pure FactorModifierLn
215+ parse "ln1p" = pure FactorModifierLn1p
216+ parse "ln2p" = pure FactorModifierLn2p
217+ parse "square" = pure FactorModifierSquare
218+ parse "sqrt" = pure FactorModifierSqrt
219+ parse "reciprocal" = pure FactorModifierReciprocal
220+ parse fm = fail ("Unexpected FactorModifier: " <> show fm)
src/Database/Bloodhound/Internal/Aggregation.hsnew file+479
@@ -0,0 +1,479 @@
1+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
2+{-# LANGUAGE OverloadedStrings #-}
3+{-# LANGUAGE RecordWildCards #-}
4+
5+module Database.Bloodhound.Internal.Aggregation where
6+
7+import Bloodhound.Import
8+
9+import qualified Data.Aeson as Aeson
10+import qualified Data.HashMap.Strict as HM
11+import qualified Data.Map.Strict as M
12+import qualified Data.Text as T
13+
14+import Database.Bloodhound.Internal.Client
15+import Database.Bloodhound.Internal.Highlight (HitHighlight)
16+import Database.Bloodhound.Internal.Newtypes
17+import Database.Bloodhound.Internal.Query
18+import Database.Bloodhound.Internal.Sort
19+
20+type Aggregations = M.Map Text Aggregation
21+
22+emptyAggregations :: Aggregations
23+emptyAggregations = M.empty
24+
25+mkAggregations :: Text -> Aggregation -> Aggregations
26+mkAggregations name aggregation = M.insert name aggregation emptyAggregations
27+
28+data Aggregation = TermsAgg TermsAggregation
29+ | CardinalityAgg CardinalityAggregation
30+ | MaxAgg MaxAggregation
31+ | DateHistogramAgg DateHistogramAggregation
32+ | ValueCountAgg ValueCountAggregation
33+ | FilterAgg FilterAggregation
34+ | DateRangeAgg DateRangeAggregation
35+ | MissingAgg MissingAggregation
36+ | TopHitsAgg TopHitsAggregation
37+ | StatsAgg StatisticsAggregation
38+ deriving (Eq, Show)
39+
40+instance ToJSON Aggregation where
41+ toJSON (TermsAgg (TermsAggregation term include exclude order minDocCount size shardSize collectMode executionHint termAggs)) =
42+ omitNulls ["terms" .= omitNulls [ toJSON' term,
43+ "include" .= include,
44+ "exclude" .= exclude,
45+ "order" .= order,
46+ "min_doc_count" .= minDocCount,
47+ "size" .= size,
48+ "shard_size" .= shardSize,
49+ "collect_mode" .= collectMode,
50+ "execution_hint" .= executionHint
51+ ],
52+ "aggs" .= termAggs ]
53+ where
54+ toJSON' x = case x of { Left y -> "field" .= y; Right y -> "script" .= y }
55+
56+ toJSON (CardinalityAgg (CardinalityAggregation field precisionThreshold)) =
57+ object ["cardinality" .= omitNulls [ "field" .= field,
58+ "precisionThreshold" .= precisionThreshold
59+ ]
60+ ]
61+
62+ toJSON (MaxAgg (MaxAggregation field)) =
63+ object ["max" .= omitNulls [ "field" .= field ]]
64+
65+ toJSON (DateHistogramAgg
66+ (DateHistogramAggregation field interval format
67+ preZone postZone preOffset postOffset dateHistoAggs)) =
68+ omitNulls ["date_histogram" .= omitNulls [ "field" .= field,
69+ "interval" .= interval,
70+ "format" .= format,
71+ "pre_zone" .= preZone,
72+ "post_zone" .= postZone,
73+ "pre_offset" .= preOffset,
74+ "post_offset" .= postOffset
75+ ],
76+ "aggs" .= dateHistoAggs ]
77+ toJSON (ValueCountAgg a) = object ["value_count" .= v]
78+ where v = case a of
79+ (FieldValueCount (FieldName n)) ->
80+ object ["field" .= n]
81+ (ScriptValueCount s) ->
82+ object ["script" .= s]
83+ toJSON (FilterAgg (FilterAggregation filt ags)) =
84+ omitNulls [ "filter" .= filt
85+ , "aggs" .= ags]
86+ toJSON (DateRangeAgg a) = object [ "date_range" .= a
87+ ]
88+ toJSON (MissingAgg (MissingAggregation{..})) =
89+ object ["missing" .= object ["field" .= maField]]
90+
91+ toJSON (TopHitsAgg (TopHitsAggregation mfrom msize msort)) =
92+ omitNulls ["top_hits" .= omitNulls [ "size" .= msize
93+ , "from" .= mfrom
94+ , "sort" .= msort
95+ ]
96+ ]
97+
98+ toJSON (StatsAgg (StatisticsAggregation typ field)) =
99+ object [stType .= omitNulls [ "field" .= field ]]
100+ where
101+ stType | typ == Basic = "stats"
102+ | otherwise = "extended_stats"
103+
104+data TopHitsAggregation = TopHitsAggregation
105+ { taFrom :: Maybe From
106+ , taSize :: Maybe Size
107+ , taSort :: Maybe Sort
108+ } deriving (Eq, Show)
109+
110+data MissingAggregation = MissingAggregation
111+ { maField :: Text
112+ } deriving (Eq, Show)
113+
114+data TermsAggregation = TermsAggregation
115+ { term :: Either Text Text
116+ , termInclude :: Maybe TermInclusion
117+ , termExclude :: Maybe TermInclusion
118+ , termOrder :: Maybe TermOrder
119+ , termMinDocCount :: Maybe Int
120+ , termSize :: Maybe Int
121+ , termShardSize :: Maybe Int
122+ , termCollectMode :: Maybe CollectionMode
123+ , termExecutionHint :: Maybe ExecutionHint
124+ , termAggs :: Maybe Aggregations
125+ } deriving (Eq, Show)
126+
127+data CardinalityAggregation = CardinalityAggregation
128+ { cardinalityField :: FieldName,
129+ precisionThreshold :: Maybe Int
130+ } deriving (Eq, Show)
131+
132+data MaxAggregation = MaxAggregation
133+ { maxField :: FieldName
134+ } deriving (Eq, Show)
135+
136+data DateHistogramAggregation = DateHistogramAggregation
137+ { dateField :: FieldName
138+ , dateInterval :: Interval
139+ , dateFormat :: Maybe Text
140+ -- pre and post deprecated in 1.5
141+ , datePreZone :: Maybe Text
142+ , datePostZone :: Maybe Text
143+ , datePreOffset :: Maybe Text
144+ , datePostOffset :: Maybe Text
145+ , dateAggs :: Maybe Aggregations
146+ } deriving (Eq, Show)
147+
148+data DateRangeAggregation = DateRangeAggregation
149+ { draField :: FieldName
150+ , draFormat :: Maybe Text
151+ , draRanges :: NonEmpty DateRangeAggRange
152+ } deriving (Eq, Show)
153+
154+instance ToJSON DateRangeAggregation where
155+ toJSON DateRangeAggregation {..} =
156+ omitNulls [ "field" .= draField
157+ , "format" .= draFormat
158+ , "ranges" .= toList draRanges
159+ ]
160+
161+data DateRangeAggRange =
162+ DateRangeFrom DateMathExpr
163+ | DateRangeTo DateMathExpr
164+ | DateRangeFromAndTo DateMathExpr DateMathExpr
165+ deriving (Eq, Show)
166+
167+instance ToJSON DateRangeAggRange where
168+ toJSON (DateRangeFrom e) = object [ "from" .= e ]
169+ toJSON (DateRangeTo e) = object [ "to" .= e ]
170+ toJSON (DateRangeFromAndTo f t) = object [ "from" .= f, "to" .= t ]
171+
172+-- | See <https://www.elastic.co/guide/en/elasticsearch/reference/current/search-aggregations-metrics-valuecount-aggregation.html> for more information.
173+data ValueCountAggregation =
174+ FieldValueCount FieldName
175+ | ScriptValueCount Script
176+ deriving (Eq, Show)
177+
178+-- | Single-bucket filter aggregations. See <https://www.elastic.co/guide/en/elasticsearch/reference/current/search-aggregations-bucket-filter-aggregation.html#search-aggregations-bucket-filter-aggregation> for more information.
179+data FilterAggregation = FilterAggregation
180+ { faFilter :: Filter
181+ , faAggs :: Maybe Aggregations }
182+ deriving (Eq, Show)
183+
184+data StatisticsAggregation = StatisticsAggregation
185+ { statsType :: StatsType
186+ , statsField :: FieldName }
187+ deriving (Eq, Show)
188+
189+data StatsType
190+ = Basic
191+ | Extended
192+ deriving (Eq, Show)
193+
194+mkTermsAggregation :: Text -> TermsAggregation
195+mkTermsAggregation t =
196+ TermsAggregation (Left t)
197+ Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing
198+
199+mkTermsScriptAggregation :: Text -> TermsAggregation
200+mkTermsScriptAggregation t = TermsAggregation (Right t) Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing
201+
202+mkDateHistogram :: FieldName -> Interval -> DateHistogramAggregation
203+mkDateHistogram t i = DateHistogramAggregation t i Nothing Nothing Nothing Nothing Nothing Nothing
204+
205+mkCardinalityAggregation :: FieldName -> CardinalityAggregation
206+mkCardinalityAggregation t = CardinalityAggregation t Nothing
207+
208+mkStatsAggregation :: FieldName -> StatisticsAggregation
209+mkStatsAggregation = StatisticsAggregation Basic
210+
211+mkExtendedStatsAggregation :: FieldName -> StatisticsAggregation
212+mkExtendedStatsAggregation = StatisticsAggregation Extended
213+
214+type AggregationResults = M.Map Text Value
215+
216+class BucketAggregation a where
217+ key :: a -> BucketValue
218+ docCount :: a -> Int
219+ aggs :: a -> Maybe AggregationResults
220+
221+data Bucket a = Bucket
222+ { buckets :: [a]
223+ } deriving (Read, Show)
224+
225+instance (FromJSON a) => FromJSON (Bucket a) where
226+ parseJSON (Object v) = Bucket <$>
227+ v .: "buckets"
228+ parseJSON _ = mempty
229+
230+data BucketValue = TextValue Text
231+ | ScientificValue Scientific
232+ | BoolValue Bool deriving (Read, Show)
233+
234+instance FromJSON BucketValue where
235+ parseJSON (String t) = return $ TextValue t
236+ parseJSON (Number s) = return $ ScientificValue s
237+ parseJSON (Bool b) = return $ BoolValue b
238+ parseJSON _ = mempty
239+
240+data TermInclusion = TermInclusion Text
241+ | TermPattern Text Text deriving (Eq, Show)
242+
243+instance ToJSON TermInclusion where
244+ toJSON (TermInclusion x) = toJSON x
245+ toJSON (TermPattern pattern flags) =
246+ omitNulls [ "pattern" .= pattern
247+ , "flags" .= flags]
248+
249+data TermOrder = TermOrder
250+ { termSortField :: Text
251+ , termSortOrder :: SortOrder } deriving (Eq, Show)
252+
253+instance ToJSON TermOrder where
254+ toJSON (TermOrder termSortField termSortOrder) =
255+ object [termSortField .= termSortOrder]
256+
257+data CollectionMode = BreadthFirst
258+ | DepthFirst deriving (Eq, Show)
259+
260+instance ToJSON CollectionMode where
261+ toJSON BreadthFirst = "breadth_first"
262+ toJSON DepthFirst = "depth_first"
263+
264+data ExecutionHint = Ordinals
265+ | GlobalOrdinals
266+ | GlobalOrdinalsHash
267+ | GlobalOrdinalsLowCardinality
268+ | Map deriving (Eq, Show)
269+
270+instance ToJSON ExecutionHint where
271+ toJSON Ordinals = "ordinals"
272+ toJSON GlobalOrdinals = "global_ordinals"
273+ toJSON GlobalOrdinalsHash = "global_ordinals_hash"
274+ toJSON GlobalOrdinalsLowCardinality = "global_ordinals_low_cardinality"
275+ toJSON Map = "map"
276+
277+-- | See <https://www.elastic.co/guide/en/elasticsearch/reference/current/common-options.html#date-math> for more information.
278+data DateMathExpr =
279+ DateMathExpr DateMathAnchor [DateMathModifier]
280+ deriving (Eq, Show)
281+
282+instance ToJSON DateMathExpr where
283+ toJSON (DateMathExpr a mods) = String (fmtA a <> mconcat (fmtMod <$> mods))
284+ where fmtA DMNow = "now"
285+ fmtA (DMDate date) = (T.pack $ showGregorian date) <> "||"
286+ fmtMod (AddTime n u) = "+" <> showText n <> fmtU u
287+ fmtMod (SubtractTime n u) = "-" <> showText n <> fmtU u
288+ fmtMod (RoundDownTo u) = "/" <> fmtU u
289+ fmtU DMYear = "y"
290+ fmtU DMMonth = "M"
291+ fmtU DMWeek = "w"
292+ fmtU DMDay = "d"
293+ fmtU DMHour = "h"
294+ fmtU DMMinute = "m"
295+ fmtU DMSecond = "s"
296+
297+-- | Starting point for a date range. This along with the 'DateMathModifiers' gets you the date ES will start from.
298+data DateMathAnchor =
299+ DMNow
300+ | DMDate Day
301+ deriving (Eq, Show)
302+
303+data DateMathModifier =
304+ AddTime Int DateMathUnit
305+ | SubtractTime Int DateMathUnit
306+ | RoundDownTo DateMathUnit
307+ deriving (Eq, Show)
308+
309+data DateMathUnit =
310+ DMYear
311+ | DMMonth
312+ | DMWeek
313+ | DMDay
314+ | DMHour
315+ | DMMinute
316+ | DMSecond
317+ deriving (Eq, Show)
318+
319+data TermsResult = TermsResult
320+ { termKey :: BucketValue
321+ , termsDocCount :: Int
322+ , termsAggs :: Maybe AggregationResults
323+ } deriving (Read, Show)
324+
325+instance FromJSON TermsResult where
326+ parseJSON (Object v) = TermsResult <$>
327+ v .: "key" <*>
328+ v .: "doc_count" <*>
329+ (pure $ getNamedSubAgg v ["key", "doc_count"])
330+ parseJSON _ = mempty
331+
332+instance BucketAggregation TermsResult where
333+ key = termKey
334+ docCount = termsDocCount
335+ aggs = termsAggs
336+
337+data DateHistogramResult = DateHistogramResult
338+ { dateKey :: Int
339+ , dateKeyStr :: Maybe Text
340+ , dateDocCount :: Int
341+ , dateHistogramAggs :: Maybe AggregationResults
342+ } deriving (Show)
343+
344+instance FromJSON DateHistogramResult where
345+ parseJSON (Object v) = DateHistogramResult <$>
346+ v .: "key" <*>
347+ v .:? "key_as_string" <*>
348+ v .: "doc_count" <*>
349+ (pure $ getNamedSubAgg v [ "key"
350+ , "doc_count"
351+ , "key_as_string"
352+ ]
353+ )
354+ parseJSON _ = mempty
355+
356+instance BucketAggregation DateHistogramResult where
357+ key = TextValue . showText . dateKey
358+ docCount = dateDocCount
359+ aggs = dateHistogramAggs
360+
361+data DateRangeResult = DateRangeResult
362+ { dateRangeKey :: Text
363+ , dateRangeFrom :: Maybe UTCTime
364+ , dateRangeFromAsString :: Maybe Text
365+ , dateRangeTo :: Maybe UTCTime
366+ , dateRangeToAsString :: Maybe Text
367+ , dateRangeDocCount :: Int
368+ , dateRangeAggs :: Maybe AggregationResults
369+ } deriving (Eq, Show)
370+
371+instance FromJSON DateRangeResult where
372+ parseJSON = withObject "DateRangeResult" parse
373+ where parse v = DateRangeResult <$>
374+ v .: "key" <*>
375+ (fmap posixMS <$> v .:? "from") <*>
376+ v .:? "from_as_string" <*>
377+ (fmap posixMS <$> v .:? "to") <*>
378+ v .:? "to_as_string" <*>
379+ v .: "doc_count" <*>
380+ (pure $ getNamedSubAgg v [ "key"
381+ , "from"
382+ , "from_as_string"
383+ , "to"
384+ , "to_as_string"
385+ , "doc_count"
386+ ]
387+ )
388+
389+instance BucketAggregation DateRangeResult where
390+ key = TextValue . dateRangeKey
391+ docCount = dateRangeDocCount
392+ aggs = dateRangeAggs
393+
394+toTerms :: Text -> AggregationResults -> Maybe (Bucket TermsResult)
395+toTerms = toAggResult
396+
397+toDateHistogram :: Text -> AggregationResults -> Maybe (Bucket DateHistogramResult)
398+toDateHistogram = toAggResult
399+
400+toMissing :: Text -> AggregationResults -> Maybe MissingResult
401+toMissing = toAggResult
402+
403+toTopHits :: (FromJSON a) => Text -> AggregationResults -> Maybe (TopHitResult a)
404+toTopHits = toAggResult
405+
406+toAggResult :: (FromJSON a) => Text -> AggregationResults -> Maybe a
407+toAggResult t a = M.lookup t a >>= deserialize
408+ where deserialize = parseMaybe parseJSON
409+
410+-- Try to get an AggregationResults when we don't know the
411+-- field name. We filter out the known keys to try to minimize the noise.
412+getNamedSubAgg :: Object -> [Text] -> Maybe AggregationResults
413+getNamedSubAgg o knownKeys = maggRes
414+ where unknownKeys = HM.filterWithKey (\k _ -> k `notElem` knownKeys) o
415+ maggRes
416+ | HM.null unknownKeys = Nothing
417+ | otherwise = Just . M.fromList $ HM.toList unknownKeys
418+
419+data MissingResult = MissingResult
420+ { missingDocCount :: Int
421+ } deriving (Show)
422+
423+instance FromJSON MissingResult where
424+ parseJSON = withObject "MissingResult" parse
425+ where parse v = MissingResult <$> v .: "doc_count"
426+
427+data TopHitResult a = TopHitResult
428+ { tarHits :: (SearchHits a)
429+ } deriving Show
430+
431+instance (FromJSON a) => FromJSON (TopHitResult a) where
432+ parseJSON (Object v) = TopHitResult <$>
433+ v .: "hits"
434+ parseJSON _ = fail "Failure in FromJSON (TopHitResult a)"
435+
436+data SearchHits a =
437+ SearchHits { hitsTotal :: Int
438+ , maxScore :: Score
439+ , hits :: [Hit a] } deriving (Eq, Show)
440+
441+
442+instance (FromJSON a) => FromJSON (SearchHits a) where
443+ parseJSON (Object v) = SearchHits <$>
444+ v .: "total" <*>
445+ v .: "max_score" <*>
446+ v .: "hits"
447+ parseJSON _ = empty
448+
449+instance Semigroup (SearchHits a) where
450+ (SearchHits ta ma ha) <> (SearchHits tb mb hb) =
451+ SearchHits (ta + tb) (max ma mb) (ha <> hb)
452+
453+instance Monoid (SearchHits a) where
454+ mempty = SearchHits 0 Nothing mempty
455+ mappend = (<>)
456+
457+type SearchAfterKey = [Aeson.Value]
458+
459+data Hit a =
460+ Hit { hitIndex :: IndexName
461+ , hitType :: MappingName
462+ , hitDocId :: DocId
463+ , hitScore :: Score
464+ , hitSource :: Maybe a
465+ , hitSort :: Maybe SearchAfterKey
466+ , hitFields :: Maybe HitFields
467+ , hitHighlight :: Maybe HitHighlight } deriving (Eq, Show)
468+
469+instance (FromJSON a) => FromJSON (Hit a) where
470+ parseJSON (Object v) = Hit <$>
471+ v .: "_index" <*>
472+ v .: "_type" <*>
473+ v .: "_id" <*>
474+ v .: "_score" <*>
475+ v .:? "_source" <*>
476+ v .:? "sort" <*>
477+ v .:? "fields" <*>
478+ v .:? "highlight"
479+ parseJSON _ = empty
src/Database/Bloodhound/Internal/Analysis.hsnew file+379
@@ -0,0 +1,379 @@
1+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
2+{-# LANGUAGE OverloadedStrings #-}
3+
4+module Database.Bloodhound.Internal.Analysis where
5+
6+import Bloodhound.Import
7+
8+import qualified Data.Map.Strict as M
9+import qualified Data.Text as T
10+
11+import Database.Bloodhound.Internal.Newtypes
12+import Database.Bloodhound.Internal.StringlyTyped
13+
14+data Analysis = Analysis
15+ { analysisAnalyzer :: M.Map Text AnalyzerDefinition
16+ , analysisTokenizer :: M.Map Text TokenizerDefinition
17+ , analysisTokenFilter :: M.Map Text TokenFilterDefinition
18+ , analysisCharFilter :: M.Map Text CharFilterDefinition
19+ } deriving (Eq, Show)
20+
21+instance ToJSON Analysis where
22+ toJSON (Analysis analyzer tokenizer tokenFilter charFilter) = object
23+ [ "analyzer" .= analyzer
24+ , "tokenizer" .= tokenizer
25+ , "filter" .= tokenFilter
26+ , "char_filter" .= charFilter
27+ ]
28+
29+instance FromJSON Analysis where
30+ parseJSON = withObject "Analysis" $ \m -> Analysis
31+ <$> m .: "analyzer"
32+ <*> m .:? "tokenizer" .!= M.empty
33+ <*> m .:? "filter" .!= M.empty
34+ <*> m .:? "char_filter" .!= M.empty
35+
36+newtype Tokenizer =
37+ Tokenizer Text
38+ deriving (Eq, Show, ToJSON, FromJSON)
39+
40+data AnalyzerDefinition = AnalyzerDefinition
41+ { analyzerDefinitionTokenizer :: Maybe Tokenizer
42+ , analyzerDefinitionFilter :: [TokenFilter]
43+ , analyzerDefinitionCharFilter :: [CharFilter]
44+ } deriving (Eq,Show)
45+
46+instance ToJSON AnalyzerDefinition where
47+ toJSON (AnalyzerDefinition tokenizer tokenFilter charFilter) =
48+ object $ catMaybes
49+ [ fmap ("tokenizer" .=) tokenizer
50+ , Just $ "filter" .= tokenFilter
51+ , Just $ "char_filter" .= charFilter
52+ ]
53+
54+instance FromJSON AnalyzerDefinition where
55+ parseJSON = withObject "AnalyzerDefinition" $ \m -> AnalyzerDefinition
56+ <$> m .:? "tokenizer"
57+ <*> m .:? "filter" .!= []
58+ <*> m .:? "char_filter" .!= []
59+
60+-- | Character filters are used to preprocess the stream of characters
61+-- before it is passed to the tokenizer.
62+data CharFilterDefinition
63+ = CharFilterDefinitionMapping (M.Map Text Text)
64+ | CharFilterDefinitionPatternReplace
65+ { charFilterDefinitionPatternReplacePattern :: Text
66+ , charFilterDefinitionPatternReplaceReplacement :: Text
67+ , charFilterDefinitionPatternReplaceFlags :: Maybe Text
68+ }
69+ deriving (Eq, Show)
70+
71+instance ToJSON CharFilterDefinition where
72+ toJSON (CharFilterDefinitionMapping ms) = object
73+ [ "type" .= ("mapping" :: Text)
74+ , "mappings" .= [a <> " => " <> b | (a, b) <- M.toList ms] ]
75+ toJSON (CharFilterDefinitionPatternReplace pat repl flags) = object $
76+ [ "type" .= ("pattern_replace" :: Text)
77+ , "pattern" .= pat
78+ , "replacement" .= repl
79+ ] ++ maybe [] (\f -> ["flags" .= f]) flags
80+
81+instance FromJSON CharFilterDefinition where
82+ parseJSON = withObject "CharFilterDefinition" $ \m -> do
83+ t <- m .: "type"
84+ case (t :: Text) of
85+ "mapping" -> CharFilterDefinitionMapping . M.fromList <$> ms
86+ where
87+ ms = m .: "mappings" >>= mapM parseMapping
88+ parseMapping kv = case T.splitOn "=>" kv of
89+ (k:vs) -> pure (T.strip k, T.strip $ T.concat vs)
90+ _ -> fail "mapping is not of the format key => value"
91+ "pattern_replace" -> CharFilterDefinitionPatternReplace
92+ <$> m .: "pattern" <*> m .: "replacement" <*> m .:? "flags"
93+ _ -> fail ("unrecognized character filter type: " ++ T.unpack t)
94+
95+newtype TokenizerDefinition =
96+ TokenizerDefinitionNgram Ngram
97+ deriving (Eq,Show)
98+
99+instance ToJSON TokenizerDefinition where
100+ toJSON x = case x of
101+ TokenizerDefinitionNgram (Ngram minGram maxGram tokenChars) -> object
102+ [ "type" .= ("ngram" :: Text)
103+ , "min_gram" .= minGram
104+ , "max_gram" .= maxGram
105+ , "token_chars" .= tokenChars
106+ ]
107+
108+instance FromJSON TokenizerDefinition where
109+ parseJSON = withObject "TokenizerDefinition" $ \m -> do
110+ typ <- m .: "type" :: Parser Text
111+ case typ of
112+ "ngram" -> fmap TokenizerDefinitionNgram $ Ngram
113+ <$> fmap unStringlyTypedInt (m .: "min_gram")
114+ <*> fmap unStringlyTypedInt (m .: "max_gram")
115+ <*> m .: "token_chars"
116+ _ -> fail "invalid TokenizerDefinition"
117+
118+data Ngram = Ngram
119+ { ngramMinGram :: Int
120+ , ngramMaxGram :: Int
121+ , ngramTokenChars :: [TokenChar]
122+ } deriving (Eq,Show)
123+
124+data TokenChar =
125+ TokenLetter
126+ | TokenDigit
127+ | TokenWhitespace
128+ | TokenPunctuation
129+ | TokenSymbol
130+ deriving (Eq,Show)
131+
132+instance ToJSON TokenChar where
133+ toJSON t = String $ case t of
134+ TokenLetter -> "letter"
135+ TokenDigit -> "digit"
136+ TokenWhitespace -> "whitespace"
137+ TokenPunctuation -> "punctuation"
138+ TokenSymbol -> "symbol"
139+
140+instance FromJSON TokenChar where
141+ parseJSON = withText "TokenChar" $ \t -> case t of
142+ "letter" -> return TokenLetter
143+ "digit" -> return TokenDigit
144+ "whitespace" -> return TokenWhitespace
145+ "punctuation" -> return TokenPunctuation
146+ "symbol" -> return TokenSymbol
147+ _ -> fail "invalid TokenChar"
148+
149+-- | Token filters are used to create custom analyzers.
150+data TokenFilterDefinition
151+ = TokenFilterDefinitionLowercase (Maybe Language)
152+ | TokenFilterDefinitionUppercase (Maybe Language)
153+ | TokenFilterDefinitionApostrophe
154+ | TokenFilterDefinitionReverse
155+ | TokenFilterDefinitionSnowball Language
156+ | TokenFilterDefinitionShingle Shingle
157+ | TokenFilterDefinitionStemmer Language
158+ | TokenFilterDefinitionStop (Either Language [StopWord])
159+ deriving (Eq, Show)
160+
161+instance ToJSON TokenFilterDefinition where
162+ toJSON x = case x of
163+ TokenFilterDefinitionLowercase mlang -> object $ catMaybes
164+ [ Just $ "type" .= ("lowercase" :: Text)
165+ , fmap (\lang -> "language" .= languageToText lang) mlang
166+ ]
167+ TokenFilterDefinitionUppercase mlang -> object $ catMaybes
168+ [ Just $ "type" .= ("uppercase" :: Text)
169+ , fmap (\lang -> "language" .= languageToText lang) mlang
170+ ]
171+ TokenFilterDefinitionApostrophe -> object
172+ [ "type" .= ("apostrophe" :: Text)
173+ ]
174+ TokenFilterDefinitionReverse -> object
175+ [ "type" .= ("reverse" :: Text)
176+ ]
177+ TokenFilterDefinitionSnowball lang -> object
178+ [ "type" .= ("snowball" :: Text)
179+ , "language" .= languageToText lang
180+ ]
181+ TokenFilterDefinitionShingle s -> object
182+ [ "type" .= ("shingle" :: Text)
183+ , "max_shingle_size" .= shingleMaxSize s
184+ , "min_shingle_size" .= shingleMinSize s
185+ , "output_unigrams" .= shingleOutputUnigrams s
186+ , "output_unigrams_if_no_shingles" .= shingleOutputUnigramsIfNoShingles s
187+ , "token_separator" .= shingleTokenSeparator s
188+ , "filler_token" .= shingleFillerToken s
189+ ]
190+ TokenFilterDefinitionStemmer lang -> object
191+ [ "type" .= ("stemmer" :: Text)
192+ , "language" .= languageToText lang
193+ ]
194+ TokenFilterDefinitionStop stop -> object
195+ [ "type" .= ("stop" :: Text)
196+ , "stopwords" .= case stop of
197+ Left lang -> String $ "_" <> languageToText lang <> "_"
198+ Right stops -> toJSON stops
199+ ]
200+
201+instance FromJSON TokenFilterDefinition where
202+ parseJSON = withObject "TokenFilterDefinition" $ \m -> do
203+ t <- m .: "type"
204+ case (t :: Text) of
205+ "reverse" -> return TokenFilterDefinitionReverse
206+ "apostrophe" -> return TokenFilterDefinitionApostrophe
207+ "lowercase" -> TokenFilterDefinitionLowercase
208+ <$> m .:? "language"
209+ "uppercase" -> TokenFilterDefinitionUppercase
210+ <$> m .:? "language"
211+ "snowball" -> TokenFilterDefinitionSnowball
212+ <$> m .: "language"
213+ "shingle" -> fmap TokenFilterDefinitionShingle $ Shingle
214+ <$> (fmap.fmap) unStringlyTypedInt (m .:? "max_shingle_size") .!= 2
215+ <*> (fmap.fmap) unStringlyTypedInt (m .:? "min_shingle_size") .!= 2
216+ <*> (fmap.fmap) unStringlyTypedBool (m .:? "output_unigrams") .!= True
217+ <*> (fmap.fmap) unStringlyTypedBool (m .:? "output_unigrams_if_no_shingles") .!= False
218+ <*> m .:? "token_separator" .!= " "
219+ <*> m .:? "filler_token" .!= "_"
220+ "stemmer" -> TokenFilterDefinitionStemmer
221+ <$> m .: "language"
222+ "stop" -> do
223+ stop <- m .: "stopwords"
224+ stop' <- case stop of
225+ String lang ->
226+ fmap Left
227+ . parseJSON
228+ . String
229+ . T.drop 1
230+ . T.dropEnd 1 $ lang
231+ _ -> Right <$> parseJSON stop
232+ return (TokenFilterDefinitionStop stop')
233+ _ -> fail ("unrecognized token filter type: " ++ T.unpack t)
234+
235+-- | The set of languages that can be passed to various analyzers,
236+-- filters, etc. in Elasticsearch. Most data types in this module
237+-- that have a 'Language' field are actually only actually to
238+-- handle a subset of these languages. Consult the official
239+-- Elasticsearch documentation to see what is actually supported.
240+data Language
241+ = Arabic
242+ | Armenian
243+ | Basque
244+ | Bengali
245+ | Brazilian
246+ | Bulgarian
247+ | Catalan
248+ | Cjk
249+ | Czech
250+ | Danish
251+ | Dutch
252+ | English
253+ | Finnish
254+ | French
255+ | Galician
256+ | German
257+ | German2
258+ | Greek
259+ | Hindi
260+ | Hungarian
261+ | Indonesian
262+ | Irish
263+ | Italian
264+ | Kp
265+ | Latvian
266+ | Lithuanian
267+ | Lovins
268+ | Norwegian
269+ | Persian
270+ | Porter
271+ | Portuguese
272+ | Romanian
273+ | Russian
274+ | Sorani
275+ | Spanish
276+ | Swedish
277+ | Thai
278+ | Turkish
279+ deriving (Eq, Show)
280+
281+instance ToJSON Language where
282+ toJSON = String . languageToText
283+
284+instance FromJSON Language where
285+ parseJSON = withText "Language" $ \t -> case languageFromText t of
286+ Nothing -> fail "not a supported Elasticsearch language"
287+ Just lang -> return lang
288+
289+languageToText :: Language -> Text
290+languageToText x = case x of
291+ Arabic -> "arabic"
292+ Armenian -> "armenian"
293+ Basque -> "basque"
294+ Bengali -> "bengali"
295+ Brazilian -> "brazilian"
296+ Bulgarian -> "bulgarian"
297+ Catalan -> "catalan"
298+ Cjk -> "cjk"
299+ Czech -> "czech"
300+ Danish -> "danish"
301+ Dutch -> "dutch"
302+ English -> "english"
303+ Finnish -> "finnish"
304+ French -> "french"
305+ Galician -> "galician"
306+ German -> "german"
307+ German2 -> "german2"
308+ Greek -> "greek"
309+ Hindi -> "hindi"
310+ Hungarian -> "hungarian"
311+ Indonesian -> "indonesian"
312+ Irish -> "irish"
313+ Italian -> "italian"
314+ Kp -> "kp"
315+ Latvian -> "latvian"
316+ Lithuanian -> "lithuanian"
317+ Lovins -> "lovins"
318+ Norwegian -> "norwegian"
319+ Persian -> "persian"
320+ Porter -> "porter"
321+ Portuguese -> "portuguese"
322+ Romanian -> "romanian"
323+ Russian -> "russian"
324+ Sorani -> "sorani"
325+ Spanish -> "spanish"
326+ Swedish -> "swedish"
327+ Thai -> "thai"
328+ Turkish -> "turkish"
329+
330+languageFromText :: Text -> Maybe Language
331+languageFromText x = case x of
332+ "arabic" -> Just Arabic
333+ "armenian" -> Just Armenian
334+ "basque" -> Just Basque
335+ "bengali" -> Just Bengali
336+ "brazilian" -> Just Brazilian
337+ "bulgarian" -> Just Bulgarian
338+ "catalan" -> Just Catalan
339+ "cjk" -> Just Cjk
340+ "czech" -> Just Czech
341+ "danish" -> Just Danish
342+ "dutch" -> Just Dutch
343+ "english" -> Just English
344+ "finnish" -> Just Finnish
345+ "french" -> Just French
346+ "galician" -> Just Galician
347+ "german" -> Just German
348+ "german2" -> Just German2
349+ "greek" -> Just Greek
350+ "hindi" -> Just Hindi
351+ "hungarian" -> Just Hungarian
352+ "indonesian" -> Just Indonesian
353+ "irish" -> Just Irish
354+ "italian" -> Just Italian
355+ "kp" -> Just Kp
356+ "latvian" -> Just Latvian
357+ "lithuanian" -> Just Lithuanian
358+ "lovins" -> Just Lovins
359+ "norwegian" -> Just Norwegian
360+ "persian" -> Just Persian
361+ "porter" -> Just Porter
362+ "portuguese" -> Just Portuguese
363+ "romanian" -> Just Romanian
364+ "russian" -> Just Russian
365+ "sorani" -> Just Sorani
366+ "spanish" -> Just Spanish
367+ "swedish" -> Just Swedish
368+ "thai" -> Just Thai
369+ "turkish" -> Just Turkish
370+ _ -> Nothing
371+
372+data Shingle = Shingle
373+ { shingleMaxSize :: Int
374+ , shingleMinSize :: Int
375+ , shingleOutputUnigrams :: Bool
376+ , shingleOutputUnigramsIfNoShingles :: Bool
377+ , shingleTokenSeparator :: Text
378+ , shingleFillerToken :: Text
379+ } deriving (Eq, Show)
src/Database/Bloodhound/Internal/Client.hsnew file+2431
@@ -0,0 +1,2431 @@
1+{-# LANGUAGE CPP #-}
2+{-# LANGUAGE FlexibleInstances #-}
3+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
4+{-# LANGUAGE MultiParamTypeClasses #-}
5+{-# LANGUAGE OverloadedStrings #-}
6+{-# LANGUAGE RecordWildCards #-}
7+{-# LANGUAGE UndecidableInstances #-}
8+
9+module Database.Bloodhound.Internal.Client where
10+
11+import Bloodhound.Import
12+
13+#if defined(MIN_VERSION_GLASGOW_HASKELL)
14+#if MIN_VERSION_GLASGOW_HASKELL(8,6,0,0)
15+import Control.Monad.Fail (MonadFail)
16+#endif
17+#endif
18+import qualified Data.Text as T
19+import qualified Data.Traversable as DT
20+import qualified Data.HashMap.Strict as HM
21+import qualified Data.SemVer as SemVer
22+import qualified Data.Vector as V
23+import GHC.Enum
24+import Network.HTTP.Client
25+import Text.Read (Read(..))
26+import qualified Text.Read as TR
27+
28+import Database.Bloodhound.Internal.Analysis
29+import Database.Bloodhound.Internal.Newtypes
30+import Database.Bloodhound.Internal.Query
31+import Database.Bloodhound.Internal.StringlyTyped
32+
33+{-| Common environment for Elasticsearch calls. Connections will be
34+ pipelined according to the provided HTTP connection manager.
35+-}
36+data BHEnv = BHEnv { bhServer :: Server
37+ , bhManager :: Manager
38+ , bhRequestHook :: Request -> IO Request
39+ -- ^ Low-level hook that is run before every request is sent. Used to implement custom authentication strategies. Defaults to 'return' with 'mkBHEnv'.
40+ }
41+
42+instance (Functor m, Applicative m, MonadIO m) => MonadBH (ReaderT BHEnv m) where
43+ getBHEnv = ask
44+
45+{-| 'Server' is used with the client functions to point at the ES instance
46+-}
47+newtype Server = Server Text deriving (Eq, Show, FromJSON)
48+
49+{-| All API calls to Elasticsearch operate within
50+ MonadBH
51+ . The idea is that it can be easily embedded in your
52+ own monad transformer stack. A default instance for a ReaderT and
53+ alias 'BH' is provided for the simple case.
54+-}
55+class (Functor m, Applicative m, MonadIO m) => MonadBH m where
56+ getBHEnv :: m BHEnv
57+
58+-- | Create a 'BHEnv' with all optional fields defaulted. HTTP hook
59+-- will be a noop. You can use the exported fields to customize
60+-- it further, e.g.:
61+--
62+-- >> (mkBHEnv myServer myManager) { bhRequestHook = customHook }
63+mkBHEnv :: Server -> Manager -> BHEnv
64+mkBHEnv s m = BHEnv s m return
65+
66+newtype BH m a = BH {
67+ unBH :: ReaderT BHEnv m a
68+ } deriving ( Functor
69+ , Applicative
70+ , Monad
71+ , MonadIO
72+ , MonadState s
73+ , MonadWriter w
74+ , MonadError e
75+ , Alternative
76+ , MonadPlus
77+ , MonadFix
78+ , MonadThrow
79+ , MonadCatch
80+#if defined(MIN_VERSION_GLASGOW_HASKELL)
81+#if MIN_VERSION_GLASGOW_HASKELL(8,6,0,0)
82+ , MonadFail
83+#endif
84+#endif
85+ , MonadMask)
86+
87+instance MonadTrans BH where
88+ lift = BH . lift
89+
90+instance (MonadReader r m) => MonadReader r (BH m) where
91+ ask = lift ask
92+ local f (BH (ReaderT m)) = BH $ ReaderT $ \r ->
93+ local f (m r)
94+
95+instance (Functor m, Applicative m, MonadIO m) => MonadBH (BH m) where
96+ getBHEnv = BH getBHEnv
97+
98+runBH :: BHEnv -> BH m a -> m a
99+runBH e f = runReaderT (unBH f) e
100+
101+{-| 'Version' is embedded in 'Status' -}
102+data Version = Version { number :: VersionNumber
103+ , build_hash :: BuildHash
104+ , build_date :: UTCTime
105+ , build_snapshot :: Bool
106+ , lucene_version :: VersionNumber }
107+ deriving (Eq, Show)
108+
109+-- | Traditional software versioning number
110+newtype VersionNumber = VersionNumber
111+ { versionNumber :: SemVer.Version }
112+ deriving (Eq, Ord, Show)
113+
114+{-| 'Status' is a data type for describing the JSON body returned by
115+ Elasticsearch when you query its status. This was deprecated in 1.2.0.
116+
117+ <http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/indices-status.html#indices-status>
118+-}
119+
120+data Status = Status
121+ { name :: Text
122+ , cluster_name :: Text
123+ , cluster_uuid :: Text
124+ , version :: Version
125+ , tagline :: Text }
126+ deriving (Eq, Show)
127+
128+instance FromJSON Status where
129+ parseJSON (Object v) = Status <$>
130+ v .: "name" <*>
131+ v .: "cluster_name" <*>
132+ v .: "cluster_uuid" <*>
133+ v .: "version" <*>
134+ v .: "tagline"
135+ parseJSON _ = empty
136+
137+{-| 'IndexSettings' is used to configure the shards and replicas when
138+ you create an Elasticsearch Index.
139+
140+ <http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/indices-create-index.html>
141+-}
142+
143+data IndexSettings = IndexSettings
144+ { indexShards :: ShardCount
145+ , indexReplicas :: ReplicaCount }
146+ deriving (Eq, Show)
147+
148+instance ToJSON IndexSettings where
149+ toJSON (IndexSettings s r) = object ["settings" .=
150+ object ["index" .=
151+ object ["number_of_shards" .= s, "number_of_replicas" .= r]
152+ ]
153+ ]
154+
155+instance FromJSON IndexSettings where
156+ parseJSON = withObject "IndexSettings" parse
157+ where parse o = do s <- o .: "settings"
158+ i <- s .: "index"
159+ IndexSettings <$> i .: "number_of_shards"
160+ <*> i .: "number_of_replicas"
161+
162+{-| 'defaultIndexSettings' is an 'IndexSettings' with 3 shards and
163+ 2 replicas. -}
164+defaultIndexSettings :: IndexSettings
165+defaultIndexSettings = IndexSettings (ShardCount 3) (ReplicaCount 2)
166+-- defaultIndexSettings is exported by Database.Bloodhound as well
167+-- no trailing slashes in servers, library handles building the path.
168+
169+
170+{-| 'ForceMergeIndexSettings' is used to configure index optimization. See
171+ <https://www.elastic.co/guide/en/elasticsearch/reference/current/indices-forcemerge.html>
172+ for more info.
173+-}
174+data ForceMergeIndexSettings =
175+ ForceMergeIndexSettings { maxNumSegments :: Maybe Int
176+ -- ^ Number of segments to optimize to. 1 will fully optimize the index. If omitted, the default behavior is to only optimize if the server deems it necessary.
177+ , onlyExpungeDeletes :: Bool
178+ -- ^ Should the optimize process only expunge segments with deletes in them? If the purpose of the optimization is to free disk space, this should be set to True.
179+ , flushAfterOptimize :: Bool
180+ -- ^ Should a flush be performed after the optimize.
181+ } deriving (Eq, Show)
182+
183+
184+{-| 'defaultForceMergeIndexSettings' implements the default settings that
185+ Elasticsearch uses for index optimization. 'maxNumSegments' is Nothing,
186+ 'onlyExpungeDeletes' is False, and flushAfterOptimize is True.
187+-}
188+defaultForceMergeIndexSettings :: ForceMergeIndexSettings
189+defaultForceMergeIndexSettings = ForceMergeIndexSettings Nothing False True
190+
191+{-| 'UpdatableIndexSetting' are settings which may be updated after an index is created.
192+
193+ <https://www.elastic.co/guide/en/elasticsearch/reference/current/indices-update-settings.html>
194+-}
195+data UpdatableIndexSetting = NumberOfReplicas ReplicaCount
196+ -- ^ The number of replicas each shard has.
197+ | AutoExpandReplicas ReplicaBounds
198+ | BlocksReadOnly Bool
199+ -- ^ Set to True to have the index read only. False to allow writes and metadata changes.
200+ | BlocksRead Bool
201+ -- ^ Set to True to disable read operations against the index.
202+ | BlocksWrite Bool
203+ -- ^ Set to True to disable write operations against the index.
204+ | BlocksMetaData Bool
205+ -- ^ Set to True to disable metadata operations against the index.
206+ | RefreshInterval NominalDiffTime
207+ -- ^ The async refresh interval of a shard
208+ | IndexConcurrency Int
209+ | FailOnMergeFailure Bool
210+ | TranslogFlushThresholdOps Int
211+ -- ^ When to flush on operations.
212+ | TranslogFlushThresholdSize Bytes
213+ -- ^ When to flush based on translog (bytes) size.
214+ | TranslogFlushThresholdPeriod NominalDiffTime
215+ -- ^ When to flush based on a period of not flushing.
216+ | TranslogDisableFlush Bool
217+ -- ^ Disables flushing. Note, should be set for a short interval and then enabled.
218+ | CacheFilterMaxSize (Maybe Bytes)
219+ -- ^ The maximum size of filter cache (per segment in shard).
220+ | CacheFilterExpire (Maybe NominalDiffTime)
221+ -- ^ The expire after access time for filter cache.
222+ | GatewaySnapshotInterval NominalDiffTime
223+ -- ^ The gateway snapshot interval (only applies to shared gateways).
224+ | RoutingAllocationInclude (NonEmpty NodeAttrFilter)
225+ -- ^ A node matching any rule will be allowed to host shards from the index.
226+ | RoutingAllocationExclude (NonEmpty NodeAttrFilter)
227+ -- ^ A node matching any rule will NOT be allowed to host shards from the index.
228+ | RoutingAllocationRequire (NonEmpty NodeAttrFilter)
229+ -- ^ Only nodes matching all rules will be allowed to host shards from the index.
230+ | RoutingAllocationEnable AllocationPolicy
231+ -- ^ Enables shard allocation for a specific index.
232+ | RoutingAllocationShardsPerNode ShardCount
233+ -- ^ Controls the total number of shards (replicas and primaries) allowed to be allocated on a single node.
234+ | RecoveryInitialShards InitialShardCount
235+ -- ^ When using local gateway a particular shard is recovered only if there can be allocated quorum shards in the cluster.
236+ | GCDeletes NominalDiffTime
237+ | TTLDisablePurge Bool
238+ -- ^ Disables temporarily the purge of expired docs.
239+ | TranslogFSType FSType
240+ | CompressionSetting Compression
241+ | IndexCompoundFormat CompoundFormat
242+ | IndexCompoundOnFlush Bool
243+ | WarmerEnabled Bool
244+ | MappingTotalFieldsLimit Int
245+ | AnalysisSetting Analysis
246+ -- ^ Analysis is not a dynamic setting and can only be performed on a closed index.
247+ deriving (Eq, Show)
248+
249+attrFilterJSON :: NonEmpty NodeAttrFilter -> Value
250+attrFilterJSON fs = object [ n .= T.intercalate "," (toList vs)
251+ | NodeAttrFilter (NodeAttrName n) vs <- toList fs]
252+
253+parseAttrFilter :: Value -> Parser (NonEmpty NodeAttrFilter)
254+parseAttrFilter = withObject "NonEmpty NodeAttrFilter" parse
255+ where parse o = case HM.toList o of
256+ [] -> fail "Expected non-empty list of NodeAttrFilters"
257+ x:xs -> DT.mapM (uncurry parse') (x :| xs)
258+ parse' n = withText "Text" $ \t ->
259+ case T.splitOn "," t of
260+ fv:fvs -> return (NodeAttrFilter (NodeAttrName n) (fv :| fvs))
261+ [] -> fail "Expected non-empty list of filter values"
262+
263+instance ToJSON UpdatableIndexSetting where
264+ toJSON (NumberOfReplicas x) = oPath ("index" :| ["number_of_replicas"]) x
265+ toJSON (AutoExpandReplicas x) = oPath ("index" :| ["auto_expand_replicas"]) x
266+ toJSON (RefreshInterval x) = oPath ("index" :| ["refresh_interval"]) (NominalDiffTimeJSON x)
267+ toJSON (IndexConcurrency x) = oPath ("index" :| ["concurrency"]) x
268+ toJSON (FailOnMergeFailure x) = oPath ("index" :| ["fail_on_merge_failure"]) x
269+ toJSON (TranslogFlushThresholdOps x) = oPath ("index" :| ["translog", "flush_threshold_ops"]) x
270+ toJSON (TranslogFlushThresholdSize x) = oPath ("index" :| ["translog", "flush_threshold_size"]) x
271+ toJSON (TranslogFlushThresholdPeriod x) = oPath ("index" :| ["translog", "flush_threshold_period"]) (NominalDiffTimeJSON x)
272+ toJSON (TranslogDisableFlush x) = oPath ("index" :| ["translog", "disable_flush"]) x
273+ toJSON (CacheFilterMaxSize x) = oPath ("index" :| ["cache", "filter", "max_size"]) x
274+ toJSON (CacheFilterExpire x) = oPath ("index" :| ["cache", "filter", "expire"]) (NominalDiffTimeJSON <$> x)
275+ toJSON (GatewaySnapshotInterval x) = oPath ("index" :| ["gateway", "snapshot_interval"]) (NominalDiffTimeJSON x)
276+ toJSON (RoutingAllocationInclude fs) = oPath ("index" :| ["routing", "allocation", "include"]) (attrFilterJSON fs)
277+ toJSON (RoutingAllocationExclude fs) = oPath ("index" :| ["routing", "allocation", "exclude"]) (attrFilterJSON fs)
278+ toJSON (RoutingAllocationRequire fs) = oPath ("index" :| ["routing", "allocation", "require"]) (attrFilterJSON fs)
279+ toJSON (RoutingAllocationEnable x) = oPath ("index" :| ["routing", "allocation", "enable"]) x
280+ toJSON (RoutingAllocationShardsPerNode x) = oPath ("index" :| ["routing", "allocation", "total_shards_per_node"]) x
281+ toJSON (RecoveryInitialShards x) = oPath ("index" :| ["recovery", "initial_shards"]) x
282+ toJSON (GCDeletes x) = oPath ("index" :| ["gc_deletes"]) (NominalDiffTimeJSON x)
283+ toJSON (TTLDisablePurge x) = oPath ("index" :| ["ttl", "disable_purge"]) x
284+ toJSON (TranslogFSType x) = oPath ("index" :| ["translog", "fs", "type"]) x
285+ toJSON (CompressionSetting x) = oPath ("index" :| ["codec"]) x
286+ toJSON (IndexCompoundFormat x) = oPath ("index" :| ["compound_format"]) x
287+ toJSON (IndexCompoundOnFlush x) = oPath ("index" :| ["compound_on_flush"]) x
288+ toJSON (WarmerEnabled x) = oPath ("index" :| ["warmer", "enabled"]) x
289+ toJSON (BlocksReadOnly x) = oPath ("blocks" :| ["read_only"]) x
290+ toJSON (BlocksRead x) = oPath ("blocks" :| ["read"]) x
291+ toJSON (BlocksWrite x) = oPath ("blocks" :| ["write"]) x
292+ toJSON (BlocksMetaData x) = oPath ("blocks" :| ["metadata"]) x
293+ toJSON (MappingTotalFieldsLimit x) = oPath ("index" :| ["mapping","total_fields","limit"]) x
294+ toJSON (AnalysisSetting x) = oPath ("index" :| ["analysis"]) x
295+
296+instance FromJSON UpdatableIndexSetting where
297+ parseJSON = withObject "UpdatableIndexSetting" parse
298+ where parse o = numberOfReplicas `taggedAt` ["index", "number_of_replicas"]
299+ <|> autoExpandReplicas `taggedAt` ["index", "auto_expand_replicas"]
300+ <|> refreshInterval `taggedAt` ["index", "refresh_interval"]
301+ <|> indexConcurrency `taggedAt` ["index", "concurrency"]
302+ <|> failOnMergeFailure `taggedAt` ["index", "fail_on_merge_failure"]
303+ <|> translogFlushThresholdOps `taggedAt` ["index", "translog", "flush_threshold_ops"]
304+ <|> translogFlushThresholdSize `taggedAt` ["index", "translog", "flush_threshold_size"]
305+ <|> translogFlushThresholdPeriod `taggedAt` ["index", "translog", "flush_threshold_period"]
306+ <|> translogDisableFlush `taggedAt` ["index", "translog", "disable_flush"]
307+ <|> cacheFilterMaxSize `taggedAt` ["index", "cache", "filter", "max_size"]
308+ <|> cacheFilterExpire `taggedAt` ["index", "cache", "filter", "expire"]
309+ <|> gatewaySnapshotInterval `taggedAt` ["index", "gateway", "snapshot_interval"]
310+ <|> routingAllocationInclude `taggedAt` ["index", "routing", "allocation", "include"]
311+ <|> routingAllocationExclude `taggedAt` ["index", "routing", "allocation", "exclude"]
312+ <|> routingAllocationRequire `taggedAt` ["index", "routing", "allocation", "require"]
313+ <|> routingAllocationEnable `taggedAt` ["index", "routing", "allocation", "enable"]
314+ <|> routingAllocationShardsPerNode `taggedAt` ["index", "routing", "allocation", "total_shards_per_node"]
315+ <|> recoveryInitialShards `taggedAt` ["index", "recovery", "initial_shards"]
316+ <|> gcDeletes `taggedAt` ["index", "gc_deletes"]
317+ <|> ttlDisablePurge `taggedAt` ["index", "ttl", "disable_purge"]
318+ <|> translogFSType `taggedAt` ["index", "translog", "fs", "type"]
319+ <|> compressionSetting `taggedAt` ["index", "codec"]
320+ <|> compoundFormat `taggedAt` ["index", "compound_format"]
321+ <|> compoundOnFlush `taggedAt` ["index", "compound_on_flush"]
322+ <|> warmerEnabled `taggedAt` ["index", "warmer", "enabled"]
323+ <|> blocksReadOnly `taggedAt` ["blocks", "read_only"]
324+ <|> blocksRead `taggedAt` ["blocks", "read"]
325+ <|> blocksWrite `taggedAt` ["blocks", "write"]
326+ <|> blocksMetaData `taggedAt` ["blocks", "metadata"]
327+ <|> mappingTotalFieldsLimit `taggedAt` ["index", "mapping", "total_fields", "limit"]
328+ <|> analysisSetting `taggedAt` ["index", "analysis"]
329+ where taggedAt f ks = taggedAt' f (Object o) ks
330+ taggedAt' f v [] =
331+ f =<< (parseJSON v <|> parseJSON (unStringlyTypeJSON v))
332+ taggedAt' f v (k:ks) =
333+ withObject "Object" (\o -> do v' <- o .: k
334+ taggedAt' f v' ks) v
335+ numberOfReplicas = pure . NumberOfReplicas
336+ autoExpandReplicas = pure . AutoExpandReplicas
337+ refreshInterval = pure . RefreshInterval . ndtJSON
338+ indexConcurrency = pure . IndexConcurrency
339+ failOnMergeFailure = pure . FailOnMergeFailure
340+ translogFlushThresholdOps = pure . TranslogFlushThresholdOps
341+ translogFlushThresholdSize = pure . TranslogFlushThresholdSize
342+ translogFlushThresholdPeriod = pure . TranslogFlushThresholdPeriod . ndtJSON
343+ translogDisableFlush = pure . TranslogDisableFlush
344+ cacheFilterMaxSize = pure . CacheFilterMaxSize
345+ cacheFilterExpire = pure . CacheFilterExpire . fmap ndtJSON
346+ gatewaySnapshotInterval = pure . GatewaySnapshotInterval . ndtJSON
347+ routingAllocationInclude = fmap RoutingAllocationInclude . parseAttrFilter
348+ routingAllocationExclude = fmap RoutingAllocationExclude . parseAttrFilter
349+ routingAllocationRequire = fmap RoutingAllocationRequire . parseAttrFilter
350+ routingAllocationEnable = pure . RoutingAllocationEnable
351+ routingAllocationShardsPerNode = pure . RoutingAllocationShardsPerNode
352+ recoveryInitialShards = pure . RecoveryInitialShards
353+ gcDeletes = pure . GCDeletes . ndtJSON
354+ ttlDisablePurge = pure . TTLDisablePurge
355+ translogFSType = pure . TranslogFSType
356+ compressionSetting = pure . CompressionSetting
357+ compoundFormat = pure . IndexCompoundFormat
358+ compoundOnFlush = pure . IndexCompoundOnFlush
359+ warmerEnabled = pure . WarmerEnabled
360+ blocksReadOnly = pure . BlocksReadOnly
361+ blocksRead = pure . BlocksRead
362+ blocksWrite = pure . BlocksWrite
363+ blocksMetaData = pure . BlocksMetaData
364+ mappingTotalFieldsLimit = pure . MappingTotalFieldsLimit
365+ analysisSetting = pure . AnalysisSetting
366+
367+data ReplicaBounds = ReplicasBounded Int Int
368+ | ReplicasLowerBounded Int
369+ | ReplicasUnbounded
370+ deriving (Eq, Show)
371+
372+
373+instance ToJSON ReplicaBounds where
374+ toJSON (ReplicasBounded a b) = String (showText a <> "-" <> showText b)
375+ toJSON (ReplicasLowerBounded a) = String (showText a <> "-all")
376+ toJSON ReplicasUnbounded = Bool False
377+
378+instance FromJSON ReplicaBounds where
379+ parseJSON v = withText "ReplicaBounds" parseText v
380+ <|> withBool "ReplicaBounds" parseBool v
381+ where parseText t = case T.splitOn "-" t of
382+ [a, "all"] -> ReplicasLowerBounded <$> parseReadText a
383+ [a, b] -> ReplicasBounded <$> parseReadText a
384+ <*> parseReadText b
385+ _ -> fail ("Could not parse ReplicaBounds: " <> show t)
386+ parseBool False = pure ReplicasUnbounded
387+ parseBool _ = fail "ReplicasUnbounded cannot be represented with True"
388+
389+data Compression
390+ = CompressionDefault
391+ -- ^ Compress with LZ4
392+ | CompressionBest
393+ -- ^ Compress with DEFLATE. Elastic
394+ -- <https://www.elastic.co/blog/elasticsearch-storage-the-true-story-2.0 blogs>
395+ -- that this can reduce disk use by 15%-25%.
396+ deriving (Eq,Show)
397+
398+instance ToJSON Compression where
399+ toJSON x = case x of
400+ CompressionDefault -> toJSON ("default" :: Text)
401+ CompressionBest -> toJSON ("best_compression" :: Text)
402+
403+instance FromJSON Compression where
404+ parseJSON = withText "Compression" $ \t -> case t of
405+ "default" -> return CompressionDefault
406+ "best_compression" -> return CompressionBest
407+ _ -> fail "invalid compression codec"
408+
409+-- | A measure of bytes used for various configurations. You may want
410+-- to use smart constructors like 'gigabytes' for larger values.
411+--
412+-- >>> gigabytes 9
413+-- Bytes 9000000000
414+--
415+-- >>> megabytes 9
416+-- Bytes 9000000
417+--
418+-- >>> kilobytes 9
419+-- Bytes 9000
420+newtype Bytes =
421+ Bytes Int
422+ deriving (Eq, Show, Ord, ToJSON, FromJSON)
423+
424+gigabytes :: Int -> Bytes
425+gigabytes n = megabytes (1000 * n)
426+
427+
428+megabytes :: Int -> Bytes
429+megabytes n = kilobytes (1000 * n)
430+
431+
432+kilobytes :: Int -> Bytes
433+kilobytes n = Bytes (1000 * n)
434+
435+
436+data FSType = FSSimple
437+ | FSBuffered deriving (Eq, Show)
438+
439+instance ToJSON FSType where
440+ toJSON FSSimple = "simple"
441+ toJSON FSBuffered = "buffered"
442+
443+instance FromJSON FSType where
444+ parseJSON = withText "FSType" parse
445+ where parse "simple" = pure FSSimple
446+ parse "buffered" = pure FSBuffered
447+ parse t = fail ("Invalid FSType: " <> show t)
448+
449+data InitialShardCount = QuorumShards
450+ | QuorumMinus1Shards
451+ | FullShards
452+ | FullMinus1Shards
453+ | ExplicitShards Int
454+ deriving (Eq, Show)
455+
456+instance FromJSON InitialShardCount where
457+ parseJSON v = withText "InitialShardCount" parseText v
458+ <|> ExplicitShards <$> parseJSON v
459+ where parseText "quorum" = pure QuorumShards
460+ parseText "quorum-1" = pure QuorumMinus1Shards
461+ parseText "full" = pure FullShards
462+ parseText "full-1" = pure FullMinus1Shards
463+ parseText _ = mzero
464+
465+instance ToJSON InitialShardCount where
466+ toJSON QuorumShards = String "quorum"
467+ toJSON QuorumMinus1Shards = String "quorum-1"
468+ toJSON FullShards = String "full"
469+ toJSON FullMinus1Shards = String "full-1"
470+ toJSON (ExplicitShards x) = toJSON x
471+
472+data NodeAttrFilter = NodeAttrFilter
473+ { nodeAttrFilterName :: NodeAttrName
474+ , nodeAttrFilterValues :: NonEmpty Text }
475+ deriving (Eq, Ord, Show)
476+
477+newtype NodeAttrName = NodeAttrName Text deriving (Eq, Ord, Show)
478+
479+data CompoundFormat = CompoundFileFormat Bool
480+ | MergeSegmentVsTotalIndex Double
481+ -- ^ percentage between 0 and 1 where 0 is false, 1 is true
482+ deriving (Eq, Show)
483+
484+instance ToJSON CompoundFormat where
485+ toJSON (CompoundFileFormat x) = Bool x
486+ toJSON (MergeSegmentVsTotalIndex x) = toJSON x
487+
488+instance FromJSON CompoundFormat where
489+ parseJSON v = CompoundFileFormat <$> parseJSON v
490+ <|> MergeSegmentVsTotalIndex <$> parseJSON v
491+
492+newtype NominalDiffTimeJSON =
493+ NominalDiffTimeJSON { ndtJSON :: NominalDiffTime }
494+
495+instance ToJSON NominalDiffTimeJSON where
496+ toJSON (NominalDiffTimeJSON t) = String (showText (round t :: Integer) <> "s")
497+
498+instance FromJSON NominalDiffTimeJSON where
499+ parseJSON = withText "NominalDiffTime" parse
500+ where parse t = case T.takeEnd 1 t of
501+ "s" -> NominalDiffTimeJSON . fromInteger <$> parseReadText (T.dropEnd 1 t)
502+ _ -> fail "Invalid or missing NominalDiffTime unit (expected s)"
503+
504+data IndexSettingsSummary = IndexSettingsSummary
505+ { sSummaryIndexName :: IndexName
506+ , sSummaryFixedSettings :: IndexSettings
507+ , sSummaryUpdateable :: [UpdatableIndexSetting]}
508+ deriving (Eq, Show)
509+
510+parseSettings :: Object -> Parser [UpdatableIndexSetting]
511+parseSettings o = do
512+ o' <- o .: "index"
513+ -- slice the index object into singleton hashmaps and try to parse each
514+ parses <- forM (HM.toList o') $ \(k, v) -> do
515+ -- blocks are now nested into the "index" key, which is not how they're serialized
516+ let atRoot = Object (HM.singleton k v)
517+ let atIndex = Object (HM.singleton "index" atRoot)
518+ optional (parseJSON atRoot <|> parseJSON atIndex)
519+ return (catMaybes parses)
520+
521+instance FromJSON IndexSettingsSummary where
522+ parseJSON = withObject "IndexSettingsSummary" parse
523+ where parse o = case HM.toList o of
524+ [(ixn, v@(Object o'))] -> IndexSettingsSummary (IndexName ixn)
525+ <$> parseJSON v
526+ <*> (fmap (filter (not . redundant)) . parseSettings =<< o' .: "settings")
527+ _ -> fail "Expected single-key object with index name"
528+ redundant (NumberOfReplicas _) = True
529+ redundant _ = False
530+
531+{-| 'Reply' and 'Method' are type synonyms from 'Network.HTTP.Types.Method.Method' -}
532+type Reply = Network.HTTP.Client.Response LByteString
533+
534+{-| 'OpenCloseIndex' is a sum type for opening and closing indices.
535+
536+ <http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/indices-open-close.html>
537+-}
538+data OpenCloseIndex = OpenIndex | CloseIndex deriving (Eq, Show)
539+
540+data FieldType = GeoPointType
541+ | GeoShapeType
542+ | FloatType
543+ | IntegerType
544+ | LongType
545+ | ShortType
546+ | ByteType deriving (Eq, Show)
547+
548+newtype FieldDefinition = FieldDefinition
549+ { fieldType :: FieldType
550+ } deriving (Eq, Show)
551+
552+{-| An 'IndexTemplate' defines a template that will automatically be
553+ applied to new indices created. The templates include both
554+ 'IndexSettings' and mappings, and a simple 'TemplatePattern' that
555+ controls if the template will be applied to the index created.
556+ Specify mappings as follows: @[toJSON TweetMapping, ...]@
557+
558+ https://www.elastic.co/guide/en/elasticsearch/reference/1.7/indices-templates.html
559+-}
560+data IndexTemplate =
561+ IndexTemplate { templatePattern :: TemplatePattern
562+ , templateSettings :: Maybe IndexSettings
563+ , templateMappings :: [Value]
564+ }
565+
566+instance ToJSON IndexTemplate where
567+ toJSON (IndexTemplate p s m) = merge
568+ (object [ "template" .= p
569+ , "mappings" .= foldl' merge (object []) m
570+ ])
571+ (toJSON s)
572+ where
573+ merge (Object o1) (Object o2) = toJSON $ HM.union o1 o2
574+ merge o Null = o
575+ merge _ _ = undefined
576+
577+data MappingField =
578+ MappingField { mappingFieldName :: FieldName
579+ , fieldDefinition :: FieldDefinition }
580+ deriving (Eq, Show)
581+
582+{-| Support for type reification of 'Mapping's is currently incomplete, for
583+ now the mapping API verbiage expects a 'ToJSON'able blob.
584+
585+ Indexes have mappings, mappings are schemas for the documents contained
586+ in the index. I'd recommend having only one mapping per index, always
587+ having a mapping, and keeping different kinds of documents separated
588+ if possible.
589+-}
590+data Mapping =
591+ Mapping { typeName :: TypeName
592+ , mappingFields :: [MappingField] }
593+ deriving (Eq, Show)
594+
595+data AllocationPolicy = AllocAll
596+ -- ^ Allows shard allocation for all shards.
597+ | AllocPrimaries
598+ -- ^ Allows shard allocation only for primary shards.
599+ | AllocNewPrimaries
600+ -- ^ Allows shard allocation only for primary shards for new indices.
601+ | AllocNone
602+ -- ^ No shard allocation is allowed
603+ deriving (Eq, Show)
604+
605+instance ToJSON AllocationPolicy where
606+ toJSON AllocAll = String "all"
607+ toJSON AllocPrimaries = String "primaries"
608+ toJSON AllocNewPrimaries = String "new_primaries"
609+ toJSON AllocNone = String "none"
610+
611+instance FromJSON AllocationPolicy where
612+ parseJSON = withText "AllocationPolicy" parse
613+ where parse "all" = pure AllocAll
614+ parse "primaries" = pure AllocPrimaries
615+ parse "new_primaries" = pure AllocNewPrimaries
616+ parse "none" = pure AllocNone
617+ parse t = fail ("Invlaid AllocationPolicy: " <> show t)
618+
619+{-| 'BulkOperation' is a sum type for expressing the four kinds of bulk
620+ operation index, create, delete, and update. 'BulkIndex' behaves like an
621+ "upsert", 'BulkCreate' will fail if a document already exists at the DocId.
622+ Consult the <http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/docs-bulk.html#docs-bulk Bulk API documentation>
623+ for further explanation.
624+ Warning: Bulk operations suffixed with @Auto@ rely on Elasticsearch to
625+ generate the id. Often, people use auto-generated identifiers when
626+ Elasticsearch is the only place that their data is stored. Do not let
627+ Elasticsearch be the only place your data is stored. It does not guarantee
628+ durability, and it may silently discard data.
629+ This <https://github.com/elastic/elasticsearch/issues/10708 issue> is
630+ discussed further on github.
631+-}
632+data BulkOperation =
633+ BulkIndex IndexName MappingName DocId Value
634+ -- ^ Create the document, replacing it if it already exists.
635+ | BulkIndexAuto IndexName MappingName Value
636+ -- ^ Create a document with an autogenerated id.
637+ | BulkIndexEncodingAuto IndexName MappingName Encoding
638+ -- ^ Create a document with an autogenerated id. Use fast JSON encoding.
639+ | BulkCreate IndexName MappingName DocId Value
640+ -- ^ Create a document, failing if it already exists.
641+ | BulkCreateEncoding IndexName MappingName DocId Encoding
642+ -- ^ Create a document, failing if it already exists. Use fast JSON encoding.
643+ | BulkDelete IndexName MappingName DocId
644+ -- ^ Delete the document
645+ | BulkUpdate IndexName MappingName DocId Value
646+ -- ^ Update the document, merging the new value with the existing one.
647+ deriving (Eq, Show)
648+
649+{-| 'EsResult' describes the standard wrapper JSON document that you see in
650+ successful Elasticsearch lookups or lookups that couldn't find the document.
651+-}
652+data EsResult a = EsResult { _index :: Text
653+ , _type :: Text
654+ , _id :: Text
655+ , foundResult :: Maybe (EsResultFound a)} deriving (Eq, Show)
656+
657+{-| 'EsResultFound' contains the document and its metadata inside of an
658+ 'EsResult' when the document was successfully found.
659+-}
660+data EsResultFound a =
661+ EsResultFound { _version :: DocVersion
662+ , _source :: a }
663+ deriving (Eq, Show)
664+
665+instance (FromJSON a) => FromJSON (EsResult a) where
666+ parseJSON jsonVal@(Object v) = do
667+ found <- v .:? "found" .!= False
668+ fr <- if found
669+ then parseJSON jsonVal
670+ else return Nothing
671+ EsResult <$> v .: "_index" <*>
672+ v .: "_type" <*>
673+ v .: "_id" <*>
674+ pure fr
675+ parseJSON _ = empty
676+
677+instance (FromJSON a) => FromJSON (EsResultFound a) where
678+ parseJSON (Object v) = EsResultFound <$>
679+ v .: "_version" <*>
680+ v .: "_source"
681+ parseJSON _ = empty
682+
683+{-| 'EsError' is the generic type that will be returned when there was a
684+ problem. If you can't parse the expected response, its a good idea to
685+ try parsing this.
686+-}
687+data EsError =
688+ EsError { errorStatus :: Int
689+ , errorMessage :: Text }
690+ deriving (Eq, Show)
691+
692+instance FromJSON EsError where
693+ parseJSON (Object v) = EsError <$>
694+ v .: "status" <*>
695+ (v .: "error" <|> (v .: "error" >>= (.: "reason")))
696+ parseJSON _ = empty
697+
698+{-| 'EsProtocolException' will be thrown if Bloodhound cannot parse a response
699+returned by the Elasticsearch server. If you encounter this error, please
700+verify that your domain data types and FromJSON instances are working properly
701+(for example, the 'a' of '[Hit a]' in 'SearchResult.searchHits.hits'). If you're
702+sure that your mappings are correct, then this error may be an indication of an
703+incompatibility between Bloodhound and Elasticsearch. Please open a bug report
704+and be sure to include the exception body.
705+-}
706+data EsProtocolException = EsProtocolException
707+ { esProtoExMessage :: !Text
708+ , esProtoExBody :: !LByteString
709+ } deriving (Eq, Show)
710+
711+instance Exception EsProtocolException
712+
713+data IndexAlias = IndexAlias { srcIndex :: IndexName
714+ , indexAlias :: IndexAliasName } deriving (Eq, Show)
715+
716+data IndexAliasAction =
717+ AddAlias IndexAlias IndexAliasCreate
718+ | RemoveAlias IndexAlias
719+ deriving (Eq, Show)
720+
721+data IndexAliasCreate =
722+ IndexAliasCreate { aliasCreateRouting :: Maybe AliasRouting
723+ , aliasCreateFilter :: Maybe Filter}
724+ deriving (Eq, Show)
725+
726+data AliasRouting =
727+ AllAliasRouting RoutingValue
728+ | GranularAliasRouting (Maybe SearchAliasRouting) (Maybe IndexAliasRouting)
729+ deriving (Eq, Show)
730+
731+newtype SearchAliasRouting =
732+ SearchAliasRouting (NonEmpty RoutingValue)
733+ deriving (Eq, Show)
734+
735+instance ToJSON SearchAliasRouting where
736+ toJSON (SearchAliasRouting rvs) = toJSON (T.intercalate "," (routingValue <$> toList rvs))
737+
738+instance FromJSON SearchAliasRouting where
739+ parseJSON = withText "SearchAliasRouting" parse
740+ where parse t = SearchAliasRouting <$> parseNEJSON (String <$> T.splitOn "," t)
741+
742+newtype IndexAliasRouting =
743+ IndexAliasRouting RoutingValue
744+ deriving (Eq, Show, ToJSON, FromJSON)
745+
746+newtype RoutingValue =
747+ RoutingValue { routingValue :: Text }
748+ deriving (Eq, Show, ToJSON, FromJSON)
749+
750+newtype IndexAliasesSummary =
751+ IndexAliasesSummary { indexAliasesSummary :: [IndexAliasSummary] }
752+ deriving (Eq, Show)
753+
754+instance FromJSON IndexAliasesSummary where
755+ parseJSON = withObject "IndexAliasesSummary" parse
756+ where parse o = IndexAliasesSummary . mconcat <$> mapM (uncurry go) (HM.toList o)
757+ go ixn = withObject "index aliases" $ \ia -> do
758+ aliases <- ia .:? "aliases" .!= mempty
759+ forM (HM.toList aliases) $ \(aName, v) -> do
760+ let indexAlias = IndexAlias (IndexName ixn) (IndexAliasName (IndexName aName))
761+ IndexAliasSummary indexAlias <$> parseJSON v
762+
763+
764+instance ToJSON IndexAliasAction where
765+ toJSON (AddAlias ia opts) = object ["add" .= (iaObj <> optsObj)]
766+ where Object iaObj = toJSON ia
767+ Object optsObj = toJSON opts
768+ toJSON (RemoveAlias ia) = object ["remove" .= iaObj]
769+ where Object iaObj = toJSON ia
770+
771+instance ToJSON IndexAlias where
772+ toJSON IndexAlias {..} = object ["index" .= srcIndex
773+ , "alias" .= indexAlias
774+ ]
775+
776+instance ToJSON IndexAliasCreate where
777+ toJSON IndexAliasCreate {..} = Object (filterObj <> routingObj)
778+ where filterObj = maybe mempty (HM.singleton "filter" . toJSON) aliasCreateFilter
779+ Object routingObj = maybe (Object mempty) toJSON aliasCreateRouting
780+
781+instance ToJSON AliasRouting where
782+ toJSON (AllAliasRouting v) = object ["routing" .= v]
783+ toJSON (GranularAliasRouting srch idx) = object (catMaybes prs)
784+ where prs = [("search_routing" .=) <$> srch
785+ ,("index_routing" .=) <$> idx]
786+
787+instance FromJSON AliasRouting where
788+ parseJSON = withObject "AliasRouting" parse
789+ where parse o = parseAll o <|> parseGranular o
790+ parseAll o = AllAliasRouting <$> o .: "routing"
791+ parseGranular o = do
792+ sr <- o .:? "search_routing"
793+ ir <- o .:? "index_routing"
794+ if isNothing sr && isNothing ir
795+ then fail "Both search_routing and index_routing can't be blank"
796+ else return (GranularAliasRouting sr ir)
797+
798+instance FromJSON IndexAliasCreate where
799+ parseJSON v = withObject "IndexAliasCreate" parse v
800+ where parse o = IndexAliasCreate <$> optional (parseJSON v)
801+ <*> o .:? "filter"
802+
803+{-| 'IndexAliasSummary' is a summary of an index alias configured for a server. -}
804+data IndexAliasSummary = IndexAliasSummary
805+ { indexAliasSummaryAlias :: IndexAlias
806+ , indexAliasSummaryCreate :: IndexAliasCreate }
807+ deriving (Eq, Show)
808+
809+{-| 'DocVersion' is an integer version number for a document between 1
810+and 9.2e+18 used for <<https://www.elastic.co/guide/en/elasticsearch/guide/current/optimistic-concurrency-control.html optimistic concurrency control>>.
811+-}
812+newtype DocVersion = DocVersion {
813+ docVersionNumber :: Int
814+ } deriving (Eq, Show, Ord, ToJSON)
815+
816+-- | Smart constructor for in-range doc version
817+mkDocVersion :: Int -> Maybe DocVersion
818+mkDocVersion i
819+ | i >= docVersionNumber minBound
820+ && i <= docVersionNumber maxBound =
821+ Just $ DocVersion i
822+ | otherwise = Nothing
823+
824+instance Bounded DocVersion where
825+ minBound = DocVersion 1
826+ maxBound = DocVersion 9200000000000000000 -- 9.2e+18
827+
828+instance Enum DocVersion where
829+ succ x
830+ | x /= maxBound = DocVersion (succ $ docVersionNumber x)
831+ | otherwise = succError "DocVersion"
832+ pred x
833+ | x /= minBound = DocVersion (pred $ docVersionNumber x)
834+ | otherwise = predError "DocVersion"
835+ toEnum i =
836+ fromMaybe (error $ show i ++ " out of DocVersion range") $ mkDocVersion i
837+ fromEnum = docVersionNumber
838+ enumFrom = boundedEnumFrom
839+ enumFromThen = boundedEnumFromThen
840+
841+instance FromJSON DocVersion where
842+ parseJSON v = do
843+ i <- parseJSON v
844+ maybe (fail "DocVersion out of range") return $ mkDocVersion i
845+
846+{-| 'ExternalDocVersion' is a convenience wrapper if your code uses its
847+own version numbers instead of ones from ES.
848+-}
849+newtype ExternalDocVersion = ExternalDocVersion DocVersion
850+ deriving (Eq, Show, Ord, Bounded, Enum, ToJSON)
851+
852+{-| 'VersionControl' is specified when indexing documents as a
853+optimistic concurrency control.
854+-}
855+data VersionControl = NoVersionControl
856+ -- ^ Don't send a version. This is a pure overwrite.
857+ | InternalVersion DocVersion
858+ -- ^ Use the default ES versioning scheme. Only
859+ -- index the document if the version is the same
860+ -- as the one specified. Only applicable to
861+ -- updates, as you should be getting Version from
862+ -- a search result.
863+ | ExternalGT ExternalDocVersion
864+ -- ^ Use your own version numbering. Only index
865+ -- the document if the version is strictly higher
866+ -- OR the document doesn't exist. The given
867+ -- version will be used as the new version number
868+ -- for the stored document. N.B. All updates must
869+ -- increment this number, meaning there is some
870+ -- global, external ordering of updates.
871+ | ExternalGTE ExternalDocVersion
872+ -- ^ Use your own version numbering. Only index
873+ -- the document if the version is equal or higher
874+ -- than the stored version. Will succeed if there
875+ -- is no existing document. The given version will
876+ -- be used as the new version number for the
877+ -- stored document. Use with care, as this could
878+ -- result in data loss.
879+ | ForceVersion ExternalDocVersion
880+ -- ^ The document will always be indexed and the
881+ -- given version will be the new version. This is
882+ -- typically used for correcting errors. Use with
883+ -- care, as this could result in data loss.
884+ deriving (Eq, Show, Ord)
885+
886+{-| 'DocumentParent' is used to specify a parent document.
887+-}
888+newtype DocumentParent = DocumentParent DocId
889+ deriving (Eq, Show)
890+
891+{-| 'IndexDocumentSettings' are special settings supplied when indexing
892+a document. For the best backwards compatiblity when new fields are
893+added, you should probably prefer to start with 'defaultIndexDocumentSettings'
894+-}
895+data IndexDocumentSettings =
896+ IndexDocumentSettings { idsVersionControl :: VersionControl
897+ , idsParent :: Maybe DocumentParent
898+ } deriving (Eq, Show)
899+
900+{-| Reasonable default settings. Chooses no version control and no parent.
901+-}
902+defaultIndexDocumentSettings :: IndexDocumentSettings
903+defaultIndexDocumentSettings = IndexDocumentSettings NoVersionControl Nothing
904+
905+{-| 'IndexSelection' is used for APIs which take a single index, a list of
906+ indexes, or the special @_all@ index.
907+-}
908+--TODO: this does not fully support <https://www.elastic.co/guide/en/elasticsearch/reference/1.7/multi-index.html multi-index syntax>. It wouldn't be too hard to implement but you'd have to add the optional parameters (ignore_unavailable, allow_no_indices, expand_wildcards) to any APIs using it. Also would be a breaking API.
909+data IndexSelection =
910+ IndexList (NonEmpty IndexName)
911+ | AllIndexes
912+ deriving (Eq, Show)
913+
914+{-| 'NodeSelection' is used for most cluster APIs. See <https://www.elastic.co/guide/en/elasticsearch/reference/current/cluster.html#cluster-nodes here> for more details.
915+-}
916+data NodeSelection =
917+ LocalNode
918+ -- ^ Whatever node receives this request
919+ | NodeList (NonEmpty NodeSelector)
920+ | AllNodes
921+ deriving (Eq, Show)
922+
923+
924+-- | An exact match or pattern to identify a node. Note that All of
925+-- these options support wildcarding, so your node name, server, attr
926+-- name can all contain * characters to be a fuzzy match.
927+data NodeSelector =
928+ NodeByName NodeName
929+ | NodeByFullNodeId FullNodeId
930+ | NodeByHost Server
931+ -- ^ e.g. 10.0.0.1 or even 10.0.0.*
932+ | NodeByAttribute NodeAttrName Text
933+ -- ^ NodeAttrName can be a pattern, e.g. rack*. The value can too.
934+ deriving (Eq, Show)
935+
936+{-| 'TemplateName' is used to describe which template to query/create/delete
937+-}
938+newtype TemplateName = TemplateName Text deriving (Eq, Show, ToJSON, FromJSON)
939+
940+{-| 'TemplatePattern' represents a pattern which is matched against index names
941+-}
942+newtype TemplatePattern = TemplatePattern Text deriving (Eq, Show, ToJSON, FromJSON)
943+
944+-- | Username type used for HTTP Basic authentication. See 'basicAuthHook'.
945+newtype EsUsername = EsUsername { esUsername :: Text } deriving (Read, Show, Eq)
946+
947+-- | Password type used for HTTP Basic authentication. See 'basicAuthHook'.
948+newtype EsPassword = EsPassword { esPassword :: Text } deriving (Read, Show, Eq)
949+
950+
951+data SnapshotRepoSelection =
952+ SnapshotRepoList (NonEmpty SnapshotRepoPattern)
953+ | AllSnapshotRepos
954+ deriving (Eq, Show)
955+
956+
957+-- | Either specifies an exact repo name or one with globs in it,
958+-- e.g. @RepoPattern "foo*"@ __NOTE__: Patterns are not supported on ES < 1.7
959+data SnapshotRepoPattern =
960+ ExactRepo SnapshotRepoName
961+ | RepoPattern Text
962+ deriving (Eq, Show)
963+
964+-- | The unique name of a snapshot repository.
965+newtype SnapshotRepoName =
966+ SnapshotRepoName { snapshotRepoName :: Text }
967+ deriving (Eq, Ord, Show, ToJSON, FromJSON)
968+
969+
970+-- | A generic representation of a snapshot repo. This is what gets
971+-- sent to and parsed from the server. For repo types enabled by
972+-- plugins that aren't exported by this library, consider making a
973+-- custom type which implements 'SnapshotRepo'. If it is a common repo
974+-- type, consider submitting a pull request to have it included in the
975+-- library proper
976+data GenericSnapshotRepo = GenericSnapshotRepo {
977+ gSnapshotRepoName :: SnapshotRepoName
978+ , gSnapshotRepoType :: SnapshotRepoType
979+ , gSnapshotRepoSettings :: GenericSnapshotRepoSettings
980+ } deriving (Eq, Show)
981+
982+
983+instance SnapshotRepo GenericSnapshotRepo where
984+ toGSnapshotRepo = id
985+ fromGSnapshotRepo = Right
986+
987+
988+newtype SnapshotRepoType =
989+ SnapshotRepoType { snapshotRepoType :: Text }
990+ deriving (Eq, Ord, Show, ToJSON, FromJSON)
991+
992+
993+-- | Opaque representation of snapshot repo settings. Instances of
994+-- 'SnapshotRepo' will produce this.
995+newtype GenericSnapshotRepoSettings =
996+ GenericSnapshotRepoSettings { gSnapshotRepoSettingsObject :: Object }
997+ deriving (Eq, Show, ToJSON)
998+
999+
1000+ -- Regardless of whether you send strongly typed json, my version of
1001+ -- ES sends back stringly typed json in the settings, e.g. booleans
1002+ -- as strings, so we'll try to convert them.
1003+instance FromJSON GenericSnapshotRepoSettings where
1004+ parseJSON = fmap (GenericSnapshotRepoSettings . fmap unStringlyTypeJSON). parseJSON
1005+
1006+-- | The result of running 'verifySnapshotRepo'.
1007+newtype SnapshotVerification =
1008+ SnapshotVerification {
1009+ snapshotNodeVerifications :: [SnapshotNodeVerification]
1010+ } deriving (Eq, Show)
1011+
1012+
1013+instance FromJSON SnapshotVerification where
1014+ parseJSON = withObject "SnapshotVerification" parse
1015+ where
1016+ parse o = do
1017+ o2 <- o .: "nodes"
1018+ SnapshotVerification <$> mapM (uncurry parse') (HM.toList o2)
1019+ parse' rawFullId = withObject "SnapshotNodeVerification" $ \o ->
1020+ SnapshotNodeVerification (FullNodeId rawFullId) <$> o .: "name"
1021+
1022+
1023+-- | A node that has verified a snapshot
1024+data SnapshotNodeVerification = SnapshotNodeVerification {
1025+ snvFullId :: FullNodeId
1026+ , snvNodeName :: NodeName
1027+ } deriving (Eq, Show)
1028+
1029+
1030+-- | Unique, automatically-generated name assigned to nodes that are
1031+-- usually returned in node-oriented APIs.
1032+newtype FullNodeId = FullNodeId { fullNodeId :: Text }
1033+ deriving (Eq, Ord, Show, FromJSON)
1034+
1035+
1036+-- | A human-readable node name that is supplied by the user in the
1037+-- node config or automatically generated by Elasticsearch.
1038+newtype NodeName = NodeName { nodeName :: Text }
1039+ deriving (Eq, Ord, Show, FromJSON)
1040+
1041+newtype ClusterName = ClusterName { clusterName :: Text }
1042+ deriving (Eq, Ord, Show, FromJSON)
1043+
1044+data NodesInfo = NodesInfo {
1045+ nodesInfo :: [NodeInfo]
1046+ , nodesClusterName :: ClusterName
1047+ } deriving (Eq, Show)
1048+
1049+data NodesStats = NodesStats {
1050+ nodesStats :: [NodeStats]
1051+ , nodesStatsClusterName :: ClusterName
1052+ } deriving (Eq, Show)
1053+
1054+data NodeStats = NodeStats {
1055+ nodeStatsName :: NodeName
1056+ , nodeStatsFullId :: FullNodeId
1057+ , nodeStatsBreakersStats :: Maybe NodeBreakersStats
1058+ , nodeStatsHTTP :: NodeHTTPStats
1059+ , nodeStatsTransport :: NodeTransportStats
1060+ , nodeStatsFS :: NodeFSStats
1061+ , nodeStatsNetwork :: Maybe NodeNetworkStats
1062+ , nodeStatsThreadPool :: NodeThreadPoolsStats
1063+ , nodeStatsJVM :: NodeJVMStats
1064+ , nodeStatsProcess :: NodeProcessStats
1065+ , nodeStatsOS :: NodeOSStats
1066+ , nodeStatsIndices :: NodeIndicesStats
1067+ } deriving (Eq, Show)
1068+
1069+data NodeBreakersStats = NodeBreakersStats {
1070+ nodeStatsParentBreaker :: NodeBreakerStats
1071+ , nodeStatsRequestBreaker :: NodeBreakerStats
1072+ , nodeStatsFieldDataBreaker :: NodeBreakerStats
1073+ } deriving (Eq, Show)
1074+
1075+data NodeBreakerStats = NodeBreakerStats {
1076+ nodeBreakersTripped :: Int
1077+ , nodeBreakersOverhead :: Double
1078+ , nodeBreakersEstSize :: Bytes
1079+ , nodeBreakersLimitSize :: Bytes
1080+ } deriving (Eq, Show)
1081+
1082+data NodeHTTPStats = NodeHTTPStats {
1083+ nodeHTTPTotalOpened :: Int
1084+ , nodeHTTPCurrentOpen :: Int
1085+ } deriving (Eq, Show)
1086+
1087+data NodeTransportStats = NodeTransportStats {
1088+ nodeTransportTXSize :: Bytes
1089+ , nodeTransportCount :: Int
1090+ , nodeTransportRXSize :: Bytes
1091+ , nodeTransportRXCount :: Int
1092+ , nodeTransportServerOpen :: Int
1093+ } deriving (Eq, Show)
1094+
1095+data NodeFSStats = NodeFSStats {
1096+ nodeFSDataPaths :: [NodeDataPathStats]
1097+ , nodeFSTotal :: NodeFSTotalStats
1098+ , nodeFSTimestamp :: UTCTime
1099+ } deriving (Eq, Show)
1100+
1101+data NodeDataPathStats = NodeDataPathStats {
1102+ nodeDataPathDiskServiceTime :: Maybe Double
1103+ , nodeDataPathDiskQueue :: Maybe Double
1104+ , nodeDataPathIOSize :: Maybe Bytes
1105+ , nodeDataPathWriteSize :: Maybe Bytes
1106+ , nodeDataPathReadSize :: Maybe Bytes
1107+ , nodeDataPathIOOps :: Maybe Int
1108+ , nodeDataPathWrites :: Maybe Int
1109+ , nodeDataPathReads :: Maybe Int
1110+ , nodeDataPathAvailable :: Bytes
1111+ , nodeDataPathFree :: Bytes
1112+ , nodeDataPathTotal :: Bytes
1113+ , nodeDataPathType :: Maybe Text
1114+ , nodeDataPathDevice :: Maybe Text
1115+ , nodeDataPathMount :: Text
1116+ , nodeDataPathPath :: Text
1117+ } deriving (Eq, Show)
1118+
1119+data NodeFSTotalStats = NodeFSTotalStats {
1120+ nodeFSTotalDiskServiceTime :: Maybe Double
1121+ , nodeFSTotalDiskQueue :: Maybe Double
1122+ , nodeFSTotalIOSize :: Maybe Bytes
1123+ , nodeFSTotalWriteSize :: Maybe Bytes
1124+ , nodeFSTotalReadSize :: Maybe Bytes
1125+ , nodeFSTotalIOOps :: Maybe Int
1126+ , nodeFSTotalWrites :: Maybe Int
1127+ , nodeFSTotalReads :: Maybe Int
1128+ , nodeFSTotalAvailable :: Bytes
1129+ , nodeFSTotalFree :: Bytes
1130+ , nodeFSTotalTotal :: Bytes
1131+ } deriving (Eq, Show)
1132+
1133+data NodeNetworkStats = NodeNetworkStats {
1134+ nodeNetTCPOutRSTs :: Int
1135+ , nodeNetTCPInErrs :: Int
1136+ , nodeNetTCPAttemptFails :: Int
1137+ , nodeNetTCPEstabResets :: Int
1138+ , nodeNetTCPRetransSegs :: Int
1139+ , nodeNetTCPOutSegs :: Int
1140+ , nodeNetTCPInSegs :: Int
1141+ , nodeNetTCPCurrEstab :: Int
1142+ , nodeNetTCPPassiveOpens :: Int
1143+ , nodeNetTCPActiveOpens :: Int
1144+ } deriving (Eq, Show)
1145+
1146+data NodeThreadPoolsStats = NodeThreadPoolsStats {
1147+ nodeThreadPoolsStatsSnapshot :: NodeThreadPoolStats
1148+ , nodeThreadPoolsStatsBulk :: NodeThreadPoolStats
1149+ , nodeThreadPoolsStatsMerge :: NodeThreadPoolStats
1150+ , nodeThreadPoolsStatsGet :: NodeThreadPoolStats
1151+ , nodeThreadPoolsStatsManagement :: NodeThreadPoolStats
1152+ , nodeThreadPoolsStatsFetchShardStore :: Maybe NodeThreadPoolStats
1153+ , nodeThreadPoolsStatsOptimize :: Maybe NodeThreadPoolStats
1154+ , nodeThreadPoolsStatsFlush :: NodeThreadPoolStats
1155+ , nodeThreadPoolsStatsSearch :: NodeThreadPoolStats
1156+ , nodeThreadPoolsStatsWarmer :: NodeThreadPoolStats
1157+ , nodeThreadPoolsStatsGeneric :: NodeThreadPoolStats
1158+ , nodeThreadPoolsStatsSuggest :: Maybe NodeThreadPoolStats
1159+ , nodeThreadPoolsStatsRefresh :: NodeThreadPoolStats
1160+ , nodeThreadPoolsStatsIndex :: NodeThreadPoolStats
1161+ , nodeThreadPoolsStatsListener :: Maybe NodeThreadPoolStats
1162+ , nodeThreadPoolsStatsFetchShardStarted :: Maybe NodeThreadPoolStats
1163+ , nodeThreadPoolsStatsPercolate :: Maybe NodeThreadPoolStats
1164+ } deriving (Eq, Show)
1165+
1166+data NodeThreadPoolStats = NodeThreadPoolStats {
1167+ nodeThreadPoolCompleted :: Int
1168+ , nodeThreadPoolLargest :: Int
1169+ , nodeThreadPoolRejected :: Int
1170+ , nodeThreadPoolActive :: Int
1171+ , nodeThreadPoolQueue :: Int
1172+ , nodeThreadPoolThreads :: Int
1173+ } deriving (Eq, Show)
1174+
1175+data NodeJVMStats = NodeJVMStats {
1176+ nodeJVMStatsMappedBufferPool :: JVMBufferPoolStats
1177+ , nodeJVMStatsDirectBufferPool :: JVMBufferPoolStats
1178+ , nodeJVMStatsGCOldCollector :: JVMGCStats
1179+ , nodeJVMStatsGCYoungCollector :: JVMGCStats
1180+ , nodeJVMStatsPeakThreadsCount :: Int
1181+ , nodeJVMStatsThreadsCount :: Int
1182+ , nodeJVMStatsOldPool :: JVMPoolStats
1183+ , nodeJVMStatsSurvivorPool :: JVMPoolStats
1184+ , nodeJVMStatsYoungPool :: JVMPoolStats
1185+ , nodeJVMStatsNonHeapCommitted :: Bytes
1186+ , nodeJVMStatsNonHeapUsed :: Bytes
1187+ , nodeJVMStatsHeapMax :: Bytes
1188+ , nodeJVMStatsHeapCommitted :: Bytes
1189+ , nodeJVMStatsHeapUsedPercent :: Int
1190+ , nodeJVMStatsHeapUsed :: Bytes
1191+ , nodeJVMStatsUptime :: NominalDiffTime
1192+ , nodeJVMStatsTimestamp :: UTCTime
1193+ } deriving (Eq, Show)
1194+
1195+data JVMBufferPoolStats = JVMBufferPoolStats {
1196+ jvmBufferPoolStatsTotalCapacity :: Bytes
1197+ , jvmBufferPoolStatsUsed :: Bytes
1198+ , jvmBufferPoolStatsCount :: Int
1199+ } deriving (Eq, Show)
1200+
1201+data JVMGCStats = JVMGCStats {
1202+ jvmGCStatsCollectionTime :: NominalDiffTime
1203+ , jvmGCStatsCollectionCount :: Int
1204+ } deriving (Eq, Show)
1205+
1206+data JVMPoolStats = JVMPoolStats {
1207+ jvmPoolStatsPeakMax :: Bytes
1208+ , jvmPoolStatsPeakUsed :: Bytes
1209+ , jvmPoolStatsMax :: Bytes
1210+ , jvmPoolStatsUsed :: Bytes
1211+ } deriving (Eq, Show)
1212+
1213+data NodeProcessStats = NodeProcessStats {
1214+ nodeProcessTimestamp :: UTCTime
1215+ , nodeProcessOpenFDs :: Int
1216+ , nodeProcessMaxFDs :: Int
1217+ , nodeProcessCPUPercent :: Int
1218+ , nodeProcessCPUTotal :: NominalDiffTime
1219+ , nodeProcessMemTotalVirtual :: Bytes
1220+ } deriving (Eq, Show)
1221+
1222+data NodeOSStats = NodeOSStats {
1223+ nodeOSTimestamp :: UTCTime
1224+ , nodeOSCPUPercent :: Int
1225+ , nodeOSLoad :: Maybe LoadAvgs
1226+ , nodeOSMemTotal :: Bytes
1227+ , nodeOSMemFree :: Bytes
1228+ , nodeOSMemFreePercent :: Int
1229+ , nodeOSMemUsed :: Bytes
1230+ , nodeOSMemUsedPercent :: Int
1231+ , nodeOSSwapTotal :: Bytes
1232+ , nodeOSSwapFree :: Bytes
1233+ , nodeOSSwapUsed :: Bytes
1234+ } deriving (Eq, Show)
1235+
1236+data LoadAvgs = LoadAvgs {
1237+ loadAvg1Min :: Double
1238+ , loadAvg5Min :: Double
1239+ , loadAvg15Min :: Double
1240+ } deriving (Eq, Show)
1241+
1242+data NodeIndicesStats = NodeIndicesStats {
1243+ nodeIndicesStatsRecoveryThrottleTime :: Maybe NominalDiffTime
1244+ , nodeIndicesStatsRecoveryCurrentAsTarget :: Maybe Int
1245+ , nodeIndicesStatsRecoveryCurrentAsSource :: Maybe Int
1246+ , nodeIndicesStatsQueryCacheMisses :: Maybe Int
1247+ , nodeIndicesStatsQueryCacheHits :: Maybe Int
1248+ , nodeIndicesStatsQueryCacheEvictions :: Maybe Int
1249+ , nodeIndicesStatsQueryCacheSize :: Maybe Bytes
1250+ , nodeIndicesStatsSuggestCurrent :: Maybe Int
1251+ , nodeIndicesStatsSuggestTime :: Maybe NominalDiffTime
1252+ , nodeIndicesStatsSuggestTotal :: Maybe Int
1253+ , nodeIndicesStatsTranslogSize :: Bytes
1254+ , nodeIndicesStatsTranslogOps :: Int
1255+ , nodeIndicesStatsSegFixedBitSetMemory :: Maybe Bytes
1256+ , nodeIndicesStatsSegVersionMapMemory :: Bytes
1257+ , nodeIndicesStatsSegIndexWriterMaxMemory :: Maybe Bytes
1258+ , nodeIndicesStatsSegIndexWriterMemory :: Bytes
1259+ , nodeIndicesStatsSegMemory :: Bytes
1260+ , nodeIndicesStatsSegCount :: Int
1261+ , nodeIndicesStatsCompletionSize :: Bytes
1262+ , nodeIndicesStatsPercolateQueries :: Maybe Int
1263+ , nodeIndicesStatsPercolateMemory :: Maybe Bytes
1264+ , nodeIndicesStatsPercolateCurrent :: Maybe Int
1265+ , nodeIndicesStatsPercolateTime :: Maybe NominalDiffTime
1266+ , nodeIndicesStatsPercolateTotal :: Maybe Int
1267+ , nodeIndicesStatsFieldDataEvictions :: Int
1268+ , nodeIndicesStatsFieldDataMemory :: Bytes
1269+ , nodeIndicesStatsWarmerTotalTime :: NominalDiffTime
1270+ , nodeIndicesStatsWarmerTotal :: Int
1271+ , nodeIndicesStatsWarmerCurrent :: Int
1272+ , nodeIndicesStatsFlushTotalTime :: NominalDiffTime
1273+ , nodeIndicesStatsFlushTotal :: Int
1274+ , nodeIndicesStatsRefreshTotalTime :: NominalDiffTime
1275+ , nodeIndicesStatsRefreshTotal :: Int
1276+ , nodeIndicesStatsMergesTotalSize :: Bytes
1277+ , nodeIndicesStatsMergesTotalDocs :: Int
1278+ , nodeIndicesStatsMergesTotalTime :: NominalDiffTime
1279+ , nodeIndicesStatsMergesTotal :: Int
1280+ , nodeIndicesStatsMergesCurrentSize :: Bytes
1281+ , nodeIndicesStatsMergesCurrentDocs :: Int
1282+ , nodeIndicesStatsMergesCurrent :: Int
1283+ , nodeIndicesStatsSearchFetchCurrent :: Int
1284+ , nodeIndicesStatsSearchFetchTime :: NominalDiffTime
1285+ , nodeIndicesStatsSearchFetchTotal :: Int
1286+ , nodeIndicesStatsSearchQueryCurrent :: Int
1287+ , nodeIndicesStatsSearchQueryTime :: NominalDiffTime
1288+ , nodeIndicesStatsSearchQueryTotal :: Int
1289+ , nodeIndicesStatsSearchOpenContexts :: Int
1290+ , nodeIndicesStatsGetCurrent :: Int
1291+ , nodeIndicesStatsGetMissingTime :: NominalDiffTime
1292+ , nodeIndicesStatsGetMissingTotal :: Int
1293+ , nodeIndicesStatsGetExistsTime :: NominalDiffTime
1294+ , nodeIndicesStatsGetExistsTotal :: Int
1295+ , nodeIndicesStatsGetTime :: NominalDiffTime
1296+ , nodeIndicesStatsGetTotal :: Int
1297+ , nodeIndicesStatsIndexingThrottleTime :: Maybe NominalDiffTime
1298+ , nodeIndicesStatsIndexingIsThrottled :: Maybe Bool
1299+ , nodeIndicesStatsIndexingNoopUpdateTotal :: Maybe Int
1300+ , nodeIndicesStatsIndexingDeleteCurrent :: Int
1301+ , nodeIndicesStatsIndexingDeleteTime :: NominalDiffTime
1302+ , nodeIndicesStatsIndexingDeleteTotal :: Int
1303+ , nodeIndicesStatsIndexingIndexCurrent :: Int
1304+ , nodeIndicesStatsIndexingIndexTime :: NominalDiffTime
1305+ , nodeIndicesStatsIndexingTotal :: Int
1306+ , nodeIndicesStatsStoreThrottleTime :: NominalDiffTime
1307+ , nodeIndicesStatsStoreSize :: Bytes
1308+ , nodeIndicesStatsDocsDeleted :: Int
1309+ , nodeIndicesStatsDocsCount :: Int
1310+ } deriving (Eq, Show)
1311+
1312+-- | A quirky address format used throughout Elasticsearch. An example
1313+-- would be inet[/1.1.1.1:9200]. inet may be a placeholder for a
1314+-- <https://en.wikipedia.org/wiki/Fully_qualified_domain_name FQDN>.
1315+newtype EsAddress = EsAddress { esAddress :: Text }
1316+ deriving (Eq, Ord, Show, FromJSON)
1317+
1318+-- | Typically a 7 character hex string.
1319+newtype BuildHash = BuildHash { buildHash :: Text }
1320+ deriving (Eq, Ord, Show, FromJSON, ToJSON)
1321+
1322+newtype PluginName = PluginName { pluginName :: Text }
1323+ deriving (Eq, Ord, Show, FromJSON)
1324+
1325+data NodeInfo = NodeInfo {
1326+ nodeInfoHTTPAddress :: Maybe EsAddress
1327+ , nodeInfoBuild :: BuildHash
1328+ , nodeInfoESVersion :: VersionNumber
1329+ , nodeInfoIP :: Server
1330+ , nodeInfoHost :: Server
1331+ , nodeInfoTransportAddress :: EsAddress
1332+ , nodeInfoName :: NodeName
1333+ , nodeInfoFullId :: FullNodeId
1334+ , nodeInfoPlugins :: [NodePluginInfo]
1335+ , nodeInfoHTTP :: NodeHTTPInfo
1336+ , nodeInfoTransport :: NodeTransportInfo
1337+ , nodeInfoNetwork :: Maybe NodeNetworkInfo
1338+ , nodeInfoThreadPool :: NodeThreadPoolsInfo
1339+ , nodeInfoJVM :: NodeJVMInfo
1340+ , nodeInfoProcess :: NodeProcessInfo
1341+ , nodeInfoOS :: NodeOSInfo
1342+ , nodeInfoSettings :: Object
1343+ -- ^ The members of the settings objects are not consistent,
1344+ -- dependent on plugins, etc.
1345+ } deriving (Eq, Show)
1346+
1347+data NodePluginInfo = NodePluginInfo {
1348+ nodePluginSite :: Maybe Bool
1349+ -- ^ Is this a site plugin?
1350+ , nodePluginJVM :: Maybe Bool
1351+ -- ^ Is this plugin running on the JVM
1352+ , nodePluginDescription :: Text
1353+ , nodePluginVersion :: MaybeNA VersionNumber
1354+ , nodePluginName :: PluginName
1355+ } deriving (Eq, Show)
1356+
1357+data NodeHTTPInfo = NodeHTTPInfo {
1358+ nodeHTTPMaxContentLength :: Bytes
1359+ , nodeHTTPTransportAddress :: BoundTransportAddress
1360+ } deriving (Eq, Show)
1361+
1362+data NodeTransportInfo = NodeTransportInfo {
1363+ nodeTransportProfiles :: [BoundTransportAddress]
1364+ , nodeTransportAddress :: BoundTransportAddress
1365+ } deriving (Eq, Show)
1366+
1367+data BoundTransportAddress = BoundTransportAddress {
1368+ publishAddress :: EsAddress
1369+ , boundAddress :: [EsAddress]
1370+ } deriving (Eq, Show)
1371+
1372+data NodeNetworkInfo = NodeNetworkInfo {
1373+ nodeNetworkPrimaryInterface :: NodeNetworkInterface
1374+ , nodeNetworkRefreshInterval :: NominalDiffTime
1375+ } deriving (Eq, Show)
1376+
1377+newtype MacAddress = MacAddress { macAddress :: Text }
1378+ deriving (Eq, Ord, Show, FromJSON)
1379+
1380+newtype NetworkInterfaceName = NetworkInterfaceName { networkInterfaceName :: Text }
1381+ deriving (Eq, Ord, Show, FromJSON)
1382+
1383+data NodeNetworkInterface = NodeNetworkInterface {
1384+ nodeNetIfaceMacAddress :: MacAddress
1385+ , nodeNetIfaceName :: NetworkInterfaceName
1386+ , nodeNetIfaceAddress :: Server
1387+ } deriving (Eq, Show)
1388+
1389+data NodeThreadPoolsInfo = NodeThreadPoolsInfo {
1390+ nodeThreadPoolsRefresh :: NodeThreadPoolInfo
1391+ , nodeThreadPoolsManagement :: NodeThreadPoolInfo
1392+ , nodeThreadPoolsPercolate :: Maybe NodeThreadPoolInfo
1393+ , nodeThreadPoolsListener :: Maybe NodeThreadPoolInfo
1394+ , nodeThreadPoolsFetchShardStarted :: Maybe NodeThreadPoolInfo
1395+ , nodeThreadPoolsSearch :: NodeThreadPoolInfo
1396+ , nodeThreadPoolsFlush :: NodeThreadPoolInfo
1397+ , nodeThreadPoolsWarmer :: NodeThreadPoolInfo
1398+ , nodeThreadPoolsOptimize :: Maybe NodeThreadPoolInfo
1399+ , nodeThreadPoolsBulk :: NodeThreadPoolInfo
1400+ , nodeThreadPoolsSuggest :: Maybe NodeThreadPoolInfo
1401+ , nodeThreadPoolsMerge :: NodeThreadPoolInfo
1402+ , nodeThreadPoolsSnapshot :: NodeThreadPoolInfo
1403+ , nodeThreadPoolsGet :: NodeThreadPoolInfo
1404+ , nodeThreadPoolsFetchShardStore :: Maybe NodeThreadPoolInfo
1405+ , nodeThreadPoolsIndex :: NodeThreadPoolInfo
1406+ , nodeThreadPoolsGeneric :: NodeThreadPoolInfo
1407+ } deriving (Eq, Show)
1408+
1409+data NodeThreadPoolInfo = NodeThreadPoolInfo {
1410+ nodeThreadPoolQueueSize :: ThreadPoolSize
1411+ , nodeThreadPoolKeepalive :: Maybe NominalDiffTime
1412+ , nodeThreadPoolMin :: Maybe Int
1413+ , nodeThreadPoolMax :: Maybe Int
1414+ , nodeThreadPoolType :: ThreadPoolType
1415+ } deriving (Eq, Show)
1416+
1417+data ThreadPoolSize = ThreadPoolBounded Int
1418+ | ThreadPoolUnbounded
1419+ deriving (Eq, Show)
1420+
1421+data ThreadPoolType = ThreadPoolScaling
1422+ | ThreadPoolFixed
1423+ | ThreadPoolCached
1424+ deriving (Eq, Show)
1425+
1426+data NodeJVMInfo = NodeJVMInfo {
1427+ nodeJVMInfoMemoryPools :: [JVMMemoryPool]
1428+ , nodeJVMInfoMemoryPoolsGCCollectors :: [JVMGCCollector]
1429+ , nodeJVMInfoMemoryInfo :: JVMMemoryInfo
1430+ , nodeJVMInfoStartTime :: UTCTime
1431+ , nodeJVMInfoVMVendor :: Text
1432+ , nodeJVMVMVersion :: VMVersion
1433+ -- ^ JVM doesn't seme to follow normal version conventions
1434+ , nodeJVMVMName :: Text
1435+ , nodeJVMVersion :: JVMVersion
1436+ , nodeJVMPID :: PID
1437+ } deriving (Eq, Show)
1438+
1439+-- | We cannot parse JVM version numbers and we're not going to try.
1440+newtype JVMVersion =
1441+ JVMVersion { unJVMVersion :: Text }
1442+ deriving (Eq, Show)
1443+
1444+instance FromJSON JVMVersion where
1445+ parseJSON = withText "JVMVersion" (pure . JVMVersion)
1446+
1447+data JVMMemoryInfo = JVMMemoryInfo {
1448+ jvmMemoryInfoDirectMax :: Bytes
1449+ , jvmMemoryInfoNonHeapMax :: Bytes
1450+ , jvmMemoryInfoNonHeapInit :: Bytes
1451+ , jvmMemoryInfoHeapMax :: Bytes
1452+ , jvmMemoryInfoHeapInit :: Bytes
1453+ } deriving (Eq, Show)
1454+
1455+-- VM version numbers don't appear to be SemVer
1456+-- so we're special casing this jawn.
1457+newtype VMVersion =
1458+ VMVersion { unVMVersion :: Text }
1459+ deriving (Eq, Show)
1460+
1461+instance ToJSON VMVersion where
1462+ toJSON = toJSON . unVMVersion
1463+
1464+instance FromJSON VMVersion where
1465+ parseJSON = withText "VMVersion" (pure . VMVersion)
1466+
1467+newtype JVMMemoryPool = JVMMemoryPool {
1468+ jvmMemoryPool :: Text
1469+ } deriving (Eq, Show, FromJSON)
1470+
1471+newtype JVMGCCollector = JVMGCCollector {
1472+ jvmGCCollector :: Text
1473+ } deriving (Eq, Show, FromJSON)
1474+
1475+newtype PID = PID {
1476+ pid :: Int
1477+ } deriving (Eq, Show, FromJSON)
1478+
1479+data NodeOSInfo = NodeOSInfo {
1480+ nodeOSRefreshInterval :: NominalDiffTime
1481+ , nodeOSName :: Text
1482+ , nodeOSArch :: Text
1483+ , nodeOSVersion :: VersionNumber
1484+ , nodeOSAvailableProcessors :: Int
1485+ , nodeOSAllocatedProcessors :: Int
1486+ } deriving (Eq, Show)
1487+
1488+data CPUInfo = CPUInfo {
1489+ cpuCacheSize :: Bytes
1490+ , cpuCoresPerSocket :: Int
1491+ , cpuTotalSockets :: Int
1492+ , cpuTotalCores :: Int
1493+ , cpuMHZ :: Int
1494+ , cpuModel :: Text
1495+ , cpuVendor :: Text
1496+ } deriving (Eq, Show)
1497+
1498+data NodeProcessInfo = NodeProcessInfo {
1499+ nodeProcessMLockAll :: Bool
1500+ -- ^ See <https://www.elastic.co/guide/en/elasticsearch/reference/current/setup-configuration.html>
1501+ , nodeProcessMaxFileDescriptors :: Maybe Int
1502+ , nodeProcessId :: PID
1503+ , nodeProcessRefreshInterval :: NominalDiffTime
1504+ } deriving (Eq, Show)
1505+
1506+data ShardResult =
1507+ ShardResult { shardTotal :: Int
1508+ , shardsSuccessful :: Int
1509+ , shardsFailed :: Int } deriving (Eq, Show)
1510+
1511+instance FromJSON ShardResult where
1512+ parseJSON (Object v) = ShardResult <$>
1513+ v .: "total" <*>
1514+ v .: "successful" <*>
1515+ v .: "failed"
1516+ parseJSON _ = empty
1517+
1518+data SnapshotState = SnapshotInit
1519+ | SnapshotStarted
1520+ | SnapshotSuccess
1521+ | SnapshotFailed
1522+ | SnapshotAborted
1523+ | SnapshotMissing
1524+ | SnapshotWaiting
1525+ deriving (Eq, Show)
1526+
1527+instance FromJSON SnapshotState where
1528+ parseJSON = withText "SnapshotState" parse
1529+ where
1530+ parse "INIT" = return SnapshotInit
1531+ parse "STARTED" = return SnapshotStarted
1532+ parse "SUCCESS" = return SnapshotSuccess
1533+ parse "FAILED" = return SnapshotFailed
1534+ parse "ABORTED" = return SnapshotAborted
1535+ parse "MISSING" = return SnapshotMissing
1536+ parse "WAITING" = return SnapshotWaiting
1537+ parse t = fail ("Invalid snapshot state " <> T.unpack t)
1538+
1539+
1540+data SnapshotRestoreSettings = SnapshotRestoreSettings {
1541+ snapRestoreWaitForCompletion :: Bool
1542+ -- ^ Should the API call return immediately after initializing
1543+ -- the restore or wait until completed? Note that if this is
1544+ -- enabled, it could wait a long time, so you should adjust your
1545+ -- 'ManagerSettings' accordingly to set long timeouts or
1546+ -- explicitly handle timeouts.
1547+ , snapRestoreIndices :: Maybe IndexSelection
1548+ -- ^ Nothing will restore all indices in the snapshot. Just [] is
1549+ -- permissable and will essentially be a no-op restore.
1550+ , snapRestoreIgnoreUnavailable :: Bool
1551+ -- ^ If set to True, any indices that do not exist will be ignored
1552+ -- during snapshot rather than failing the restore.
1553+ , snapRestoreIncludeGlobalState :: Bool
1554+ -- ^ If set to false, will ignore any global state in the snapshot
1555+ -- and will not restore it.
1556+ , snapRestoreRenamePattern :: Maybe RestoreRenamePattern
1557+ -- ^ A regex pattern for matching indices. Used with
1558+ -- 'snapRestoreRenameReplacement', the restore can reference the
1559+ -- matched index and create a new index name upon restore.
1560+ , snapRestoreRenameReplacement :: Maybe (NonEmpty RestoreRenameToken)
1561+ -- ^ Expression of how index renames should be constructed.
1562+ , snapRestorePartial :: Bool
1563+ -- ^ If some indices fail to restore, should the process proceed?
1564+ , snapRestoreIncludeAliases :: Bool
1565+ -- ^ Should the restore also restore the aliases captured in the
1566+ -- snapshot.
1567+ , snapRestoreIndexSettingsOverrides :: Maybe RestoreIndexSettings
1568+ -- ^ Settings to apply during the restore process. __NOTE:__ This
1569+ -- option is not supported in ES < 1.5 and should be set to
1570+ -- Nothing in that case.
1571+ , snapRestoreIgnoreIndexSettings :: Maybe (NonEmpty Text)
1572+ -- ^ This type could be more rich but it isn't clear which
1573+ -- settings are allowed to be ignored during restore, so we're
1574+ -- going with including this feature in a basic form rather than
1575+ -- omitting it. One example here would be
1576+ -- "index.refresh_interval". Any setting specified here will
1577+ -- revert back to the server default during the restore process.
1578+ } deriving (Eq, Show)
1579+
1580+newtype SnapshotRepoUpdateSettings = SnapshotRepoUpdateSettings
1581+ { repoUpdateVerify :: Bool
1582+ -- ^ After creation/update, synchronously check that nodes can
1583+ -- write to this repo. Defaults to True. You may use False if you
1584+ -- need a faster response and plan on verifying manually later
1585+ -- with 'verifySnapshotRepo'.
1586+ } deriving (Eq, Show)
1587+
1588+
1589+-- | Reasonable defaults for repo creation/update
1590+--
1591+-- * repoUpdateVerify True
1592+defaultSnapshotRepoUpdateSettings :: SnapshotRepoUpdateSettings
1593+defaultSnapshotRepoUpdateSettings = SnapshotRepoUpdateSettings True
1594+
1595+
1596+-- | A filesystem-based snapshot repo that ships with
1597+-- Elasticsearch. This is an instance of 'SnapshotRepo' so it can be
1598+-- used with 'updateSnapshotRepo'
1599+data FsSnapshotRepo = FsSnapshotRepo {
1600+ fsrName :: SnapshotRepoName
1601+ , fsrLocation :: FilePath
1602+ , fsrCompressMetadata :: Bool
1603+ , fsrChunkSize :: Maybe Bytes
1604+ -- ^ Size by which to split large files during snapshotting.
1605+ , fsrMaxRestoreBytesPerSec :: Maybe Bytes
1606+ -- ^ Throttle node restore rate. If not supplied, defaults to 40mb/sec
1607+ , fsrMaxSnapshotBytesPerSec :: Maybe Bytes
1608+ -- ^ Throttle node snapshot rate. If not supplied, defaults to 40mb/sec
1609+ } deriving (Eq, Show)
1610+
1611+
1612+instance SnapshotRepo FsSnapshotRepo where
1613+ toGSnapshotRepo FsSnapshotRepo {..} =
1614+ GenericSnapshotRepo fsrName fsRepoType (GenericSnapshotRepoSettings settings)
1615+ where
1616+ Object settings = object $ [ "location" .= fsrLocation
1617+ , "compress" .= fsrCompressMetadata
1618+ ] ++ optionalPairs
1619+ optionalPairs = catMaybes [ ("chunk_size" .=) <$> fsrChunkSize
1620+ , ("max_restore_bytes_per_sec" .=) <$> fsrMaxRestoreBytesPerSec
1621+ , ("max_snapshot_bytes_per_sec" .=) <$> fsrMaxSnapshotBytesPerSec
1622+ ]
1623+ fromGSnapshotRepo GenericSnapshotRepo {..}
1624+ | gSnapshotRepoType == fsRepoType = do
1625+ let o = gSnapshotRepoSettingsObject gSnapshotRepoSettings
1626+ parseRepo $
1627+ FsSnapshotRepo gSnapshotRepoName <$> o .: "location"
1628+ <*> o .:? "compress" .!= False
1629+ <*> o .:? "chunk_size"
1630+ <*> o .:? "max_restore_bytes_per_sec"
1631+ <*> o .:? "max_snapshot_bytes_per_sec"
1632+ | otherwise = Left (RepoTypeMismatch fsRepoType gSnapshotRepoType)
1633+
1634+
1635+parseRepo :: Parser a -> Either SnapshotRepoConversionError a
1636+parseRepo parser = case parseEither (const parser) () of
1637+ Left e -> Left (OtherRepoConversionError (T.pack e))
1638+ Right a -> Right a
1639+
1640+
1641+fsRepoType :: SnapshotRepoType
1642+fsRepoType = SnapshotRepoType "fs"
1643+
1644+-- | Law: fromGSnapshotRepo (toGSnapshotRepo r) == Right r
1645+class SnapshotRepo r where
1646+ toGSnapshotRepo :: r -> GenericSnapshotRepo
1647+ fromGSnapshotRepo :: GenericSnapshotRepo -> Either SnapshotRepoConversionError r
1648+
1649+
1650+data SnapshotRepoConversionError = RepoTypeMismatch SnapshotRepoType SnapshotRepoType
1651+ -- ^ Expected type and actual type
1652+ | OtherRepoConversionError Text
1653+ deriving (Show, Eq)
1654+
1655+
1656+instance Exception SnapshotRepoConversionError
1657+
1658+
1659+data SnapshotCreateSettings = SnapshotCreateSettings {
1660+ snapWaitForCompletion :: Bool
1661+ -- ^ Should the API call return immediately after initializing
1662+ -- the snapshot or wait until completed? Note that if this is
1663+ -- enabled it could wait a long time, so you should adjust your
1664+ -- 'ManagerSettings' accordingly to set long timeouts or
1665+ -- explicitly handle timeouts.
1666+ , snapIndices :: Maybe IndexSelection
1667+ -- ^ Nothing will snapshot all indices. Just [] is permissable and
1668+ -- will essentially be a no-op snapshot.
1669+ , snapIgnoreUnavailable :: Bool
1670+ -- ^ If set to True, any matched indices that don't exist will be
1671+ -- ignored. Otherwise it will be an error and fail.
1672+ , snapIncludeGlobalState :: Bool
1673+ , snapPartial :: Bool
1674+ -- ^ If some indices failed to snapshot (e.g. if not all primary
1675+ -- shards are available), should the process proceed?
1676+ } deriving (Eq, Show)
1677+
1678+
1679+-- | Reasonable defaults for snapshot creation
1680+--
1681+-- * snapWaitForCompletion False
1682+-- * snapIndices Nothing
1683+-- * snapIgnoreUnavailable False
1684+-- * snapIncludeGlobalState True
1685+-- * snapPartial False
1686+defaultSnapshotCreateSettings :: SnapshotCreateSettings
1687+defaultSnapshotCreateSettings = SnapshotCreateSettings {
1688+ snapWaitForCompletion = False
1689+ , snapIndices = Nothing
1690+ , snapIgnoreUnavailable = False
1691+ , snapIncludeGlobalState = True
1692+ , snapPartial = False
1693+ }
1694+
1695+
1696+data SnapshotSelection =
1697+ SnapshotList (NonEmpty SnapshotPattern)
1698+ | AllSnapshots
1699+ deriving (Eq, Show)
1700+
1701+
1702+-- | Either specifies an exact snapshot name or one with globs in it,
1703+-- e.g. @SnapPattern "foo*"@ __NOTE__: Patterns are not supported on
1704+-- ES < 1.7
1705+data SnapshotPattern =
1706+ ExactSnap SnapshotName
1707+ | SnapPattern Text
1708+ deriving (Eq, Show)
1709+
1710+
1711+-- | General information about the state of a snapshot. Has some
1712+-- redundancies with 'SnapshotStatus'
1713+data SnapshotInfo = SnapshotInfo {
1714+ snapInfoShards :: ShardResult
1715+ , snapInfoFailures :: [SnapshotShardFailure]
1716+ , snapInfoDuration :: NominalDiffTime
1717+ , snapInfoEndTime :: UTCTime
1718+ , snapInfoStartTime :: UTCTime
1719+ , snapInfoState :: SnapshotState
1720+ , snapInfoIndices :: [IndexName]
1721+ , snapInfoName :: SnapshotName
1722+ } deriving (Eq, Show)
1723+
1724+
1725+instance FromJSON SnapshotInfo where
1726+ parseJSON = withObject "SnapshotInfo" parse
1727+ where
1728+ parse o = SnapshotInfo <$> o .: "shards"
1729+ <*> o .: "failures"
1730+ <*> (unMS <$> o .: "duration_in_millis")
1731+ <*> (posixMS <$> o .: "end_time_in_millis")
1732+ <*> (posixMS <$> o .: "start_time_in_millis")
1733+ <*> o .: "state"
1734+ <*> o .: "indices"
1735+ <*> o .: "snapshot"
1736+
1737+data SnapshotShardFailure = SnapshotShardFailure {
1738+ snapShardFailureIndex :: IndexName
1739+ , snapShardFailureNodeId :: Maybe NodeName -- I'm not 100% sure this isn't actually 'FullNodeId'
1740+ , snapShardFailureReason :: Text
1741+ , snapShardFailureShardId :: ShardId
1742+ } deriving (Eq, Show)
1743+
1744+
1745+instance FromJSON SnapshotShardFailure where
1746+ parseJSON = withObject "SnapshotShardFailure" parse
1747+ where
1748+ parse o = SnapshotShardFailure <$> o .: "index"
1749+ <*> o .:? "node_id"
1750+ <*> o .: "reason"
1751+ <*> o .: "shard_id"
1752+
1753+-- | Regex-stype pattern, e.g. "index_(.+)" to match index names
1754+newtype RestoreRenamePattern =
1755+ RestoreRenamePattern { rrPattern :: Text }
1756+ deriving (Eq, Show, Ord, ToJSON)
1757+
1758+
1759+-- | A single token in a index renaming scheme for a restore. These
1760+-- are concatenated into a string before being sent to
1761+-- Elasticsearch. Check out these Java
1762+-- <https://docs.oracle.com/javase/7/docs/api/java/util/regex/Matcher.html docs> to find out more if you're into that sort of thing.
1763+data RestoreRenameToken = RRTLit Text
1764+ -- ^ Just a literal string of characters
1765+ | RRSubWholeMatch
1766+ -- ^ Equivalent to $0. The entire matched pattern, not any subgroup
1767+ | RRSubGroup RRGroupRefNum
1768+ -- ^ A specific reference to a group number
1769+ deriving (Eq, Show)
1770+
1771+
1772+-- | A group number for regex matching. Only values from 1-9 are
1773+-- supported. Construct with 'mkRRGroupRefNum'
1774+newtype RRGroupRefNum =
1775+ RRGroupRefNum { rrGroupRefNum :: Int }
1776+ deriving (Eq, Ord, Show)
1777+
1778+instance Bounded RRGroupRefNum where
1779+ minBound = RRGroupRefNum 1
1780+ maxBound = RRGroupRefNum 9
1781+
1782+
1783+-- | Only allows valid group number references (1-9).
1784+mkRRGroupRefNum :: Int -> Maybe RRGroupRefNum
1785+mkRRGroupRefNum i
1786+ | i >= rrGroupRefNum minBound
1787+ && i <= rrGroupRefNum maxBound =
1788+ Just $ RRGroupRefNum i
1789+ | otherwise = Nothing
1790+
1791+-- | Reasonable defaults for snapshot restores
1792+--
1793+-- * snapRestoreWaitForCompletion False
1794+-- * snapRestoreIndices Nothing
1795+-- * snapRestoreIgnoreUnavailable False
1796+-- * snapRestoreIncludeGlobalState True
1797+-- * snapRestoreRenamePattern Nothing
1798+-- * snapRestoreRenameReplacement Nothing
1799+-- * snapRestorePartial False
1800+-- * snapRestoreIncludeAliases True
1801+-- * snapRestoreIndexSettingsOverrides Nothing
1802+-- * snapRestoreIgnoreIndexSettings Nothing
1803+defaultSnapshotRestoreSettings :: SnapshotRestoreSettings
1804+defaultSnapshotRestoreSettings = SnapshotRestoreSettings {
1805+ snapRestoreWaitForCompletion = False
1806+ , snapRestoreIndices = Nothing
1807+ , snapRestoreIgnoreUnavailable = False
1808+ , snapRestoreIncludeGlobalState = True
1809+ , snapRestoreRenamePattern = Nothing
1810+ , snapRestoreRenameReplacement = Nothing
1811+ , snapRestorePartial = False
1812+ , snapRestoreIncludeAliases = True
1813+ , snapRestoreIndexSettingsOverrides = Nothing
1814+ , snapRestoreIgnoreIndexSettings = Nothing
1815+ }
1816+
1817+
1818+-- | Index settings that can be overridden. The docs only mention you
1819+-- can update number of replicas, but there may be more. You
1820+-- definitely cannot override shard count.
1821+newtype RestoreIndexSettings = RestoreIndexSettings
1822+ { restoreOverrideReplicas :: Maybe ReplicaCount
1823+ } deriving (Eq, Show)
1824+
1825+
1826+instance ToJSON RestoreIndexSettings where
1827+ toJSON RestoreIndexSettings {..} = object prs
1828+ where
1829+ prs = catMaybes [("index.number_of_replicas" .=) <$> restoreOverrideReplicas]
1830+
1831+
1832+instance FromJSON NodesInfo where
1833+ parseJSON = withObject "NodesInfo" parse
1834+ where
1835+ parse o = do
1836+ nodes <- o .: "nodes"
1837+ infos <- forM (HM.toList nodes) $ \(fullNID, v) -> do
1838+ node <- parseJSON v
1839+ parseNodeInfo (FullNodeId fullNID) node
1840+ cn <- o .: "cluster_name"
1841+ return (NodesInfo infos cn)
1842+
1843+instance FromJSON NodesStats where
1844+ parseJSON = withObject "NodesStats" parse
1845+ where
1846+ parse o = do
1847+ nodes <- o .: "nodes"
1848+ stats <- forM (HM.toList nodes) $ \(fullNID, v) -> do
1849+ node <- parseJSON v
1850+ parseNodeStats (FullNodeId fullNID) node
1851+ cn <- o .: "cluster_name"
1852+ return (NodesStats stats cn)
1853+
1854+instance FromJSON NodeBreakerStats where
1855+ parseJSON = withObject "NodeBreakerStats" parse
1856+ where
1857+ parse o = NodeBreakerStats <$> o .: "tripped"
1858+ <*> o .: "overhead"
1859+ <*> o .: "estimated_size_in_bytes"
1860+ <*> o .: "limit_size_in_bytes"
1861+
1862+instance FromJSON NodeHTTPStats where
1863+ parseJSON = withObject "NodeHTTPStats" parse
1864+ where
1865+ parse o = NodeHTTPStats <$> o .: "total_opened"
1866+ <*> o .: "current_open"
1867+
1868+instance FromJSON NodeTransportStats where
1869+ parseJSON = withObject "NodeTransportStats" parse
1870+ where
1871+ parse o = NodeTransportStats <$> o .: "tx_size_in_bytes"
1872+ <*> o .: "tx_count"
1873+ <*> o .: "rx_size_in_bytes"
1874+ <*> o .: "rx_count"
1875+ <*> o .: "server_open"
1876+
1877+instance FromJSON NodeFSStats where
1878+ parseJSON = withObject "NodeFSStats" parse
1879+ where
1880+ parse o = NodeFSStats <$> o .: "data"
1881+ <*> o .: "total"
1882+ <*> (posixMS <$> o .: "timestamp")
1883+
1884+instance FromJSON NodeDataPathStats where
1885+ parseJSON = withObject "NodeDataPathStats" parse
1886+ where
1887+ parse o =
1888+ NodeDataPathStats <$> (fmap unStringlyTypedDouble <$> o .:? "disk_service_time")
1889+ <*> (fmap unStringlyTypedDouble <$> o .:? "disk_queue")
1890+ <*> o .:? "disk_io_size_in_bytes"
1891+ <*> o .:? "disk_write_size_in_bytes"
1892+ <*> o .:? "disk_read_size_in_bytes"
1893+ <*> o .:? "disk_io_op"
1894+ <*> o .:? "disk_writes"
1895+ <*> o .:? "disk_reads"
1896+ <*> o .: "available_in_bytes"
1897+ <*> o .: "free_in_bytes"
1898+ <*> o .: "total_in_bytes"
1899+ <*> o .:? "type"
1900+ <*> o .:? "dev"
1901+ <*> o .: "mount"
1902+ <*> o .: "path"
1903+
1904+instance FromJSON NodeFSTotalStats where
1905+ parseJSON = withObject "NodeFSTotalStats" parse
1906+ where
1907+ parse o = NodeFSTotalStats <$> (fmap unStringlyTypedDouble <$> o .:? "disk_service_time")
1908+ <*> (fmap unStringlyTypedDouble <$> o .:? "disk_queue")
1909+ <*> o .:? "disk_io_size_in_bytes"
1910+ <*> o .:? "disk_write_size_in_bytes"
1911+ <*> o .:? "disk_read_size_in_bytes"
1912+ <*> o .:? "disk_io_op"
1913+ <*> o .:? "disk_writes"
1914+ <*> o .:? "disk_reads"
1915+ <*> o .: "available_in_bytes"
1916+ <*> o .: "free_in_bytes"
1917+ <*> o .: "total_in_bytes"
1918+
1919+instance FromJSON NodeNetworkStats where
1920+ parseJSON = withObject "NodeNetworkStats" parse
1921+ where
1922+ parse o = do
1923+ tcp <- o .: "tcp"
1924+ NodeNetworkStats <$> tcp .: "out_rsts"
1925+ <*> tcp .: "in_errs"
1926+ <*> tcp .: "attempt_fails"
1927+ <*> tcp .: "estab_resets"
1928+ <*> tcp .: "retrans_segs"
1929+ <*> tcp .: "out_segs"
1930+ <*> tcp .: "in_segs"
1931+ <*> tcp .: "curr_estab"
1932+ <*> tcp .: "passive_opens"
1933+ <*> tcp .: "active_opens"
1934+
1935+instance FromJSON NodeThreadPoolsStats where
1936+ parseJSON = withObject "NodeThreadPoolsStats" parse
1937+ where
1938+ parse o = NodeThreadPoolsStats <$> o .: "snapshot"
1939+ <*> o .: "bulk"
1940+ <*> o .: "force_merge"
1941+ <*> o .: "get"
1942+ <*> o .: "management"
1943+ <*> o .:? "fetch_shard_store"
1944+ <*> o .:? "optimize"
1945+ <*> o .: "flush"
1946+ <*> o .: "search"
1947+ <*> o .: "warmer"
1948+ <*> o .: "generic"
1949+ <*> o .:? "suggest"
1950+ <*> o .: "refresh"
1951+ <*> o .: "index"
1952+ <*> o .:? "listener"
1953+ <*> o .:? "fetch_shard_started"
1954+ <*> o .:? "percolate"
1955+instance FromJSON NodeThreadPoolStats where
1956+ parseJSON = withObject "NodeThreadPoolStats" parse
1957+ where
1958+ parse o = NodeThreadPoolStats <$> o .: "completed"
1959+ <*> o .: "largest"
1960+ <*> o .: "rejected"
1961+ <*> o .: "active"
1962+ <*> o .: "queue"
1963+ <*> o .: "threads"
1964+
1965+instance FromJSON NodeJVMStats where
1966+ parseJSON = withObject "NodeJVMStats" parse
1967+ where
1968+ parse o = do
1969+ bufferPools <- o .: "buffer_pools"
1970+ mapped <- bufferPools .: "mapped"
1971+ direct <- bufferPools .: "direct"
1972+ gc <- o .: "gc"
1973+ collectors <- gc .: "collectors"
1974+ oldC <- collectors .: "old"
1975+ youngC <- collectors .: "young"
1976+ threads <- o .: "threads"
1977+ mem <- o .: "mem"
1978+ pools <- mem .: "pools"
1979+ oldM <- pools .: "old"
1980+ survivorM <- pools .: "survivor"
1981+ youngM <- pools .: "young"
1982+ NodeJVMStats <$> pure mapped
1983+ <*> pure direct
1984+ <*> pure oldC
1985+ <*> pure youngC
1986+ <*> threads .: "peak_count"
1987+ <*> threads .: "count"
1988+ <*> pure oldM
1989+ <*> pure survivorM
1990+ <*> pure youngM
1991+ <*> mem .: "non_heap_committed_in_bytes"
1992+ <*> mem .: "non_heap_used_in_bytes"
1993+ <*> mem .: "heap_max_in_bytes"
1994+ <*> mem .: "heap_committed_in_bytes"
1995+ <*> mem .: "heap_used_percent"
1996+ <*> mem .: "heap_used_in_bytes"
1997+ <*> (unMS <$> o .: "uptime_in_millis")
1998+ <*> (posixMS <$> o .: "timestamp")
1999+
2000+instance FromJSON JVMBufferPoolStats where
2001+ parseJSON = withObject "JVMBufferPoolStats" parse
2002+ where
2003+ parse o = JVMBufferPoolStats <$> o .: "total_capacity_in_bytes"
2004+ <*> o .: "used_in_bytes"
2005+ <*> o .: "count"
2006+
2007+instance FromJSON JVMGCStats where
2008+ parseJSON = withObject "JVMGCStats" parse
2009+ where
2010+ parse o = JVMGCStats <$> (unMS <$> o .: "collection_time_in_millis")
2011+ <*> o .: "collection_count"
2012+
2013+instance FromJSON JVMPoolStats where
2014+ parseJSON = withObject "JVMPoolStats" parse
2015+ where
2016+ parse o = JVMPoolStats <$> o .: "peak_max_in_bytes"
2017+ <*> o .: "peak_used_in_bytes"
2018+ <*> o .: "max_in_bytes"
2019+ <*> o .: "used_in_bytes"
2020+
2021+instance FromJSON NodeProcessStats where
2022+ parseJSON = withObject "NodeProcessStats" parse
2023+ where
2024+ parse o = do
2025+ mem <- o .: "mem"
2026+ cpu <- o .: "cpu"
2027+ NodeProcessStats <$> (posixMS <$> o .: "timestamp")
2028+ <*> o .: "open_file_descriptors"
2029+ <*> o .: "max_file_descriptors"
2030+ <*> cpu .: "percent"
2031+ <*> (unMS <$> cpu .: "total_in_millis")
2032+ <*> mem .: "total_virtual_in_bytes"
2033+
2034+instance FromJSON NodeOSStats where
2035+ parseJSON = withObject "NodeOSStats" parse
2036+ where
2037+ parse o = do
2038+ swap <- o .: "swap"
2039+ mem <- o .: "mem"
2040+ cpu <- o .: "cpu"
2041+ load <- o .:? "load_average"
2042+ NodeOSStats <$> (posixMS <$> o .: "timestamp")
2043+ <*> cpu .: "percent"
2044+ <*> pure load
2045+ <*> mem .: "total_in_bytes"
2046+ <*> mem .: "free_in_bytes"
2047+ <*> mem .: "free_percent"
2048+ <*> mem .: "used_in_bytes"
2049+ <*> mem .: "used_percent"
2050+ <*> swap .: "total_in_bytes"
2051+ <*> swap .: "free_in_bytes"
2052+ <*> swap .: "used_in_bytes"
2053+
2054+instance FromJSON LoadAvgs where
2055+ parseJSON = withArray "LoadAvgs" parse
2056+ where
2057+ parse v = case V.toList v of
2058+ [one, five, fifteen] -> LoadAvgs <$> parseJSON one
2059+ <*> parseJSON five
2060+ <*> parseJSON fifteen
2061+ _ -> fail "Expecting a triple of Doubles"
2062+
2063+instance FromJSON NodeIndicesStats where
2064+ parseJSON = withObject "NodeIndicesStats" parse
2065+ where
2066+ parse o = do
2067+ let (.::) mv k = case mv of
2068+ Just v -> Just <$> v .: k
2069+ Nothing -> pure Nothing
2070+ mRecovery <- o .:? "recovery"
2071+ mQueryCache <- o .:? "query_cache"
2072+ mSuggest <- o .:? "suggest"
2073+ translog <- o .: "translog"
2074+ segments <- o .: "segments"
2075+ completion <- o .: "completion"
2076+ mPercolate <- o .:? "percolate"
2077+ fielddata <- o .: "fielddata"
2078+ warmer <- o .: "warmer"
2079+ flush <- o .: "flush"
2080+ refresh <- o .: "refresh"
2081+ merges <- o .: "merges"
2082+ search <- o .: "search"
2083+ getStats <- o .: "get"
2084+ indexing <- o .: "indexing"
2085+ store <- o .: "store"
2086+ docs <- o .: "docs"
2087+ NodeIndicesStats <$> (fmap unMS <$> mRecovery .:: "throttle_time_in_millis")
2088+ <*> mRecovery .:: "current_as_target"
2089+ <*> mRecovery .:: "current_as_source"
2090+ <*> mQueryCache .:: "miss_count"
2091+ <*> mQueryCache .:: "hit_count"
2092+ <*> mQueryCache .:: "evictions"
2093+ <*> mQueryCache .:: "memory_size_in_bytes"
2094+ <*> mSuggest .:: "current"
2095+ <*> (fmap unMS <$> mSuggest .:: "time_in_millis")
2096+ <*> mSuggest .:: "total"
2097+ <*> translog .: "size_in_bytes"
2098+ <*> translog .: "operations"
2099+ <*> segments .:? "fixed_bit_set_memory_in_bytes"
2100+ <*> segments .: "version_map_memory_in_bytes"
2101+ <*> segments .:? "index_writer_max_memory_in_bytes"
2102+ <*> segments .: "index_writer_memory_in_bytes"
2103+ <*> segments .: "memory_in_bytes"
2104+ <*> segments .: "count"
2105+ <*> completion .: "size_in_bytes"
2106+ <*> mPercolate .:: "queries"
2107+ <*> mPercolate .:: "memory_size_in_bytes"
2108+ <*> mPercolate .:: "current"
2109+ <*> (fmap unMS <$> mPercolate .:: "time_in_millis")
2110+ <*> mPercolate .:: "total"
2111+ <*> fielddata .: "evictions"
2112+ <*> fielddata .: "memory_size_in_bytes"
2113+ <*> (unMS <$> warmer .: "total_time_in_millis")
2114+ <*> warmer .: "total"
2115+ <*> warmer .: "current"
2116+ <*> (unMS <$> flush .: "total_time_in_millis")
2117+ <*> flush .: "total"
2118+ <*> (unMS <$> refresh .: "total_time_in_millis")
2119+ <*> refresh .: "total"
2120+ <*> merges .: "total_size_in_bytes"
2121+ <*> merges .: "total_docs"
2122+ <*> (unMS <$> merges .: "total_time_in_millis")
2123+ <*> merges .: "total"
2124+ <*> merges .: "current_size_in_bytes"
2125+ <*> merges .: "current_docs"
2126+ <*> merges .: "current"
2127+ <*> search .: "fetch_current"
2128+ <*> (unMS <$> search .: "fetch_time_in_millis")
2129+ <*> search .: "fetch_total"
2130+ <*> search .: "query_current"
2131+ <*> (unMS <$> search .: "query_time_in_millis")
2132+ <*> search .: "query_total"
2133+ <*> search .: "open_contexts"
2134+ <*> getStats .: "current"
2135+ <*> (unMS <$> getStats .: "missing_time_in_millis")
2136+ <*> getStats .: "missing_total"
2137+ <*> (unMS <$> getStats .: "exists_time_in_millis")
2138+ <*> getStats .: "exists_total"
2139+ <*> (unMS <$> getStats .: "time_in_millis")
2140+ <*> getStats .: "total"
2141+ <*> (fmap unMS <$> indexing .:? "throttle_time_in_millis")
2142+ <*> indexing .:? "is_throttled"
2143+ <*> indexing .:? "noop_update_total"
2144+ <*> indexing .: "delete_current"
2145+ <*> (unMS <$> indexing .: "delete_time_in_millis")
2146+ <*> indexing .: "delete_total"
2147+ <*> indexing .: "index_current"
2148+ <*> (unMS <$> indexing .: "index_time_in_millis")
2149+ <*> indexing .: "index_total"
2150+ <*> (unMS <$> store .: "throttle_time_in_millis")
2151+ <*> store .: "size_in_bytes"
2152+ <*> docs .: "deleted"
2153+ <*> docs .: "count"
2154+
2155+instance FromJSON NodeBreakersStats where
2156+ parseJSON = withObject "NodeBreakersStats" parse
2157+ where
2158+ parse o = NodeBreakersStats <$> o .: "parent"
2159+ <*> o .: "request"
2160+ <*> o .: "fielddata"
2161+
2162+parseNodeStats :: FullNodeId -> Object -> Parser NodeStats
2163+parseNodeStats fnid o =
2164+ NodeStats <$> o .: "name"
2165+ <*> pure fnid
2166+ <*> o .:? "breakers"
2167+ <*> o .: "http"
2168+ <*> o .: "transport"
2169+ <*> o .: "fs"
2170+ <*> o .:? "network"
2171+ <*> o .: "thread_pool"
2172+ <*> o .: "jvm"
2173+ <*> o .: "process"
2174+ <*> o .: "os"
2175+ <*> o .: "indices"
2176+
2177+parseNodeInfo :: FullNodeId -> Object -> Parser NodeInfo
2178+parseNodeInfo nid o =
2179+ NodeInfo <$> o .:? "http_address"
2180+ <*> o .: "build_hash"
2181+ <*> o .: "version"
2182+ <*> o .: "ip"
2183+ <*> o .: "host"
2184+ <*> o .: "transport_address"
2185+ <*> o .: "name"
2186+ <*> pure nid
2187+ <*> o .: "plugins"
2188+ <*> o .: "http"
2189+ <*> o .: "transport"
2190+ <*> o .:? "network"
2191+ <*> o .: "thread_pool"
2192+ <*> o .: "jvm"
2193+ <*> o .: "process"
2194+ <*> o .: "os"
2195+ <*> o .: "settings"
2196+
2197+instance FromJSON NodePluginInfo where
2198+ parseJSON = withObject "NodePluginInfo" parse
2199+ where
2200+ parse o = NodePluginInfo <$> o .:? "site"
2201+ <*> o .:? "jvm"
2202+ <*> o .: "description"
2203+ <*> o .: "version"
2204+ <*> o .: "name"
2205+
2206+instance FromJSON NodeHTTPInfo where
2207+ parseJSON = withObject "NodeHTTPInfo" parse
2208+ where
2209+ parse o = NodeHTTPInfo <$> o .: "max_content_length_in_bytes"
2210+ <*> parseJSON (Object o)
2211+
2212+instance FromJSON BoundTransportAddress where
2213+ parseJSON = withObject "BoundTransportAddress" parse
2214+ where
2215+ parse o = BoundTransportAddress <$> o .: "publish_address"
2216+ <*> o .: "bound_address"
2217+
2218+instance FromJSON NodeOSInfo where
2219+ parseJSON = withObject "NodeOSInfo" parse
2220+ where
2221+ parse o =
2222+ NodeOSInfo <$> (unMS <$> o .: "refresh_interval_in_millis")
2223+ <*> o .: "name"
2224+ <*> o .: "arch"
2225+ <*> o .: "version"
2226+ <*> o .: "available_processors"
2227+ <*> o .: "allocated_processors"
2228+
2229+
2230+instance FromJSON CPUInfo where
2231+ parseJSON = withObject "CPUInfo" parse
2232+ where
2233+ parse o = CPUInfo <$> o .: "cache_size_in_bytes"
2234+ <*> o .: "cores_per_socket"
2235+ <*> o .: "total_sockets"
2236+ <*> o .: "total_cores"
2237+ <*> o .: "mhz"
2238+ <*> o .: "model"
2239+ <*> o .: "vendor"
2240+
2241+instance FromJSON NodeProcessInfo where
2242+ parseJSON = withObject "NodeProcessInfo" parse
2243+ where
2244+ parse o = NodeProcessInfo <$> o .: "mlockall"
2245+ <*> o .:? "max_file_descriptors"
2246+ <*> o .: "id"
2247+ <*> (unMS <$> o .: "refresh_interval_in_millis")
2248+
2249+instance FromJSON NodeJVMInfo where
2250+ parseJSON = withObject "NodeJVMInfo" parse
2251+ where
2252+ parse o = NodeJVMInfo <$> o .: "memory_pools"
2253+ <*> o .: "gc_collectors"
2254+ <*> o .: "mem"
2255+ <*> (posixMS <$> o .: "start_time_in_millis")
2256+ <*> o .: "vm_vendor"
2257+ <*> o .: "vm_version"
2258+ <*> o .: "vm_name"
2259+ <*> o .: "version"
2260+ <*> o .: "pid"
2261+
2262+instance FromJSON JVMMemoryInfo where
2263+ parseJSON = withObject "JVMMemoryInfo" parse
2264+ where
2265+ parse o = JVMMemoryInfo <$> o .: "direct_max_in_bytes"
2266+ <*> o .: "non_heap_max_in_bytes"
2267+ <*> o .: "non_heap_init_in_bytes"
2268+ <*> o .: "heap_max_in_bytes"
2269+ <*> o .: "heap_init_in_bytes"
2270+
2271+instance FromJSON NodeThreadPoolsInfo where
2272+ parseJSON = withObject "NodeThreadPoolsInfo" parse
2273+ where
2274+ parse o = NodeThreadPoolsInfo <$> o .: "refresh"
2275+ <*> o .: "management"
2276+ <*> o .:? "percolate"
2277+ <*> o .:? "listener"
2278+ <*> o .:? "fetch_shard_started"
2279+ <*> o .: "search"
2280+ <*> o .: "flush"
2281+ <*> o .: "warmer"
2282+ <*> o .:? "optimize"
2283+ <*> o .: "bulk"
2284+ <*> o .:? "suggest"
2285+ <*> o .: "force_merge"
2286+ <*> o .: "snapshot"
2287+ <*> o .: "get"
2288+ <*> o .:? "fetch_shard_store"
2289+ <*> o .: "index"
2290+ <*> o .: "generic"
2291+
2292+instance FromJSON NodeThreadPoolInfo where
2293+ parseJSON = withObject "NodeThreadPoolInfo" parse
2294+ where
2295+ parse o = do
2296+ ka <- maybe (return Nothing) (fmap Just . parseStringInterval) =<< o .:? "keep_alive"
2297+ NodeThreadPoolInfo <$> (parseJSON . unStringlyTypeJSON =<< o .: "queue_size")
2298+ <*> pure ka
2299+ <*> o .:? "min"
2300+ <*> o .:? "max"
2301+ <*> o .: "type"
2302+
2303+data TimeInterval = Weeks
2304+ | Days
2305+ | Hours
2306+ | Minutes
2307+ | Seconds deriving Eq
2308+
2309+instance Show TimeInterval where
2310+ show Weeks = "w"
2311+ show Days = "d"
2312+ show Hours = "h"
2313+ show Minutes = "m"
2314+ show Seconds = "s"
2315+
2316+instance Read TimeInterval where
2317+ readPrec = f =<< TR.get
2318+ where
2319+ f 'w' = return Weeks
2320+ f 'd' = return Days
2321+ f 'h' = return Hours
2322+ f 'm' = return Minutes
2323+ f 's' = return Seconds
2324+ f _ = fail "TimeInterval expected one of w, d, h, m, s"
2325+
2326+data Interval = Year
2327+ | Quarter
2328+ | Month
2329+ | Week
2330+ | Day
2331+ | Hour
2332+ | Minute
2333+ | Second deriving (Eq, Show)
2334+
2335+instance ToJSON Interval where
2336+ toJSON Year = "year"
2337+ toJSON Quarter = "quarter"
2338+ toJSON Month = "month"
2339+ toJSON Week = "week"
2340+ toJSON Day = "day"
2341+ toJSON Hour = "hour"
2342+ toJSON Minute = "minute"
2343+ toJSON Second = "second"
2344+
2345+parseStringInterval :: (Monad m) => String -> m NominalDiffTime
2346+parseStringInterval s = case span isNumber s of
2347+ ("", _) -> fail "Invalid interval"
2348+ (nS, unitS) -> case (readMay nS, readMay unitS) of
2349+ (Just n, Just unit) -> return (fromInteger (n * unitNDT unit))
2350+ (Nothing, _) -> fail "Invalid interval number"
2351+ (_, Nothing) -> fail "Invalid interval unit"
2352+ where
2353+ unitNDT Seconds = 1
2354+ unitNDT Minutes = 60
2355+ unitNDT Hours = 60 * 60
2356+ unitNDT Days = 24 * 60 * 60
2357+ unitNDT Weeks = 7 * 24 * 60 * 60
2358+
2359+instance FromJSON ThreadPoolSize where
2360+ parseJSON v = parseAsNumber v <|> parseAsString v
2361+ where
2362+ parseAsNumber = parseAsInt <=< parseJSON
2363+ parseAsInt (-1) = return ThreadPoolUnbounded
2364+ parseAsInt n
2365+ | n >= 0 = return (ThreadPoolBounded n)
2366+ | otherwise = fail "Thread pool size must be >= -1."
2367+ parseAsString = withText "ThreadPoolSize" $ \t ->
2368+ case first (readMay . T.unpack) (T.span isNumber t) of
2369+ (Just n, "k") -> return (ThreadPoolBounded (n * 1000))
2370+ (Just n, "") -> return (ThreadPoolBounded n)
2371+ _ -> fail ("Invalid thread pool size " <> T.unpack t)
2372+
2373+instance FromJSON ThreadPoolType where
2374+ parseJSON = withText "ThreadPoolType" parse
2375+ where
2376+ parse "scaling" = return ThreadPoolScaling
2377+ parse "fixed" = return ThreadPoolFixed
2378+ parse "cached" = return ThreadPoolCached
2379+ parse e = fail ("Unexpected thread pool type" <> T.unpack e)
2380+
2381+instance FromJSON NodeTransportInfo where
2382+ parseJSON = withObject "NodeTransportInfo" parse
2383+ where
2384+ parse o = NodeTransportInfo <$> (maybe (return mempty) parseProfiles =<< o .:? "profiles")
2385+ <*> parseJSON (Object o)
2386+ parseProfiles (Object o) | HM.null o = return []
2387+ parseProfiles v@(Array _) = parseJSON v
2388+ parseProfiles Null = return []
2389+ parseProfiles _ = fail "Could not parse profiles"
2390+
2391+instance FromJSON NodeNetworkInfo where
2392+ parseJSON = withObject "NodeNetworkInfo" parse
2393+ where
2394+ parse o = NodeNetworkInfo <$> o .: "primary_interface"
2395+ <*> (unMS <$> o .: "refresh_interval_in_millis")
2396+
2397+
2398+instance FromJSON NodeNetworkInterface where
2399+ parseJSON = withObject "NodeNetworkInterface" parse
2400+ where
2401+ parse o = NodeNetworkInterface <$> o .: "mac_address"
2402+ <*> o .: "name"
2403+ <*> o .: "address"
2404+
2405+
2406+instance ToJSON Version where
2407+ toJSON Version {..} = object ["number" .= number
2408+ ,"build_hash" .= build_hash
2409+ ,"build_date" .= build_date
2410+ ,"build_snapshot" .= build_snapshot
2411+ ,"lucene_version" .= lucene_version]
2412+
2413+instance FromJSON Version where
2414+ parseJSON = withObject "Version" parse
2415+ where parse o = Version
2416+ <$> o .: "number"
2417+ <*> o .: "build_hash"
2418+ <*> o .: "build_date"
2419+ <*> o .: "build_snapshot"
2420+ <*> o .: "lucene_version"
2421+
2422+instance ToJSON VersionNumber where
2423+ toJSON = toJSON . SemVer.toText . versionNumber
2424+
2425+instance FromJSON VersionNumber where
2426+ parseJSON = withText "VersionNumber" parse
2427+ where
2428+ parse t =
2429+ case SemVer.fromText t of
2430+ (Left err) -> fail err
2431+ (Right v) -> return (VersionNumber v)
src/Database/Bloodhound/Internal/Highlight.hsnew file+164
@@ -0,0 +1,164 @@
1+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
2+{-# LANGUAGE OverloadedStrings #-}
3+
4+module Database.Bloodhound.Internal.Highlight where
5+
6+import Bloodhound.Import
7+
8+import qualified Data.Map.Strict as M
9+
10+import Database.Bloodhound.Internal.Newtypes
11+import Database.Bloodhound.Internal.Query
12+
13+type HitHighlight = M.Map Text [Text]
14+
15+data Highlights = Highlights
16+ { globalsettings :: Maybe HighlightSettings
17+ , highlightFields :: [FieldHighlight]
18+ } deriving (Eq, Show)
19+
20+instance ToJSON Highlights where
21+ toJSON (Highlights global fields) =
22+ omitNulls (("fields" .= fields)
23+ : highlightSettingsPairs global)
24+
25+data FieldHighlight =
26+ FieldHighlight FieldName (Maybe HighlightSettings)
27+ deriving (Eq, Show)
28+
29+
30+instance ToJSON FieldHighlight where
31+ toJSON (FieldHighlight (FieldName fName) (Just fSettings)) =
32+ object [ fName .= fSettings ]
33+ toJSON (FieldHighlight (FieldName fName) Nothing) =
34+ object [ fName .= emptyObject ]
35+
36+data HighlightSettings =
37+ Plain PlainHighlight
38+ | Postings PostingsHighlight
39+ | FastVector FastVectorHighlight
40+ deriving (Eq, Show)
41+
42+
43+instance ToJSON HighlightSettings where
44+ toJSON hs = omitNulls (highlightSettingsPairs (Just hs))
45+
46+data PlainHighlight =
47+ PlainHighlight { plainCommon :: Maybe CommonHighlight
48+ , plainNonPost :: Maybe NonPostings }
49+ deriving (Eq, Show)
50+
51+ -- This requires that index_options are set to 'offset' in the mapping.
52+data PostingsHighlight =
53+ PostingsHighlight (Maybe CommonHighlight)
54+ deriving (Eq, Show)
55+
56+-- This requires that term_vector is set to 'with_positions_offsets' in the mapping.
57+data FastVectorHighlight = FastVectorHighlight
58+ { fvCommon :: Maybe CommonHighlight
59+ , fvNonPostSettings :: Maybe NonPostings
60+ , boundaryChars :: Maybe Text
61+ , boundaryMaxScan :: Maybe Int
62+ , fragmentOffset :: Maybe Int
63+ , matchedFields :: [Text]
64+ , phraseLimit :: Maybe Int
65+ } deriving (Eq, Show)
66+
67+data CommonHighlight = CommonHighlight
68+ { order :: Maybe Text
69+ , forceSource :: Maybe Bool
70+ , tag :: Maybe HighlightTag
71+ , encoder :: Maybe HighlightEncoder
72+ , noMatchSize :: Maybe Int
73+ , highlightQuery :: Maybe Query
74+ , requireFieldMatch :: Maybe Bool
75+ } deriving (Eq, Show)
76+
77+-- Settings that are only applicable to FastVector and Plain highlighters.
78+data NonPostings =
79+ NonPostings { fragmentSize :: Maybe Int
80+ , numberOfFragments :: Maybe Int
81+ } deriving (Eq, Show)
82+
83+data HighlightEncoder = DefaultEncoder
84+ | HTMLEncoder
85+ deriving (Eq, Show)
86+
87+instance ToJSON HighlightEncoder where
88+ toJSON DefaultEncoder = String "default"
89+ toJSON HTMLEncoder = String "html"
90+
91+-- NOTE: Should the tags use some kind of HTML type, rather than Text?
92+data HighlightTag =
93+ TagSchema Text
94+ -- Only uses more than the first value in the lists if fvh
95+ | CustomTags ([Text], [Text])
96+ deriving (Eq, Show)
97+
98+highlightSettingsPairs :: Maybe HighlightSettings -> [Pair]
99+highlightSettingsPairs Nothing = []
100+highlightSettingsPairs (Just (Plain plh)) = plainHighPairs (Just plh)
101+highlightSettingsPairs (Just (Postings ph)) = postHighPairs (Just ph)
102+highlightSettingsPairs (Just (FastVector fvh)) = fastVectorHighPairs (Just fvh)
103+
104+
105+plainHighPairs :: Maybe PlainHighlight -> [Pair]
106+plainHighPairs Nothing = []
107+plainHighPairs (Just (PlainHighlight plCom plNonPost)) =
108+ [ "type" .= String "plain"]
109+ ++ commonHighlightPairs plCom
110+ ++ nonPostingsToPairs plNonPost
111+
112+postHighPairs :: Maybe PostingsHighlight -> [Pair]
113+postHighPairs Nothing = []
114+postHighPairs (Just (PostingsHighlight pCom)) =
115+ ("type" .= String "postings")
116+ : commonHighlightPairs pCom
117+
118+fastVectorHighPairs :: Maybe FastVectorHighlight -> [Pair]
119+fastVectorHighPairs Nothing = []
120+fastVectorHighPairs
121+ (Just
122+ (FastVectorHighlight fvCom fvNonPostSettings' fvBoundChars
123+ fvBoundMaxScan fvFragOff fvMatchedFields
124+ fvPhraseLim)) =
125+ [ "type" .= String "fvh"
126+ , "boundary_chars" .= fvBoundChars
127+ , "boundary_max_scan" .= fvBoundMaxScan
128+ , "fragment_offset" .= fvFragOff
129+ , "matched_fields" .= fvMatchedFields
130+ , "phraseLimit" .= fvPhraseLim]
131+ ++ commonHighlightPairs fvCom
132+ ++ nonPostingsToPairs fvNonPostSettings'
133+
134+commonHighlightPairs :: Maybe CommonHighlight -> [Pair]
135+commonHighlightPairs Nothing = []
136+commonHighlightPairs (Just (CommonHighlight chScore chForceSource
137+ chTag chEncoder chNoMatchSize
138+ chHighlightQuery chRequireFieldMatch)) =
139+ [ "order" .= chScore
140+ , "force_source" .= chForceSource
141+ , "encoder" .= chEncoder
142+ , "no_match_size" .= chNoMatchSize
143+ , "highlight_query" .= chHighlightQuery
144+ , "require_fieldMatch" .= chRequireFieldMatch
145+ ]
146+ ++ highlightTagToPairs chTag
147+
148+
149+nonPostingsToPairs :: Maybe NonPostings -> [Pair]
150+nonPostingsToPairs Nothing = []
151+nonPostingsToPairs (Just (NonPostings npFragSize npNumOfFrags)) =
152+ [ "fragment_size" .= npFragSize
153+ , "number_of_fragments" .= npNumOfFrags
154+ ]
155+
156+highlightTagToPairs :: Maybe HighlightTag -> [Pair]
157+highlightTagToPairs (Just (TagSchema _)) =
158+ [ "scheme" .= String "default"
159+ ]
160+highlightTagToPairs (Just (CustomTags (pre, post))) =
161+ [ "pre_tags" .= pre
162+ , "post_tags" .= post
163+ ]
164+highlightTagToPairs Nothing = []
src/Database/Bloodhound/Internal/Newtypes.hsnew file+237
@@ -0,0 +1,237 @@
1+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
2+{-# LANGUAGE OverloadedStrings #-}
3+
4+module Database.Bloodhound.Internal.Newtypes where
5+
6+import Bloodhound.Import
7+
8+import qualified Data.Map.Strict as M
9+
10+newtype From = From Int deriving (Eq, Show, ToJSON)
11+newtype Size = Size Int deriving (Eq, Show, ToJSON, FromJSON)
12+
13+-- Used with scripts
14+newtype HitFields =
15+ HitFields (M.Map Text [Value])
16+ deriving (Eq, Show)
17+
18+instance FromJSON HitFields where
19+ parseJSON x
20+ = HitFields <$> parseJSON x
21+
22+-- Slight misnomer.
23+type Score = Maybe Double
24+
25+{-| 'MappingName' is part of mappings which are how ES describes and schematizes
26+ the data in the indices.
27+-}
28+newtype MappingName =
29+ MappingName Text
30+ deriving (Eq, Show, ToJSON, FromJSON)
31+
32+newtype ShardId = ShardId { shardId :: Int }
33+ deriving (Eq, Show, FromJSON)
34+
35+{-| 'DocId' is a generic wrapper value for expressing unique Document IDs.
36+ Can be set by the user or created by ES itself. Often used in client
37+ functions for poking at specific documents.
38+-}
39+newtype DocId =
40+ DocId Text
41+ deriving (Eq, Show, ToJSON, FromJSON)
42+
43+{-| 'FieldName' is used all over the place wherever a specific field within
44+ a document needs to be specified, usually in 'Query's or 'Filter's.
45+-}
46+newtype FieldName =
47+ FieldName Text
48+ deriving (Eq, Read, Show, ToJSON, FromJSON)
49+
50+newtype TypeName =
51+ TypeName Text
52+ deriving (Eq, Show, ToJSON, FromJSON)
53+
54+{-| 'QueryString' is used to wrap query text bodies, be they human written or not.
55+-}
56+newtype QueryString =
57+ QueryString Text
58+ deriving (Eq, Show, ToJSON, FromJSON)
59+
60+
61+-- {-| 'Script' is often used in place of 'FieldName' to specify more
62+-- complex ways of extracting a value from a document.
63+-- -}
64+-- newtype Script =
65+-- Script { scriptText :: Text }
66+-- deriving (Eq, Show)
67+
68+{-| 'CacheName' is used in 'RegexpFilter' for describing the
69+ 'CacheKey' keyed caching behavior.
70+-}
71+newtype CacheName =
72+ CacheName Text
73+ deriving (Eq, Show, FromJSON, ToJSON)
74+
75+{-| 'CacheKey' is used in 'RegexpFilter' to key regex caching.
76+-}
77+newtype CacheKey =
78+ CacheKey Text deriving (Eq, Show, FromJSON, ToJSON)
79+newtype Existence =
80+ Existence Bool deriving (Eq, Show, FromJSON, ToJSON)
81+newtype NullValue =
82+ NullValue Bool deriving (Eq, Show, FromJSON, ToJSON)
83+newtype CutoffFrequency =
84+ CutoffFrequency Double deriving (Eq, Show, FromJSON, ToJSON)
85+newtype Analyzer =
86+ Analyzer Text deriving (Eq, Show, FromJSON, ToJSON)
87+newtype MaxExpansions =
88+ MaxExpansions Int deriving (Eq, Show, FromJSON, ToJSON)
89+
90+{-| 'Lenient', if set to true, will cause format based failures to be
91+ ignored. I don't know what the bloody default is, Elasticsearch
92+ documentation didn't say what it was. Let me know if you figure it out.
93+-}
94+newtype Lenient =
95+ Lenient Bool deriving (Eq, Show, FromJSON, ToJSON)
96+newtype Tiebreaker =
97+ Tiebreaker Double deriving (Eq, Show, FromJSON, ToJSON)
98+
99+{-| 'MinimumMatch' controls how many should clauses in the bool query should
100+ match. Can be an absolute value (2) or a percentage (30%) or a
101+ combination of both.
102+-}
103+newtype MinimumMatch =
104+ MinimumMatch Int deriving (Eq, Show, FromJSON, ToJSON)
105+newtype DisableCoord =
106+ DisableCoord Bool deriving (Eq, Show, FromJSON, ToJSON)
107+newtype IgnoreTermFrequency =
108+ IgnoreTermFrequency Bool deriving (Eq, Show, FromJSON, ToJSON)
109+newtype MinimumTermFrequency =
110+ MinimumTermFrequency Int deriving (Eq, Show, FromJSON, ToJSON)
111+newtype MaxQueryTerms =
112+ MaxQueryTerms Int deriving (Eq, Show, FromJSON, ToJSON)
113+
114+{-| 'PrefixLength' is the prefix length used in queries, defaults to 0. -}
115+newtype PrefixLength =
116+ PrefixLength Int deriving (Eq, Show, FromJSON, ToJSON)
117+newtype PercentMatch =
118+ PercentMatch Double deriving (Eq, Show, FromJSON, ToJSON)
119+newtype StopWord =
120+ StopWord Text deriving (Eq, Show, FromJSON, ToJSON)
121+newtype QueryPath =
122+ QueryPath Text deriving (Eq, Show, FromJSON, ToJSON)
123+
124+{-| Allowing a wildcard at the beginning of a word (eg "*ing") is particularly
125+ heavy, because all terms in the index need to be examined, just in case
126+ they match. Leading wildcards can be disabled by setting
127+ 'AllowLeadingWildcard' to false. -}
128+newtype AllowLeadingWildcard =
129+ AllowLeadingWildcard Bool deriving (Eq, Show, FromJSON, ToJSON)
130+newtype LowercaseExpanded =
131+ LowercaseExpanded Bool deriving (Eq, Show, FromJSON, ToJSON)
132+newtype EnablePositionIncrements =
133+ EnablePositionIncrements Bool deriving (Eq, Show, FromJSON, ToJSON)
134+
135+{-| By default, wildcard terms in a query are not analyzed.
136+ Setting 'AnalyzeWildcard' to true enables best-effort analysis.
137+-}
138+newtype AnalyzeWildcard = AnalyzeWildcard Bool deriving (Eq, Show, FromJSON, ToJSON)
139+
140+{-| 'GeneratePhraseQueries' defaults to false.
141+-}
142+newtype GeneratePhraseQueries =
143+ GeneratePhraseQueries Bool deriving (Eq, Show, FromJSON, ToJSON)
144+
145+{-| 'Locale' is used for string conversions - defaults to ROOT.
146+-}
147+newtype Locale = Locale Text deriving (Eq, Show, FromJSON, ToJSON)
148+newtype MaxWordLength = MaxWordLength Int deriving (Eq, Show, FromJSON, ToJSON)
149+newtype MinWordLength = MinWordLength Int deriving (Eq, Show, FromJSON, ToJSON)
150+
151+{-| 'PhraseSlop' sets the default slop for phrases, 0 means exact
152+ phrase matches. Default is 0.
153+-}
154+newtype PhraseSlop = PhraseSlop Int deriving (Eq, Show, FromJSON, ToJSON)
155+newtype MinDocFrequency = MinDocFrequency Int deriving (Eq, Show, FromJSON, ToJSON)
156+newtype MaxDocFrequency = MaxDocFrequency Int deriving (Eq, Show, FromJSON, ToJSON)
157+
158+-- | Newtype wrapper to parse ES's concerning tendency to in some APIs return a floating point number of milliseconds since epoch ಠ_ಠ
159+newtype POSIXMS = POSIXMS { posixMS :: UTCTime }
160+
161+instance FromJSON POSIXMS where
162+ parseJSON = withScientific "POSIXMS" (return . parse)
163+ where parse n =
164+ let n' = truncate n :: Integer
165+ in POSIXMS (posixSecondsToUTCTime (fromInteger (n' `div` 1000)))
166+
167+newtype Boost =
168+ Boost Double
169+ deriving (Eq, Show, ToJSON, FromJSON)
170+
171+newtype BoostTerms =
172+ BoostTerms Double
173+ deriving (Eq, Show, ToJSON, FromJSON)
174+
175+{-| 'ReplicaCount' is part of 'IndexSettings' -}
176+newtype ReplicaCount =
177+ ReplicaCount Int
178+ deriving (Eq, Show, ToJSON)
179+
180+{-| 'ShardCount' is part of 'IndexSettings' -}
181+newtype ShardCount =
182+ ShardCount Int
183+ deriving (Eq, Show, ToJSON)
184+
185+-- This insanity is because ES *sometimes* returns Replica/Shard counts as strings
186+instance FromJSON ReplicaCount where
187+ parseJSON v = parseAsInt v
188+ <|> parseAsString v
189+ where parseAsInt = fmap ReplicaCount . parseJSON
190+ parseAsString = withText "ReplicaCount" (fmap ReplicaCount . parseReadText)
191+
192+instance FromJSON ShardCount where
193+ parseJSON v = parseAsInt v
194+ <|> parseAsString v
195+ where parseAsInt = fmap ShardCount . parseJSON
196+ parseAsString = withText "ShardCount" (fmap ShardCount . parseReadText)
197+
198+{-| 'IndexName' is used to describe which index to query/create/delete -}
199+newtype IndexName =
200+ IndexName Text
201+ deriving (Eq, Show, ToJSON, FromJSON)
202+
203+newtype IndexAliasName =
204+ IndexAliasName { indexAliasName :: IndexName }
205+ deriving (Eq, Show, ToJSON)
206+
207+newtype MaybeNA a = MaybeNA { unMaybeNA :: Maybe a }
208+ deriving (Show, Eq)
209+
210+instance FromJSON a => FromJSON (MaybeNA a) where
211+ parseJSON (String "NA") = pure $ MaybeNA Nothing
212+ parseJSON o = MaybeNA . Just <$> parseJSON o
213+
214+newtype SnapshotName =
215+ SnapshotName { snapshotName :: Text }
216+ deriving (Eq, Show, ToJSON, FromJSON)
217+
218+-- | Milliseconds
219+newtype MS = MS NominalDiffTime
220+
221+-- keeps the unexported constructor warnings at bay
222+unMS :: MS -> NominalDiffTime
223+unMS (MS t) = t
224+
225+
226+instance FromJSON MS where
227+ parseJSON = withScientific "MS" (return . MS . parse)
228+ where
229+ parse n = fromInteger (truncate n * 1000)
230+
231+newtype TokenFilter =
232+ TokenFilter Text
233+ deriving (Eq, Show, FromJSON, ToJSON)
234+
235+newtype CharFilter =
236+ CharFilter Text
237+ deriving (Eq, Show, FromJSON, ToJSON)
src/Database/Bloodhound/Internal/Query.hsnew file+1640
@@ -0,0 +1,1640 @@
1+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
2+{-# LANGUAGE OverloadedStrings #-}
3+{-# LANGUAGE RecordWildCards #-}
4+
5+module Database.Bloodhound.Internal.Query
6+ ( module X
7+ , module Database.Bloodhound.Internal.Query
8+ ) where
9+
10+import Bloodhound.Import
11+
12+import Data.Char (isNumber)
13+import qualified Data.HashMap.Strict as HM
14+import Data.List (nub)
15+import qualified Data.Text as T
16+
17+import Database.Bloodhound.Common.Script as X
18+import Database.Bloodhound.Internal.Newtypes
19+
20+data Query =
21+ TermQuery Term (Maybe Boost)
22+ | TermsQuery Text (NonEmpty Text)
23+ | QueryMatchQuery MatchQuery
24+ | QueryMultiMatchQuery MultiMatchQuery
25+ | QueryBoolQuery BoolQuery
26+ | QueryBoostingQuery BoostingQuery
27+ | QueryCommonTermsQuery CommonTermsQuery
28+ | ConstantScoreQuery Query Boost
29+ | QueryFunctionScoreQuery FunctionScoreQuery
30+ | QueryDisMaxQuery DisMaxQuery
31+ | QueryFuzzyLikeThisQuery FuzzyLikeThisQuery
32+ | QueryFuzzyLikeFieldQuery FuzzyLikeFieldQuery
33+ | QueryFuzzyQuery FuzzyQuery
34+ | QueryHasChildQuery HasChildQuery
35+ | QueryHasParentQuery HasParentQuery
36+ | IdsQuery MappingName [DocId]
37+ | QueryIndicesQuery IndicesQuery
38+ | MatchAllQuery (Maybe Boost)
39+ | QueryMoreLikeThisQuery MoreLikeThisQuery
40+ | QueryMoreLikeThisFieldQuery MoreLikeThisFieldQuery
41+ | QueryNestedQuery NestedQuery
42+ | QueryPrefixQuery PrefixQuery
43+ | QueryQueryStringQuery QueryStringQuery
44+ | QuerySimpleQueryStringQuery SimpleQueryStringQuery
45+ | QueryRangeQuery RangeQuery
46+ | QueryRegexpQuery RegexpQuery
47+ | QueryExistsQuery FieldName
48+ | QueryTemplateQueryInline TemplateQueryInline
49+ | QueryMatchNoneQuery
50+ | QueryWildcardQuery WildcardQuery
51+ deriving (Eq, Show)
52+
53+instance ToJSON Query where
54+ toJSON (TermQuery (Term termQueryField termQueryValue) boost) =
55+ object [ "term" .=
56+ object [termQueryField .= object merged]]
57+ where
58+ base = [ "value" .= termQueryValue ]
59+ boosted = maybe [] (return . ("boost" .=)) boost
60+ merged = mappend base boosted
61+
62+ toJSON (TermsQuery fieldName terms) =
63+ object [ "terms" .= object conjoined ]
64+ where conjoined = [fieldName .= terms]
65+
66+ toJSON (IdsQuery idsQueryMappingName docIds) =
67+ object [ "ids" .= object conjoined ]
68+ where conjoined = [ "type" .= idsQueryMappingName
69+ , "values" .= fmap toJSON docIds ]
70+
71+ toJSON (QueryQueryStringQuery qQueryStringQuery) =
72+ object [ "query_string" .= qQueryStringQuery ]
73+
74+ toJSON (QueryMatchQuery matchQuery) =
75+ object [ "match" .= matchQuery ]
76+
77+ toJSON (QueryMultiMatchQuery multiMatchQuery) =
78+ toJSON multiMatchQuery
79+
80+ toJSON (QueryBoolQuery boolQuery) =
81+ object [ "bool" .= boolQuery ]
82+
83+ toJSON (QueryBoostingQuery boostingQuery) =
84+ object [ "boosting" .= boostingQuery ]
85+
86+ toJSON (QueryCommonTermsQuery commonTermsQuery) =
87+ object [ "common" .= commonTermsQuery ]
88+
89+ toJSON (ConstantScoreQuery query boost) =
90+ object ["constant_score" .= object ["query" .= query
91+ , "boost" .= boost]]
92+
93+ toJSON (QueryFunctionScoreQuery functionScoreQuery) =
94+ object [ "function_score" .= functionScoreQuery ]
95+
96+ toJSON (QueryDisMaxQuery disMaxQuery) =
97+ object [ "dis_max" .= disMaxQuery ]
98+
99+ toJSON (QueryFuzzyLikeThisQuery fuzzyQuery) =
100+ object [ "fuzzy_like_this" .= fuzzyQuery ]
101+
102+ toJSON (QueryFuzzyLikeFieldQuery fuzzyFieldQuery) =
103+ object [ "fuzzy_like_this_field" .= fuzzyFieldQuery ]
104+
105+ toJSON (QueryFuzzyQuery fuzzyQuery) =
106+ object [ "fuzzy" .= fuzzyQuery ]
107+
108+ toJSON (QueryHasChildQuery childQuery) =
109+ object [ "has_child" .= childQuery ]
110+
111+ toJSON (QueryHasParentQuery parentQuery) =
112+ object [ "has_parent" .= parentQuery ]
113+
114+ toJSON (QueryIndicesQuery qIndicesQuery) =
115+ object [ "indices" .= qIndicesQuery ]
116+
117+ toJSON (MatchAllQuery boost) =
118+ object [ "match_all" .= omitNulls [ "boost" .= boost ] ]
119+
120+ toJSON (QueryMoreLikeThisQuery query) =
121+ object [ "more_like_this" .= query ]
122+
123+ toJSON (QueryMoreLikeThisFieldQuery query) =
124+ object [ "more_like_this_field" .= query ]
125+
126+ toJSON (QueryNestedQuery query) =
127+ object [ "nested" .= query ]
128+
129+ toJSON (QueryPrefixQuery query) =
130+ object [ "prefix" .= query ]
131+
132+ toJSON (QueryRangeQuery query) =
133+ object [ "range" .= query ]
134+
135+ toJSON (QueryRegexpQuery query) =
136+ object [ "regexp" .= query ]
137+
138+ toJSON (QuerySimpleQueryStringQuery query) =
139+ object [ "simple_query_string" .= query ]
140+
141+ toJSON (QueryExistsQuery (FieldName fieldName)) =
142+ object ["exists" .= object
143+ ["field" .= fieldName]
144+ ]
145+ toJSON QueryMatchNoneQuery =
146+ object ["match_none" .= object []]
147+
148+ toJSON (QueryTemplateQueryInline templateQuery) =
149+ object [ "template" .= templateQuery ]
150+
151+ toJSON (QueryWildcardQuery query) =
152+ object [ "wildcard" .= query ]
153+
154+instance FromJSON Query where
155+ parseJSON v = withObject "Query" parse v
156+ where parse o = termQuery `taggedWith` "term"
157+ <|> termsQuery `taggedWith` "terms"
158+ <|> idsQuery `taggedWith` "ids"
159+ <|> queryQueryStringQuery `taggedWith` "query_string"
160+ <|> queryMatchQuery `taggedWith` "match"
161+ <|> queryMultiMatchQuery
162+ <|> queryBoolQuery `taggedWith` "bool"
163+ <|> queryBoostingQuery `taggedWith` "boosting"
164+ <|> queryCommonTermsQuery `taggedWith` "common"
165+ <|> constantScoreQuery `taggedWith` "constant_score"
166+ <|> queryFunctionScoreQuery `taggedWith` "function_score"
167+ <|> queryDisMaxQuery `taggedWith` "dis_max"
168+ <|> queryFuzzyLikeThisQuery `taggedWith` "fuzzy_like_this"
169+ <|> queryFuzzyLikeFieldQuery `taggedWith` "fuzzy_like_this_field"
170+ <|> queryFuzzyQuery `taggedWith` "fuzzy"
171+ <|> queryHasChildQuery `taggedWith` "has_child"
172+ <|> queryHasParentQuery `taggedWith` "has_parent"
173+ <|> queryIndicesQuery `taggedWith` "indices"
174+ <|> matchAllQuery `taggedWith` "match_all"
175+ <|> queryMoreLikeThisQuery `taggedWith` "more_like_this"
176+ <|> queryMoreLikeThisFieldQuery `taggedWith` "more_like_this_field"
177+ <|> queryNestedQuery `taggedWith` "nested"
178+ <|> queryPrefixQuery `taggedWith` "prefix"
179+ <|> queryRangeQuery `taggedWith` "range"
180+ <|> queryRegexpQuery `taggedWith` "regexp"
181+ <|> querySimpleQueryStringQuery `taggedWith` "simple_query_string"
182+ <|> queryTemplateQueryInline `taggedWith` "template"
183+ <|> queryWildcardQuery `taggedWith` "wildcard"
184+ where taggedWith parser k = parser =<< o .: k
185+ termQuery = fieldTagged $ \(FieldName fn) o ->
186+ TermQuery <$> (Term fn <$> o .: "value") <*> o .:? "boost"
187+ termsQuery o = case HM.toList o of
188+ [(fn, vs)] -> do vals <- parseJSON vs
189+ case vals of
190+ x:xs -> return (TermsQuery fn (x :| xs))
191+ _ -> fail "Expected non empty list of values"
192+ _ -> fail "Expected object with 1 field-named key"
193+ idsQuery o = IdsQuery <$> o .: "type"
194+ <*> o .: "values"
195+ queryQueryStringQuery = pure . QueryQueryStringQuery
196+ queryMatchQuery = pure . QueryMatchQuery
197+ queryMultiMatchQuery = QueryMultiMatchQuery <$> parseJSON v
198+ queryBoolQuery = pure . QueryBoolQuery
199+ queryBoostingQuery = pure . QueryBoostingQuery
200+ queryCommonTermsQuery = pure . QueryCommonTermsQuery
201+ constantScoreQuery o = case HM.lookup "query" o of
202+ Just x -> ConstantScoreQuery <$> parseJSON x
203+ <*> o .: "boost"
204+ _ -> fail "Does not appear to be a ConstantScoreQuery"
205+ queryFunctionScoreQuery = pure . QueryFunctionScoreQuery
206+ queryDisMaxQuery = pure . QueryDisMaxQuery
207+ queryFuzzyLikeThisQuery = pure . QueryFuzzyLikeThisQuery
208+ queryFuzzyLikeFieldQuery = pure . QueryFuzzyLikeFieldQuery
209+ queryFuzzyQuery = pure . QueryFuzzyQuery
210+ queryHasChildQuery = pure . QueryHasChildQuery
211+ queryHasParentQuery = pure . QueryHasParentQuery
212+ queryIndicesQuery = pure . QueryIndicesQuery
213+ matchAllQuery o = MatchAllQuery <$> o .:? "boost"
214+ queryMoreLikeThisQuery = pure . QueryMoreLikeThisQuery
215+ queryMoreLikeThisFieldQuery = pure . QueryMoreLikeThisFieldQuery
216+ queryNestedQuery = pure . QueryNestedQuery
217+ queryPrefixQuery = pure . QueryPrefixQuery
218+ queryRangeQuery = pure . QueryRangeQuery
219+ queryRegexpQuery = pure . QueryRegexpQuery
220+ querySimpleQueryStringQuery = pure . QuerySimpleQueryStringQuery
221+ -- queryExistsQuery o = QueryExistsQuery <$> o .: "field"
222+ queryTemplateQueryInline = pure . QueryTemplateQueryInline
223+ queryWildcardQuery = pure . QueryWildcardQuery
224+
225+-- | As of Elastic 2.0, 'Filters' are just 'Queries' housed in a
226+-- Bool Query, and flagged in a different context.
227+newtype Filter = Filter { unFilter :: Query }
228+ deriving (Eq, Show)
229+
230+instance ToJSON Filter where
231+ toJSON = toJSON . unFilter
232+
233+instance FromJSON Filter where
234+ parseJSON v = Filter <$> parseJSON v
235+
236+data RegexpQuery =
237+ RegexpQuery { regexpQueryField :: FieldName
238+ , regexpQuery :: Regexp
239+ , regexpQueryFlags :: RegexpFlags
240+ , regexpQueryBoost :: Maybe Boost
241+ } deriving (Eq, Show)
242+
243+instance ToJSON RegexpQuery where
244+ toJSON (RegexpQuery (FieldName rqQueryField)
245+ (Regexp regexpQueryQuery) rqQueryFlags
246+ rqQueryBoost) =
247+ object [ rqQueryField .= omitNulls base ]
248+ where base = [ "value" .= regexpQueryQuery
249+ , "flags" .= rqQueryFlags
250+ , "boost" .= rqQueryBoost ]
251+
252+instance FromJSON RegexpQuery where
253+ parseJSON = withObject "RegexpQuery" parse
254+ where parse = fieldTagged $ \fn o ->
255+ RegexpQuery fn
256+ <$> o .: "value"
257+ <*> o .: "flags"
258+ <*> o .:? "boost"
259+
260+data WildcardQuery =
261+ WildcardQuery { wildcardQueryField :: FieldName
262+ , wildcardQuery :: Text
263+ , wildcardQueryBoost :: Maybe Boost
264+ } deriving (Eq, Show)
265+
266+instance ToJSON WildcardQuery where
267+ toJSON (WildcardQuery (FieldName wcQueryField)
268+ (wcQueryQuery) wcQueryBoost) =
269+ object [ wcQueryField .= omitNulls base ]
270+ where base = [ "value" .= wcQueryQuery
271+ , "boost" .= wcQueryBoost ]
272+
273+instance FromJSON WildcardQuery where
274+ parseJSON = withObject "WildcardQuery" parse
275+ where parse = fieldTagged $ \fn o ->
276+ WildcardQuery fn
277+ <$> o .: "value"
278+ <*> o .:? "boost"
279+
280+data RangeQuery =
281+ RangeQuery { rangeQueryField :: FieldName
282+ , rangeQueryRange :: RangeValue
283+ , rangeQueryBoost :: Boost } deriving (Eq, Show)
284+
285+instance ToJSON RangeQuery where
286+ toJSON (RangeQuery (FieldName fieldName) range boost) =
287+ object [ fieldName .= object conjoined ]
288+ where
289+ conjoined = ("boost" .= boost) : rangeValueToPair range
290+
291+instance FromJSON RangeQuery where
292+ parseJSON = withObject "RangeQuery" parse
293+ where parse = fieldTagged $ \fn o ->
294+ RangeQuery fn
295+ <$> parseJSON (Object o)
296+ <*> o .: "boost"
297+
298+mkRangeQuery :: FieldName -> RangeValue -> RangeQuery
299+mkRangeQuery f r = RangeQuery f r (Boost 1.0)
300+
301+data SimpleQueryStringQuery =
302+ SimpleQueryStringQuery
303+ { simpleQueryStringQuery :: QueryString
304+ , simpleQueryStringField :: Maybe FieldOrFields
305+ , simpleQueryStringOperator :: Maybe BooleanOperator
306+ , simpleQueryStringAnalyzer :: Maybe Analyzer
307+ , simpleQueryStringFlags :: Maybe (NonEmpty SimpleQueryFlag)
308+ , simpleQueryStringLowercaseExpanded :: Maybe LowercaseExpanded
309+ , simpleQueryStringLocale :: Maybe Locale
310+ } deriving (Eq, Show)
311+
312+
313+instance ToJSON SimpleQueryStringQuery where
314+ toJSON SimpleQueryStringQuery {..} =
315+ omitNulls (base ++ maybeAdd)
316+ where base = [ "query" .= simpleQueryStringQuery ]
317+ maybeAdd = [ "fields" .= simpleQueryStringField
318+ , "default_operator" .= simpleQueryStringOperator
319+ , "analyzer" .= simpleQueryStringAnalyzer
320+ , "flags" .= simpleQueryStringFlags
321+ , "lowercase_expanded_terms" .= simpleQueryStringLowercaseExpanded
322+ , "locale" .= simpleQueryStringLocale ]
323+
324+instance FromJSON SimpleQueryStringQuery where
325+ parseJSON = withObject "SimpleQueryStringQuery" parse
326+ where parse o = SimpleQueryStringQuery <$> o .: "query"
327+ <*> o .:? "fields"
328+ <*> o .:? "default_operator"
329+ <*> o .:? "analyzer"
330+ <*> (parseFlags <$> o .:? "flags")
331+ <*> o .:? "lowercase_expanded_terms"
332+ <*> o .:? "locale"
333+ parseFlags (Just (x:xs)) = Just (x :| xs)
334+ parseFlags _ = Nothing
335+
336+data SimpleQueryFlag =
337+ SimpleQueryAll
338+ | SimpleQueryNone
339+ | SimpleQueryAnd
340+ | SimpleQueryOr
341+ | SimpleQueryPrefix
342+ | SimpleQueryPhrase
343+ | SimpleQueryPrecedence
344+ | SimpleQueryEscape
345+ | SimpleQueryWhitespace
346+ | SimpleQueryFuzzy
347+ | SimpleQueryNear
348+ | SimpleQuerySlop deriving (Eq, Show)
349+
350+instance ToJSON SimpleQueryFlag where
351+ toJSON SimpleQueryAll = "ALL"
352+ toJSON SimpleQueryNone = "NONE"
353+ toJSON SimpleQueryAnd = "AND"
354+ toJSON SimpleQueryOr = "OR"
355+ toJSON SimpleQueryPrefix = "PREFIX"
356+ toJSON SimpleQueryPhrase = "PHRASE"
357+ toJSON SimpleQueryPrecedence = "PRECEDENCE"
358+ toJSON SimpleQueryEscape = "ESCAPE"
359+ toJSON SimpleQueryWhitespace = "WHITESPACE"
360+ toJSON SimpleQueryFuzzy = "FUZZY"
361+ toJSON SimpleQueryNear = "NEAR"
362+ toJSON SimpleQuerySlop = "SLOP"
363+
364+instance FromJSON SimpleQueryFlag where
365+ parseJSON = withText "SimpleQueryFlag" parse
366+ where parse "ALL" = pure SimpleQueryAll
367+ parse "NONE" = pure SimpleQueryNone
368+ parse "AND" = pure SimpleQueryAnd
369+ parse "OR" = pure SimpleQueryOr
370+ parse "PREFIX" = pure SimpleQueryPrefix
371+ parse "PHRASE" = pure SimpleQueryPhrase
372+ parse "PRECEDENCE" = pure SimpleQueryPrecedence
373+ parse "ESCAPE" = pure SimpleQueryEscape
374+ parse "WHITESPACE" = pure SimpleQueryWhitespace
375+ parse "FUZZY" = pure SimpleQueryFuzzy
376+ parse "NEAR" = pure SimpleQueryNear
377+ parse "SLOP" = pure SimpleQuerySlop
378+ parse f = fail ("Unexpected SimpleQueryFlag: " <> show f)
379+
380+-- use_dis_max and tie_breaker when fields are plural?
381+data QueryStringQuery =
382+ QueryStringQuery
383+ { queryStringQuery :: QueryString
384+ , queryStringDefaultField :: Maybe FieldName
385+ , queryStringOperator :: Maybe BooleanOperator
386+ , queryStringAnalyzer :: Maybe Analyzer
387+ , queryStringAllowLeadingWildcard :: Maybe AllowLeadingWildcard
388+ , queryStringLowercaseExpanded :: Maybe LowercaseExpanded
389+ , queryStringEnablePositionIncrements :: Maybe EnablePositionIncrements
390+ , queryStringFuzzyMaxExpansions :: Maybe MaxExpansions
391+ , queryStringFuzziness :: Maybe Fuzziness
392+ , queryStringFuzzyPrefixLength :: Maybe PrefixLength
393+ , queryStringPhraseSlop :: Maybe PhraseSlop
394+ , queryStringBoost :: Maybe Boost
395+ , queryStringAnalyzeWildcard :: Maybe AnalyzeWildcard
396+ , queryStringGeneratePhraseQueries :: Maybe GeneratePhraseQueries
397+ , queryStringMinimumShouldMatch :: Maybe MinimumMatch
398+ , queryStringLenient :: Maybe Lenient
399+ , queryStringLocale :: Maybe Locale
400+ } deriving (Eq, Show)
401+
402+
403+instance ToJSON QueryStringQuery where
404+ toJSON (QueryStringQuery qsQueryString
405+ qsDefaultField qsOperator
406+ qsAnalyzer qsAllowWildcard
407+ qsLowercaseExpanded qsEnablePositionIncrements
408+ qsFuzzyMaxExpansions qsFuzziness
409+ qsFuzzyPrefixLength qsPhraseSlop
410+ qsBoost qsAnalyzeWildcard
411+ qsGeneratePhraseQueries qsMinimumShouldMatch
412+ qsLenient qsLocale) =
413+ omitNulls base
414+ where
415+ base = [ "query" .= qsQueryString
416+ , "default_field" .= qsDefaultField
417+ , "default_operator" .= qsOperator
418+ , "analyzer" .= qsAnalyzer
419+ , "allow_leading_wildcard" .= qsAllowWildcard
420+ , "lowercase_expanded_terms" .= qsLowercaseExpanded
421+ , "enable_position_increments" .= qsEnablePositionIncrements
422+ , "fuzzy_max_expansions" .= qsFuzzyMaxExpansions
423+ , "fuzziness" .= qsFuzziness
424+ , "fuzzy_prefix_length" .= qsFuzzyPrefixLength
425+ , "phrase_slop" .= qsPhraseSlop
426+ , "boost" .= qsBoost
427+ , "analyze_wildcard" .= qsAnalyzeWildcard
428+ , "auto_generate_phrase_queries" .= qsGeneratePhraseQueries
429+ , "minimum_should_match" .= qsMinimumShouldMatch
430+ , "lenient" .= qsLenient
431+ , "locale" .= qsLocale ]
432+
433+instance FromJSON QueryStringQuery where
434+ parseJSON = withObject "QueryStringQuery" parse
435+ where parse o = QueryStringQuery
436+ <$> o .: "query"
437+ <*> o .:? "default_field"
438+ <*> o .:? "default_operator"
439+ <*> o .:? "analyzer"
440+ <*> o .:? "allow_leading_wildcard"
441+ <*> o .:? "lowercase_expanded_terms"
442+ <*> o .:? "enable_position_increments"
443+ <*> o .:? "fuzzy_max_expansions"
444+ <*> o .:? "fuzziness"
445+ <*> o .:? "fuzzy_prefix_length"
446+ <*> o .:? "phrase_slop"
447+ <*> o .:? "boost"
448+ <*> o .:? "analyze_wildcard"
449+ <*> o .:? "auto_generate_phrase_queries"
450+ <*> o .:? "minimum_should_match"
451+ <*> o .:? "lenient"
452+ <*> o .:? "locale"
453+
454+mkQueryStringQuery :: QueryString -> QueryStringQuery
455+mkQueryStringQuery qs =
456+ QueryStringQuery qs Nothing Nothing
457+ Nothing Nothing Nothing Nothing
458+ Nothing Nothing Nothing Nothing
459+ Nothing Nothing Nothing Nothing
460+ Nothing Nothing
461+
462+data FieldOrFields = FofField FieldName
463+ | FofFields (NonEmpty FieldName) deriving (Eq, Show)
464+
465+instance ToJSON FieldOrFields where
466+ toJSON (FofField fieldName) =
467+ toJSON fieldName
468+ toJSON (FofFields fieldNames) =
469+ toJSON fieldNames
470+
471+instance FromJSON FieldOrFields where
472+ parseJSON v = FofField <$> parseJSON v
473+ <|> FofFields <$> (parseNEJSON =<< parseJSON v)
474+
475+data PrefixQuery =
476+ PrefixQuery
477+ { prefixQueryField :: FieldName
478+ , prefixQueryPrefixValue :: Text
479+ , prefixQueryBoost :: Maybe Boost } deriving (Eq, Show)
480+
481+instance ToJSON PrefixQuery where
482+ toJSON (PrefixQuery (FieldName fieldName) queryValue boost) =
483+ object [ fieldName .= omitNulls base ]
484+ where base = [ "value" .= queryValue
485+ , "boost" .= boost ]
486+
487+instance FromJSON PrefixQuery where
488+ parseJSON = withObject "PrefixQuery" parse
489+ where parse = fieldTagged $ \fn o ->
490+ PrefixQuery fn
491+ <$> o .: "value"
492+ <*> o .:? "boost"
493+
494+data NestedQuery =
495+ NestedQuery
496+ { nestedQueryPath :: QueryPath
497+ , nestedQueryScoreType :: ScoreType
498+ , nestedQuery :: Query } deriving (Eq, Show)
499+
500+instance ToJSON NestedQuery where
501+ toJSON (NestedQuery nqPath nqScoreType nqQuery) =
502+ object [ "path" .= nqPath
503+ , "score_mode" .= nqScoreType
504+ , "query" .= nqQuery ]
505+
506+instance FromJSON NestedQuery where
507+ parseJSON = withObject "NestedQuery" parse
508+ where parse o = NestedQuery
509+ <$> o .: "path"
510+ <*> o .: "score_mode"
511+ <*> o .: "query"
512+
513+data MoreLikeThisFieldQuery =
514+ MoreLikeThisFieldQuery
515+ { moreLikeThisFieldText :: Text
516+ , moreLikeThisFieldFields :: FieldName
517+ -- default 0.3 (30%)
518+ , moreLikeThisFieldPercentMatch :: Maybe PercentMatch
519+ , moreLikeThisFieldMinimumTermFreq :: Maybe MinimumTermFrequency
520+ , moreLikeThisFieldMaxQueryTerms :: Maybe MaxQueryTerms
521+ , moreLikeThisFieldStopWords :: Maybe (NonEmpty StopWord)
522+ , moreLikeThisFieldMinDocFrequency :: Maybe MinDocFrequency
523+ , moreLikeThisFieldMaxDocFrequency :: Maybe MaxDocFrequency
524+ , moreLikeThisFieldMinWordLength :: Maybe MinWordLength
525+ , moreLikeThisFieldMaxWordLength :: Maybe MaxWordLength
526+ , moreLikeThisFieldBoostTerms :: Maybe BoostTerms
527+ , moreLikeThisFieldBoost :: Maybe Boost
528+ , moreLikeThisFieldAnalyzer :: Maybe Analyzer
529+ } deriving (Eq, Show)
530+
531+
532+instance ToJSON MoreLikeThisFieldQuery where
533+ toJSON (MoreLikeThisFieldQuery text (FieldName fieldName)
534+ percent mtf mqt stopwords mindf maxdf
535+ minwl maxwl boostTerms boost analyzer) =
536+ object [ fieldName .= omitNulls base ]
537+ where base = [ "like_text" .= text
538+ , "percent_terms_to_match" .= percent
539+ , "min_term_freq" .= mtf
540+ , "max_query_terms" .= mqt
541+ , "stop_words" .= stopwords
542+ , "min_doc_freq" .= mindf
543+ , "max_doc_freq" .= maxdf
544+ , "min_word_length" .= minwl
545+ , "max_word_length" .= maxwl
546+ , "boost_terms" .= boostTerms
547+ , "boost" .= boost
548+ , "analyzer" .= analyzer ]
549+
550+instance FromJSON MoreLikeThisFieldQuery where
551+ parseJSON = withObject "MoreLikeThisFieldQuery" parse
552+ where parse = fieldTagged $ \fn o ->
553+ MoreLikeThisFieldQuery
554+ <$> o .: "like_text"
555+ <*> pure fn
556+ <*> o .:? "percent_terms_to_match"
557+ <*> o .:? "min_term_freq"
558+ <*> o .:? "max_query_terms"
559+ -- <*> (optionalNE =<< o .:? "stop_words")
560+ <*> o .:? "stop_words"
561+ <*> o .:? "min_doc_freq"
562+ <*> o .:? "max_doc_freq"
563+ <*> o .:? "min_word_length"
564+ <*> o .:? "max_word_length"
565+ <*> o .:? "boost_terms"
566+ <*> o .:? "boost"
567+ <*> o .:? "analyzer"
568+ -- optionalNE = maybe (pure Nothing) (fmap Just . parseNEJSON)
569+
570+data MoreLikeThisQuery =
571+ MoreLikeThisQuery
572+ { moreLikeThisText :: Text
573+ , moreLikeThisFields :: Maybe (NonEmpty FieldName)
574+ -- default 0.3 (30%)
575+ , moreLikeThisPercentMatch :: Maybe PercentMatch
576+ , moreLikeThisMinimumTermFreq :: Maybe MinimumTermFrequency
577+ , moreLikeThisMaxQueryTerms :: Maybe MaxQueryTerms
578+ , moreLikeThisStopWords :: Maybe (NonEmpty StopWord)
579+ , moreLikeThisMinDocFrequency :: Maybe MinDocFrequency
580+ , moreLikeThisMaxDocFrequency :: Maybe MaxDocFrequency
581+ , moreLikeThisMinWordLength :: Maybe MinWordLength
582+ , moreLikeThisMaxWordLength :: Maybe MaxWordLength
583+ , moreLikeThisBoostTerms :: Maybe BoostTerms
584+ , moreLikeThisBoost :: Maybe Boost
585+ , moreLikeThisAnalyzer :: Maybe Analyzer
586+ } deriving (Eq, Show)
587+
588+
589+instance ToJSON MoreLikeThisQuery where
590+ toJSON (MoreLikeThisQuery text fields percent
591+ mtf mqt stopwords mindf maxdf
592+ minwl maxwl boostTerms boost analyzer) =
593+ omitNulls base
594+ where base = [ "like_text" .= text
595+ , "fields" .= fields
596+ , "percent_terms_to_match" .= percent
597+ , "min_term_freq" .= mtf
598+ , "max_query_terms" .= mqt
599+ , "stop_words" .= stopwords
600+ , "min_doc_freq" .= mindf
601+ , "max_doc_freq" .= maxdf
602+ , "min_word_length" .= minwl
603+ , "max_word_length" .= maxwl
604+ , "boost_terms" .= boostTerms
605+ , "boost" .= boost
606+ , "analyzer" .= analyzer ]
607+
608+instance FromJSON MoreLikeThisQuery where
609+ parseJSON = withObject "MoreLikeThisQuery" parse
610+ where parse o = MoreLikeThisQuery
611+ <$> o .: "like_text"
612+ -- <*> (optionalNE =<< o .:? "fields")
613+ <*> o .:? "fields"
614+ <*> o .:? "percent_terms_to_match"
615+ <*> o .:? "min_term_freq"
616+ <*> o .:? "max_query_terms"
617+ -- <*> (optionalNE =<< o .:? "stop_words")
618+ <*> o .:? "stop_words"
619+ <*> o .:? "min_doc_freq"
620+ <*> o .:? "max_doc_freq"
621+ <*> o .:? "min_word_length"
622+ <*> o .:? "max_word_length"
623+ <*> o .:? "boost_terms"
624+ <*> o .:? "boost"
625+ <*> o .:? "analyzer"
626+ -- optionalNE = maybe (pure Nothing) (fmap Just . parseNEJSON)
627+
628+data IndicesQuery =
629+ IndicesQuery
630+ { indicesQueryIndices :: [IndexName]
631+ , indicesQuery :: Query
632+ -- default "all"
633+ , indicesQueryNoMatch :: Maybe Query } deriving (Eq, Show)
634+
635+
636+instance ToJSON IndicesQuery where
637+ toJSON (IndicesQuery indices query noMatch) =
638+ omitNulls [ "indices" .= indices
639+ , "no_match_query" .= noMatch
640+ , "query" .= query ]
641+
642+instance FromJSON IndicesQuery where
643+ parseJSON = withObject "IndicesQuery" parse
644+ where parse o = IndicesQuery
645+ <$> o .:? "indices" .!= []
646+ <*> o .: "query"
647+ <*> o .:? "no_match_query"
648+
649+data HasParentQuery =
650+ HasParentQuery
651+ { hasParentQueryType :: TypeName
652+ , hasParentQuery :: Query
653+ , hasParentQueryScoreType :: Maybe ScoreType } deriving (Eq, Show)
654+
655+instance ToJSON HasParentQuery where
656+ toJSON (HasParentQuery queryType query scoreType) =
657+ omitNulls [ "parent_type" .= queryType
658+ , "score_type" .= scoreType
659+ , "query" .= query ]
660+
661+instance FromJSON HasParentQuery where
662+ parseJSON = withObject "HasParentQuery" parse
663+ where parse o = HasParentQuery
664+ <$> o .: "parent_type"
665+ <*> o .: "query"
666+ <*> o .:? "score_type"
667+
668+data HasChildQuery =
669+ HasChildQuery
670+ { hasChildQueryType :: TypeName
671+ , hasChildQuery :: Query
672+ , hasChildQueryScoreType :: Maybe ScoreType } deriving (Eq, Show)
673+
674+instance ToJSON HasChildQuery where
675+ toJSON (HasChildQuery queryType query scoreType) =
676+ omitNulls [ "query" .= query
677+ , "score_type" .= scoreType
678+ , "type" .= queryType ]
679+
680+instance FromJSON HasChildQuery where
681+ parseJSON = withObject "HasChildQuery" parse
682+ where parse o = HasChildQuery
683+ <$> o .: "type"
684+ <*> o .: "query"
685+ <*> o .:? "score_type"
686+
687+data ScoreType =
688+ ScoreTypeMax
689+ | ScoreTypeSum
690+ | ScoreTypeAvg
691+ | ScoreTypeNone deriving (Eq, Show)
692+
693+instance ToJSON ScoreType where
694+ toJSON ScoreTypeMax = "max"
695+ toJSON ScoreTypeAvg = "avg"
696+ toJSON ScoreTypeSum = "sum"
697+ toJSON ScoreTypeNone = "none"
698+
699+instance FromJSON ScoreType where
700+ parseJSON = withText "ScoreType" parse
701+ where parse "max" = pure ScoreTypeMax
702+ parse "avg" = pure ScoreTypeAvg
703+ parse "sum" = pure ScoreTypeSum
704+ parse "none" = pure ScoreTypeNone
705+ parse t = fail ("Unexpected ScoreType: " <> show t)
706+
707+data FuzzyQuery =
708+ FuzzyQuery { fuzzyQueryField :: FieldName
709+ , fuzzyQueryValue :: Text
710+ , fuzzyQueryPrefixLength :: PrefixLength
711+ , fuzzyQueryMaxExpansions :: MaxExpansions
712+ , fuzzyQueryFuzziness :: Fuzziness
713+ , fuzzyQueryBoost :: Maybe Boost
714+ } deriving (Eq, Show)
715+
716+
717+instance ToJSON FuzzyQuery where
718+ toJSON (FuzzyQuery (FieldName fieldName) queryText
719+ prefixLength maxEx fuzziness boost) =
720+ object [ fieldName .= omitNulls base ]
721+ where base = [ "value" .= queryText
722+ , "fuzziness" .= fuzziness
723+ , "prefix_length" .= prefixLength
724+ , "boost" .= boost
725+ , "max_expansions" .= maxEx ]
726+
727+instance FromJSON FuzzyQuery where
728+ parseJSON = withObject "FuzzyQuery" parse
729+ where parse = fieldTagged $ \fn o ->
730+ FuzzyQuery fn
731+ <$> o .: "value"
732+ <*> o .: "prefix_length"
733+ <*> o .: "max_expansions"
734+ <*> o .: "fuzziness"
735+ <*> o .:? "boost"
736+
737+data FuzzyLikeFieldQuery =
738+ FuzzyLikeFieldQuery
739+ { fuzzyLikeField :: FieldName
740+ -- anaphora is good for the soul.
741+ , fuzzyLikeFieldText :: Text
742+ , fuzzyLikeFieldMaxQueryTerms :: MaxQueryTerms
743+ , fuzzyLikeFieldIgnoreTermFrequency :: IgnoreTermFrequency
744+ , fuzzyLikeFieldFuzziness :: Fuzziness
745+ , fuzzyLikeFieldPrefixLength :: PrefixLength
746+ , fuzzyLikeFieldBoost :: Boost
747+ , fuzzyLikeFieldAnalyzer :: Maybe Analyzer
748+ } deriving (Eq, Show)
749+
750+
751+instance ToJSON FuzzyLikeFieldQuery where
752+ toJSON (FuzzyLikeFieldQuery (FieldName fieldName)
753+ fieldText maxTerms ignoreFreq fuzziness prefixLength
754+ boost analyzer) =
755+ object [ fieldName .=
756+ omitNulls [ "like_text" .= fieldText
757+ , "max_query_terms" .= maxTerms
758+ , "ignore_tf" .= ignoreFreq
759+ , "fuzziness" .= fuzziness
760+ , "prefix_length" .= prefixLength
761+ , "analyzer" .= analyzer
762+ , "boost" .= boost ]]
763+
764+instance FromJSON FuzzyLikeFieldQuery where
765+ parseJSON = withObject "FuzzyLikeFieldQuery" parse
766+ where parse = fieldTagged $ \fn o ->
767+ FuzzyLikeFieldQuery fn
768+ <$> o .: "like_text"
769+ <*> o .: "max_query_terms"
770+ <*> o .: "ignore_tf"
771+ <*> o .: "fuzziness"
772+ <*> o .: "prefix_length"
773+ <*> o .: "boost"
774+ <*> o .:? "analyzer"
775+
776+data FuzzyLikeThisQuery =
777+ FuzzyLikeThisQuery
778+ { fuzzyLikeFields :: [FieldName]
779+ , fuzzyLikeText :: Text
780+ , fuzzyLikeMaxQueryTerms :: MaxQueryTerms
781+ , fuzzyLikeIgnoreTermFrequency :: IgnoreTermFrequency
782+ , fuzzyLikeFuzziness :: Fuzziness
783+ , fuzzyLikePrefixLength :: PrefixLength
784+ , fuzzyLikeBoost :: Boost
785+ , fuzzyLikeAnalyzer :: Maybe Analyzer
786+ } deriving (Eq, Show)
787+
788+
789+instance ToJSON FuzzyLikeThisQuery where
790+ toJSON (FuzzyLikeThisQuery fields text maxTerms
791+ ignoreFreq fuzziness prefixLength boost analyzer) =
792+ omitNulls base
793+ where base = [ "fields" .= fields
794+ , "like_text" .= text
795+ , "max_query_terms" .= maxTerms
796+ , "ignore_tf" .= ignoreFreq
797+ , "fuzziness" .= fuzziness
798+ , "prefix_length" .= prefixLength
799+ , "analyzer" .= analyzer
800+ , "boost" .= boost ]
801+
802+instance FromJSON FuzzyLikeThisQuery where
803+ parseJSON = withObject "FuzzyLikeThisQuery" parse
804+ where parse o = FuzzyLikeThisQuery
805+ <$> o .:? "fields" .!= []
806+ <*> o .: "like_text"
807+ <*> o .: "max_query_terms"
808+ <*> o .: "ignore_tf"
809+ <*> o .: "fuzziness"
810+ <*> o .: "prefix_length"
811+ <*> o .: "boost"
812+ <*> o .:? "analyzer"
813+
814+data DisMaxQuery =
815+ DisMaxQuery { disMaxQueries :: [Query]
816+ -- default 0.0
817+ , disMaxTiebreaker :: Tiebreaker
818+ , disMaxBoost :: Maybe Boost
819+ } deriving (Eq, Show)
820+
821+
822+instance ToJSON DisMaxQuery where
823+ toJSON (DisMaxQuery queries tiebreaker boost) =
824+ omitNulls base
825+ where base = [ "queries" .= queries
826+ , "boost" .= boost
827+ , "tie_breaker" .= tiebreaker ]
828+
829+instance FromJSON DisMaxQuery where
830+ parseJSON = withObject "DisMaxQuery" parse
831+ where parse o = DisMaxQuery
832+ <$> o .:? "queries" .!= []
833+ <*> o .: "tie_breaker"
834+ <*> o .:? "boost"
835+
836+data MatchQuery = MatchQuery
837+ { matchQueryField :: FieldName
838+ , matchQueryQueryString :: QueryString
839+ , matchQueryOperator :: BooleanOperator
840+ , matchQueryZeroTerms :: ZeroTermsQuery
841+ , matchQueryCutoffFrequency :: Maybe CutoffFrequency
842+ , matchQueryMatchType :: Maybe MatchQueryType
843+ , matchQueryAnalyzer :: Maybe Analyzer
844+ , matchQueryMaxExpansions :: Maybe MaxExpansions
845+ , matchQueryLenient :: Maybe Lenient
846+ , matchQueryBoost :: Maybe Boost
847+ , matchQueryMinimumShouldMatch :: Maybe Text
848+ , matchQueryFuzziness :: Maybe Fuzziness
849+ } deriving (Eq, Show)
850+
851+
852+instance ToJSON MatchQuery where
853+ toJSON (MatchQuery (FieldName fieldName)
854+ (QueryString mqQueryString) booleanOperator
855+ zeroTermsQuery cutoffFrequency matchQueryType
856+ analyzer maxExpansions lenient boost
857+ minShouldMatch mqFuzziness
858+ ) =
859+ object [ fieldName .= omitNulls base ]
860+ where base = [ "query" .= mqQueryString
861+ , "operator" .= booleanOperator
862+ , "zero_terms_query" .= zeroTermsQuery
863+ , "cutoff_frequency" .= cutoffFrequency
864+ , "type" .= matchQueryType
865+ , "analyzer" .= analyzer
866+ , "max_expansions" .= maxExpansions
867+ , "lenient" .= lenient
868+ , "boost" .= boost
869+ , "minimum_should_match" .= minShouldMatch
870+ , "fuzziness" .= mqFuzziness
871+ ]
872+
873+instance FromJSON MatchQuery where
874+ parseJSON = withObject "MatchQuery" parse
875+ where parse = fieldTagged $ \fn o ->
876+ MatchQuery fn
877+ <$> o .: "query"
878+ <*> o .: "operator"
879+ <*> o .: "zero_terms_query"
880+ <*> o .:? "cutoff_frequency"
881+ <*> o .:? "type"
882+ <*> o .:? "analyzer"
883+ <*> o .:? "max_expansions"
884+ <*> o .:? "lenient"
885+ <*> o .:? "boost"
886+ <*> o .:? "minimum_should_match"
887+ <*> o .:? "fuzziness"
888+
889+{-| 'mkMatchQuery' is a convenience function that defaults the less common parameters,
890+ enabling you to provide only the 'FieldName' and 'QueryString' to make a 'MatchQuery'
891+-}
892+mkMatchQuery :: FieldName -> QueryString -> MatchQuery
893+mkMatchQuery field query = MatchQuery field query Or ZeroTermsNone Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing
894+
895+data MatchQueryType =
896+ MatchPhrase
897+ | MatchPhrasePrefix deriving (Eq, Show)
898+
899+instance ToJSON MatchQueryType where
900+ toJSON MatchPhrase = "phrase"
901+ toJSON MatchPhrasePrefix = "phrase_prefix"
902+
903+instance FromJSON MatchQueryType where
904+ parseJSON = withText "MatchQueryType" parse
905+ where parse "phrase" = pure MatchPhrase
906+ parse "phrase_prefix" = pure MatchPhrasePrefix
907+ parse t = fail ("Unexpected MatchQueryType: " <> show t)
908+
909+data MultiMatchQuery = MultiMatchQuery
910+ { multiMatchQueryFields :: [FieldName]
911+ , multiMatchQueryString :: QueryString
912+ , multiMatchQueryOperator :: BooleanOperator
913+ , multiMatchQueryZeroTerms :: ZeroTermsQuery
914+ , multiMatchQueryTiebreaker :: Maybe Tiebreaker
915+ , multiMatchQueryType :: Maybe MultiMatchQueryType
916+ , multiMatchQueryCutoffFrequency :: Maybe CutoffFrequency
917+ , multiMatchQueryAnalyzer :: Maybe Analyzer
918+ , multiMatchQueryMaxExpansions :: Maybe MaxExpansions
919+ , multiMatchQueryLenient :: Maybe Lenient
920+ } deriving (Eq, Show)
921+
922+instance ToJSON MultiMatchQuery where
923+ toJSON (MultiMatchQuery fields (QueryString query) boolOp
924+ ztQ tb mmqt cf analyzer maxEx lenient) =
925+ object ["multi_match" .= omitNulls base]
926+ where base = [ "fields" .= fmap toJSON fields
927+ , "query" .= query
928+ , "operator" .= boolOp
929+ , "zero_terms_query" .= ztQ
930+ , "tie_breaker" .= tb
931+ , "type" .= mmqt
932+ , "cutoff_frequency" .= cf
933+ , "analyzer" .= analyzer
934+ , "max_expansions" .= maxEx
935+ , "lenient" .= lenient ]
936+
937+instance FromJSON MultiMatchQuery where
938+ parseJSON = withObject "MultiMatchQuery" parse
939+ where parse raw = do o <- raw .: "multi_match"
940+ MultiMatchQuery
941+ <$> o .:? "fields" .!= []
942+ <*> o .: "query"
943+ <*> o .: "operator"
944+ <*> o .: "zero_terms_query"
945+ <*> o .:? "tie_breaker"
946+ <*> o .:? "type"
947+ <*> o .:? "cutoff_frequency"
948+ <*> o .:? "analyzer"
949+ <*> o .:? "max_expansions"
950+ <*> o .:? "lenient"
951+
952+{-| 'mkMultiMatchQuery' is a convenience function that defaults the less common parameters,
953+ enabling you to provide only the list of 'FieldName's and 'QueryString' to
954+ make a 'MultiMatchQuery'.
955+-}
956+
957+mkMultiMatchQuery :: [FieldName] -> QueryString -> MultiMatchQuery
958+mkMultiMatchQuery matchFields query =
959+ MultiMatchQuery matchFields query
960+ Or ZeroTermsNone Nothing Nothing Nothing Nothing Nothing Nothing
961+
962+data MultiMatchQueryType =
963+ MultiMatchBestFields
964+ | MultiMatchMostFields
965+ | MultiMatchCrossFields
966+ | MultiMatchPhrase
967+ | MultiMatchPhrasePrefix deriving (Eq, Show)
968+
969+instance ToJSON MultiMatchQueryType where
970+ toJSON MultiMatchBestFields = "best_fields"
971+ toJSON MultiMatchMostFields = "most_fields"
972+ toJSON MultiMatchCrossFields = "cross_fields"
973+ toJSON MultiMatchPhrase = "phrase"
974+ toJSON MultiMatchPhrasePrefix = "phrase_prefix"
975+
976+instance FromJSON MultiMatchQueryType where
977+ parseJSON = withText "MultiMatchPhrasePrefix" parse
978+ where parse "best_fields" = pure MultiMatchBestFields
979+ parse "most_fields" = pure MultiMatchMostFields
980+ parse "cross_fields" = pure MultiMatchCrossFields
981+ parse "phrase" = pure MultiMatchPhrase
982+ parse "phrase_prefix" = pure MultiMatchPhrasePrefix
983+ parse t = fail ("Unexpected MultiMatchPhrasePrefix: " <> show t)
984+
985+data BoolQuery =
986+ BoolQuery { boolQueryMustMatch :: [Query]
987+ , boolQueryFilter :: [Filter]
988+ , boolQueryMustNotMatch :: [Query]
989+ , boolQueryShouldMatch :: [Query]
990+ , boolQueryMinimumShouldMatch :: Maybe MinimumMatch
991+ , boolQueryBoost :: Maybe Boost
992+ , boolQueryDisableCoord :: Maybe DisableCoord
993+ } deriving (Eq, Show)
994+
995+
996+instance ToJSON BoolQuery where
997+ toJSON (BoolQuery mustM filterM' notM shouldM bqMin boost disableCoord) =
998+ omitNulls base
999+ where base = [ "must" .= mustM
1000+ , "filter" .= filterM'
1001+ , "must_not" .= notM
1002+ , "should" .= shouldM
1003+ , "minimum_should_match" .= bqMin
1004+ , "boost" .= boost
1005+ , "disable_coord" .= disableCoord ]
1006+
1007+instance FromJSON BoolQuery where
1008+ parseJSON = withObject "BoolQuery" parse
1009+ where parse o = BoolQuery
1010+ <$> o .:? "must" .!= []
1011+ <*> o .:? "filter" .!= []
1012+ <*> o .:? "must_not" .!= []
1013+ <*> o .:? "should" .!= []
1014+ <*> o .:? "minimum_should_match"
1015+ <*> o .:? "boost"
1016+ <*> o .:? "disable_coord"
1017+
1018+mkBoolQuery :: [Query] -> [Filter] -> [Query] -> [Query] -> BoolQuery
1019+mkBoolQuery must filt mustNot should =
1020+ BoolQuery must filt mustNot should Nothing Nothing Nothing
1021+
1022+data BoostingQuery =
1023+ BoostingQuery { positiveQuery :: Query
1024+ , negativeQuery :: Query
1025+ , negativeBoost :: Boost } deriving (Eq, Show)
1026+
1027+instance ToJSON BoostingQuery where
1028+ toJSON (BoostingQuery bqPositiveQuery bqNegativeQuery bqNegativeBoost) =
1029+ object [ "positive" .= bqPositiveQuery
1030+ , "negative" .= bqNegativeQuery
1031+ , "negative_boost" .= bqNegativeBoost ]
1032+
1033+instance FromJSON BoostingQuery where
1034+ parseJSON = withObject "BoostingQuery" parse
1035+ where parse o = BoostingQuery
1036+ <$> o .: "positive"
1037+ <*> o .: "negative"
1038+ <*> o .: "negative_boost"
1039+
1040+data CommonTermsQuery =
1041+ CommonTermsQuery { commonField :: FieldName
1042+ , commonQuery :: QueryString
1043+ , commonCutoffFrequency :: CutoffFrequency
1044+ , commonLowFreqOperator :: BooleanOperator
1045+ , commonHighFreqOperator :: BooleanOperator
1046+ , commonMinimumShouldMatch :: Maybe CommonMinimumMatch
1047+ , commonBoost :: Maybe Boost
1048+ , commonAnalyzer :: Maybe Analyzer
1049+ , commonDisableCoord :: Maybe DisableCoord
1050+ } deriving (Eq, Show)
1051+
1052+
1053+instance ToJSON CommonTermsQuery where
1054+ toJSON (CommonTermsQuery (FieldName fieldName)
1055+ (QueryString query) cf lfo hfo msm
1056+ boost analyzer disableCoord) =
1057+ object [fieldName .= omitNulls base ]
1058+ where base = [ "query" .= query
1059+ , "cutoff_frequency" .= cf
1060+ , "low_freq_operator" .= lfo
1061+ , "minimum_should_match" .= msm
1062+ , "boost" .= boost
1063+ , "analyzer" .= analyzer
1064+ , "disable_coord" .= disableCoord
1065+ , "high_freq_operator" .= hfo ]
1066+
1067+instance FromJSON CommonTermsQuery where
1068+ parseJSON = withObject "CommonTermsQuery" parse
1069+ where parse = fieldTagged $ \fn o ->
1070+ CommonTermsQuery fn
1071+ <$> o .: "query"
1072+ <*> o .: "cutoff_frequency"
1073+ <*> o .: "low_freq_operator"
1074+ <*> o .: "high_freq_operator"
1075+ <*> o .:? "minimum_should_match"
1076+ <*> o .:? "boost"
1077+ <*> o .:? "analyzer"
1078+ <*> o .:? "disable_coord"
1079+
1080+data CommonMinimumMatch =
1081+ CommonMinimumMatchHighLow MinimumMatchHighLow
1082+ | CommonMinimumMatch MinimumMatch
1083+ deriving (Eq, Show)
1084+
1085+
1086+instance ToJSON CommonMinimumMatch where
1087+ toJSON (CommonMinimumMatch mm) = toJSON mm
1088+ toJSON (CommonMinimumMatchHighLow (MinimumMatchHighLow lowF highF)) =
1089+ object [ "low_freq" .= lowF
1090+ , "high_freq" .= highF ]
1091+
1092+instance FromJSON CommonMinimumMatch where
1093+ parseJSON v = parseMinimum v
1094+ <|> parseMinimumHighLow v
1095+ where parseMinimum = fmap CommonMinimumMatch . parseJSON
1096+ parseMinimumHighLow = fmap CommonMinimumMatchHighLow . withObject "CommonMinimumMatchHighLow" (\o ->
1097+ MinimumMatchHighLow
1098+ <$> o .: "low_freq"
1099+ <*> o .: "high_freq")
1100+
1101+data MinimumMatchHighLow =
1102+ MinimumMatchHighLow { lowFreq :: MinimumMatch
1103+ , highFreq :: MinimumMatch } deriving (Eq, Show)
1104+
1105+data ZeroTermsQuery =
1106+ ZeroTermsNone
1107+ | ZeroTermsAll deriving (Eq, Show)
1108+
1109+instance ToJSON ZeroTermsQuery where
1110+ toJSON ZeroTermsNone = String "none"
1111+ toJSON ZeroTermsAll = String "all"
1112+
1113+instance FromJSON ZeroTermsQuery where
1114+ parseJSON = withText "ZeroTermsQuery" parse
1115+ where parse "none" = pure ZeroTermsNone
1116+ parse "all" = pure ZeroTermsAll
1117+ parse q = fail ("Unexpected ZeroTermsQuery: " <> show q)
1118+
1119+data RangeExecution = RangeExecutionIndex
1120+ | RangeExecutionFielddata deriving (Eq, Show)
1121+
1122+-- index for smaller ranges, fielddata for longer ranges
1123+instance ToJSON RangeExecution where
1124+ toJSON RangeExecutionIndex = "index"
1125+ toJSON RangeExecutionFielddata = "fielddata"
1126+
1127+
1128+instance FromJSON RangeExecution where
1129+ parseJSON = withText "RangeExecution" parse
1130+ where parse "index" = pure RangeExecutionIndex
1131+ parse "fielddata" = pure RangeExecutionFielddata
1132+ parse t = error ("Unrecognized RangeExecution " <> show t)
1133+
1134+newtype Regexp = Regexp Text deriving (Eq, Show, FromJSON)
1135+
1136+data RegexpFlags = AllRegexpFlags
1137+ | NoRegexpFlags
1138+ | SomeRegexpFlags (NonEmpty RegexpFlag) deriving (Eq, Show)
1139+
1140+instance ToJSON RegexpFlags where
1141+ toJSON AllRegexpFlags = String "ALL"
1142+ toJSON NoRegexpFlags = String "NONE"
1143+ toJSON (SomeRegexpFlags (h :| fs)) = String $ T.intercalate "|" flagStrs
1144+ where flagStrs = map flagStr . nub $ h:fs
1145+ flagStr AnyString = "ANYSTRING"
1146+ flagStr Automaton = "AUTOMATON"
1147+ flagStr Complement = "COMPLEMENT"
1148+ flagStr Empty = "EMPTY"
1149+ flagStr Intersection = "INTERSECTION"
1150+ flagStr Interval = "INTERVAL"
1151+
1152+instance FromJSON RegexpFlags where
1153+ parseJSON = withText "RegexpFlags" parse
1154+ where parse "ALL" = pure AllRegexpFlags
1155+ parse "NONE" = pure NoRegexpFlags
1156+ parse t = SomeRegexpFlags <$> parseNEJSON (String <$> T.splitOn "|" t)
1157+
1158+data RegexpFlag = AnyString
1159+ | Automaton
1160+ | Complement
1161+ | Empty
1162+ | Intersection
1163+ | Interval deriving (Eq, Show)
1164+
1165+instance FromJSON RegexpFlag where
1166+ parseJSON = withText "RegexpFlag" parse
1167+ where parse "ANYSTRING" = pure AnyString
1168+ parse "AUTOMATON" = pure Automaton
1169+ parse "COMPLEMENT" = pure Complement
1170+ parse "EMPTY" = pure Empty
1171+ parse "INTERSECTION" = pure Intersection
1172+ parse "INTERVAL" = pure Interval
1173+ parse f = fail ("Unknown RegexpFlag: " <> show f)
1174+
1175+newtype LessThan = LessThan Double deriving (Eq, Show)
1176+newtype LessThanEq = LessThanEq Double deriving (Eq, Show)
1177+newtype GreaterThan = GreaterThan Double deriving (Eq, Show)
1178+newtype GreaterThanEq = GreaterThanEq Double deriving (Eq, Show)
1179+
1180+newtype LessThanD = LessThanD UTCTime deriving (Eq, Show)
1181+newtype LessThanEqD = LessThanEqD UTCTime deriving (Eq, Show)
1182+newtype GreaterThanD = GreaterThanD UTCTime deriving (Eq, Show)
1183+newtype GreaterThanEqD = GreaterThanEqD UTCTime deriving (Eq, Show)
1184+
1185+data RangeValue = RangeDateLte LessThanEqD
1186+ | RangeDateLt LessThanD
1187+ | RangeDateGte GreaterThanEqD
1188+ | RangeDateGt GreaterThanD
1189+ | RangeDateGtLt GreaterThanD LessThanD
1190+ | RangeDateGteLte GreaterThanEqD LessThanEqD
1191+ | RangeDateGteLt GreaterThanEqD LessThanD
1192+ | RangeDateGtLte GreaterThanD LessThanEqD
1193+ | RangeDoubleLte LessThanEq
1194+ | RangeDoubleLt LessThan
1195+ | RangeDoubleGte GreaterThanEq
1196+ | RangeDoubleGt GreaterThan
1197+ | RangeDoubleGtLt GreaterThan LessThan
1198+ | RangeDoubleGteLte GreaterThanEq LessThanEq
1199+ | RangeDoubleGteLt GreaterThanEq LessThan
1200+ | RangeDoubleGtLte GreaterThan LessThanEq
1201+ deriving (Eq, Show)
1202+
1203+
1204+parseRangeValue :: ( FromJSON t4
1205+ , FromJSON t3
1206+ , FromJSON t2
1207+ , FromJSON t1
1208+ )
1209+ => (t3 -> t5)
1210+ -> (t1 -> t6)
1211+ -> (t4 -> t7)
1212+ -> (t2 -> t8)
1213+ -> (t5 -> t6 -> b)
1214+ -> (t7 -> t6 -> b)
1215+ -> (t5 -> t8 -> b)
1216+ -> (t7 -> t8 -> b)
1217+ -> (t5 -> b)
1218+ -> (t6 -> b)
1219+ -> (t7 -> b)
1220+ -> (t8 -> b)
1221+ -> Parser b
1222+ -> Object
1223+ -> Parser b
1224+parseRangeValue mkGt mkLt mkGte mkLte
1225+ fGtLt fGteLt fGtLte fGteLte
1226+ fGt fLt fGte fLte nada o = do
1227+ lt <- o .:? "lt"
1228+ lte <- o .:? "lte"
1229+ gt <- o .:? "gt"
1230+ gte <- o .:? "gte"
1231+ case (lt, lte, gt, gte) of
1232+ (Just a, _, Just b, _) ->
1233+ return (fGtLt (mkGt b) (mkLt a))
1234+ (Just a, _, _, Just b) ->
1235+ return (fGteLt (mkGte b) (mkLt a))
1236+ (_, Just a, Just b, _) ->
1237+ return (fGtLte (mkGt b) (mkLte a))
1238+ (_, Just a, _, Just b) ->
1239+ return (fGteLte (mkGte b) (mkLte a))
1240+ (_, _, Just a, _) ->
1241+ return (fGt (mkGt a))
1242+ (Just a, _, _, _) ->
1243+ return (fLt (mkLt a))
1244+ (_, _, _, Just a) ->
1245+ return (fGte (mkGte a))
1246+ (_, Just a, _, _) ->
1247+ return (fLte (mkLte a))
1248+ (Nothing, Nothing, Nothing, Nothing) ->
1249+ nada
1250+
1251+
1252+instance FromJSON RangeValue where
1253+ parseJSON = withObject "RangeValue" parse
1254+ where parse o = parseDate o
1255+ <|> parseDouble o
1256+ parseDate o =
1257+ parseRangeValue
1258+ GreaterThanD LessThanD
1259+ GreaterThanEqD LessThanEqD
1260+ RangeDateGtLt RangeDateGteLt
1261+ RangeDateGtLte RangeDateGteLte
1262+ RangeDateGt RangeDateLt
1263+ RangeDateGte RangeDateLte
1264+ mzero o
1265+ parseDouble o =
1266+ parseRangeValue
1267+ GreaterThan LessThan
1268+ GreaterThanEq LessThanEq
1269+ RangeDoubleGtLt RangeDoubleGteLt
1270+ RangeDoubleGtLte RangeDoubleGteLte
1271+ RangeDoubleGt RangeDoubleLt
1272+ RangeDoubleGte RangeDoubleLte
1273+ mzero o
1274+
1275+rangeValueToPair :: RangeValue -> [Pair]
1276+rangeValueToPair rv = case rv of
1277+ RangeDateLte (LessThanEqD t) -> ["lte" .= t]
1278+ RangeDateGte (GreaterThanEqD t) -> ["gte" .= t]
1279+ RangeDateLt (LessThanD t) -> ["lt" .= t]
1280+ RangeDateGt (GreaterThanD t) -> ["gt" .= t]
1281+ RangeDateGteLte (GreaterThanEqD l) (LessThanEqD g) -> ["gte" .= l, "lte" .= g]
1282+ RangeDateGtLte (GreaterThanD l) (LessThanEqD g) -> ["gt" .= l, "lte" .= g]
1283+ RangeDateGteLt (GreaterThanEqD l) (LessThanD g) -> ["gte" .= l, "lt" .= g]
1284+ RangeDateGtLt (GreaterThanD l) (LessThanD g) -> ["gt" .= l, "lt" .= g]
1285+ RangeDoubleLte (LessThanEq t) -> ["lte" .= t]
1286+ RangeDoubleGte (GreaterThanEq t) -> ["gte" .= t]
1287+ RangeDoubleLt (LessThan t) -> ["lt" .= t]
1288+ RangeDoubleGt (GreaterThan t) -> ["gt" .= t]
1289+ RangeDoubleGteLte (GreaterThanEq l) (LessThanEq g) -> ["gte" .= l, "lte" .= g]
1290+ RangeDoubleGtLte (GreaterThan l) (LessThanEq g) -> ["gt" .= l, "lte" .= g]
1291+ RangeDoubleGteLt (GreaterThanEq l) (LessThan g) -> ["gte" .= l, "lt" .= g]
1292+ RangeDoubleGtLt (GreaterThan l) (LessThan g) -> ["gt" .= l, "lt" .= g]
1293+
1294+data Term = Term { termField :: Text
1295+ , termValue :: Text } deriving (Eq, Show)
1296+
1297+instance ToJSON Term where
1298+ toJSON (Term field value) = object ["term" .= object
1299+ [field .= value]]
1300+
1301+instance FromJSON Term where
1302+ parseJSON = withObject "Term" parse
1303+ where parse o = do termObj <- o .: "term"
1304+ case HM.toList termObj of
1305+ [(fn, v)] -> Term fn <$> parseJSON v
1306+ _ -> fail "Expected object with 1 field-named key"
1307+
1308+data BoolMatch = MustMatch Term Cache
1309+ | MustNotMatch Term Cache
1310+ | ShouldMatch [Term] Cache deriving (Eq, Show)
1311+
1312+
1313+instance ToJSON BoolMatch where
1314+ toJSON (MustMatch term cache) = object ["must" .= term,
1315+ "_cache" .= cache]
1316+ toJSON (MustNotMatch term cache) = object ["must_not" .= term,
1317+ "_cache" .= cache]
1318+ toJSON (ShouldMatch terms cache) = object ["should" .= fmap toJSON terms,
1319+ "_cache" .= cache]
1320+
1321+instance FromJSON BoolMatch where
1322+ parseJSON = withObject "BoolMatch" parse
1323+ where parse o = mustMatch `taggedWith` "must"
1324+ <|> mustNotMatch `taggedWith` "must_not"
1325+ <|> shouldMatch `taggedWith` "should"
1326+ where taggedWith parser k = parser =<< o .: k
1327+ mustMatch t = MustMatch t <$> o .:? "_cache" .!= defaultCache
1328+ mustNotMatch t = MustNotMatch t <$> o .:? "_cache" .!= defaultCache
1329+ shouldMatch t = ShouldMatch t <$> o .:? "_cache" .!= defaultCache
1330+
1331+-- "memory" or "indexed"
1332+data GeoFilterType = GeoFilterMemory
1333+ | GeoFilterIndexed deriving (Eq, Show)
1334+
1335+instance ToJSON GeoFilterType where
1336+ toJSON GeoFilterMemory = String "memory"
1337+ toJSON GeoFilterIndexed = String "indexed"
1338+
1339+instance FromJSON GeoFilterType where
1340+ parseJSON = withText "GeoFilterType" parse
1341+ where parse "memory" = pure GeoFilterMemory
1342+ parse "indexed" = pure GeoFilterIndexed
1343+ parse t = fail ("Unrecognized GeoFilterType: " <> show t)
1344+
1345+data LatLon = LatLon { lat :: Double
1346+ , lon :: Double } deriving (Eq, Show)
1347+
1348+instance ToJSON LatLon where
1349+ toJSON (LatLon lLat lLon) =
1350+ object ["lat" .= lLat
1351+ , "lon" .= lLon]
1352+
1353+instance FromJSON LatLon where
1354+ parseJSON = withObject "LatLon" parse
1355+ where parse o = LatLon <$> o .: "lat"
1356+ <*> o .: "lon"
1357+
1358+data GeoBoundingBox =
1359+ GeoBoundingBox { topLeft :: LatLon
1360+ , bottomRight :: LatLon } deriving (Eq, Show)
1361+
1362+instance ToJSON GeoBoundingBox where
1363+ toJSON (GeoBoundingBox gbbTopLeft gbbBottomRight) =
1364+ object ["top_left" .= gbbTopLeft
1365+ , "bottom_right" .= gbbBottomRight]
1366+
1367+instance FromJSON GeoBoundingBox where
1368+ parseJSON = withObject "GeoBoundingBox" parse
1369+ where parse o = GeoBoundingBox
1370+ <$> o .: "top_left"
1371+ <*> o .: "bottom_right"
1372+
1373+data GeoBoundingBoxConstraint =
1374+ GeoBoundingBoxConstraint { geoBBField :: FieldName
1375+ , constraintBox :: GeoBoundingBox
1376+ , bbConstraintcache :: Cache
1377+ , geoType :: GeoFilterType
1378+ } deriving (Eq, Show)
1379+
1380+instance ToJSON GeoBoundingBoxConstraint where
1381+ toJSON (GeoBoundingBoxConstraint
1382+ (FieldName gbbcGeoBBField) gbbcConstraintBox cache type') =
1383+ object [gbbcGeoBBField .= gbbcConstraintBox
1384+ , "_cache" .= cache
1385+ , "type" .= type']
1386+
1387+instance FromJSON GeoBoundingBoxConstraint where
1388+ parseJSON = withObject "GeoBoundingBoxConstraint" parse
1389+ where parse o = case HM.toList (deleteSeveral ["type", "_cache"] o) of
1390+ [(fn, v)] -> GeoBoundingBoxConstraint (FieldName fn)
1391+ <$> parseJSON v
1392+ <*> o .:? "_cache" .!= defaultCache
1393+ <*> o .: "type"
1394+ _ -> fail "Could not find field name for GeoBoundingBoxConstraint"
1395+
1396+data GeoPoint =
1397+ GeoPoint { geoField :: FieldName
1398+ , latLon :: LatLon} deriving (Eq, Show)
1399+
1400+instance ToJSON GeoPoint where
1401+ toJSON (GeoPoint (FieldName geoPointField) geoPointLatLon) =
1402+ object [ geoPointField .= geoPointLatLon ]
1403+
1404+data DistanceUnit = Miles
1405+ | Yards
1406+ | Feet
1407+ | Inches
1408+ | Kilometers
1409+ | Meters
1410+ | Centimeters
1411+ | Millimeters
1412+ | NauticalMiles deriving (Eq, Show)
1413+
1414+instance ToJSON DistanceUnit where
1415+ toJSON Miles = String "mi"
1416+ toJSON Yards = String "yd"
1417+ toJSON Feet = String "ft"
1418+ toJSON Inches = String "in"
1419+ toJSON Kilometers = String "km"
1420+ toJSON Meters = String "m"
1421+ toJSON Centimeters = String "cm"
1422+ toJSON Millimeters = String "mm"
1423+ toJSON NauticalMiles = String "nmi"
1424+
1425+instance FromJSON DistanceUnit where
1426+ parseJSON = withText "DistanceUnit" parse
1427+ where parse "mi" = pure Miles
1428+ parse "yd" = pure Yards
1429+ parse "ft" = pure Feet
1430+ parse "in" = pure Inches
1431+ parse "km" = pure Kilometers
1432+ parse "m" = pure Meters
1433+ parse "cm" = pure Centimeters
1434+ parse "mm" = pure Millimeters
1435+ parse "nmi" = pure NauticalMiles
1436+ parse u = fail ("Unrecognized DistanceUnit: " <> show u)
1437+
1438+data DistanceType = Arc
1439+ | SloppyArc -- doesn't exist <1.0
1440+ | Plane deriving (Eq, Show)
1441+
1442+instance ToJSON DistanceType where
1443+ toJSON Arc = String "arc"
1444+ toJSON SloppyArc = String "sloppy_arc"
1445+ toJSON Plane = String "plane"
1446+
1447+instance FromJSON DistanceType where
1448+ parseJSON = withText "DistanceType" parse
1449+ where parse "arc" = pure Arc
1450+ parse "sloppy_arc" = pure SloppyArc
1451+ parse "plane" = pure Plane
1452+ parse t = fail ("Unrecognized DistanceType: " <> show t)
1453+
1454+data OptimizeBbox = OptimizeGeoFilterType GeoFilterType
1455+ | NoOptimizeBbox deriving (Eq, Show)
1456+
1457+
1458+instance ToJSON OptimizeBbox where
1459+ toJSON NoOptimizeBbox = String "none"
1460+ toJSON (OptimizeGeoFilterType gft) = toJSON gft
1461+
1462+instance FromJSON OptimizeBbox where
1463+ parseJSON v = withText "NoOptimizeBbox" parseNoOptimize v
1464+ <|> parseOptimize v
1465+ where parseNoOptimize "none" = pure NoOptimizeBbox
1466+ parseNoOptimize _ = mzero
1467+ parseOptimize = fmap OptimizeGeoFilterType . parseJSON
1468+
1469+data Distance =
1470+ Distance { coefficient :: Double
1471+ , unit :: DistanceUnit } deriving (Eq, Show)
1472+
1473+
1474+instance ToJSON Distance where
1475+ toJSON (Distance dCoefficient dUnit) =
1476+ String boltedTogether where
1477+ coefText = showText dCoefficient
1478+ (String unitText) = toJSON dUnit
1479+ boltedTogether = mappend coefText unitText
1480+
1481+instance FromJSON Distance where
1482+ parseJSON = withText "Distance" parse
1483+ where parse t = Distance <$> parseCoeff nT
1484+ <*> parseJSON (String unitT)
1485+ where (nT, unitT) = T.span validForNumber t
1486+ -- may be a better way to do this
1487+ validForNumber '-' = True
1488+ validForNumber '.' = True
1489+ validForNumber 'e' = True
1490+ validForNumber c = isNumber c
1491+ parseCoeff "" = fail "Empty string cannot be parsed as number"
1492+ parseCoeff s = return (read (T.unpack s))
1493+
1494+data DistanceRange =
1495+ DistanceRange { distanceFrom :: Distance
1496+ , distanceTo :: Distance } deriving (Eq, Show)
1497+
1498+type TemplateQueryKey = Text
1499+type TemplateQueryValue = Text
1500+
1501+newtype TemplateQueryKeyValuePairs =
1502+ TemplateQueryKeyValuePairs (HM.HashMap TemplateQueryKey TemplateQueryValue)
1503+ deriving (Eq, Show)
1504+
1505+instance ToJSON TemplateQueryKeyValuePairs where
1506+ toJSON (TemplateQueryKeyValuePairs x) =
1507+ Object $ HM.map toJSON x
1508+
1509+instance FromJSON TemplateQueryKeyValuePairs where
1510+ parseJSON (Object o) =
1511+ pure . TemplateQueryKeyValuePairs $ HM.mapMaybe getValue o
1512+ where getValue (String x) = Just x
1513+ getValue _ = Nothing
1514+ parseJSON _ =
1515+ fail "error parsing TemplateQueryKeyValuePairs"
1516+
1517+data TemplateQueryInline =
1518+ TemplateQueryInline { inline :: Query
1519+ , params :: TemplateQueryKeyValuePairs
1520+ }
1521+ deriving (Eq, Show)
1522+
1523+instance ToJSON TemplateQueryInline where
1524+ toJSON TemplateQueryInline{..} = object [ "inline" .= inline
1525+ , "params" .= params
1526+ ]
1527+
1528+instance FromJSON TemplateQueryInline where
1529+ parseJSON = withObject "TemplateQueryInline" parse
1530+ where parse o = TemplateQueryInline
1531+ <$> o .: "inline"
1532+ <*> o .: "params"
1533+
1534+{-| 'BooleanOperator' is the usual And/Or operators with an ES compatible
1535+ JSON encoding baked in. Used all over the place.
1536+-}
1537+data BooleanOperator = And | Or deriving (Eq, Show)
1538+
1539+instance ToJSON BooleanOperator where
1540+ toJSON And = String "and"
1541+ toJSON Or = String "or"
1542+
1543+instance FromJSON BooleanOperator where
1544+ parseJSON = withText "BooleanOperator" parse
1545+ where parse "and" = pure And
1546+ parse "or" = pure Or
1547+ parse o = fail ("Unexpected BooleanOperator: " <> show o)
1548+
1549+{-| 'Cache' is for telling ES whether it should cache a 'Filter' not.
1550+ 'Query's cannot be cached.
1551+-}
1552+type Cache = Bool -- caching on/off
1553+defaultCache :: Cache
1554+defaultCache = False
1555+
1556+
1557+data FunctionScoreQuery =
1558+ FunctionScoreQuery { functionScoreQuery :: Maybe Query
1559+ , functionScoreBoost :: Maybe Boost
1560+ , functionScoreFunctions :: FunctionScoreFunctions
1561+ , functionScoreMaxBoost :: Maybe Boost
1562+ , functionScoreBoostMode :: Maybe BoostMode
1563+ , functionScoreMinScore :: Score
1564+ , functionScoreScoreMode :: Maybe ScoreMode
1565+ } deriving (Eq, Show)
1566+
1567+instance ToJSON FunctionScoreQuery where
1568+ toJSON (FunctionScoreQuery query boost fns maxBoost boostMode minScore scoreMode) =
1569+ omitNulls base
1570+ where base = functionScoreFunctionsPair fns :
1571+ [ "query" .= query
1572+ , "boost" .= boost
1573+ , "max_boost" .= maxBoost
1574+ , "boost_mode" .= boostMode
1575+ , "min_score" .= minScore
1576+ , "score_mode" .= scoreMode ]
1577+
1578+instance FromJSON FunctionScoreQuery where
1579+ parseJSON = withObject "FunctionScoreQuery" parse
1580+ where parse o = FunctionScoreQuery
1581+ <$> o .:? "query"
1582+ <*> o .:? "boost"
1583+ <*> (singleFunction o
1584+ <|> multipleFunctions `taggedWith` "functions")
1585+ <*> o .:? "max_boost"
1586+ <*> o .:? "boost_mode"
1587+ <*> o .:? "min_score"
1588+ <*> o .:? "score_mode"
1589+ where taggedWith parser k = parser =<< o .: k
1590+ singleFunction = fmap FunctionScoreSingle . parseFunctionScoreFunction
1591+ multipleFunctions = pure . FunctionScoreMultiple
1592+
1593+data FunctionScoreFunctions =
1594+ FunctionScoreSingle FunctionScoreFunction
1595+ | FunctionScoreMultiple (NonEmpty ComponentFunctionScoreFunction) deriving (Eq, Show)
1596+
1597+data ComponentFunctionScoreFunction =
1598+ ComponentFunctionScoreFunction { componentScoreFunctionFilter :: Maybe Filter
1599+ , componentScoreFunction :: FunctionScoreFunction
1600+ , componentScoreFunctionWeight :: Maybe Weight
1601+ } deriving (Eq, Show)
1602+
1603+instance ToJSON ComponentFunctionScoreFunction where
1604+ toJSON (ComponentFunctionScoreFunction filter' fn weight) =
1605+ omitNulls base
1606+ where base = functionScoreFunctionPair fn :
1607+ [ "filter" .= filter'
1608+ , "weight" .= weight ]
1609+
1610+instance FromJSON ComponentFunctionScoreFunction where
1611+ parseJSON = withObject "ComponentFunctionScoreFunction" parse
1612+ where parse o = ComponentFunctionScoreFunction
1613+ <$> o .:? "filter"
1614+ <*> parseFunctionScoreFunction o
1615+ <*> o .:? "weight"
1616+
1617+functionScoreFunctionsPair :: FunctionScoreFunctions -> (Text, Value)
1618+functionScoreFunctionsPair (FunctionScoreSingle fn)
1619+ = functionScoreFunctionPair fn
1620+functionScoreFunctionsPair (FunctionScoreMultiple componentFns) =
1621+ ("functions", toJSON componentFns)
1622+
1623+fieldTagged :: Monad m => (FieldName -> Object -> m a) -> Object -> m a
1624+fieldTagged f o = case HM.toList o of
1625+ [(k, Object o')] -> f (FieldName k) o'
1626+ _ -> fail "Expected object with 1 field-named key"
1627+
1628+-- | Fuzziness value as a number or 'AUTO'.
1629+-- See:
1630+-- https://www.elastic.co/guide/en/elasticsearch/reference/current/common-options.html#fuzziness
1631+data Fuzziness = Fuzziness Double | FuzzinessAuto
1632+ deriving (Eq, Show)
1633+
1634+instance ToJSON Fuzziness where
1635+ toJSON (Fuzziness n) = toJSON n
1636+ toJSON FuzzinessAuto = String "AUTO"
1637+
1638+instance FromJSON Fuzziness where
1639+ parseJSON (String "AUTO") = return FuzzinessAuto
1640+ parseJSON v = Fuzziness <$> parseJSON v
src/Database/Bloodhound/Internal/Sort.hsnew file+107
@@ -0,0 +1,107 @@
1+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
2+{-# LANGUAGE OverloadedStrings #-}
3+{-# LANGUAGE RecordWildCards #-}
4+
5+module Database.Bloodhound.Internal.Sort where
6+
7+import Bloodhound.Import
8+
9+import Database.Bloodhound.Internal.Newtypes
10+import Database.Bloodhound.Internal.Query
11+
12+{-| 'SortMode' prescribes how to handle sorting array/multi-valued fields.
13+
14+http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/search-request-sort.html#_sort_mode_option
15+-}
16+data SortMode = SortMin
17+ | SortMax
18+ | SortSum
19+ | SortAvg deriving (Eq, Show)
20+
21+instance ToJSON SortMode where
22+ toJSON SortMin = String "min"
23+ toJSON SortMax = String "max"
24+ toJSON SortSum = String "sum"
25+ toJSON SortAvg = String "avg"
26+
27+{-| 'mkSort' defaults everything but the 'FieldName' and the 'SortOrder' so
28+ that you can concisely describe the usual kind of 'SortSpec's you want.
29+-}
30+mkSort :: FieldName -> SortOrder -> DefaultSort
31+mkSort fieldName sOrder = DefaultSort fieldName sOrder Nothing Nothing Nothing Nothing
32+
33+{-| 'Sort' is a synonym for a list of 'SortSpec's. Sort behavior is order
34+ dependent with later sorts acting as tie-breakers for earlier sorts.
35+-}
36+type Sort = [SortSpec]
37+
38+{-| The two main kinds of 'SortSpec' are 'DefaultSortSpec' and
39+ 'GeoDistanceSortSpec'. The latter takes a 'SortOrder', 'GeoPoint', and
40+ 'DistanceUnit' to express "nearness" to a single geographical point as a
41+ sort specification.
42+
43+<http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/search-request-sort.html#search-request-sort>
44+-}
45+data SortSpec =
46+ DefaultSortSpec DefaultSort
47+ | GeoDistanceSortSpec SortOrder GeoPoint DistanceUnit
48+ deriving (Eq, Show)
49+
50+instance ToJSON SortSpec where
51+ toJSON (DefaultSortSpec
52+ (DefaultSort (FieldName dsSortFieldName) dsSortOrder dsIgnoreUnmapped
53+ dsSortMode dsMissingSort dsNestedFilter)) =
54+ object [dsSortFieldName .= omitNulls base] where
55+ base = [ "order" .= dsSortOrder
56+ , "unmapped_type" .= dsIgnoreUnmapped
57+ , "mode" .= dsSortMode
58+ , "missing" .= dsMissingSort
59+ , "nested_filter" .= dsNestedFilter ]
60+
61+ toJSON (GeoDistanceSortSpec gdsSortOrder (GeoPoint (FieldName field) gdsLatLon) units) =
62+ object [ "unit" .= units
63+ , field .= gdsLatLon
64+ , "order" .= gdsSortOrder ]
65+
66+{-| 'DefaultSort' is usually the kind of 'SortSpec' you'll want. There's a
67+ 'mkSort' convenience function for when you want to specify only the most
68+ common parameters.
69+
70+ The `ignoreUnmapped`, when `Just` field is used to set the elastic 'unmapped_type'
71+
72+<http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/search-request-sort.html#search-request-sort>
73+-}
74+data DefaultSort =
75+ DefaultSort { sortFieldName :: FieldName
76+ , sortOrder :: SortOrder
77+ -- default False
78+ , ignoreUnmapped :: Maybe Text
79+ , sortMode :: Maybe SortMode
80+ , missingSort :: Maybe Missing
81+ , nestedFilter :: Maybe Filter } deriving (Eq, Show)
82+
83+{-| 'SortOrder' is 'Ascending' or 'Descending', as you might expect. These get
84+ encoded into "asc" or "desc" when turned into JSON.
85+
86+<http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/search-request-sort.html#search-request-sort>
87+-}
88+data SortOrder = Ascending
89+ | Descending deriving (Eq, Show)
90+
91+instance ToJSON SortOrder where
92+ toJSON Ascending = String "asc"
93+ toJSON Descending = String "desc"
94+
95+{-| 'Missing' prescribes how to handle missing fields. A missing field can be
96+ sorted last, first, or using a custom value as a substitute.
97+
98+<http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/search-request-sort.html#_missing_values>
99+-}
100+data Missing = LastMissing
101+ | FirstMissing
102+ | CustomMissing Text deriving (Eq, Show)
103+
104+instance ToJSON Missing where
105+ toJSON LastMissing = String "_last"
106+ toJSON FirstMissing = String "_first"
107+ toJSON (CustomMissing txt) = String txt
src/Database/Bloodhound/Internal/StringlyTyped.hsnew file+51
@@ -0,0 +1,51 @@
1+{-# LANGUAGE OverloadedStrings #-}
2+
3+module Database.Bloodhound.Internal.StringlyTyped where
4+
5+import Bloodhound.Import
6+
7+import qualified Data.Text as T
8+
9+
10+-- This whole module is a sin bucket to deal with Elasticsearch badness.
11+newtype StringlyTypedDouble = StringlyTypedDouble
12+ { unStringlyTypedDouble :: Double }
13+
14+instance FromJSON StringlyTypedDouble where
15+ parseJSON =
16+ fmap StringlyTypedDouble
17+ . parseJSON
18+ . unStringlyTypeJSON
19+
20+newtype StringlyTypedInt = StringlyTypedInt
21+ { unStringlyTypedInt :: Int }
22+
23+instance FromJSON StringlyTypedInt where
24+ parseJSON =
25+ fmap StringlyTypedInt
26+ . parseJSON
27+ . unStringlyTypeJSON
28+
29+newtype StringlyTypedBool = StringlyTypedBool { unStringlyTypedBool :: Bool }
30+
31+instance FromJSON StringlyTypedBool where
32+ parseJSON =
33+ fmap StringlyTypedBool
34+ . parseJSON
35+ . unStringlyTypeJSON
36+
37+-- | For some reason in several settings APIs, all leaf values get returned
38+-- as strings. This function attempts to recover from this for all
39+-- non-recursive JSON types. If nothing can be done, the value is left alone.
40+unStringlyTypeJSON :: Value -> Value
41+unStringlyTypeJSON (String "true") =
42+ Bool True
43+unStringlyTypeJSON (String "false") =
44+ Bool False
45+unStringlyTypeJSON (String "null") =
46+ Null
47+unStringlyTypeJSON v@(String t) =
48+ case readMay (T.unpack t) of
49+ Just n -> Number n
50+ Nothing -> v
51+unStringlyTypeJSON v = v
src/Database/Bloodhound/Internal/Suggest.hsnew file+270
@@ -0,0 +1,270 @@
1+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
2+{-# LANGUAGE RecordWildCards #-}
3+{-# LANGUAGE OverloadedStrings #-}
4+
5+module Database.Bloodhound.Internal.Suggest where
6+
7+import Bloodhound.Import
8+
9+import qualified Data.HashMap.Strict as HM
10+
11+import Database.Bloodhound.Internal.Newtypes
12+import Database.Bloodhound.Internal.Query (TemplateQueryInline(..), params)
13+
14+data Suggest = Suggest
15+ { suggestText :: Text
16+ , suggestName :: Text
17+ , suggestType :: SuggestType
18+ } deriving (Eq, Show)
19+
20+instance ToJSON Suggest where
21+ toJSON Suggest{..} =
22+ object [ "text" .= suggestText
23+ , suggestName .= suggestType
24+ ]
25+
26+instance FromJSON Suggest where
27+ parseJSON (Object o) = do
28+ suggestText' <- o .: "text"
29+ let dropTextList =
30+ HM.toList
31+ $ HM.filterWithKey (\x _ -> x /= "text") o
32+ suggestName' <-
33+ case dropTextList of
34+ [(x, _)] -> return x
35+ _ -> fail "error parsing Suggest field name"
36+ suggestType' <- o .: suggestName'
37+ return $ Suggest suggestText' suggestName' suggestType'
38+ parseJSON x = typeMismatch "Suggest" x
39+
40+data SuggestType =
41+ SuggestTypePhraseSuggester PhraseSuggester
42+ deriving (Eq, Show)
43+
44+instance ToJSON SuggestType where
45+ toJSON (SuggestTypePhraseSuggester x) =
46+ object [ "phrase" .= x ]
47+
48+instance FromJSON SuggestType where
49+ parseJSON = withObject "SuggestType" parse
50+ where parse o = phraseSuggester `taggedWith` "phrase"
51+ where taggedWith parser k = parser =<< o .: k
52+ phraseSuggester = pure . SuggestTypePhraseSuggester
53+
54+data PhraseSuggester = PhraseSuggester
55+ { phraseSuggesterField :: FieldName
56+ , phraseSuggesterGramSize :: Maybe Int
57+ , phraseSuggesterRealWordErrorLikelihood :: Maybe Int
58+ , phraseSuggesterConfidence :: Maybe Int
59+ , phraseSuggesterMaxErrors :: Maybe Int
60+ , phraseSuggesterSeparator :: Maybe Text
61+ , phraseSuggesterSize :: Maybe Size
62+ , phraseSuggesterAnalyzer :: Maybe Analyzer
63+ , phraseSuggesterShardSize :: Maybe Int
64+ , phraseSuggesterHighlight :: Maybe PhraseSuggesterHighlighter
65+ , phraseSuggesterCollate :: Maybe PhraseSuggesterCollate
66+ , phraseSuggesterCandidateGenerators :: [DirectGenerators]
67+ } deriving (Eq, Show)
68+
69+instance ToJSON PhraseSuggester where
70+ toJSON PhraseSuggester{..} =
71+ omitNulls [ "field" .= phraseSuggesterField
72+ , "gram_size" .= phraseSuggesterGramSize
73+ , "real_word_error_likelihood" .=
74+ phraseSuggesterRealWordErrorLikelihood
75+ , "confidence" .= phraseSuggesterConfidence
76+ , "max_errors" .= phraseSuggesterMaxErrors
77+ , "separator" .= phraseSuggesterSeparator
78+ , "size" .= phraseSuggesterSize
79+ , "analyzer" .= phraseSuggesterAnalyzer
80+ , "shard_size" .= phraseSuggesterShardSize
81+ , "highlight" .= phraseSuggesterHighlight
82+ , "collate" .= phraseSuggesterCollate
83+ , "direct_generator" .=
84+ phraseSuggesterCandidateGenerators
85+ ]
86+
87+instance FromJSON PhraseSuggester where
88+ parseJSON = withObject "PhraseSuggester" parse
89+ where parse o = PhraseSuggester
90+ <$> o .: "field"
91+ <*> o .:? "gram_size"
92+ <*> o .:? "real_word_error_likelihood"
93+ <*> o .:? "confidence"
94+ <*> o .:? "max_errors"
95+ <*> o .:? "separator"
96+ <*> o .:? "size"
97+ <*> o .:? "analyzer"
98+ <*> o .:? "shard_size"
99+ <*> o .:? "highlight"
100+ <*> o .:? "collate"
101+ <*> o .:? "direct_generator" .!= []
102+
103+mkPhraseSuggester :: FieldName -> PhraseSuggester
104+mkPhraseSuggester fName =
105+ PhraseSuggester fName Nothing Nothing Nothing Nothing Nothing Nothing
106+ Nothing Nothing Nothing Nothing []
107+
108+data PhraseSuggesterHighlighter =
109+ PhraseSuggesterHighlighter { phraseSuggesterHighlighterPreTag :: Text
110+ , phraseSuggesterHighlighterPostTag :: Text
111+ }
112+ deriving (Eq, Show)
113+
114+instance ToJSON PhraseSuggesterHighlighter where
115+ toJSON PhraseSuggesterHighlighter{..} =
116+ object [ "pre_tag" .= phraseSuggesterHighlighterPreTag
117+ , "post_tag" .= phraseSuggesterHighlighterPostTag
118+ ]
119+
120+instance FromJSON PhraseSuggesterHighlighter where
121+ parseJSON = withObject "PhraseSuggesterHighlighter" parse
122+ where parse o = PhraseSuggesterHighlighter
123+ <$> o .: "pre_tag"
124+ <*> o .: "post_tag"
125+
126+data PhraseSuggesterCollate = PhraseSuggesterCollate
127+ { phraseSuggesterCollateTemplateQuery :: TemplateQueryInline
128+ , phraseSuggesterCollatePrune :: Bool
129+ } deriving (Eq, Show)
130+
131+instance ToJSON PhraseSuggesterCollate where
132+ toJSON PhraseSuggesterCollate{..} =
133+ object [ "query" .= object
134+ [ "inline" .= (inline phraseSuggesterCollateTemplateQuery)
135+ ]
136+ , "params" .= (params phraseSuggesterCollateTemplateQuery)
137+ , "prune" .= phraseSuggesterCollatePrune
138+ ]
139+
140+instance FromJSON PhraseSuggesterCollate where
141+ parseJSON (Object o) = do
142+ query' <- o .: "query"
143+ inline' <- query' .: "inline"
144+ params' <- o .: "params"
145+ prune' <- o .:? "prune" .!= False
146+ return $ PhraseSuggesterCollate
147+ (TemplateQueryInline inline' params') prune'
148+ parseJSON x = typeMismatch "PhraseSuggesterCollate" x
149+
150+data SuggestOptions =
151+ SuggestOptions { suggestOptionsText :: Text
152+ , suggestOptionsScore :: Double
153+ , suggestOptionsFreq :: Maybe Int
154+ , suggestOptionsHighlighted :: Maybe Text
155+ }
156+ deriving (Eq, Read, Show)
157+
158+instance FromJSON SuggestOptions where
159+ parseJSON = withObject "SuggestOptions" parse
160+ where
161+ parse o = SuggestOptions
162+ <$> o .: "text"
163+ <*> o .: "score"
164+ <*> o .:? "freq"
165+ <*> o .:? "highlighted"
166+
167+data SuggestResponse =
168+ SuggestResponse { suggestResponseText :: Text
169+ , suggestResponseOffset :: Int
170+ , suggestResponseLength :: Int
171+ , suggestResponseOptions :: [SuggestOptions]
172+ }
173+ deriving (Eq, Read, Show)
174+
175+instance FromJSON SuggestResponse where
176+ parseJSON = withObject "SuggestResponse" parse
177+ where parse o = SuggestResponse
178+ <$> o .: "text"
179+ <*> o .: "offset"
180+ <*> o .: "length"
181+ <*> o .: "options"
182+
183+data NamedSuggestionResponse = NamedSuggestionResponse
184+ { nsrName :: Text
185+ , nsrResponses :: [SuggestResponse]
186+ } deriving (Eq, Read, Show)
187+
188+instance FromJSON NamedSuggestionResponse where
189+ parseJSON (Object o) = do
190+ suggestionName' <- case HM.toList o of
191+ [(x, _)] -> return x
192+ _ -> fail "error parsing NamedSuggestionResponse name"
193+ suggestionResponses' <- o .: suggestionName'
194+ return $ NamedSuggestionResponse suggestionName' suggestionResponses'
195+
196+ parseJSON x = typeMismatch "NamedSuggestionResponse" x
197+
198+data DirectGeneratorSuggestModeTypes = DirectGeneratorSuggestModeMissing
199+ | DirectGeneratorSuggestModePopular
200+ | DirectGeneratorSuggestModeAlways
201+ deriving (Eq, Show)
202+
203+instance ToJSON DirectGeneratorSuggestModeTypes where
204+ toJSON DirectGeneratorSuggestModeMissing = "missing"
205+ toJSON DirectGeneratorSuggestModePopular = "popular"
206+ toJSON DirectGeneratorSuggestModeAlways = "always"
207+
208+instance FromJSON DirectGeneratorSuggestModeTypes where
209+ parseJSON = withText "DirectGeneratorSuggestModeTypes" parse
210+ where
211+ parse "missing" =
212+ pure DirectGeneratorSuggestModeMissing
213+ parse "popular" =
214+ pure DirectGeneratorSuggestModePopular
215+ parse "always" =
216+ pure DirectGeneratorSuggestModeAlways
217+ parse f =
218+ fail ("Unexpected DirectGeneratorSuggestModeTypes: " <> show f)
219+
220+data DirectGenerators = DirectGenerators
221+ { directGeneratorsField :: FieldName
222+ , directGeneratorsSize :: Maybe Int
223+ , directGeneratorSuggestMode :: DirectGeneratorSuggestModeTypes
224+ , directGeneratorMaxEdits :: Maybe Double
225+ , directGeneratorPrefixLength :: Maybe Int
226+ , directGeneratorMinWordLength :: Maybe Int
227+ , directGeneratorMaxInspections :: Maybe Int
228+ , directGeneratorMinDocFreq :: Maybe Double
229+ , directGeneratorMaxTermFreq :: Maybe Double
230+ , directGeneratorPreFilter :: Maybe Text
231+ , directGeneratorPostFilter :: Maybe Text
232+ } deriving (Eq, Show)
233+
234+instance ToJSON DirectGenerators where
235+ toJSON DirectGenerators{..} =
236+ omitNulls [ "field" .= directGeneratorsField
237+ , "size" .= directGeneratorsSize
238+ , "suggest_mode" .= directGeneratorSuggestMode
239+ , "max_edits" .= directGeneratorMaxEdits
240+ , "prefix_length" .= directGeneratorPrefixLength
241+ , "min_word_length" .= directGeneratorMinWordLength
242+ , "max_inspections" .= directGeneratorMaxInspections
243+ , "min_doc_freq" .= directGeneratorMinDocFreq
244+ , "max_term_freq" .= directGeneratorMaxTermFreq
245+ , "pre_filter" .= directGeneratorPreFilter
246+ , "post_filter" .= directGeneratorPostFilter
247+ ]
248+
249+instance FromJSON DirectGenerators where
250+ parseJSON = withObject "DirectGenerators" parse
251+ where parse o = DirectGenerators
252+ <$> o .: "field"
253+ <*> o .:? "size"
254+ <*> o .: "suggest_mode"
255+ <*> o .:? "max_edits"
256+ <*> o .:? "prefix_length"
257+ <*> o .:? "min_word_length"
258+ <*> o .:? "max_inspections"
259+ <*> o .:? "min_doc_freq"
260+ <*> o .:? "max_term_freq"
261+ <*> o .:? "pre_filter"
262+ <*> o .:? "post_filter"
263+
264+mkDirectGenerators :: FieldName -> DirectGenerators
265+mkDirectGenerators fn =
266+ DirectGenerators
267+ fn
268+ Nothing
269+ DirectGeneratorSuggestModeMissing
270+ Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing
src/Database/Bloodhound/Types.hs+137−4809
@@ -1,10 +1,7 @@
1−{-# LANGUAGE DeriveDataTypeable #-}
2−{-# LANGUAGE DeriveGeneric #-}
3{-# LANGUAGE FlexibleContexts #-}
1{-# LANGUAGE FlexibleContexts #-}
4{-# LANGUAGE FlexibleInstances #-}
2{-# LANGUAGE FlexibleInstances #-}
5{-# LANGUAGE GeneralizedNewtypeDeriving #-}
3{-# LANGUAGE GeneralizedNewtypeDeriving #-}
6{-# LANGUAGE MultiParamTypeClasses #-}
4{-# LANGUAGE MultiParamTypeClasses #-}
7−-- {-# LANGUAGE NoMonomorphismRestriction #-}
8{-# LANGUAGE NamedFieldPuns #-}
5{-# LANGUAGE NamedFieldPuns #-}
9{-# LANGUAGE OverloadedStrings #-}
6{-# LANGUAGE OverloadedStrings #-}
10{-# LANGUAGE RecordWildCards #-}
7{-# LANGUAGE RecordWildCards #-}
@@ -13,11 +10,11 @@
13-------------------------------------------------------------------------------
10-------------------------------------------------------------------------------
14-- |
11-- |
15-- Module : Database.Bloodhound.Types
12-- Module : Database.Bloodhound.Types
16−-- Copyright : (C) 2014, 2015, 2016 Chris Allen
13+-- Copyright : (C) 2014, 2018 Chris Allen
17-- License : BSD-style (see the file LICENSE)
14-- License : BSD-style (see the file LICENSE)
18-- Maintainer : Chris Allen <cma@bitemyapp.com
15-- Maintainer : Chris Allen <cma@bitemyapp.com
19-- Stability : provisional
16-- Stability : provisional
20−-- Portability : DeriveGeneric, RecordWildCards
17+-- Portability : RecordWildCards
21--
18--
22-- Data types for describing actions and data structures performed to interact
19-- Data types for describing actions and data structures performed to interact
23-- with Elasticsearch. The two main buckets your queries against Elasticsearch
20-- with Elasticsearch. The two main buckets your queries against Elasticsearch
@@ -47,10 +44,13 @@ module Database.Bloodhound.Types
47 , mkDateHistogram
44 , mkDateHistogram
48 , mkCardinalityAggregation
45 , mkCardinalityAggregation
49 , mkDocVersion
46 , mkDocVersion
47+ , mkStatsAggregation
48+ , mkExtendedStatsAggregation
50 , docVersionNumber
49 , docVersionNumber
51 , toMissing
50 , toMissing
52 , toTerms
51 , toTerms
53 , toDateHistogram
52 , toDateHistogram
53+ , toTopHits
54 , omitNulls
54 , omitNulls
55 , BH(..)
55 , BH(..)
56 , runBH
56 , runBH
@@ -62,6 +62,7 @@ module Database.Bloodhound.Types
62 , MonadBH(..)
62 , MonadBH(..)
63 , Version(..)
63 , Version(..)
64 , VersionNumber(..)
64 , VersionNumber(..)
65+ , MaybeNA(..)
65 , BuildHash(..)
66 , BuildHash(..)
66 , Status(..)
67 , Status(..)
67 , Existence(..)
68 , Existence(..)
@@ -70,6 +71,7 @@ module Database.Bloodhound.Types
70 , UpdatableIndexSetting(..)
71 , UpdatableIndexSetting(..)
71 , IndexSettingsSummary(..)
72 , IndexSettingsSummary(..)
72 , AllocationPolicy(..)
73 , AllocationPolicy(..)
74+ , Compression(..)
73 , ReplicaBounds(..)
75 , ReplicaBounds(..)
74 , Bytes(..)
76 , Bytes(..)
75 , gigabytes
77 , gigabytes
@@ -118,8 +120,8 @@ module Database.Bloodhound.Types
118 , Pattern(..)
120 , Pattern(..)
119 , ShardResult(..)
121 , ShardResult(..)
120 , Hit(..)
122 , Hit(..)
123+ , HitFields(..)
121 , Filter(..)
124 , Filter(..)
122− , Seminearring(..)
123 , BoolMatch(..)
125 , BoolMatch(..)
124 , Term(..)
126 , Term(..)
125 , GeoPoint(..)
127 , GeoPoint(..)
@@ -146,13 +148,22 @@ module Database.Bloodhound.Types
146 , RegexpFlags(..)
148 , RegexpFlags(..)
147 , RegexpFlag(..)
149 , RegexpFlag(..)
148 , FieldName(..)
150 , FieldName(..)
151+ , ScriptFields(..)
152+ , ScriptFieldName
153+ , ScriptFieldValue
149 , Script(..)
154 , Script(..)
155+ , ScriptLanguage(..)
156+ , ScriptInline(..)
157+ , ScriptId(..)
158+ , ScriptParams(..)
159+ , ScriptParamName
160+ , ScriptParamValue
150 , IndexName(..)
161 , IndexName(..)
151 , IndexSelection(..)
162 , IndexSelection(..)
152 , NodeSelection(..)
163 , NodeSelection(..)
153 , NodeSelector(..)
164 , NodeSelector(..)
154− , IndexOptimizationSettings(..)
165+ , ForceMergeIndexSettings(..)
155− , defaultIndexOptimizationSettings
166+ , defaultForceMergeIndexSettings
156 , TemplateName(..)
167 , TemplateName(..)
157 , TemplatePattern(..)
168 , TemplatePattern(..)
158 , MappingName(..)
169 , MappingName(..)
@@ -176,8 +187,19 @@ module Database.Bloodhound.Types
176 , BoolQuery(..)
187 , BoolQuery(..)
177 , BoostingQuery(..)
188 , BoostingQuery(..)
178 , CommonTermsQuery(..)
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(..)
179 , DisMaxQuery(..)
202 , DisMaxQuery(..)
180− , FilteredQuery(..)
181 , FuzzyLikeThisQuery(..)
203 , FuzzyLikeThisQuery(..)
182 , FuzzyLikeFieldQuery(..)
204 , FuzzyLikeFieldQuery(..)
183 , FuzzyQuery(..)
205 , FuzzyQuery(..)
@@ -193,10 +215,16 @@ module Database.Bloodhound.Types
193 , RangeQuery(..)
215 , RangeQuery(..)
194 , RegexpQuery(..)
216 , RegexpQuery(..)
195 , QueryString(..)
217 , QueryString(..)
218+ , TemplateQueryInline(..)
219+ , TemplateQueryKeyValuePairs(..)
220+ , WildcardQuery(..)
196 , BooleanOperator(..)
221 , BooleanOperator(..)
197 , ZeroTermsQuery(..)
222 , ZeroTermsQuery(..)
198 , CutoffFrequency(..)
223 , CutoffFrequency(..)
199 , Analyzer(..)
224 , Analyzer(..)
225+ , Tokenizer(..)
226+ , TokenFilter(..)
227+ , CharFilter(..)
200 , MaxExpansions(..)
228 , MaxExpansions(..)
201 , Lenient(..)
229 , Lenient(..)
202 , MatchQueryType(..)
230 , MatchQueryType(..)
@@ -320,6 +348,18 @@ module Database.Bloodhound.Types
320 , rrGroupRefNum
348 , rrGroupRefNum
321 , mkRRGroupRefNum
349 , mkRRGroupRefNum
322 , RestoreIndexSettings(..)
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 (..)
323
363
324 , Aggregation(..)
364 , Aggregation(..)
325 , Aggregations
365 , Aggregations
@@ -332,6 +372,7 @@ module Database.Bloodhound.Types
332 , ValueCountAggregation(..)
372 , ValueCountAggregation(..)
333 , FilterAggregation(..)
373 , FilterAggregation(..)
334 , CardinalityAggregation(..)
374 , CardinalityAggregation(..)
375+ , MaxAggregation(..)
335 , DateHistogramAggregation(..)
376 , DateHistogramAggregation(..)
336 , DateRangeAggregation(..)
377 , DateRangeAggregation(..)
337 , DateRangeAggRange(..)
378 , DateRangeAggRange(..)
@@ -339,6 +380,9 @@ module Database.Bloodhound.Types
339 , DateMathAnchor(..)
380 , DateMathAnchor(..)
340 , DateMathModifier(..)
381 , DateMathModifier(..)
341 , DateMathUnit(..)
382 , DateMathUnit(..)
383+ , TopHitsAggregation(..)
384+ , StatisticsAggregation(..)
385+ , SearchAfterKey
342
386
343 , Highlights(..)
387 , Highlights(..)
344 , FieldHighlight(..)
388 , FieldHighlight(..)
@@ -356,724 +400,32 @@ module Database.Bloodhound.Types
356 , TermsResult(..)
400 , TermsResult(..)
357 , DateHistogramResult(..)
401 , DateHistogramResult(..)
358 , DateRangeResult(..)
402 , DateRangeResult(..)
403+ , TopHitResult(..)
359
404
360 , EsUsername(..)
405 , EsUsername(..)
361 , EsPassword(..)
406 , EsPassword(..)
362− ) where
363
407
364−import Control.Applicative as A
408+ , Analysis(..)
365−import Control.Arrow (first)
409+ , AnalyzerDefinition(..)
366−import Control.Monad.Catch
410+ , TokenizerDefinition(..)
367−import Control.Monad.Except
411+ , TokenFilterDefinition(..)
368−import Control.Monad.Reader
412+ , CharFilterDefinition(..)
369−import Control.Monad.State
413+ , Ngram(..)
370−import Control.Monad.Writer
414+ , TokenChar(..)
371−import Data.Aeson
415+ , Shingle(..)
372−import Data.Aeson.Types (Pair, Parser, emptyObject,
416+ , Language(..)
373− parseEither, parseMaybe)
417+ ) where
374−import qualified Data.ByteString.Lazy.Char8 as L
418+
375−import Data.Char
419+import Bloodhound.Import
376−import Data.Hashable (Hashable)
420+
377−import qualified Data.HashMap.Strict as HM
421+import Database.Bloodhound.Internal.Aggregation
378−import Data.List (foldl', intercalate, nub)
422+import Database.Bloodhound.Internal.Analysis
379−import Data.List.NonEmpty (NonEmpty (..), toList)
423+import Database.Bloodhound.Internal.Client
380−import qualified Data.Map.Strict as M
424+import Database.Bloodhound.Internal.Highlight
381−import Data.Maybe
425+import Database.Bloodhound.Internal.Newtypes
382−import Data.Scientific (Scientific)
426+import Database.Bloodhound.Internal.Query
383−import Data.Text (Text)
427+import Database.Bloodhound.Internal.Sort
384−import qualified Data.Text as T
428+import Database.Bloodhound.Internal.Suggest
385−import Data.Time.Calendar
386−import Data.Time.Clock (NominalDiffTime, UTCTime)
387−import Data.Time.Clock.POSIX
388−import qualified Data.Traversable as DT
389−import Data.Typeable (Typeable)
390−import qualified Data.Vector as V
391−import qualified Data.Version as Vers
392−import GHC.Enum
393−import GHC.Generics (Generic)
394−import Network.HTTP.Client
395−import qualified Network.HTTP.Types.Method as NHTM
396−import qualified Text.ParserCombinators.ReadP as RP
397−import qualified Text.Read as TR
398−
399−import Database.Bloodhound.Types.Class
400−import Database.Bloodhound.Types.Internal
401−
402−-- $setup
403−-- >>> :set -XOverloadedStrings
404−-- >>> import Data.Aeson
405−-- >>> import Database.Bloodhound
406−-- >>> let testServer = (Server "http://localhost:9200")
407−-- >>> let testIndex = IndexName "twitter"
408−-- >>> let testMapping = MappingName "tweet"
409−-- >>> let defaultIndexSettings = IndexSettings (ShardCount 3) (ReplicaCount 2)
410−
411−-- defaultIndexSettings is exported by Database.Bloodhound as well
412−-- no trailing slashes in servers, library handles building the path.
413−
414−-- | Create a 'BHEnv' with all optional fields defaulted. HTTP hook
415−-- will be a noop. You can use the exported fields to customize it further, e.g.:
416−--
417−-- >> (mkBHEnv myServer myManager) { bhRequestHook = customHook }
418−mkBHEnv :: Server -> Manager -> BHEnv
419−mkBHEnv s m = BHEnv s m return
420−
421−newtype BH m a = BH {
422− unBH :: ReaderT BHEnv m a
423− } deriving ( Functor
424− , A.Applicative
425− , Monad
426− , MonadIO
427− , MonadState s
428− , MonadWriter w
429− , MonadError e
430− , Alternative
431− , MonadPlus
432− , MonadFix
433− , MonadThrow
434− , MonadCatch
435− , MonadMask)
436−
437−instance MonadTrans BH where
438− lift = BH . lift
439−
440−instance (MonadReader r m) => MonadReader r (BH m) where
441− ask = lift ask
442− local f (BH (ReaderT m)) = BH $ ReaderT $ \r ->
443− local f (m r)
444−
445−instance (Functor m, Applicative m, MonadIO m) => MonadBH (BH m) where
446− getBHEnv = BH getBHEnv
447−
448−runBH :: BHEnv -> BH m a -> m a
449−runBH e f = runReaderT (unBH f) e
450−
451−{-| 'Version' is embedded in 'Status' -}
452−data Version = Version { number :: VersionNumber
453− , build_hash :: BuildHash
454− , build_timestamp :: UTCTime
455− , build_snapshot :: Bool
456− , lucene_version :: VersionNumber } deriving (Eq, Read, Show, Generic, Typeable)
457−
458−-- | Traditional software versioning number
459−newtype VersionNumber = VersionNumber { versionNumber :: Vers.Version
460− } deriving (Eq, Read, Show, Generic, Typeable, Ord)
461−
462−{-| 'Status' is a data type for describing the JSON body returned by
463− Elasticsearch when you query its status. This was deprecated in 1.2.0.
464−
465− <http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/indices-status.html#indices-status>
466−-}
467−
468−data Status = Status { ok :: Maybe Bool
469− , status :: Int
470− , name :: Text
471− , version :: Version
472− , tagline :: Text } deriving (Eq, Read, Show, Generic)
473−
474−{-| 'IndexSettings' is used to configure the shards and replicas when you create
475− an Elasticsearch Index.
476−
477− <http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/indices-create-index.html>
478−-}
479−
480−data IndexSettings =
481− IndexSettings { indexShards :: ShardCount
482− , indexReplicas :: ReplicaCount } deriving (Eq, Read, Show, Generic, Typeable)
483−
484−{-| 'defaultIndexSettings' is an 'IndexSettings' with 3 shards and 2 replicas. -}
485−defaultIndexSettings :: IndexSettings
486−defaultIndexSettings = IndexSettings (ShardCount 3) (ReplicaCount 2)
487−
488−
489−{-| 'IndexOptimizationSettings' is used to configure index optimization. See
490− <https://www.elastic.co/guide/en/elasticsearch/reference/1.7/indices-optimize.html>
491− for more info.
492−-}
493−data IndexOptimizationSettings =
494− IndexOptimizationSettings { maxNumSegments :: Maybe Int
495− -- ^ 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.
496− , onlyExpungeDeletes :: Bool
497− -- ^ 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.
498− , flushAfterOptimize :: Bool
499− -- ^ Should a flush be performed after the optimize.
500− } deriving (Eq, Show, Generic, Typeable)
501−
502−
503−{-| 'defaultIndexOptimizationSettings' implements the default settings that
504− ElasticSearch uses for index optimization. 'maxNumSegments' is Nothing,
505− 'onlyExpungeDeletes' is False, and flushAfterOptimize is True.
506−-}
507−defaultIndexOptimizationSettings :: IndexOptimizationSettings
508−defaultIndexOptimizationSettings = IndexOptimizationSettings Nothing False True
509−
510−{-| 'UpdatableIndexSetting' are settings which may be updated after an index is created.
511−
512− <https://www.elastic.co/guide/en/elasticsearch/reference/current/indices-update-settings.html>
513−-}
514−data UpdatableIndexSetting = NumberOfReplicas ReplicaCount
515− -- ^ The number of replicas each shard has.
516− | AutoExpandReplicas ReplicaBounds
517− | BlocksReadOnly Bool
518− -- ^ Set to True to have the index read only. False to allow writes and metadata changes.
519− | BlocksRead Bool
520− -- ^ Set to True to disable read operations against the index.
521− | BlocksWrite Bool
522− -- ^ Set to True to disable write operations against the index.
523− | BlocksMetaData Bool
524− -- ^ Set to True to disable metadata operations against the index.
525− | RefreshInterval NominalDiffTime
526− -- ^ The async refresh interval of a shard
527− | IndexConcurrency Int
528− | FailOnMergeFailure Bool
529− | TranslogFlushThresholdOps Int
530− -- ^ When to flush on operations.
531− | TranslogFlushThresholdSize Bytes
532− -- ^ When to flush based on translog (bytes) size.
533− | TranslogFlushThresholdPeriod NominalDiffTime
534− -- ^ When to flush based on a period of not flushing.
535− | TranslogDisableFlush Bool
536− -- ^ Disables flushing. Note, should be set for a short interval and then enabled.
537− | CacheFilterMaxSize (Maybe Bytes)
538− -- ^ The maximum size of filter cache (per segment in shard).
539− | CacheFilterExpire (Maybe NominalDiffTime)
540− -- ^ The expire after access time for filter cache.
541− | GatewaySnapshotInterval NominalDiffTime
542− -- ^ The gateway snapshot interval (only applies to shared gateways).
543− | RoutingAllocationInclude (NonEmpty NodeAttrFilter)
544− -- ^ A node matching any rule will be allowed to host shards from the index.
545− | RoutingAllocationExclude (NonEmpty NodeAttrFilter)
546− -- ^ A node matching any rule will NOT be allowed to host shards from the index.
547− | RoutingAllocationRequire (NonEmpty NodeAttrFilter)
548− -- ^ Only nodes matching all rules will be allowed to host shards from the index.
549− | RoutingAllocationEnable AllocationPolicy
550− -- ^ Enables shard allocation for a specific index.
551− | RoutingAllocationShardsPerNode ShardCount
552− -- ^ Controls the total number of shards (replicas and primaries) allowed to be allocated on a single node.
553− | RecoveryInitialShards InitialShardCount
554− -- ^ When using local gateway a particular shard is recovered only if there can be allocated quorum shards in the cluster.
555− | GCDeletes NominalDiffTime
556− | TTLDisablePurge Bool
557− -- ^ Disables temporarily the purge of expired docs.
558− | TranslogFSType FSType
559− | IndexCompoundFormat CompoundFormat
560− | IndexCompoundOnFlush Bool
561− | WarmerEnabled Bool
562− deriving (Eq, Show, Generic, Typeable)
563−
564−data AllocationPolicy = AllocAll
565− -- ^ Allows shard allocation for all shards.
566− | AllocPrimaries
567− -- ^ Allows shard allocation only for primary shards.
568− | AllocNewPrimaries
569− -- ^ Allows shard allocation only for primary shards for new indices.
570− | AllocNone
571− -- ^ No shard allocation is allowed
572− deriving (Eq, Read, Show, Generic, Typeable)
573−
574−data ReplicaBounds = ReplicasBounded Int Int
575− | ReplicasLowerBounded Int
576− | ReplicasUnbounded
577− deriving (Eq, Read, Show, Generic, Typeable)
578−
579−-- | A measure of bytes used for various configurations. You may want
580−-- to use smart constructors like 'gigabytes' for larger values.
581−--
582−-- >>> gigabytes 9
583−-- Bytes 9000000000
584−--
585−-- >>> megabytes 9
586−-- Bytes 9000000
587−--
588−-- >>> kilobytes 9
589−-- Bytes 9000
590−newtype Bytes = Bytes Int deriving (Eq, Read, Show, Generic, Typeable, Ord, ToJSON, FromJSON)
591−
592−gigabytes :: Int -> Bytes
593−gigabytes n = megabytes (1000 * n)
594−
595−
596−megabytes :: Int -> Bytes
597−megabytes n = kilobytes (1000 * n)
598−
599−
600−kilobytes :: Int -> Bytes
601−kilobytes n = Bytes (1000 * n)
602−
603−
604−data FSType = FSSimple
605− | FSBuffered deriving (Eq, Read, Show, Generic, Typeable, Ord)
606−
607−data InitialShardCount = QuorumShards
608− | QuorumMinus1Shards
609− | FullShards
610− | FullMinus1Shards
611− | ExplicitShards Int
612− deriving (Eq, Read, Show, Generic, Typeable)
613−
614−data NodeAttrFilter = NodeAttrFilter { nodeAttrFilterName :: NodeAttrName
615− , nodeAttrFilterValues :: NonEmpty Text}
616− deriving (Eq, Read, Show, Generic, Ord, Typeable)
617−
618−newtype NodeAttrName = NodeAttrName Text deriving (Eq, Read, Show, Ord, Generic, Typeable)
619−
620−data CompoundFormat = CompoundFileFormat Bool
621− | MergeSegmentVsTotalIndex Double
622− -- ^ percentage between 0 and 1 where 0 is false, 1 is true
623− deriving (Eq, Read, Show, Generic, Typeable)
624−
625−newtype NominalDiffTimeJSON = NominalDiffTimeJSON { ndtJSON :: NominalDiffTime }
626−
627−data IndexSettingsSummary = IndexSettingsSummary { sSummaryIndexName :: IndexName
628− , sSummaryFixedSettings :: IndexSettings
629− , sSummaryUpdateable :: [UpdatableIndexSetting]}
630− deriving (Eq, Show, Generic, Typeable)
631−
632−{-| 'Reply' and 'Method' are type synonyms from 'Network.HTTP.Types.Method.Method' -}
633−type Reply = Network.HTTP.Client.Response L.ByteString
634−type Method = NHTM.Method
635−
636−{-| 'OpenCloseIndex' is a sum type for opening and closing indices.
637−
638− <http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/indices-open-close.html>
639−-}
640−data OpenCloseIndex = OpenIndex | CloseIndex deriving (Eq, Read, Show, Generic, Typeable)
641−
642−data FieldType = GeoPointType
643− | GeoShapeType
644− | FloatType
645− | IntegerType
646− | LongType
647− | ShortType
648− | ByteType deriving (Eq, Read, Show, Generic, Typeable)
649−
650−data FieldDefinition =
651− FieldDefinition { fieldType :: FieldType } deriving (Eq, Read, Show, Generic, Typeable)
652−
653−{-| An 'IndexTemplate' defines a template that will automatically be
654− applied to new indices created. The templates include both
655− 'IndexSettings' and mappings, and a simple 'TemplatePattern' that
656− controls if the template will be applied to the index created.
657− Specify mappings as follows: @[toJSON TweetMapping, ...]@
658−
659− https://www.elastic.co/guide/en/elasticsearch/reference/1.7/indices-templates.html
660−-}
661−data IndexTemplate =
662− IndexTemplate { templatePattern :: TemplatePattern
663− , templateSettings :: Maybe IndexSettings
664− , templateMappings :: [Value]
665− }
666−
667−data MappingField =
668− MappingField { mappingFieldName :: FieldName
669− , fieldDefinition :: FieldDefinition } deriving (Eq, Read, Show, Generic, Typeable)
670−
671−{-| Support for type reification of 'Mapping's is currently incomplete, for
672− now the mapping API verbiage expects a 'ToJSON'able blob.
673−
674− Indexes have mappings, mappings are schemas for the documents contained in the
675− index. I'd recommend having only one mapping per index, always having a mapping,
676− and keeping different kinds of documents separated if possible.
677−-}
678−data Mapping = Mapping { typeName :: TypeName
679− , mappingFields :: [MappingField] } deriving (Eq, Read, Show, Generic, Typeable)
680−
681−{-| 'BulkOperation' is a sum type for expressing the four kinds of bulk
682− operation index, create, delete, and update. 'BulkIndex' behaves like an
683− "upsert", 'BulkCreate' will fail if a document already exists at the DocId.
684−
685− <http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/docs-bulk.html#docs-bulk>
686−-}
687−data BulkOperation =
688− BulkIndex IndexName MappingName DocId Value
689− | BulkCreate IndexName MappingName DocId Value
690− | BulkDelete IndexName MappingName DocId
691− | BulkUpdate IndexName MappingName DocId Value deriving (Eq, Read, Show, Generic, Typeable)
692−
693−{-| 'EsResult' describes the standard wrapper JSON document that you see in
694− successful Elasticsearch lookups or lookups that couldn't find the document.
695−-}
696−data EsResult a = EsResult { _index :: Text
697− , _type :: Text
698− , _id :: Text
699− , foundResult :: Maybe (EsResultFound a)} deriving (Eq, Read, Show, Generic, Typeable)
700−
701−{-| 'EsResultFound' contains the document and its metadata inside of an
702− 'EsResult' when the document was successfully found.
703−-}
704−data EsResultFound a = EsResultFound { _version :: DocVersion
705− , _source :: a } deriving (Eq, Read, Show, Generic, Typeable)
706−
707−{-| 'EsError' is the generic type that will be returned when there was a
708− problem. If you can't parse the expected response, its a good idea to
709− try parsing this.
710−-}
711−data EsError = EsError { errorStatus :: Int
712− , errorMessage :: Text } deriving (Eq, Read, Show, Generic, Typeable)
713−
714−{-| 'EsProtocolException' will be thrown if Bloodhound cannot parse a response
715−returned by the ElasticSearch server. If you encounter this error, please
716−verify that your domain data types and FromJSON instances are working properly
717−(for example, the 'a' of '[Hit a]' in 'SearchResult.searchHits.hits'). If you're
718−sure that your mappings are correct, then this error may be an indication of an
719−incompatibility between Bloodhound and ElasticSearch. Please open a bug report
720−and be sure to include the exception body.
721−-}
722−data EsProtocolException = EsProtocolException { esProtoExBody :: L.ByteString }
723− deriving (Eq, Read, Show, Generic, Typeable)
724−
725−instance Exception EsProtocolException
726−
727−data IndexAlias = IndexAlias { srcIndex :: IndexName
728− , indexAlias :: IndexAliasName } deriving (Eq, Read, Show, Generic, Typeable)
729−
730−newtype IndexAliasName = IndexAliasName { indexAliasName :: IndexName } deriving (Eq, Read, Show, Generic, ToJSON)
731−
732−data IndexAliasAction = AddAlias IndexAlias IndexAliasCreate
733− | RemoveAlias IndexAlias deriving (Read, Show, Eq, Generic, Typeable)
734−
735−data IndexAliasCreate = IndexAliasCreate { aliasCreateRouting :: Maybe AliasRouting
736− , aliasCreateFilter :: Maybe Filter}
737− deriving (Read, Show, Eq, Generic, Typeable)
738−
739−data AliasRouting = AllAliasRouting RoutingValue
740− | GranularAliasRouting (Maybe SearchAliasRouting) (Maybe IndexAliasRouting)
741− deriving (Read, Show, Eq, Generic, Typeable)
742−
743−newtype SearchAliasRouting = SearchAliasRouting (NonEmpty RoutingValue) deriving (Read, Show, Eq, Generic, Typeable)
744−
745−newtype IndexAliasRouting = IndexAliasRouting RoutingValue deriving (Read, Show, Eq, Generic, ToJSON, FromJSON, Typeable)
746−
747−newtype RoutingValue = RoutingValue { routingValue :: Text } deriving (Read, Show, Eq, Generic, ToJSON, FromJSON, Typeable)
748−
749−newtype IndexAliasesSummary = IndexAliasesSummary { indexAliasesSummary :: [IndexAliasSummary] } deriving (Read, Show, Eq, Generic, Typeable)
750−
751−{-| 'IndexAliasSummary' is a summary of an index alias configured for a server. -}
752−data IndexAliasSummary = IndexAliasSummary { indexAliasSummaryAlias :: IndexAlias
753− , indexAliasSummaryCreate :: IndexAliasCreate} deriving (Read, Show, Eq, Generic, Typeable)
754−
755−{-| 'DocVersion' is an integer version number for a document between 1
756−and 9.2e+18 used for <<https://www.elastic.co/guide/en/elasticsearch/guide/current/optimistic-concurrency-control.html optimistic concurrency control>>.
757−-}
758−newtype DocVersion = DocVersion {
759− docVersionNumber :: Int
760− } deriving (Eq, Read, Show, Generic, Ord, ToJSON)
761−
762−-- | Smart constructor for in-range doc version
763−mkDocVersion :: Int -> Maybe DocVersion
764−mkDocVersion i
765− | i >= (docVersionNumber minBound) && i <= (docVersionNumber maxBound) =
766− Just $ DocVersion i
767− | otherwise = Nothing
768−
769−
770−{-| 'ExternalDocVersion' is a convenience wrapper if your code uses its
771−own version numbers instead of ones from ES.
772−-}
773−newtype ExternalDocVersion = ExternalDocVersion DocVersion
774− deriving (Eq, Read, Show, Generic, Ord, Bounded, Enum, ToJSON)
775−
776−{-| 'VersionControl' is specified when indexing documents as a
777−optimistic concurrency control.
778−-}
779−data VersionControl = NoVersionControl
780− -- ^ Don't send a version. This is a pure overwrite.
781− | InternalVersion DocVersion
782− -- ^ Use the default ES versioning scheme. Only
783− -- index the document if the version is the same
784− -- as the one specified. Only applicable to
785− -- updates, as you should be getting Version from
786− -- a search result.
787− | ExternalGT ExternalDocVersion
788− -- ^ Use your own version numbering. Only index
789− -- the document if the version is strictly higher
790− -- OR the document doesn't exist. The given
791− -- version will be used as the new version number
792− -- for the stored document. N.B. All updates must
793− -- increment this number, meaning there is some
794− -- global, external ordering of updates.
795− | ExternalGTE ExternalDocVersion
796− -- ^ Use your own version numbering. Only index
797− -- the document if the version is equal or higher
798− -- than the stored version. Will succeed if there
799− -- is no existing document. The given version will
800− -- be used as the new version number for the
801− -- stored document. Use with care, as this could
802− -- result in data loss.
803− | ForceVersion ExternalDocVersion
804− -- ^ The document will always be indexed and the
805− -- given version will be the new version. This is
806− -- typically used for correcting errors. Use with
807− -- care, as this could result in data loss.
808− deriving (Read, Show, Eq, Generic, Ord)
809−
810−{-| 'DocumentParent' is used to specify a parent document.
811−-}
812−newtype DocumentParent = DocumentParent DocId
813− deriving (Eq, Read, Show, Generic, Typeable)
814−
815−{-| 'IndexDocumentSettings' are special settings supplied when indexing
816−a document. For the best backwards compatiblity when new fields are
817−added, you should probably prefer to start with 'defaultIndexDocumentSettings'
818−-}
819−data IndexDocumentSettings =
820− IndexDocumentSettings { idsVersionControl :: VersionControl
821− , idsParent :: Maybe DocumentParent
822− } deriving (Eq, Read, Show, Generic, Typeable)
823−
824−{-| Reasonable default settings. Chooses no version control and no parent.
825−-}
826−defaultIndexDocumentSettings :: IndexDocumentSettings
827−defaultIndexDocumentSettings = IndexDocumentSettings NoVersionControl Nothing
828−
829−{-| 'Sort' is a synonym for a list of 'SortSpec's. Sort behavior is order
830− dependent with later sorts acting as tie-breakers for earlier sorts.
831−-}
832−type Sort = [SortSpec]
833−
834−{-| The two main kinds of 'SortSpec' are 'DefaultSortSpec' and
835− 'GeoDistanceSortSpec'. The latter takes a 'SortOrder', 'GeoPoint', and
836− 'DistanceUnit' to express "nearness" to a single geographical point as a
837− sort specification.
838−
839−<http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/search-request-sort.html#search-request-sort>
840−-}
841−data SortSpec = DefaultSortSpec DefaultSort
842− | GeoDistanceSortSpec SortOrder GeoPoint DistanceUnit deriving (Eq, Read, Show, Generic, Typeable)
843−
844−{-| 'DefaultSort' is usually the kind of 'SortSpec' you'll want. There's a
845− 'mkSort' convenience function for when you want to specify only the most
846− common parameters.
847−
848−<http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/search-request-sort.html#search-request-sort>
849−-}
850−data DefaultSort =
851− DefaultSort { sortFieldName :: FieldName
852− , sortOrder :: SortOrder
853− -- default False
854− , ignoreUnmapped :: Bool
855− , sortMode :: Maybe SortMode
856− , missingSort :: Maybe Missing
857− , nestedFilter :: Maybe Filter } deriving (Eq, Read, Show, Generic, Typeable)
858−
859−{-| 'SortOrder' is 'Ascending' or 'Descending', as you might expect. These get
860− encoded into "asc" or "desc" when turned into JSON.
861−
862−<http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/search-request-sort.html#search-request-sort>
863−-}
864−data SortOrder = Ascending
865− | Descending deriving (Eq, Read, Show, Generic, Typeable)
866−
867−{-| 'Missing' prescribes how to handle missing fields. A missing field can be
868− sorted last, first, or using a custom value as a substitute.
869−
870−<http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/search-request-sort.html#_missing_values>
871−-}
872−data Missing = LastMissing
873− | FirstMissing
874− | CustomMissing Text deriving (Eq, Read, Show, Generic, Typeable)
875−
876−{-| 'SortMode' prescribes how to handle sorting array/multi-valued fields.
877−
878−http://www.elasticsearch.org/guide/en/elasticsearch/reference/current/search-request-sort.html#_sort_mode_option
879−-}
880−data SortMode = SortMin
881− | SortMax
882− | SortSum
883− | SortAvg deriving (Eq, Read, Show, Generic, Typeable)
884−
885−{-| 'mkSort' defaults everything but the 'FieldName' and the 'SortOrder' so
886− that you can concisely describe the usual kind of 'SortSpec's you want.
887−-}
888−mkSort :: FieldName -> SortOrder -> DefaultSort
889−mkSort fieldName sOrder = DefaultSort fieldName sOrder False Nothing Nothing Nothing
890−
891−{-| 'Cache' is for telling ES whether it should cache a 'Filter' not.
892− 'Query's cannot be cached.
893−-}
894−type Cache = Bool -- caching on/off
895−defaultCache :: Cache
896−defaultCache = False
897−
898−{-| 'PrefixValue' is used in 'PrefixQuery' as the main query component.
899−-}
900−type PrefixValue = Text
901−
902−{-| 'BooleanOperator' is the usual And/Or operators with an ES compatible
903− JSON encoding baked in. Used all over the place.
904−-}
905−data BooleanOperator = And | Or deriving (Eq, Read, Show, Generic, Typeable)
906−
907−{-| 'ShardCount' is part of 'IndexSettings'
908−-}
909−newtype ShardCount = ShardCount Int deriving (Eq, Read, Show, Generic, ToJSON, Typeable)
910−
911−{-| 'ReplicaCount' is part of 'IndexSettings'
912−-}
913−newtype ReplicaCount = ReplicaCount Int deriving (Eq, Read, Show, Generic, ToJSON, Typeable)
914−
915−{-| 'IndexName' is used to describe which index to query/create/delete
916−-}
917−newtype IndexName = IndexName Text deriving (Eq, Generic, Read, Show, ToJSON, FromJSON, Typeable)
918−
919−{-| 'IndexSelection' is used for APIs which take a single index, a list of
920− indexes, or the special @_all@ index.
921−-}
922−--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.
923−data IndexSelection = IndexList (NonEmpty IndexName)
924− | AllIndexes deriving (Eq, Generic, Show, Typeable)
925−
926−{-| '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.
927−-}
928−data NodeSelection = LocalNode
929− -- ^ Whatever node receives this request
930− | NodeList (NonEmpty NodeSelector)
931− | AllNodes deriving (Eq, Generic, Show, Typeable)
932−
933−
934−-- | An exact match or pattern to identify a node. Note that All of
935−-- these options support wildcarding, so your node name, server, attr
936−-- name can all contain * characters to be a fuzzy match.
937−data NodeSelector = NodeByName NodeName
938− | NodeByFullNodeId FullNodeId
939− | NodeByHost Server
940− -- ^ e.g. 10.0.0.1 or even 10.0.0.*
941− | NodeByAttribute NodeAttrName Text
942− -- ^ NodeAttrName can be a pattern, e.g. rack*. The value can too.
943− deriving (Eq, Generic, Show, Typeable)
944−
945−{-| 'TemplateName' is used to describe which template to query/create/delete
946−-}
947−newtype TemplateName = TemplateName Text deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
948−
949−{-| 'TemplatePattern' represents a pattern which is matched against index names
950−-}
951−newtype TemplatePattern = TemplatePattern Text deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
952−
953−{-| 'MappingName' is part of mappings which are how ES describes and schematizes
954− the data in the indices.
955−-}
956−newtype MappingName = MappingName Text deriving (Eq, Generic, Read, Show, ToJSON, FromJSON, Typeable)
957−
958−{-| 'DocId' is a generic wrapper value for expressing unique Document IDs.
959− Can be set by the user or created by ES itself. Often used in client
960− functions for poking at specific documents.
961−-}
962−newtype DocId = DocId Text deriving (Eq, Generic, Read, Show, ToJSON, FromJSON, Typeable)
963−
964−{-| 'QueryString' is used to wrap query text bodies, be they human written or not.
965−-}
966−newtype QueryString = QueryString Text deriving (Eq, Generic, Read, Show, ToJSON, FromJSON, Typeable)
967−
968−{-| 'FieldName' is used all over the place wherever a specific field within
969− a document needs to be specified, usually in 'Query's or 'Filter's.
970−-}
971−newtype FieldName = FieldName Text deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
972−
973−
974−{-| 'Script' is often used in place of 'FieldName' to specify more
975−complex ways of extracting a value from a document.
976−-}
977−newtype Script = Script { scriptText :: Text } deriving (Eq, Read, Show, Generic, Typeable)
978−
979−{-| 'CacheName' is used in 'RegexpFilter' for describing the
980− 'CacheKey' keyed caching behavior.
981−-}
982−newtype CacheName = CacheName Text deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
983−
984−{-| 'CacheKey' is used in 'RegexpFilter' to key regex caching.
985−-}
986−newtype CacheKey =
987− CacheKey Text deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
988−newtype Existence =
989− Existence Bool deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
990−newtype NullValue =
991− NullValue Bool deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
992−newtype CutoffFrequency =
993− CutoffFrequency Double deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
994−newtype Analyzer =
995− Analyzer Text deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
996−newtype MaxExpansions =
997− MaxExpansions Int deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
998−
999−{-| 'Lenient', if set to true, will cause format based failures to be
1000− ignored. I don't know what the bloody default is, Elasticsearch
1001− documentation didn't say what it was. Let me know if you figure it out.
1002−-}
1003−newtype Lenient =
1004− Lenient Bool deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1005−newtype Tiebreaker =
1006− Tiebreaker Double deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1007−newtype Boost =
1008− Boost Double deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1009−newtype BoostTerms =
1010− BoostTerms Double deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1011−
1012−{-| 'MinimumMatch' controls how many should clauses in the bool query should
1013− match. Can be an absolute value (2) or a percentage (30%) or a
1014− combination of both.
1015−-}
1016−newtype MinimumMatch =
1017− MinimumMatch Int deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1018−newtype DisableCoord =
1019− DisableCoord Bool deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1020−newtype IgnoreTermFrequency =
1021− IgnoreTermFrequency Bool deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1022−newtype MinimumTermFrequency =
1023− MinimumTermFrequency Int deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1024−newtype MaxQueryTerms =
1025− MaxQueryTerms Int deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1026−newtype Fuzziness =
1027− Fuzziness Double deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1028−
1029−{-| 'PrefixLength' is the prefix length used in queries, defaults to 0. -}
1030−newtype PrefixLength =
1031− PrefixLength Int deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1032−newtype TypeName =
1033− TypeName Text deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1034−newtype PercentMatch =
1035− PercentMatch Double deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1036−newtype StopWord =
1037− StopWord Text deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1038−newtype QueryPath =
1039− QueryPath Text deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1040−
1041−{-| Allowing a wildcard at the beginning of a word (eg "*ing") is particularly
1042− heavy, because all terms in the index need to be examined, just in case
1043− they match. Leading wildcards can be disabled by setting
1044− 'AllowLeadingWildcard' to false. -}
1045−newtype AllowLeadingWildcard =
1046− AllowLeadingWildcard Bool deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1047−newtype LowercaseExpanded =
1048− LowercaseExpanded Bool deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1049−newtype EnablePositionIncrements =
1050− EnablePositionIncrements Bool deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1051−
1052−{-| By default, wildcard terms in a query are not analyzed.
1053− Setting 'AnalyzeWildcard' to true enables best-effort analysis.
1054−-}
1055−newtype AnalyzeWildcard = AnalyzeWildcard Bool deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1056−
1057−{-| 'GeneratePhraseQueries' defaults to false.
1058−-}
1059−newtype GeneratePhraseQueries =
1060− GeneratePhraseQueries Bool deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1061−
1062−{-| 'Locale' is used for string conversions - defaults to ROOT.
1063−-}
1064−newtype Locale = Locale Text deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1065−newtype MaxWordLength = MaxWordLength Int deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1066−newtype MinWordLength = MinWordLength Int deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1067−
1068−{-| 'PhraseSlop' sets the default slop for phrases, 0 means exact
1069− phrase matches. Default is 0.
1070−-}
1071−newtype PhraseSlop = PhraseSlop Int deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1072−newtype MinDocFrequency = MinDocFrequency Int deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1073−newtype MaxDocFrequency = MaxDocFrequency Int deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable)
1074−
1075−-- | Newtype wrapper to parse ES's concerning tendency to in some APIs return a floating point number of milliseconds since epoch ಠ_ಠ
1076−newtype POSIXMS = POSIXMS { posixMS :: UTCTime }
1077
429
1078{-| 'unpackId' is a silly convenience function that gets used once.
430{-| 'unpackId' is a silly convenience function that gets used once.
1079-}
431-}
@@ -1081,8 +433,6 @@ unpackId :: DocId -> Text
1081unpackId (DocId docId) = docId
433unpackId (DocId docId) = docId
1082
434
1083type TrackSortScores = Bool
435type TrackSortScores = Bool
1084−newtype From = From Int deriving (Eq, Read, Show, Generic, ToJSON)
1085−newtype Size = Size Int deriving (Eq, Read, Show, Generic, ToJSON)
1086
436
1087data Search = Search { queryBody :: Maybe Query
437data Search = Search { queryBody :: Maybe Query
1088 , filterBody :: Maybe Filter
438 , filterBody :: Maybe Filter
@@ -1094,537 +444,74 @@ data Search = Search { queryBody :: Maybe Query
1094 , from :: From
444 , from :: From
1095 , size :: Size
445 , size :: Size
1096 , searchType :: SearchType
446 , searchType :: SearchType
447+ , searchAfterKey :: Maybe SearchAfterKey
1097 , fields :: Maybe [FieldName]
448 , fields :: Maybe [FieldName]
449+ , scriptFields :: Maybe ScriptFields
1098− , source :: Maybe Source } deriving (Eq, Read, Show, Generic, Typeable)
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] [] []
1099
479
1100data SearchType = SearchTypeQueryThenFetch
480data SearchType = SearchTypeQueryThenFetch
1101 | SearchTypeDfsQueryThenFetch
481 | SearchTypeDfsQueryThenFetch
1102− | SearchTypeCount
1103− | SearchTypeScan
1104− | SearchTypeQueryAndFetch
1105− | SearchTypeDfsQueryAndFetch
1106− deriving (Eq, Read, Show, Generic, Typeable)
482+ deriving (Eq, Show)
1107
483
1108data Source =
484data Source =
1109 NoSource
485 NoSource
1110 | SourcePatterns PatternOrPatterns
486 | SourcePatterns PatternOrPatterns
1111 | SourceIncludeExclude Include Exclude
487 | SourceIncludeExclude Include Exclude
1112− deriving (Read, Show, Eq, Generic, Typeable)
488+ deriving (Eq, Show)
1113−
1114−data PatternOrPatterns = PopPattern Pattern
1115− | PopPatterns [Pattern] deriving (Eq, Read, Show, Generic, Typeable)
1116−
1117−data Include = Include [Pattern] deriving (Eq, Read, Show, Generic, Typeable)
1118−data Exclude = Exclude [Pattern] deriving (Eq, Read, Show, Generic, Typeable)
1119−
1120−newtype Pattern = Pattern Text deriving (Eq, Read, Show, Generic, Typeable)
1121−
1122−data Highlights = Highlights { globalsettings :: Maybe HighlightSettings
1123− , highlightFields :: [FieldHighlight]
1124− } deriving (Read, Show, Eq, Generic, Typeable)
1125−
1126−data FieldHighlight = FieldHighlight FieldName (Maybe HighlightSettings)
1127− deriving (Read, Show, Eq, Generic, Typeable)
1128−
1129−
1130−data HighlightSettings = Plain PlainHighlight
1131− | Postings PostingsHighlight
1132− | FastVector FastVectorHighlight
1133− deriving (Read, Show, Eq, Generic, Typeable)
1134−data PlainHighlight =
1135− PlainHighlight { plainCommon :: Maybe CommonHighlight
1136− , plainNonPost :: Maybe NonPostings } deriving (Read, Show, Eq, Generic, Typeable)
1137−
1138− -- This requires that index_options are set to 'offset' in the mapping.
1139−data PostingsHighlight = PostingsHighlight (Maybe CommonHighlight) deriving (Read, Show, Eq, Generic, Typeable)
1140−
1141−-- This requires that term_vector is set to 'with_positions_offsets' in the mapping.
1142−data FastVectorHighlight =
1143− FastVectorHighlight { fvCommon :: Maybe CommonHighlight
1144− , fvNonPostSettings :: Maybe NonPostings
1145− , boundaryChars :: Maybe Text
1146− , boundaryMaxScan :: Maybe Int
1147− , fragmentOffset :: Maybe Int
1148− , matchedFields :: [Text]
1149− , phraseLimit :: Maybe Int
1150− } deriving (Read, Show, Eq, Generic, Typeable)
1151−
1152−data CommonHighlight =
1153− CommonHighlight { order :: Maybe Text
1154− , forceSource :: Maybe Bool
1155− , tag :: Maybe HighlightTag
1156− , encoder :: Maybe HighlightEncoder
1157− , noMatchSize :: Maybe Int
1158− , highlightQuery :: Maybe Query
1159− , requireFieldMatch :: Maybe Bool
1160− } deriving (Read, Show, Eq, Generic, Typeable)
1161−
1162−-- Settings that are only applicable to FastVector and Plain highlighters.
1163−data NonPostings =
1164− NonPostings { fragmentSize :: Maybe Int
1165− , numberOfFragments :: Maybe Int} deriving (Read, Show, Eq, Generic, Typeable)
1166−
1167−data HighlightEncoder = DefaultEncoder
1168− | HTMLEncoder
1169− deriving (Read, Show, Eq, Generic, Typeable)
1170−
1171−-- NOTE: Should the tags use some kind of HTML type, rather than Text?
1172−data HighlightTag = TagSchema Text
1173− | CustomTags ([Text], [Text]) -- Only uses more than the first value in the lists if fvh
1174− deriving (Read, Show, Eq, Generic, Typeable)
1175−
1176−
1177−data Query =
1178− TermQuery Term (Maybe Boost)
1179− | TermsQuery Text (NonEmpty Text)
1180− | QueryMatchQuery MatchQuery
1181− | QueryMultiMatchQuery MultiMatchQuery
1182− | QueryBoolQuery BoolQuery
1183− | QueryBoostingQuery BoostingQuery
1184− | QueryCommonTermsQuery CommonTermsQuery
1185− | ConstantScoreFilter Filter Boost
1186− | ConstantScoreQuery Query Boost
1187− | QueryDisMaxQuery DisMaxQuery
1188− | QueryFilteredQuery FilteredQuery
1189− | QueryFuzzyLikeThisQuery FuzzyLikeThisQuery
1190− | QueryFuzzyLikeFieldQuery FuzzyLikeFieldQuery
1191− | QueryFuzzyQuery FuzzyQuery
1192− | QueryHasChildQuery HasChildQuery
1193− | QueryHasParentQuery HasParentQuery
1194− | IdsQuery MappingName [DocId]
1195− | QueryIndicesQuery IndicesQuery
1196− | MatchAllQuery (Maybe Boost)
1197− | QueryMoreLikeThisQuery MoreLikeThisQuery
1198− | QueryMoreLikeThisFieldQuery MoreLikeThisFieldQuery
1199− | QueryNestedQuery NestedQuery
1200− | QueryPrefixQuery PrefixQuery
1201− | QueryQueryStringQuery QueryStringQuery
1202− | QuerySimpleQueryStringQuery SimpleQueryStringQuery
1203− | QueryRangeQuery RangeQuery
1204− | QueryRegexpQuery RegexpQuery
1205− deriving (Eq, Read, Show, Generic, Typeable)
1206−
1207−data RegexpQuery =
1208− RegexpQuery { regexpQueryField :: FieldName
1209− , regexpQuery :: Regexp
1210− , regexpQueryFlags :: RegexpFlags
1211− , regexpQueryBoost :: Maybe Boost
1212− } deriving (Eq, Read, Show, Generic, Typeable)
1213−
1214−data RangeQuery =
1215− RangeQuery { rangeQueryField :: FieldName
1216− , rangeQueryRange :: RangeValue
1217− , rangeQueryBoost :: Boost } deriving (Eq, Read, Show, Generic, Typeable)
1218−
1219−mkRangeQuery :: FieldName -> RangeValue -> RangeQuery
1220−mkRangeQuery f r = RangeQuery f r (Boost 1.0)
1221−
1222−data SimpleQueryStringQuery =
1223− SimpleQueryStringQuery
1224− { simpleQueryStringQuery :: QueryString
1225− , simpleQueryStringField :: Maybe FieldOrFields
1226− , simpleQueryStringOperator :: Maybe BooleanOperator
1227− , simpleQueryStringAnalyzer :: Maybe Analyzer
1228− , simpleQueryStringFlags :: Maybe (NonEmpty SimpleQueryFlag)
1229− , simpleQueryStringLowercaseExpanded :: Maybe LowercaseExpanded
1230− , simpleQueryStringLocale :: Maybe Locale
1231− } deriving (Eq, Read, Show, Generic, Typeable)
1232
489
1233−data SimpleQueryFlag =
490+instance ToJSON Source where
1234− SimpleQueryAll
491+ toJSON NoSource = toJSON False
1235− | SimpleQueryNone
492+ toJSON (SourcePatterns patterns) = toJSON patterns
1236− | SimpleQueryAnd
493+ toJSON (SourceIncludeExclude incl excl) = object [ "includes" .= incl, "excludes" .= excl ]
1237− | SimpleQueryOr
1238− | SimpleQueryPrefix
1239− | SimpleQueryPhrase
1240− | SimpleQueryPrecedence
1241− | SimpleQueryEscape
1242− | SimpleQueryWhitespace
1243− | SimpleQueryFuzzy
1244− | SimpleQueryNear
1245− | SimpleQuerySlop deriving (Eq, Read, Show, Generic, Typeable)
1246−
1247−-- use_dis_max and tie_breaker when fields are plural?
1248−data QueryStringQuery =
1249− QueryStringQuery
1250− { queryStringQuery :: QueryString
1251− , queryStringDefaultField :: Maybe FieldName
1252− , queryStringOperator :: Maybe BooleanOperator
1253− , queryStringAnalyzer :: Maybe Analyzer
1254− , queryStringAllowLeadingWildcard :: Maybe AllowLeadingWildcard
1255− , queryStringLowercaseExpanded :: Maybe LowercaseExpanded
1256− , queryStringEnablePositionIncrements :: Maybe EnablePositionIncrements
1257− , queryStringFuzzyMaxExpansions :: Maybe MaxExpansions
1258− , queryStringFuzziness :: Maybe Fuzziness
1259− , queryStringFuzzyPrefixLength :: Maybe PrefixLength
1260− , queryStringPhraseSlop :: Maybe PhraseSlop
1261− , queryStringBoost :: Maybe Boost
1262− , queryStringAnalyzeWildcard :: Maybe AnalyzeWildcard
1263− , queryStringGeneratePhraseQueries :: Maybe GeneratePhraseQueries
1264− , queryStringMinimumShouldMatch :: Maybe MinimumMatch
1265− , queryStringLenient :: Maybe Lenient
1266− , queryStringLocale :: Maybe Locale
1267− } deriving (Eq, Read, Show, Generic, Typeable)
1268−
1269−mkQueryStringQuery :: QueryString -> QueryStringQuery
1270−mkQueryStringQuery qs =
1271− QueryStringQuery qs Nothing Nothing
1272− Nothing Nothing Nothing Nothing
1273− Nothing Nothing Nothing Nothing
1274− Nothing Nothing Nothing Nothing
1275− Nothing Nothing
1276−
1277−data FieldOrFields = FofField FieldName
1278− | FofFields (NonEmpty FieldName) deriving (Eq, Read, Show, Generic, Typeable)
1279−
1280−data PrefixQuery =
1281− PrefixQuery
1282− { prefixQueryField :: FieldName
1283− , prefixQueryPrefixValue :: Text
1284− , prefixQueryBoost :: Maybe Boost } deriving (Eq, Read, Show, Generic, Typeable)
1285−
1286−data NestedQuery =
1287− NestedQuery
1288− { nestedQueryPath :: QueryPath
1289− , nestedQueryScoreType :: ScoreType
1290− , nestedQuery :: Query } deriving (Eq, Read, Show, Generic, Typeable)
1291−
1292−data MoreLikeThisFieldQuery =
1293− MoreLikeThisFieldQuery
1294− { moreLikeThisFieldText :: Text
1295− , moreLikeThisFieldFields :: FieldName
1296− -- default 0.3 (30%)
1297− , moreLikeThisFieldPercentMatch :: Maybe PercentMatch
1298− , moreLikeThisFieldMinimumTermFreq :: Maybe MinimumTermFrequency
1299− , moreLikeThisFieldMaxQueryTerms :: Maybe MaxQueryTerms
1300− , moreLikeThisFieldStopWords :: Maybe (NonEmpty StopWord)
1301− , moreLikeThisFieldMinDocFrequency :: Maybe MinDocFrequency
1302− , moreLikeThisFieldMaxDocFrequency :: Maybe MaxDocFrequency
1303− , moreLikeThisFieldMinWordLength :: Maybe MinWordLength
1304− , moreLikeThisFieldMaxWordLength :: Maybe MaxWordLength
1305− , moreLikeThisFieldBoostTerms :: Maybe BoostTerms
1306− , moreLikeThisFieldBoost :: Maybe Boost
1307− , moreLikeThisFieldAnalyzer :: Maybe Analyzer
1308− } deriving (Eq, Read, Show, Generic, Typeable)
1309−
1310−data MoreLikeThisQuery =
1311− MoreLikeThisQuery
1312− { moreLikeThisText :: Text
1313− , moreLikeThisFields :: Maybe (NonEmpty FieldName)
1314− -- default 0.3 (30%)
1315− , moreLikeThisPercentMatch :: Maybe PercentMatch
1316− , moreLikeThisMinimumTermFreq :: Maybe MinimumTermFrequency
1317− , moreLikeThisMaxQueryTerms :: Maybe MaxQueryTerms
1318− , moreLikeThisStopWords :: Maybe (NonEmpty StopWord)
1319− , moreLikeThisMinDocFrequency :: Maybe MinDocFrequency
1320− , moreLikeThisMaxDocFrequency :: Maybe MaxDocFrequency
1321− , moreLikeThisMinWordLength :: Maybe MinWordLength
1322− , moreLikeThisMaxWordLength :: Maybe MaxWordLength
1323− , moreLikeThisBoostTerms :: Maybe BoostTerms
1324− , moreLikeThisBoost :: Maybe Boost
1325− , moreLikeThisAnalyzer :: Maybe Analyzer
1326− } deriving (Eq, Read, Show, Generic, Typeable)
1327−
1328−data IndicesQuery =
1329− IndicesQuery
1330− { indicesQueryIndices :: [IndexName]
1331− , indicesQuery :: Query
1332− -- default "all"
1333− , indicesQueryNoMatch :: Maybe Query } deriving (Eq, Read, Show, Generic, Typeable)
1334−
1335−data HasParentQuery =
1336− HasParentQuery
1337− { hasParentQueryType :: TypeName
1338− , hasParentQuery :: Query
1339− , hasParentQueryScoreType :: Maybe ScoreType } deriving (Eq, Read, Show, Generic, Typeable)
1340−
1341−data HasChildQuery =
1342− HasChildQuery
1343− { hasChildQueryType :: TypeName
1344− , hasChildQuery :: Query
1345− , hasChildQueryScoreType :: Maybe ScoreType } deriving (Eq, Read, Show, Generic, Typeable)
1346−
1347−data ScoreType =
1348− ScoreTypeMax
1349− | ScoreTypeSum
1350− | ScoreTypeAvg
1351− | ScoreTypeNone deriving (Eq, Read, Show, Generic, Typeable)
1352−
1353−data FuzzyQuery =
1354− FuzzyQuery { fuzzyQueryField :: FieldName
1355− , fuzzyQueryValue :: Text
1356− , fuzzyQueryPrefixLength :: PrefixLength
1357− , fuzzyQueryMaxExpansions :: MaxExpansions
1358− , fuzzyQueryFuzziness :: Fuzziness
1359− , fuzzyQueryBoost :: Maybe Boost
1360− } deriving (Eq, Read, Show, Generic, Typeable)
1361−
1362−data FuzzyLikeFieldQuery =
1363− FuzzyLikeFieldQuery
1364− { fuzzyLikeField :: FieldName
1365− -- anaphora is good for the soul.
1366− , fuzzyLikeFieldText :: Text
1367− , fuzzyLikeFieldMaxQueryTerms :: MaxQueryTerms
1368− , fuzzyLikeFieldIgnoreTermFrequency :: IgnoreTermFrequency
1369− , fuzzyLikeFieldFuzziness :: Fuzziness
1370− , fuzzyLikeFieldPrefixLength :: PrefixLength
1371− , fuzzyLikeFieldBoost :: Boost
1372− , fuzzyLikeFieldAnalyzer :: Maybe Analyzer
1373− } deriving (Eq, Read, Show, Generic, Typeable)
1374−
1375−data FuzzyLikeThisQuery =
1376− FuzzyLikeThisQuery
1377− { fuzzyLikeFields :: [FieldName]
1378− , fuzzyLikeText :: Text
1379− , fuzzyLikeMaxQueryTerms :: MaxQueryTerms
1380− , fuzzyLikeIgnoreTermFrequency :: IgnoreTermFrequency
1381− , fuzzyLikeFuzziness :: Fuzziness
1382− , fuzzyLikePrefixLength :: PrefixLength
1383− , fuzzyLikeBoost :: Boost
1384− , fuzzyLikeAnalyzer :: Maybe Analyzer
1385− } deriving (Eq, Read, Show, Generic, Typeable)
1386−
1387−data FilteredQuery =
1388− FilteredQuery
1389− { filteredQuery :: Query
1390− , filteredFilter :: Filter } deriving (Eq, Read, Show, Generic, Typeable)
1391−
1392−data DisMaxQuery =
1393− DisMaxQuery { disMaxQueries :: [Query]
1394− -- default 0.0
1395− , disMaxTiebreaker :: Tiebreaker
1396− , disMaxBoost :: Maybe Boost
1397− } deriving (Eq, Read, Show, Generic, Typeable)
1398−
1399−data MatchQuery =
1400− MatchQuery { matchQueryField :: FieldName
1401− , matchQueryQueryString :: QueryString
1402− , matchQueryOperator :: BooleanOperator
1403− , matchQueryZeroTerms :: ZeroTermsQuery
1404− , matchQueryCutoffFrequency :: Maybe CutoffFrequency
1405− , matchQueryMatchType :: Maybe MatchQueryType
1406− , matchQueryAnalyzer :: Maybe Analyzer
1407− , matchQueryMaxExpansions :: Maybe MaxExpansions
1408− , matchQueryLenient :: Maybe Lenient
1409− , matchQueryBoost :: Maybe Boost } deriving (Eq, Read, Show, Generic, Typeable)
1410−
1411−{-| 'mkMatchQuery' is a convenience function that defaults the less common parameters,
1412− enabling you to provide only the 'FieldName' and 'QueryString' to make a 'MatchQuery'
1413−-}
1414−mkMatchQuery :: FieldName -> QueryString -> MatchQuery
1415−mkMatchQuery field query = MatchQuery field query Or ZeroTermsNone Nothing Nothing Nothing Nothing Nothing Nothing
1416−
1417−data MatchQueryType =
1418− MatchPhrase
1419− | MatchPhrasePrefix deriving (Eq, Read, Show, Generic, Typeable)
1420−
1421−data MultiMatchQuery =
1422− MultiMatchQuery { multiMatchQueryFields :: [FieldName]
1423− , multiMatchQueryString :: QueryString
1424− , multiMatchQueryOperator :: BooleanOperator
1425− , multiMatchQueryZeroTerms :: ZeroTermsQuery
1426− , multiMatchQueryTiebreaker :: Maybe Tiebreaker
1427− , multiMatchQueryType :: Maybe MultiMatchQueryType
1428− , multiMatchQueryCutoffFrequency :: Maybe CutoffFrequency
1429− , multiMatchQueryAnalyzer :: Maybe Analyzer
1430− , multiMatchQueryMaxExpansions :: Maybe MaxExpansions
1431− , multiMatchQueryLenient :: Maybe Lenient } deriving (Eq, Read, Show, Generic, Typeable)
1432−
1433−{-| 'mkMultiMatchQuery' is a convenience function that defaults the less common parameters,
1434− enabling you to provide only the list of 'FieldName's and 'QueryString' to
1435− make a 'MultiMatchQuery'.
1436−-}
1437−
1438−mkMultiMatchQuery :: [FieldName] -> QueryString -> MultiMatchQuery
1439−mkMultiMatchQuery matchFields query =
1440− MultiMatchQuery matchFields query
1441− Or ZeroTermsNone Nothing Nothing Nothing Nothing Nothing Nothing
1442−
1443−data MultiMatchQueryType =
1444− MultiMatchBestFields
1445− | MultiMatchMostFields
1446− | MultiMatchCrossFields
1447− | MultiMatchPhrase
1448− | MultiMatchPhrasePrefix deriving (Eq, Read, Show, Generic, Typeable)
1449−
1450−data BoolQuery =
1451− BoolQuery { boolQueryMustMatch :: [Query]
1452− , boolQueryMustNotMatch :: [Query]
1453− , boolQueryShouldMatch :: [Query]
1454− , boolQueryMinimumShouldMatch :: Maybe MinimumMatch
1455− , boolQueryBoost :: Maybe Boost
1456− , boolQueryDisableCoord :: Maybe DisableCoord
1457− } deriving (Eq, Read, Show, Generic, Typeable)
1458−
1459−mkBoolQuery :: [Query] -> [Query] -> [Query] -> BoolQuery
1460−mkBoolQuery must mustNot should =
1461− BoolQuery must mustNot should Nothing Nothing Nothing
1462−
1463−data BoostingQuery =
1464− BoostingQuery { positiveQuery :: Query
1465− , negativeQuery :: Query
1466− , negativeBoost :: Boost } deriving (Eq, Read, Show, Generic, Typeable)
1467−
1468−data CommonTermsQuery =
1469− CommonTermsQuery { commonField :: FieldName
1470− , commonQuery :: QueryString
1471− , commonCutoffFrequency :: CutoffFrequency
1472− , commonLowFreqOperator :: BooleanOperator
1473− , commonHighFreqOperator :: BooleanOperator
1474− , commonMinimumShouldMatch :: Maybe CommonMinimumMatch
1475− , commonBoost :: Maybe Boost
1476− , commonAnalyzer :: Maybe Analyzer
1477− , commonDisableCoord :: Maybe DisableCoord
1478− } deriving (Eq, Read, Show, Generic, Typeable)
1479−
1480−data CommonMinimumMatch =
1481− CommonMinimumMatchHighLow MinimumMatchHighLow
1482− | CommonMinimumMatch MinimumMatch
1483− deriving (Eq, Read, Show, Generic, Typeable)
1484−
1485−data MinimumMatchHighLow =
1486− MinimumMatchHighLow { lowFreq :: MinimumMatch
1487− , highFreq :: MinimumMatch } deriving (Eq, Read, Show, Generic, Typeable)
1488−
1489−data Filter = AndFilter [Filter] Cache
1490− | OrFilter [Filter] Cache
1491− | NotFilter Filter Cache
1492− | IdentityFilter
1493− | BoolFilter BoolMatch
1494− | ExistsFilter FieldName -- always cached
1495− | GeoBoundingBoxFilter GeoBoundingBoxConstraint
1496− | GeoDistanceFilter GeoPoint Distance DistanceType OptimizeBbox Cache
1497− | GeoDistanceRangeFilter GeoPoint DistanceRange
1498− | GeoPolygonFilter FieldName [LatLon]
1499− | IdsFilter MappingName [DocId]
1500− | LimitFilter Int
1501− | MissingFilter FieldName Existence NullValue
1502− | PrefixFilter FieldName PrefixValue Cache
1503− | QueryFilter Query Cache
1504− | RangeFilter FieldName RangeValue RangeExecution Cache
1505− | RegexpFilter FieldName Regexp RegexpFlags CacheName Cache CacheKey
1506− | TermFilter Term Cache
1507− deriving (Eq, Read, Show, Generic, Typeable)
1508−
1509−data ZeroTermsQuery = ZeroTermsNone
1510− | ZeroTermsAll deriving (Eq, Read, Show, Generic, Typeable)
1511−
1512−data RangeExecution = RangeExecutionIndex
1513− | RangeExecutionFielddata deriving (Eq, Read, Show, Generic, Typeable)
1514−
1515−newtype Regexp = Regexp Text deriving (Eq, Read, Show, Generic, Typeable, FromJSON)
1516−
1517−data RegexpFlags = AllRegexpFlags
1518− | NoRegexpFlags
1519− | SomeRegexpFlags (NonEmpty RegexpFlag) deriving (Eq, Read, Show, Generic, Typeable)
1520−
1521−data RegexpFlag = AnyString
1522− | Automaton
1523− | Complement
1524− | Empty
1525− | Intersection
1526− | Interval deriving (Eq, Read, Show, Generic, Typeable)
1527−
1528−newtype LessThan = LessThan Double deriving (Eq, Read, Show, Generic, Typeable)
1529−newtype LessThanEq = LessThanEq Double deriving (Eq, Read, Show, Generic, Typeable)
1530−newtype GreaterThan = GreaterThan Double deriving (Eq, Read, Show, Generic, Typeable)
1531−newtype GreaterThanEq = GreaterThanEq Double deriving (Eq, Read, Show, Generic, Typeable)
1532−
1533−newtype LessThanD = LessThanD UTCTime deriving (Eq, Read, Show, Generic, Typeable)
1534−newtype LessThanEqD = LessThanEqD UTCTime deriving (Eq, Read, Show, Generic, Typeable)
1535−newtype GreaterThanD = GreaterThanD UTCTime deriving (Eq, Read, Show, Generic, Typeable)
1536−newtype GreaterThanEqD = GreaterThanEqD UTCTime deriving (Eq, Read, Show, Generic, Typeable)
1537−
1538−data RangeValue = RangeDateLte LessThanEqD
1539− | RangeDateLt LessThanD
1540− | RangeDateGte GreaterThanEqD
1541− | RangeDateGt GreaterThanD
1542− | RangeDateGtLt GreaterThanD LessThanD
1543− | RangeDateGteLte GreaterThanEqD LessThanEqD
1544− | RangeDateGteLt GreaterThanEqD LessThanD
1545− | RangeDateGtLte GreaterThanD LessThanEqD
1546− | RangeDoubleLte LessThanEq
1547− | RangeDoubleLt LessThan
1548− | RangeDoubleGte GreaterThanEq
1549− | RangeDoubleGt GreaterThan
1550− | RangeDoubleGtLt GreaterThan LessThan
1551− | RangeDoubleGteLte GreaterThanEq LessThanEq
1552− | RangeDoubleGteLt GreaterThanEq LessThan
1553− | RangeDoubleGtLte GreaterThan LessThanEq
1554− deriving (Eq, Read, Show, Generic, Typeable)
1555−
1556−rangeValueToPair :: RangeValue -> [Pair]
1557−rangeValueToPair rv = case rv of
1558− RangeDateLte (LessThanEqD t) -> ["lte" .= t]
1559− RangeDateGte (GreaterThanEqD t) -> ["gte" .= t]
1560− RangeDateLt (LessThanD t) -> ["lt" .= t]
1561− RangeDateGt (GreaterThanD t) -> ["gt" .= t]
1562− RangeDateGteLte (GreaterThanEqD l) (LessThanEqD g) -> ["gte" .= l, "lte" .= g]
1563− RangeDateGtLte (GreaterThanD l) (LessThanEqD g) -> ["gt" .= l, "lte" .= g]
1564− RangeDateGteLt (GreaterThanEqD l) (LessThanD g) -> ["gte" .= l, "lt" .= g]
1565− RangeDateGtLt (GreaterThanD l) (LessThanD g) -> ["gt" .= l, "lt" .= g]
1566− RangeDoubleLte (LessThanEq t) -> ["lte" .= t]
1567− RangeDoubleGte (GreaterThanEq t) -> ["gte" .= t]
1568− RangeDoubleLt (LessThan t) -> ["lt" .= t]
1569− RangeDoubleGt (GreaterThan t) -> ["gt" .= t]
1570− RangeDoubleGteLte (GreaterThanEq l) (LessThanEq g) -> ["gte" .= l, "lte" .= g]
1571− RangeDoubleGtLte (GreaterThan l) (LessThanEq g) -> ["gt" .= l, "lte" .= g]
1572− RangeDoubleGteLt (GreaterThanEq l) (LessThan g) -> ["gte" .= l, "lt" .= g]
1573− RangeDoubleGtLt (GreaterThan l) (LessThan g) -> ["gt" .= l, "lt" .= g]
1574−
1575−data Term = Term { termField :: Text
1576− , termValue :: Text } deriving (Eq, Read, Show, Generic, Typeable)
1577−
1578−data BoolMatch = MustMatch Term Cache
1579− | MustNotMatch Term Cache
1580− | ShouldMatch [Term] Cache deriving (Eq, Read, Show, Generic, Typeable)
1581−
1582−-- "memory" or "indexed"
1583−data GeoFilterType = GeoFilterMemory
1584− | GeoFilterIndexed deriving (Eq, Read, Show, Generic, Typeable)
1585−
1586−data LatLon = LatLon { lat :: Double
1587− , lon :: Double } deriving (Eq, Read, Show, Generic, Typeable)
1588−
1589−data GeoBoundingBox =
1590− GeoBoundingBox { topLeft :: LatLon
1591− , bottomRight :: LatLon } deriving (Eq, Read, Show, Generic, Typeable)
1592
494
1593−data GeoBoundingBoxConstraint =
495+data PatternOrPatterns = PopPattern Pattern
1594− GeoBoundingBoxConstraint { geoBBField :: FieldName
1595− , constraintBox :: GeoBoundingBox
1596− , bbConstraintcache :: Cache
1597− , geoType :: GeoFilterType
1598− } deriving (Eq, Read, Show, Generic, Typeable)
496+ | PopPatterns [Pattern] deriving (Eq, Read, Show)
1599
497
1600−data GeoPoint =
498+instance ToJSON PatternOrPatterns where
1601− GeoPoint { geoField :: FieldName
499+ toJSON (PopPattern pattern) = toJSON pattern
1602− , latLon :: LatLon} deriving (Eq, Read, Show, Generic, Typeable)
500+ toJSON (PopPatterns patterns) = toJSON patterns
1603
501
1604−data DistanceUnit = Miles
502+data Include = Include [Pattern] deriving (Eq, Read, Show)
1605− | Yards
1606− | Feet
1607− | Inches
1608− | Kilometers
1609− | Meters
1610− | Centimeters
1611− | Millimeters
1612− | NauticalMiles deriving (Eq, Read, Show, Generic, Typeable)
503+data Exclude = Exclude [Pattern] deriving (Eq, Read, Show)
1613
504
1614−data DistanceType = Arc
505+instance ToJSON Include where
1615− | SloppyArc -- doesn't exist <1.0
506+ toJSON (Include patterns) = toJSON patterns
1616− | Plane deriving (Eq, Read, Show, Generic, Typeable)
1617
507
1618−data OptimizeBbox = OptimizeGeoFilterType GeoFilterType
508+instance ToJSON Exclude where
1619− | NoOptimizeBbox deriving (Eq, Read, Show, Generic, Typeable)
509+ toJSON (Exclude patterns) = toJSON patterns
1620
510
1621−data Distance =
511+newtype Pattern = Pattern Text deriving (Eq, Read, Show)
1622− Distance { coefficient :: Double
1623− , unit :: DistanceUnit } deriving (Eq, Read, Show, Generic, Typeable)
1624
512
1625−data DistanceRange =
513+instance ToJSON Pattern where
1626− DistanceRange { distanceFrom :: Distance
514+ toJSON (Pattern pattern) = toJSON pattern
1627− , distanceTo :: Distance } deriving (Eq, Read, Show, Generic, Typeable)
1628
515
1629data SearchResult a =
516data SearchResult a =
1630 SearchResult { took :: Int
517 SearchResult { took :: Int
@@ -1632,2080 +519,12 @@ data SearchResult a =
1632 , shards :: ShardResult
519 , shards :: ShardResult
1633 , searchHits :: SearchHits a
520 , searchHits :: SearchHits a
1634 , aggregations :: Maybe AggregationResults
521 , aggregations :: Maybe AggregationResults
1635− , scrollId :: Maybe ScrollId } deriving (Eq, Read, Show, Generic, Typeable)
522+ , scrollId :: Maybe ScrollId
1636−
523+ -- ^ Only one Suggestion request / response per
1637−newtype ScrollId = ScrollId Text deriving (Eq, Read, Show, Generic, Ord, ToJSON, FromJSON)
524+ -- Search is supported.
1638−
525+ , suggest :: Maybe NamedSuggestionResponse
1639−type Score = Maybe Double
526+ }
1640−
527+ deriving (Eq, Show)
1641−data SearchHits a =
1642− SearchHits { hitsTotal :: Int
1643− , maxScore :: Score
1644− , hits :: [Hit a] } deriving (Eq, Read, Show, Generic, Typeable)
1645−
1646−
1647−instance Monoid (SearchHits a) where
1648− mempty = SearchHits 0 Nothing mempty
1649− mappend (SearchHits ta ma ha) (SearchHits tb mb hb) =
1650− SearchHits (ta + tb) (max ma mb) (ha <> hb)
1651−
1652−
1653−data Hit a =
1654− Hit { hitIndex :: IndexName
1655− , hitType :: MappingName
1656− , hitDocId :: DocId
1657− , hitScore :: Score
1658− , hitSource :: Maybe a
1659− , hitHighlight :: Maybe HitHighlight } deriving (Eq, Read, Show, Generic, Typeable)
1660−
1661−data ShardResult =
1662− ShardResult { shardTotal :: Int
1663− , shardsSuccessful :: Int
1664− , shardsFailed :: Int } deriving (Eq, Read, Show, Generic, Typeable)
1665−
1666−type HitHighlight = M.Map Text [Text]
1667−
1668−showText :: Show a => a -> Text
1669−showText = T.pack . show
1670−
1671−readMay :: Read a => String -> Maybe a
1672−readMay s = case reads s of
1673− (a, ""):_ -> Just a
1674− _ -> Nothing
1675−
1676−parseReadText :: Read a => Text -> Parser a
1677−parseReadText = maybe mzero return . readMay . T.unpack
1678−
1679−type Aggregations = M.Map Text Aggregation
1680−
1681−emptyAggregations :: Aggregations
1682−emptyAggregations = M.empty
1683−
1684−mkAggregations :: Text -> Aggregation -> Aggregations
1685−mkAggregations name aggregation = M.insert name aggregation emptyAggregations
1686−
1687−data TermOrder = TermOrder{ termSortField :: Text
1688− , termSortOrder :: SortOrder } deriving (Eq, Read, Show, Generic, Typeable)
1689−
1690−data TermInclusion = TermInclusion Text
1691− | TermPattern Text Text deriving (Eq, Read, Show, Generic, Typeable)
1692−
1693−data CollectionMode = BreadthFirst
1694− | DepthFirst deriving (Eq, Read, Show, Generic, Typeable)
1695−
1696−data ExecutionHint = Ordinals
1697− | GlobalOrdinals
1698− | GlobalOrdinalsHash
1699− | GlobalOrdinalsLowCardinality
1700− | Map deriving (Eq, Read, Show, Generic, Typeable)
1701−
1702−data TimeInterval = Weeks
1703− | Days
1704− | Hours
1705− | Minutes
1706− | Seconds deriving Eq
1707−
1708−data Interval = Year
1709− | Quarter
1710− | Month
1711− | Week
1712− | Day
1713− | Hour
1714− | Minute
1715− | Second
1716− | FractionalInterval Float TimeInterval deriving (Eq, Read, Show, Generic, Typeable)
1717−
1718−data Aggregation = TermsAgg TermsAggregation
1719− | CardinalityAgg CardinalityAggregation
1720− | DateHistogramAgg DateHistogramAggregation
1721− | ValueCountAgg ValueCountAggregation
1722− | FilterAgg FilterAggregation
1723− | DateRangeAgg DateRangeAggregation
1724− | MissingAgg MissingAggregation deriving (Eq, Read, Show, Generic, Typeable)
1725−
1726−data MissingAggregation = MissingAggregation
1727− { maField :: Text
1728− } deriving (Eq, Read, Show, Generic, Typeable)
1729−
1730−data TermsAggregation = TermsAggregation { term :: Either Text Text
1731− , termInclude :: Maybe TermInclusion
1732− , termExclude :: Maybe TermInclusion
1733− , termOrder :: Maybe TermOrder
1734− , termMinDocCount :: Maybe Int
1735− , termSize :: Maybe Int
1736− , termShardSize :: Maybe Int
1737− , termCollectMode :: Maybe CollectionMode
1738− , termExecutionHint :: Maybe ExecutionHint
1739− , termAggs :: Maybe Aggregations
1740− } deriving (Eq, Read, Show, Generic, Typeable)
1741−
1742−data CardinalityAggregation = CardinalityAggregation { cardinalityField :: FieldName,
1743− precisionThreshold :: Maybe Int
1744− } deriving (Eq, Read, Show, Generic, Typeable)
1745−
1746−data DateHistogramAggregation = DateHistogramAggregation { dateField :: FieldName
1747− , dateInterval :: Interval
1748− , dateFormat :: Maybe Text
1749− -- pre and post deprecated in 1.5
1750− , datePreZone :: Maybe Text
1751− , datePostZone :: Maybe Text
1752− , datePreOffset :: Maybe Text
1753− , datePostOffset :: Maybe Text
1754− , dateAggs :: Maybe Aggregations
1755− } deriving (Eq, Read, Show, Generic, Typeable)
1756−
1757−
1758−data DateRangeAggregation = DateRangeAggregation { draField :: FieldName
1759− , draFormat :: Maybe Text
1760− , draRanges :: NonEmpty DateRangeAggRange
1761− } deriving (Eq, Read, Show, Generic, Typeable)
1762−
1763−data DateRangeAggRange = DateRangeFrom DateMathExpr
1764− | DateRangeTo DateMathExpr
1765− | DateRangeFromAndTo DateMathExpr DateMathExpr deriving (Eq, Read, Show, Generic, Typeable)
1766−
1767−-- | See <https://www.elastic.co/guide/en/elasticsearch/reference/current/common-options.html#date-math> for more information.
1768−data DateMathExpr = DateMathExpr DateMathAnchor [DateMathModifier] deriving (Eq, Read, Show, Generic, Typeable)
1769−
1770−
1771−-- | Starting point for a date range. This along with the 'DateMathModifiers' gets you the date ES will start from.
1772−data DateMathAnchor = DMNow
1773− | DMDate Day deriving (Eq, Read, Show, Generic, Typeable)
1774−
1775−data DateMathModifier = AddTime Int DateMathUnit
1776− | SubtractTime Int DateMathUnit
1777− | RoundDownTo DateMathUnit deriving (Eq, Read, Show, Generic, Typeable)
1778−
1779−data DateMathUnit = DMYear
1780− | DMMonth
1781− | DMWeek
1782− | DMDay
1783− | DMHour
1784− | DMMinute
1785− | DMSecond deriving (Eq, Read, Show, Generic, Typeable)
1786−
1787−-- | See <https://www.elastic.co/guide/en/elasticsearch/reference/current/search-aggregations-metrics-valuecount-aggregation.html> for more information.
1788−data ValueCountAggregation = FieldValueCount FieldName
1789− | ScriptValueCount Script deriving (Eq, Read, Show, Generic, Typeable)
1790−
1791−-- | Single-bucket filter aggregations. See <https://www.elastic.co/guide/en/elasticsearch/reference/current/search-aggregations-bucket-filter-aggregation.html#search-aggregations-bucket-filter-aggregation> for more information.
1792−data FilterAggregation = FilterAggregation { faFilter :: Filter
1793− , faAggs :: Maybe Aggregations} deriving (Eq, Read, Show, Generic, Typeable)
1794−
1795−mkTermsAggregation :: Text -> TermsAggregation
1796−mkTermsAggregation t = TermsAggregation (Left t) Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing
1797−
1798−mkTermsScriptAggregation :: Text -> TermsAggregation
1799−mkTermsScriptAggregation t = TermsAggregation (Right t) Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing
1800−
1801−mkDateHistogram :: FieldName -> Interval -> DateHistogramAggregation
1802−mkDateHistogram t i = DateHistogramAggregation t i Nothing Nothing Nothing Nothing Nothing Nothing
1803−
1804−mkCardinalityAggregation :: FieldName -> CardinalityAggregation
1805−mkCardinalityAggregation t = CardinalityAggregation t Nothing
1806−
1807−instance ToJSON Version where
1808− toJSON Version {..} = object ["number" .= number
1809− ,"build_hash" .= build_hash
1810− ,"build_timestamp" .= build_timestamp
1811− ,"build_snapshot" .= build_snapshot
1812− ,"lucene_version" .= lucene_version]
1813−
1814−instance FromJSON Version where
1815− parseJSON = withObject "Version" parse
1816− where parse o = Version
1817− <$> o .: "number"
1818− <*> o .: "build_hash"
1819− <*> o .: "build_timestamp"
1820− <*> o .: "build_snapshot"
1821− <*> o .: "lucene_version"
1822−
1823−instance ToJSON VersionNumber where
1824− toJSON = toJSON . Vers.showVersion . versionNumber
1825−
1826−instance FromJSON VersionNumber where
1827− parseJSON = withText "VersionNumber" (parse . T.unpack)
1828− where
1829− parse s = case filter (null . snd)(RP.readP_to_S Vers.parseVersion s) of
1830− [(v, _)] -> pure (VersionNumber v)
1831− [] -> fail ("Invalid version string " ++ s)
1832− xs -> fail ("Ambiguous version string " ++ s ++ " (" ++ intercalate ", " (Vers.showVersion . fst <$> xs) ++ ")")
1833−
1834−instance ToJSON TermOrder where
1835− toJSON (TermOrder termSortField termSortOrder) = object [termSortField .= termSortOrder]
1836−
1837−instance ToJSON TermInclusion where
1838− toJSON (TermInclusion x) = toJSON x
1839− toJSON (TermPattern pattern flags) = omitNulls [ "pattern" .= pattern,
1840− "flags" .= flags]
1841−
1842−instance ToJSON CollectionMode where
1843− toJSON BreadthFirst = "breadth_first"
1844− toJSON DepthFirst = "depth_first"
1845−
1846−instance ToJSON ExecutionHint where
1847− toJSON Ordinals = "ordinals"
1848− toJSON GlobalOrdinals = "global_ordinals"
1849− toJSON GlobalOrdinalsHash = "global_ordinals_hash"
1850− toJSON GlobalOrdinalsLowCardinality = "global_ordinals_low_cardinality"
1851− toJSON Map = "map"
1852−
1853−instance ToJSON Interval where
1854− toJSON Year = "year"
1855− toJSON Quarter = "quarter"
1856− toJSON Month = "month"
1857− toJSON Week = "week"
1858− toJSON Day = "day"
1859− toJSON Hour = "hour"
1860− toJSON Minute = "minute"
1861− toJSON Second = "second"
1862− toJSON (FractionalInterval fraction interval) = toJSON $ show fraction ++ show interval
1863−
1864−instance Show TimeInterval where
1865− show Weeks = "w"
1866− show Days = "d"
1867− show Hours = "h"
1868− show Minutes = "m"
1869− show Seconds = "s"
1870−
1871−instance Read TimeInterval where
1872− readPrec = f =<< TR.get
1873− where
1874− f 'w' = return Weeks
1875− f 'd' = return Days
1876− f 'h' = return Hours
1877− f 'm' = return Minutes
1878− f 's' = return Seconds
1879− f _ = fail "TimeInterval expected one of w, d, h, m, s"
1880−
1881−instance ToJSON Aggregation where
1882− toJSON (TermsAgg (TermsAggregation term include exclude order minDocCount size shardSize collectMode executionHint termAggs)) =
1883− omitNulls ["terms" .= omitNulls [ toJSON' term,
1884− "include" .= include,
1885− "exclude" .= exclude,
1886− "order" .= order,
1887− "min_doc_count" .= minDocCount,
1888− "size" .= size,
1889− "shard_size" .= shardSize,
1890− "collect_mode" .= collectMode,
1891− "execution_hint" .= executionHint
1892− ],
1893− "aggs" .= termAggs ]
1894− where
1895− toJSON' x = case x of { Left y -> "field" .= y; Right y -> "script" .= y }
1896−
1897− toJSON (CardinalityAgg (CardinalityAggregation field precisionThreshold)) =
1898− object ["cardinality" .= omitNulls [ "field" .= field,
1899− "precisionThreshold" .= precisionThreshold
1900− ]
1901− ]
1902−
1903− toJSON (DateHistogramAgg (DateHistogramAggregation field interval format preZone postZone preOffset postOffset dateHistoAggs)) =
1904− omitNulls ["date_histogram" .= omitNulls [ "field" .= field,
1905− "interval" .= interval,
1906− "format" .= format,
1907− "pre_zone" .= preZone,
1908− "post_zone" .= postZone,
1909− "pre_offset" .= preOffset,
1910− "post_offset" .= postOffset
1911− ],
1912− "aggs" .= dateHistoAggs ]
1913− toJSON (ValueCountAgg a) = object ["value_count" .= v]
1914− where v = case a of
1915− (FieldValueCount (FieldName n)) -> object ["field" .= n]
1916− (ScriptValueCount (Script s)) -> object ["script" .= s]
1917− toJSON (FilterAgg (FilterAggregation filt ags)) =
1918− omitNulls [ "filter" .= filt
1919− , "aggs" .= ags]
1920− toJSON (DateRangeAgg a) = object [ "date_range" .= a
1921− ]
1922− toJSON (MissingAgg (MissingAggregation{..})) =
1923− object ["missing" .= object ["field" .= maField]]
1924−
1925−instance ToJSON DateRangeAggregation where
1926− toJSON DateRangeAggregation {..} =
1927− omitNulls [ "field" .= draField
1928− , "format" .= draFormat
1929− , "ranges" .= toList draRanges
1930− ]
1931−
1932−instance ToJSON DateRangeAggRange where
1933− toJSON (DateRangeFrom e) = object [ "from" .= e ]
1934− toJSON (DateRangeTo e) = object [ "to" .= e ]
1935− toJSON (DateRangeFromAndTo f t) = object [ "from" .= f, "to" .= t ]
1936−
1937−instance ToJSON DateMathExpr where
1938− toJSON (DateMathExpr a mods) = String (fmtA a <> mconcat (fmtMod <$> mods))
1939− where fmtA DMNow = "now"
1940− fmtA (DMDate date) = (T.pack $ showGregorian date) <> "||"
1941− fmtMod (AddTime n u) = "+" <> showText n <> fmtU u
1942− fmtMod (SubtractTime n u) = "-" <> showText n <> fmtU u
1943− fmtMod (RoundDownTo u) = "/" <> fmtU u
1944− fmtU DMYear = "y"
1945− fmtU DMMonth = "M"
1946− fmtU DMWeek = "w"
1947− fmtU DMDay = "d"
1948− fmtU DMHour = "h"
1949− fmtU DMMinute = "m"
1950− fmtU DMSecond = "s"
1951−
1952−
1953−type AggregationResults = M.Map Text Value
1954−
1955−class BucketAggregation a where
1956− key :: a -> BucketValue
1957− docCount :: a -> Int
1958− aggs :: a -> Maybe AggregationResults
1959−
1960−
1961−data Bucket a = Bucket { buckets :: [a]} deriving (Read, Show)
1962−
1963−data BucketValue = TextValue Text
1964− | ScientificValue Scientific
1965− | BoolValue Bool deriving (Read, Show)
1966−
1967−data MissingResult = MissingResult { missingDocCount :: Int } deriving (Show)
1968−
1969−data TermsResult = TermsResult { termKey :: BucketValue
1970− , termsDocCount :: Int
1971− , termsAggs :: Maybe AggregationResults } deriving (Read, Show)
1972−
1973−data DateHistogramResult = DateHistogramResult { dateKey :: Int
1974− , dateKeyStr :: Maybe Text
1975− , dateDocCount :: Int
1976− , dateHistogramAggs :: Maybe AggregationResults } deriving (Read, Show)
1977−
1978−data DateRangeResult = DateRangeResult { dateRangeKey :: Text
1979− , dateRangeFrom :: Maybe UTCTime
1980− , dateRangeFromAsString :: Maybe Text
1981− , dateRangeTo :: Maybe UTCTime
1982− , dateRangeToAsString :: Maybe Text
1983− , dateRangeDocCount :: Int
1984− , dateRangeAggs :: Maybe AggregationResults } deriving (Read, Show, Eq, Generic, Typeable)
1985−
1986−toTerms :: Text -> AggregationResults -> Maybe (Bucket TermsResult)
1987−toTerms = toAggResult
1988−
1989−toDateHistogram :: Text -> AggregationResults -> Maybe (Bucket DateHistogramResult)
1990−toDateHistogram = toAggResult
1991−
1992−toMissing :: Text -> AggregationResults -> Maybe MissingResult
1993−toMissing = toAggResult
1994−
1995−toAggResult :: (FromJSON a) => Text -> AggregationResults -> Maybe a
1996−toAggResult t a = M.lookup t a >>= deserialize
1997− where deserialize = parseMaybe parseJSON
1998−
1999−instance BucketAggregation TermsResult where
2000− key = termKey
2001− docCount = termsDocCount
2002− aggs = termsAggs
2003−
2004−instance BucketAggregation DateHistogramResult where
2005− key = TextValue . showText . dateKey
2006− docCount = dateDocCount
2007− aggs = dateHistogramAggs
2008−
2009−instance BucketAggregation DateRangeResult where
2010− key = TextValue . dateRangeKey
2011− docCount = dateRangeDocCount
2012− aggs = dateRangeAggs
2013−
2014−instance (FromJSON a, BucketAggregation a) => FromJSON (Bucket a) where
2015− parseJSON (Object v) = Bucket <$>
2016− v .: "buckets"
2017− parseJSON _ = mempty
2018−
2019−instance FromJSON BucketValue where
2020− parseJSON (String t) = return $ TextValue t
2021− parseJSON (Number s) = return $ ScientificValue s
2022− parseJSON (Bool b) = return $ BoolValue b
2023− parseJSON _ = mempty
2024−
2025−instance FromJSON MissingResult where
2026− parseJSON = withObject "MissingResult" parse
2027− where parse v = MissingResult <$> v .: "doc_count"
2028−
2029−instance FromJSON TermsResult where
2030− parseJSON (Object v) = TermsResult <$>
2031− v .: "key" <*>
2032− v .: "doc_count" <*>
2033− v .:? "aggregations"
2034− parseJSON _ = mempty
2035−
2036−instance FromJSON DateHistogramResult where
2037− parseJSON (Object v) = DateHistogramResult <$>
2038− v .: "key" <*>
2039− v .:? "key_as_string" <*>
2040− v .: "doc_count" <*>
2041− v .:? "aggregations"
2042− parseJSON _ = mempty
2043−
2044−instance FromJSON DateRangeResult where
2045− parseJSON = withObject "DateRangeResult" parse
2046− where parse v = DateRangeResult <$>
2047− v .: "key" <*>
2048− (fmap posixMS <$> v .:? "from") <*>
2049− v .:? "from_as_string" <*>
2050− (fmap posixMS <$> v .:? "to") <*>
2051− v .:? "to_as_string" <*>
2052− v .: "doc_count" <*>
2053− v .:? "aggregations"
2054−
2055−instance FromJSON POSIXMS where
2056− parseJSON = withScientific "POSIXMS" (return . parse)
2057− where parse n = let n' = truncate n :: Integer
2058− in POSIXMS (posixSecondsToUTCTime (fromInteger (n' `div` 1000)))
2059−
2060−instance Monoid Filter where
2061− mempty = IdentityFilter
2062− mappend a b = AndFilter [a, b] defaultCache
2063−
2064−instance Seminearring Filter where
2065− a <||> b = OrFilter [a, b] defaultCache
2066−
2067−instance ToJSON Filter where
2068− toJSON (AndFilter filters cache) =
2069− object ["and" .=
2070− object [ "filters" .= fmap toJSON filters
2071− , "_cache" .= cache]]
2072−
2073− toJSON (OrFilter filters cache) =
2074− object ["or" .=
2075− object [ "filters" .= fmap toJSON filters
2076− , "_cache" .= cache]]
2077−
2078− toJSON (NotFilter notFilter cache) =
2079− object ["not" .=
2080− object ["filter" .= notFilter
2081− , "_cache" .= cache]]
2082−
2083− toJSON (IdentityFilter) =
2084− object ["match_all" .= object []]
2085−
2086− toJSON (TermFilter (Term termFilterField termFilterValue) cache) =
2087− object ["term" .= object base]
2088− where base = [termFilterField .= termFilterValue,
2089− "_cache" .= cache]
2090−
2091− toJSON (ExistsFilter (FieldName fieldName)) =
2092− object ["exists" .= object
2093− ["field" .= fieldName]]
2094−
2095− toJSON (BoolFilter boolMatch) =
2096− object ["bool" .= boolMatch]
2097−
2098− toJSON (GeoBoundingBoxFilter bbConstraint) =
2099− object ["geo_bounding_box" .= bbConstraint]
2100−
2101− toJSON (GeoDistanceFilter (GeoPoint (FieldName distanceGeoField) geoDistLatLon)
2102− distance distanceType optimizeBbox cache) =
2103− object ["geo_distance" .=
2104− object ["distance" .= distance
2105− , "distance_type" .= distanceType
2106− , "optimize_bbox" .= optimizeBbox
2107− , distanceGeoField .= geoDistLatLon
2108− , "_cache" .= cache]]
2109−
2110− toJSON (GeoDistanceRangeFilter (GeoPoint (FieldName gddrField) drLatLon)
2111− (DistanceRange geoDistRangeDistFrom drDistanceTo)) =
2112− object ["geo_distance_range" .=
2113− object ["from" .= geoDistRangeDistFrom
2114− , "to" .= drDistanceTo
2115− , gddrField .= drLatLon]]
2116−
2117− toJSON (GeoPolygonFilter (FieldName geoPolygonFilterField) latLons) =
2118− object ["geo_polygon" .=
2119− object [geoPolygonFilterField .=
2120− object ["points" .= fmap toJSON latLons]]]
2121−
2122− toJSON (IdsFilter (MappingName mappingName) values) =
2123− object ["ids" .=
2124− object ["type" .= mappingName
2125− , "values" .= fmap unpackId values]]
2126−
2127− toJSON (LimitFilter limit) =
2128− object ["limit" .= object ["value" .= limit]]
2129−
2130− toJSON (MissingFilter (FieldName fieldName) (Existence existence) (NullValue nullValue)) =
2131− object ["missing" .=
2132− object ["field" .= fieldName
2133− , "existence" .= existence
2134− , "null_value" .= nullValue]]
2135−
2136− toJSON (PrefixFilter (FieldName fieldName) fieldValue cache) =
2137− object ["prefix" .=
2138− object [fieldName .= fieldValue
2139− , "_cache" .= cache]]
2140−
2141− toJSON (QueryFilter query False) =
2142− object ["query" .= toJSON query ]
2143− toJSON (QueryFilter query True) =
2144− object ["fquery" .=
2145− object [ "query" .= toJSON query
2146− , "_cache" .= True ]]
2147−
2148− toJSON (RangeFilter (FieldName fieldName) rangeValue rangeExecution cache) =
2149− object ["range" .=
2150− object [ fieldName .= object (rangeValueToPair rangeValue)
2151− , "execution" .= rangeExecution
2152− , "_cache" .= cache]]
2153−
2154− toJSON (RegexpFilter (FieldName fieldName)
2155− (Regexp regexText) flags (CacheName cacheName) cache (CacheKey cacheKey)) =
2156− object ["regexp" .=
2157− object [fieldName .=
2158− object ["value" .= regexText
2159− , "flags" .= flags]
2160− , "_name" .= cacheName
2161− , "_cache" .= cache
2162− , "_cache_key" .= cacheKey]]
2163−
2164−instance FromJSON Filter where
2165− parseJSON = withObject "Filter" parse
2166− where parse o = andFilter `taggedWith` "and"
2167− <|> orFilter `taggedWith` "or"
2168− <|> notFilter `taggedWith` "not"
2169− <|> identityFilter `taggedWith` "match_all"
2170− <|> boolFilter `taggedWith` "bool"
2171− <|> existsFilter `taggedWith` "exists"
2172− <|> geoBoundingBoxFilter `taggedWith` "geo_bounding_box"
2173− <|> geoDistanceFilter `taggedWith` "geo_distance"
2174− <|> geoDistanceRangeFilter `taggedWith` "geo_distance_range"
2175− <|> geoPolygonFilter `taggedWith` "geo_polygon"
2176− <|> idsFilter `taggedWith` "ids"
2177− <|> limitFilter `taggedWith` "limit"
2178− <|> missingFilter `taggedWith` "missing"
2179− <|> prefixFilter `taggedWith` "prefix"
2180− <|> queryFilter `taggedWith` "query"
2181− <|> fqueryFilter `taggedWith` "fquery"
2182− <|> rangeFilter `taggedWith` "range"
2183− <|> regexpFilter `taggedWith` "regexp"
2184− <|> termFilter `taggedWith` "term"
2185− where taggedWith parser k = parser =<< o .: k
2186− andFilter o = AndFilter <$> o .: "filters"
2187− <*> o .:? "_cache" .!= defaultCache
2188− orFilter o = OrFilter <$> o .: "filters"
2189− <*> o .:? "_cache" .!= defaultCache
2190− notFilter o = NotFilter <$> o .: "filter"
2191− <*> o .: "_cache" .!= defaultCache
2192− identityFilter :: Object -> Parser Filter
2193− identityFilter m
2194− | HM.null m = pure IdentityFilter
2195− | otherwise = fail ("Identityfilter expected empty object but got " <> show m)
2196− boolFilter = pure . BoolFilter
2197− existsFilter o = ExistsFilter <$> o .: "field"
2198− geoBoundingBoxFilter = pure . GeoBoundingBoxFilter
2199− geoDistanceFilter o = do
2200− case HM.toList (deleteSeveral ["distance", "distance_type", "optimize_bbox", "_cache"] o) of
2201− [(fn, v)] -> do
2202− gp <- GeoPoint (FieldName fn) <$> parseJSON v
2203− GeoDistanceFilter gp <$> o .: "distance"
2204− <*> o .: "distance_type"
2205− <*> o .: "optimize_bbox"
2206− <*> o .:? "_cache" .!= defaultCache
2207− _ -> fail "Could not find GeoDistanceFilter field name"
2208− geoDistanceRangeFilter o = do
2209− case HM.toList (deleteSeveral ["from", "to"] o) of
2210− [(fn, v)] -> do
2211− gp <- GeoPoint (FieldName fn) <$> parseJSON v
2212− rng <- DistanceRange <$> o .: "from" <*> o .: "to"
2213− return (GeoDistanceRangeFilter gp rng)
2214− _ -> fail "Could not find GeoDistanceRangeFilter field name"
2215− geoPolygonFilter = fieldTagged $ \fn o -> GeoPolygonFilter fn <$> o .: "points"
2216− idsFilter o = IdsFilter <$> o .: "type"
2217− <*> o .: "values"
2218− limitFilter o = LimitFilter <$> o .: "value"
2219− missingFilter o = MissingFilter <$> o .: "field"
2220− <*> o .: "existence"
2221− <*> o .: "null_value"
2222− prefixFilter o = case HM.toList (HM.delete "_cache" o) of
2223− [(fn, String v)] -> PrefixFilter (FieldName fn) v <$> o .:? "_cache" .!= defaultCache
2224− _ -> fail "Could not parse PrefixFilter"
2225−
2226− queryFilter q = pure (QueryFilter q False)
2227− fqueryFilter o = QueryFilter <$> o .: "query" <*> pure True
2228− rangeFilter o = case HM.toList (deleteSeveral ["execution", "_cache"] o) of
2229− [(fn, v)] -> RangeFilter (FieldName fn)
2230− <$> parseJSON v
2231− <*> o .: "execution"
2232− <*> o .:? "_cache" .!= defaultCache
2233− _ -> fail "Could not find field name for RangeFilter"
2234− regexpFilter o = case HM.toList (deleteSeveral ["_name", "_cache", "_cache_key"] o) of
2235− [(fn, Object o')] -> RegexpFilter (FieldName fn)
2236− <$> o' .: "value"
2237− <*> o' .: "flags"
2238− <*> o .: "_name"
2239− <*> o .:? "_cache" .!= defaultCache
2240− <*> o .: "_cache_key"
2241− _ -> fail "Could not find field name for RegexpFilter"
2242− termFilter o = case HM.toList (HM.delete "_cache" o) of
2243− [(termField, String termVal)] -> TermFilter (Term termField termVal)
2244− <$> o .:? "_cache" .!= defaultCache
2245− _ -> fail "Could not find term field for TermFilter"
2246−
2247−fieldTagged :: Monad m => (FieldName -> Object -> m a) -> Object -> m a
2248−fieldTagged f o = case HM.toList o of
2249− [(k, Object o')] -> f (FieldName k) o'
2250− _ -> fail "Expected object with 1 field-named key"
2251−
2252−instance ToJSON GeoPoint where
2253− toJSON (GeoPoint (FieldName geoPointField) geoPointLatLon) =
2254− object [ geoPointField .= geoPointLatLon ]
2255−
2256−
2257−instance ToJSON Query where
2258− toJSON (TermQuery (Term termQueryField termQueryValue) boost) =
2259− object [ "term" .=
2260− object [termQueryField .= object merged]]
2261− where
2262− base = [ "value" .= termQueryValue ]
2263− boosted = maybe [] (return . ("boost" .=)) boost
2264− merged = mappend base boosted
2265−
2266− toJSON (TermsQuery fieldName terms) =
2267− object [ "terms" .= object conjoined ]
2268− where conjoined = [fieldName .= terms]
2269−
2270− toJSON (IdsQuery idsQueryMappingName docIds) =
2271− object [ "ids" .= object conjoined ]
2272− where conjoined = [ "type" .= idsQueryMappingName
2273− , "values" .= fmap toJSON docIds ]
2274−
2275− toJSON (QueryQueryStringQuery qQueryStringQuery) =
2276− object [ "query_string" .= qQueryStringQuery ]
2277−
2278− toJSON (QueryMatchQuery matchQuery) =
2279− object [ "match" .= matchQuery ]
2280−
2281− toJSON (QueryMultiMatchQuery multiMatchQuery) =
2282− toJSON multiMatchQuery
2283−
2284− toJSON (QueryBoolQuery boolQuery) =
2285− object [ "bool" .= boolQuery ]
2286−
2287− toJSON (QueryBoostingQuery boostingQuery) =
2288− object [ "boosting" .= boostingQuery ]
2289−
2290− toJSON (QueryCommonTermsQuery commonTermsQuery) =
2291− object [ "common" .= commonTermsQuery ]
2292−
2293− toJSON (ConstantScoreFilter csFilter boost) =
2294− object ["constant_score" .= object ["filter" .= csFilter
2295− , "boost" .= boost]]
2296−
2297− toJSON (ConstantScoreQuery query boost) =
2298− object ["constant_score" .= object ["query" .= query
2299− , "boost" .= boost]]
2300−
2301− toJSON (QueryDisMaxQuery disMaxQuery) =
2302− object [ "dis_max" .= disMaxQuery ]
2303−
2304− toJSON (QueryFilteredQuery qFilteredQuery) =
2305− object [ "filtered" .= qFilteredQuery ]
2306−
2307− toJSON (QueryFuzzyLikeThisQuery fuzzyQuery) =
2308− object [ "fuzzy_like_this" .= fuzzyQuery ]
2309−
2310− toJSON (QueryFuzzyLikeFieldQuery fuzzyFieldQuery) =
2311− object [ "fuzzy_like_this_field" .= fuzzyFieldQuery ]
2312−
2313− toJSON (QueryFuzzyQuery fuzzyQuery) =
2314− object [ "fuzzy" .= fuzzyQuery ]
2315−
2316− toJSON (QueryHasChildQuery childQuery) =
2317− object [ "has_child" .= childQuery ]
2318−
2319− toJSON (QueryHasParentQuery parentQuery) =
2320− object [ "has_parent" .= parentQuery ]
2321−
2322− toJSON (QueryIndicesQuery qIndicesQuery) =
2323− object [ "indices" .= qIndicesQuery ]
2324−
2325− toJSON (MatchAllQuery boost) =
2326− object [ "match_all" .= omitNulls [ "boost" .= boost ] ]
2327−
2328− toJSON (QueryMoreLikeThisQuery query) =
2329− object [ "more_like_this" .= query ]
2330−
2331− toJSON (QueryMoreLikeThisFieldQuery query) =
2332− object [ "more_like_this_field" .= query ]
2333−
2334− toJSON (QueryNestedQuery query) =
2335− object [ "nested" .= query ]
2336−
2337− toJSON (QueryPrefixQuery query) =
2338− object [ "prefix" .= query ]
2339−
2340− toJSON (QueryRangeQuery query) =
2341− object [ "range" .= query ]
2342−
2343− toJSON (QueryRegexpQuery query) =
2344− object [ "regexp" .= query ]
2345−
2346− toJSON (QuerySimpleQueryStringQuery query) =
2347− object [ "simple_query_string" .= query ]
2348−
2349−instance FromJSON Query where
2350− parseJSON v = withObject "Query" parse v
2351− where parse o = termQuery `taggedWith` "term"
2352− <|> termsQuery `taggedWith` "terms"
2353− <|> idsQuery `taggedWith` "ids"
2354− <|> queryQueryStringQuery `taggedWith` "query_string"
2355− <|> queryMatchQuery `taggedWith` "match"
2356− <|> queryMultiMatchQuery
2357− <|> queryBoolQuery `taggedWith` "bool"
2358− <|> queryBoostingQuery `taggedWith` "boosting"
2359− <|> queryCommonTermsQuery `taggedWith` "common"
2360− <|> constantScoreFilter `taggedWith` "constant_score"
2361− <|> constantScoreQuery `taggedWith` "constant_score"
2362− <|> queryDisMaxQuery `taggedWith` "dis_max"
2363− <|> queryFilteredQuery `taggedWith` "filtered"
2364− <|> queryFuzzyLikeThisQuery `taggedWith` "fuzzy_like_this"
2365− <|> queryFuzzyLikeFieldQuery `taggedWith` "fuzzy_like_this_field"
2366− <|> queryFuzzyQuery `taggedWith` "fuzzy"
2367− <|> queryHasChildQuery `taggedWith` "has_child"
2368− <|> queryHasParentQuery `taggedWith` "has_parent"
2369− <|> queryIndicesQuery `taggedWith` "indices"
2370− <|> matchAllQuery `taggedWith` "match_all"
2371− <|> queryMoreLikeThisQuery `taggedWith` "more_like_this"
2372− <|> queryMoreLikeThisFieldQuery `taggedWith` "more_like_this_field"
2373− <|> queryNestedQuery `taggedWith` "nested"
2374− <|> queryPrefixQuery `taggedWith` "prefix"
2375− <|> queryRangeQuery `taggedWith` "range"
2376− <|> queryRegexpQuery `taggedWith` "regexp"
2377− <|> querySimpleQueryStringQuery `taggedWith` "simple_query_string"
2378− where taggedWith parser k = parser =<< o .: k
2379− termQuery = fieldTagged $ \(FieldName fn) o ->
2380− TermQuery <$> (Term fn <$> o .: "value") <*> o .:? "boost"
2381− termsQuery o = case HM.toList o of
2382− [(fn, vs)] -> do vals <- parseJSON vs
2383− case vals of
2384− x:xs -> return (TermsQuery fn (x :| xs))
2385− _ -> fail "Expected non empty list of values"
2386− _ -> fail "Expected object with 1 field-named key"
2387− idsQuery o = IdsQuery <$> o .: "type"
2388− <*> o .: "values"
2389− queryQueryStringQuery = pure . QueryQueryStringQuery
2390− queryMatchQuery = pure . QueryMatchQuery
2391− queryMultiMatchQuery = QueryMultiMatchQuery <$> parseJSON v
2392− queryBoolQuery = pure . QueryBoolQuery
2393− queryBoostingQuery = pure . QueryBoostingQuery
2394− queryCommonTermsQuery = pure . QueryCommonTermsQuery
2395− constantScoreFilter o = case HM.lookup "filter" o of
2396− Just x -> ConstantScoreFilter <$> parseJSON x
2397− <*> o .: "boost"
2398− _ -> fail "Does not appear to be a ConstantScoreFilter"
2399− constantScoreQuery o = case HM.lookup "query" o of
2400− Just x -> ConstantScoreQuery <$> parseJSON x
2401− <*> o .: "boost"
2402− _ -> fail "Does not appear to be a ConstantScoreQuery"
2403− queryDisMaxQuery = pure . QueryDisMaxQuery
2404− queryFilteredQuery = pure . QueryFilteredQuery
2405− queryFuzzyLikeThisQuery = pure . QueryFuzzyLikeThisQuery
2406− queryFuzzyLikeFieldQuery = pure . QueryFuzzyLikeFieldQuery
2407− queryFuzzyQuery = pure . QueryFuzzyQuery
2408− queryHasChildQuery = pure . QueryHasChildQuery
2409− queryHasParentQuery = pure . QueryHasParentQuery
2410− queryIndicesQuery = pure . QueryIndicesQuery
2411− matchAllQuery o = MatchAllQuery <$> o .:? "boost"
2412− queryMoreLikeThisQuery = pure . QueryMoreLikeThisQuery
2413− queryMoreLikeThisFieldQuery = pure . QueryMoreLikeThisFieldQuery
2414− queryNestedQuery = pure . QueryNestedQuery
2415− queryPrefixQuery = pure . QueryPrefixQuery
2416− queryRangeQuery = pure . QueryRangeQuery
2417− queryRegexpQuery = pure . QueryRegexpQuery
2418− querySimpleQueryStringQuery = pure . QuerySimpleQueryStringQuery
2419−
2420−
2421−omitNulls :: [(Text, Value)] -> Value
2422−omitNulls = object . filter notNull where
2423− notNull (_, Null) = False
2424− notNull (_, Array a) = (not . V.null) a
2425− notNull _ = True
2426−
2427−
2428−instance ToJSON SimpleQueryStringQuery where
2429− toJSON SimpleQueryStringQuery {..} =
2430− omitNulls (base ++ maybeAdd)
2431− where base = [ "query" .= simpleQueryStringQuery ]
2432− maybeAdd = [ "fields" .= simpleQueryStringField
2433− , "default_operator" .= simpleQueryStringOperator
2434− , "analyzer" .= simpleQueryStringAnalyzer
2435− , "flags" .= simpleQueryStringFlags
2436− , "lowercase_expanded_terms" .= simpleQueryStringLowercaseExpanded
2437− , "locale" .= simpleQueryStringLocale ]
2438−
2439−instance FromJSON SimpleQueryStringQuery where
2440− parseJSON = withObject "SimpleQueryStringQuery" parse
2441− where parse o = SimpleQueryStringQuery <$> o .: "query"
2442− <*> o .:? "fields"
2443− <*> o .:? "default_operator"
2444− <*> o .:? "analyzer"
2445− <*> (parseFlags <$> o .:? "flags")
2446− <*> o .:? "lowercase_expanded_terms"
2447− <*> o .:? "locale"
2448− parseFlags (Just (x:xs)) = Just (x :| xs)
2449− parseFlags _ = Nothing
2450−
2451−instance ToJSON FieldOrFields where
2452− toJSON (FofField fieldName) =
2453− toJSON fieldName
2454− toJSON (FofFields fieldNames) =
2455− toJSON fieldNames
2456−
2457−instance FromJSON FieldOrFields where
2458− parseJSON v = FofField <$> parseJSON v
2459− <|> FofFields <$> (parseNEJSON =<< parseJSON v)
2460−
2461−instance ToJSON SimpleQueryFlag where
2462− toJSON SimpleQueryAll = "ALL"
2463− toJSON SimpleQueryNone = "NONE"
2464− toJSON SimpleQueryAnd = "AND"
2465− toJSON SimpleQueryOr = "OR"
2466− toJSON SimpleQueryPrefix = "PREFIX"
2467− toJSON SimpleQueryPhrase = "PHRASE"
2468− toJSON SimpleQueryPrecedence = "PRECEDENCE"
2469− toJSON SimpleQueryEscape = "ESCAPE"
2470− toJSON SimpleQueryWhitespace = "WHITESPACE"
2471− toJSON SimpleQueryFuzzy = "FUZZY"
2472− toJSON SimpleQueryNear = "NEAR"
2473− toJSON SimpleQuerySlop = "SLOP"
2474−
2475−instance FromJSON SimpleQueryFlag where
2476− parseJSON = withText "SimpleQueryFlag" parse
2477− where parse "ALL" = pure SimpleQueryAll
2478− parse "NONE" = pure SimpleQueryNone
2479− parse "AND" = pure SimpleQueryAnd
2480− parse "OR" = pure SimpleQueryOr
2481− parse "PREFIX" = pure SimpleQueryPrefix
2482− parse "PHRASE" = pure SimpleQueryPhrase
2483− parse "PRECEDENCE" = pure SimpleQueryPrecedence
2484− parse "ESCAPE" = pure SimpleQueryEscape
2485− parse "WHITESPACE" = pure SimpleQueryWhitespace
2486− parse "FUZZY" = pure SimpleQueryFuzzy
2487− parse "NEAR" = pure SimpleQueryNear
2488− parse "SLOP" = pure SimpleQuerySlop
2489− parse f = fail ("Unexpected SimpleQueryFlag: " <> show f)
2490−
2491−instance ToJSON RegexpQuery where
2492− toJSON (RegexpQuery (FieldName rqQueryField)
2493− (Regexp regexpQueryQuery) rqQueryFlags
2494− rqQueryBoost) =
2495− object [ rqQueryField .= omitNulls base ]
2496− where base = [ "value" .= regexpQueryQuery
2497− , "flags" .= rqQueryFlags
2498− , "boost" .= rqQueryBoost ]
2499−
2500−instance FromJSON RegexpQuery where
2501− parseJSON = withObject "RegexpQuery" parse
2502− where parse = fieldTagged $ \fn o ->
2503− RegexpQuery fn
2504− <$> o .: "value"
2505− <*> o .: "flags"
2506− <*> o .:? "boost"
2507−
2508−instance ToJSON QueryStringQuery where
2509− toJSON (QueryStringQuery qsQueryString
2510− qsDefaultField qsOperator
2511− qsAnalyzer qsAllowWildcard
2512− qsLowercaseExpanded qsEnablePositionIncrements
2513− qsFuzzyMaxExpansions qsFuzziness
2514− qsFuzzyPrefixLength qsPhraseSlop
2515− qsBoost qsAnalyzeWildcard
2516− qsGeneratePhraseQueries qsMinimumShouldMatch
2517− qsLenient qsLocale) =
2518− omitNulls base
2519− where
2520− base = [ "query" .= qsQueryString
2521− , "default_field" .= qsDefaultField
2522− , "default_operator" .= qsOperator
2523− , "analyzer" .= qsAnalyzer
2524− , "allow_leading_wildcard" .= qsAllowWildcard
2525− , "lowercase_expanded_terms" .= qsLowercaseExpanded
2526− , "enable_position_increments" .= qsEnablePositionIncrements
2527− , "fuzzy_max_expansions" .= qsFuzzyMaxExpansions
2528− , "fuzziness" .= qsFuzziness
2529− , "fuzzy_prefix_length" .= qsFuzzyPrefixLength
2530− , "phrase_slop" .= qsPhraseSlop
2531− , "boost" .= qsBoost
2532− , "analyze_wildcard" .= qsAnalyzeWildcard
2533− , "auto_generate_phrase_queries" .= qsGeneratePhraseQueries
2534− , "minimum_should_match" .= qsMinimumShouldMatch
2535− , "lenient" .= qsLenient
2536− , "locale" .= qsLocale ]
2537−
2538−instance FromJSON QueryStringQuery where
2539− parseJSON = withObject "QueryStringQuery" parse
2540− where parse o = QueryStringQuery
2541− <$> o .: "query"
2542− <*> o .:? "default_field"
2543− <*> o .:? "default_operator"
2544− <*> o .:? "analyzer"
2545− <*> o .:? "allow_leading_wildcard"
2546− <*> o .:? "lowercase_expanded_terms"
2547− <*> o .:? "enable_position_increments"
2548− <*> o .:? "fuzzy_max_expansions"
2549− <*> o .:? "fuzziness"
2550− <*> o .:? "fuzzy_prefix_length"
2551− <*> o .:? "phrase_slop"
2552− <*> o .:? "boost"
2553− <*> o .:? "analyze_wildcard"
2554− <*> o .:? "auto_generate_phrase_queries"
2555− <*> o .:? "minimum_should_match"
2556− <*> o .:? "lenient"
2557− <*> o .:? "locale"
2558−
2559−instance ToJSON RangeQuery where
2560− toJSON (RangeQuery (FieldName fieldName) range boost) =
2561− object [ fieldName .= object conjoined ]
2562− where conjoined = [ "boost" .= boost ] ++ (rangeValueToPair range)
2563−
2564−instance FromJSON RangeQuery where
2565− parseJSON = withObject "RangeQuery" parse
2566− where parse = fieldTagged $ \fn o ->
2567− RangeQuery fn
2568− <$> parseJSON (Object o)
2569− <*> o .: "boost"
2570−
2571−instance FromJSON RangeValue where
2572− parseJSON = withObject "RangeValue" parse
2573− where parse o = parseDate o
2574− <|> parseDouble o
2575− parseDate o = do lt <- o .:? "lt"
2576− lte <- o .:? "lte"
2577− gt <- o .:? "gt"
2578− gte <- o .:? "gte"
2579− case (lt, lte, gt, gte) of
2580− (Just a, _, Just b, _) -> return (RangeDateGtLt (GreaterThanD b) (LessThanD a))
2581− (Just a, _, _, Just b)-> return (RangeDateGteLt (GreaterThanEqD b) (LessThanD a))
2582− (_, Just a, Just b, _)-> return (RangeDateGtLte (GreaterThanD b) (LessThanEqD a))
2583− (_, Just a, _, Just b)-> return (RangeDateGteLte (GreaterThanEqD b) (LessThanEqD a))
2584− (_, _, Just a, _)-> return (RangeDateGt (GreaterThanD a))
2585− (Just a, _, _, _)-> return (RangeDateLt (LessThanD a))
2586− (_, _, _, Just a)-> return (RangeDateGte (GreaterThanEqD a))
2587− (_, Just a, _, _)-> return (RangeDateLte (LessThanEqD a))
2588− (Nothing, Nothing, Nothing, Nothing) -> mzero
2589− parseDouble o = do lt <- o .:? "lt"
2590− lte <- o .:? "lte"
2591− gt <- o .:? "gt"
2592− gte <- o .:? "gte"
2593− case (lt, lte, gt, gte) of
2594− (Just a, _, Just b, _) -> return (RangeDoubleGtLt (GreaterThan b) (LessThan a))
2595− (Just a, _, _, Just b)-> return (RangeDoubleGteLt (GreaterThanEq b) (LessThan a))
2596− (_, Just a, Just b, _)-> return (RangeDoubleGtLte (GreaterThan b) (LessThanEq a))
2597− (_, Just a, _, Just b)-> return (RangeDoubleGteLte (GreaterThanEq b) (LessThanEq a))
2598− (_, _, Just a, _)-> return (RangeDoubleGt (GreaterThan a))
2599− (Just a, _, _, _)-> return (RangeDoubleLt (LessThan a))
2600− (_, _, _, Just a)-> return (RangeDoubleGte (GreaterThanEq a))
2601− (_, Just a, _, _)-> return (RangeDoubleLte (LessThanEq a))
2602− (Nothing, Nothing, Nothing, Nothing) -> mzero
2603−
2604−instance ToJSON PrefixQuery where
2605− toJSON (PrefixQuery (FieldName fieldName) queryValue boost) =
2606− object [ fieldName .= omitNulls base ]
2607− where base = [ "value" .= queryValue
2608− , "boost" .= boost ]
2609−
2610−instance FromJSON PrefixQuery where
2611− parseJSON = withObject "PrefixQuery" parse
2612− where parse = fieldTagged $ \fn o ->
2613− PrefixQuery fn
2614− <$> o .: "value"
2615− <*> o .:? "boost"
2616−
2617−instance ToJSON NestedQuery where
2618− toJSON (NestedQuery nqPath nqScoreType nqQuery) =
2619− object [ "path" .= nqPath
2620− , "score_mode" .= nqScoreType
2621− , "query" .= nqQuery ]
2622−
2623−instance FromJSON NestedQuery where
2624− parseJSON = withObject "NestedQuery" parse
2625− where parse o = NestedQuery
2626− <$> o .: "path"
2627− <*> o .: "score_mode"
2628− <*> o .: "query"
2629−
2630−instance ToJSON MoreLikeThisFieldQuery where
2631− toJSON (MoreLikeThisFieldQuery text (FieldName fieldName)
2632− percent mtf mqt stopwords mindf maxdf
2633− minwl maxwl boostTerms boost analyzer) =
2634− object [ fieldName .= omitNulls base ]
2635− where base = [ "like_text" .= text
2636− , "percent_terms_to_match" .= percent
2637− , "min_term_freq" .= mtf
2638− , "max_query_terms" .= mqt
2639− , "stop_words" .= stopwords
2640− , "min_doc_freq" .= mindf
2641− , "max_doc_freq" .= maxdf
2642− , "min_word_length" .= minwl
2643− , "max_word_length" .= maxwl
2644− , "boost_terms" .= boostTerms
2645− , "boost" .= boost
2646− , "analyzer" .= analyzer ]
2647−
2648−instance FromJSON MoreLikeThisFieldQuery where
2649− parseJSON = withObject "MoreLikeThisFieldQuery" parse
2650− where parse = fieldTagged $ \fn o ->
2651− MoreLikeThisFieldQuery
2652− <$> o .: "like_text"
2653− <*> pure fn
2654− <*> o .:? "percent_terms_to_match"
2655− <*> o .:? "min_term_freq"
2656− <*> o .:? "max_query_terms"
2657− -- <*> (optionalNE =<< o .:? "stop_words")
2658− <*> o .:? "stop_words"
2659− <*> o .:? "min_doc_freq"
2660− <*> o .:? "max_doc_freq"
2661− <*> o .:? "min_word_length"
2662− <*> o .:? "max_word_length"
2663− <*> o .:? "boost_terms"
2664− <*> o .:? "boost"
2665− <*> o .:? "analyzer"
2666− -- optionalNE = maybe (pure Nothing) (fmap Just . parseNEJSON)
2667−
2668−instance ToJSON MoreLikeThisQuery where
2669− toJSON (MoreLikeThisQuery text fields percent
2670− mtf mqt stopwords mindf maxdf
2671− minwl maxwl boostTerms boost analyzer) =
2672− omitNulls base
2673− where base = [ "like_text" .= text
2674− , "fields" .= fields
2675− , "percent_terms_to_match" .= percent
2676− , "min_term_freq" .= mtf
2677− , "max_query_terms" .= mqt
2678− , "stop_words" .= stopwords
2679− , "min_doc_freq" .= mindf
2680− , "max_doc_freq" .= maxdf
2681− , "min_word_length" .= minwl
2682− , "max_word_length" .= maxwl
2683− , "boost_terms" .= boostTerms
2684− , "boost" .= boost
2685− , "analyzer" .= analyzer ]
2686−
2687−instance FromJSON MoreLikeThisQuery where
2688− parseJSON = withObject "MoreLikeThisQuery" parse
2689− where parse o = MoreLikeThisQuery
2690− <$> o .: "like_text"
2691− -- <*> (optionalNE =<< o .:? "fields")
2692− <*> o .:? "fields"
2693− <*> o .:? "percent_terms_to_match"
2694− <*> o .:? "min_term_freq"
2695− <*> o .:? "max_query_terms"
2696− -- <*> (optionalNE =<< o .:? "stop_words")
2697− <*> o .:? "stop_words"
2698− <*> o .:? "min_doc_freq"
2699− <*> o .:? "max_doc_freq"
2700− <*> o .:? "min_word_length"
2701− <*> o .:? "max_word_length"
2702− <*> o .:? "boost_terms"
2703− <*> o .:? "boost"
2704− <*> o .:? "analyzer"
2705− -- optionalNE = maybe (pure Nothing) (fmap Just . parseNEJSON)
2706−
2707−instance ToJSON IndicesQuery where
2708− toJSON (IndicesQuery indices query noMatch) =
2709− omitNulls [ "indices" .= indices
2710− , "no_match_query" .= noMatch
2711− , "query" .= query ]
2712−
2713−instance FromJSON IndicesQuery where
2714− parseJSON = withObject "IndicesQuery" parse
2715− where parse o = IndicesQuery
2716− <$> o .:? "indices" .!= []
2717− <*> o .: "query"
2718− <*> o .:? "no_match_query"
2719−
2720−instance ToJSON HasParentQuery where
2721− toJSON (HasParentQuery queryType query scoreType) =
2722− omitNulls [ "parent_type" .= queryType
2723− , "score_type" .= scoreType
2724− , "query" .= query ]
2725−
2726−instance FromJSON HasParentQuery where
2727− parseJSON = withObject "HasParentQuery" parse
2728− where parse o = HasParentQuery
2729− <$> o .: "parent_type"
2730− <*> o .: "query"
2731− <*> o .:? "score_type"
2732−
2733−instance ToJSON HasChildQuery where
2734− toJSON (HasChildQuery queryType query scoreType) =
2735− omitNulls [ "query" .= query
2736− , "score_type" .= scoreType
2737− , "type" .= queryType ]
2738−
2739−instance FromJSON HasChildQuery where
2740− parseJSON = withObject "HasChildQuery" parse
2741− where parse o = HasChildQuery
2742− <$> o .: "type"
2743− <*> o .: "query"
2744− <*> o .:? "score_type"
2745−
2746−instance ToJSON FuzzyQuery where
2747− toJSON (FuzzyQuery (FieldName fieldName) queryText
2748− prefixLength maxEx fuzziness boost) =
2749− object [ fieldName .= omitNulls base ]
2750− where base = [ "value" .= queryText
2751− , "fuzziness" .= fuzziness
2752− , "prefix_length" .= prefixLength
2753− , "boost" .= boost
2754− , "max_expansions" .= maxEx ]
2755−
2756−instance FromJSON FuzzyQuery where
2757− parseJSON = withObject "FuzzyQuery" parse
2758− where parse = fieldTagged $ \fn o ->
2759− FuzzyQuery fn
2760− <$> o .: "value"
2761− <*> o .: "prefix_length"
2762− <*> o .: "max_expansions"
2763− <*> o .: "fuzziness"
2764− <*> o .:? "boost"
2765−
2766−instance ToJSON FuzzyLikeFieldQuery where
2767− toJSON (FuzzyLikeFieldQuery (FieldName fieldName)
2768− fieldText maxTerms ignoreFreq fuzziness prefixLength
2769− boost analyzer) =
2770− object [ fieldName .=
2771− omitNulls [ "like_text" .= fieldText
2772− , "max_query_terms" .= maxTerms
2773− , "ignore_tf" .= ignoreFreq
2774− , "fuzziness" .= fuzziness
2775− , "prefix_length" .= prefixLength
2776− , "analyzer" .= analyzer
2777− , "boost" .= boost ]]
2778−
2779−instance FromJSON FuzzyLikeFieldQuery where
2780− parseJSON = withObject "FuzzyLikeFieldQuery" parse
2781− where parse = fieldTagged $ \fn o ->
2782− FuzzyLikeFieldQuery fn
2783− <$> o .: "like_text"
2784− <*> o .: "max_query_terms"
2785− <*> o .: "ignore_tf"
2786− <*> o .: "fuzziness"
2787− <*> o .: "prefix_length"
2788− <*> o .: "boost"
2789− <*> o .:? "analyzer"
2790−
2791−instance ToJSON FuzzyLikeThisQuery where
2792− toJSON (FuzzyLikeThisQuery fields text maxTerms
2793− ignoreFreq fuzziness prefixLength boost analyzer) =
2794− omitNulls base
2795− where base = [ "fields" .= fields
2796− , "like_text" .= text
2797− , "max_query_terms" .= maxTerms
2798− , "ignore_tf" .= ignoreFreq
2799− , "fuzziness" .= fuzziness
2800− , "prefix_length" .= prefixLength
2801− , "analyzer" .= analyzer
2802− , "boost" .= boost ]
2803−
2804−instance FromJSON FuzzyLikeThisQuery where
2805− parseJSON = withObject "FuzzyLikeThisQuery" parse
2806− where parse o = FuzzyLikeThisQuery
2807− <$> o .:? "fields" .!= []
2808− <*> o .: "like_text"
2809− <*> o .: "max_query_terms"
2810− <*> o .: "ignore_tf"
2811− <*> o .: "fuzziness"
2812− <*> o .: "prefix_length"
2813− <*> o .: "boost"
2814− <*> o .:? "analyzer"
2815−
2816−instance ToJSON FilteredQuery where
2817− toJSON (FilteredQuery query fFilter) =
2818− object [ "query" .= query
2819− , "filter" .= fFilter ]
2820−
2821−instance FromJSON FilteredQuery where
2822− parseJSON = withObject "FilteredQuery" parse
2823− where parse o = FilteredQuery
2824− <$> o .: "query"
2825− <*> o .: "filter"
2826−
2827−instance ToJSON DisMaxQuery where
2828− toJSON (DisMaxQuery queries tiebreaker boost) =
2829− omitNulls base
2830− where base = [ "queries" .= queries
2831− , "boost" .= boost
2832− , "tie_breaker" .= tiebreaker ]
2833−
2834−instance FromJSON DisMaxQuery where
2835− parseJSON = withObject "DisMaxQuery" parse
2836− where parse o = DisMaxQuery
2837− <$> o .:? "queries" .!= []
2838− <*> o .: "tie_breaker"
2839− <*> o .:? "boost"
2840−
2841−instance ToJSON CommonTermsQuery where
2842− toJSON (CommonTermsQuery (FieldName fieldName)
2843− (QueryString query) cf lfo hfo msm
2844− boost analyzer disableCoord) =
2845− object [fieldName .= omitNulls base ]
2846− where base = [ "query" .= query
2847− , "cutoff_frequency" .= cf
2848− , "low_freq_operator" .= lfo
2849− , "minimum_should_match" .= msm
2850− , "boost" .= boost
2851− , "analyzer" .= analyzer
2852− , "disable_coord" .= disableCoord
2853− , "high_freq_operator" .= hfo ]
2854−
2855−instance FromJSON CommonTermsQuery where
2856− parseJSON = withObject "CommonTermsQuery" parse
2857− where parse = fieldTagged $ \fn o ->
2858− CommonTermsQuery fn
2859− <$> o .: "query"
2860− <*> o .: "cutoff_frequency"
2861− <*> o .: "low_freq_operator"
2862− <*> o .: "high_freq_operator"
2863− <*> o .:? "minimum_should_match"
2864− <*> o .:? "boost"
2865− <*> o .:? "analyzer"
2866− <*> o .:? "disable_coord"
2867−
2868−instance ToJSON CommonMinimumMatch where
2869− toJSON (CommonMinimumMatch mm) = toJSON mm
2870− toJSON (CommonMinimumMatchHighLow (MinimumMatchHighLow lowF highF)) =
2871− object [ "low_freq" .= lowF
2872− , "high_freq" .= highF ]
2873−
2874−instance FromJSON CommonMinimumMatch where
2875− parseJSON v = parseMinimum v
2876− <|> parseMinimumHighLow v
2877− where parseMinimum = fmap CommonMinimumMatch . parseJSON
2878− parseMinimumHighLow = fmap CommonMinimumMatchHighLow . withObject "CommonMinimumMatchHighLow" (\o ->
2879− MinimumMatchHighLow
2880− <$> o .: "low_freq"
2881− <*> o .: "high_freq")
2882−
2883−
2884−instance ToJSON BoostingQuery where
2885− toJSON (BoostingQuery bqPositiveQuery bqNegativeQuery bqNegativeBoost) =
2886− object [ "positive" .= bqPositiveQuery
2887− , "negative" .= bqNegativeQuery
2888− , "negative_boost" .= bqNegativeBoost ]
2889−
2890−instance FromJSON BoostingQuery where
2891− parseJSON = withObject "BoostingQuery" parse
2892− where parse o = BoostingQuery
2893− <$> o .: "positive"
2894− <*> o .: "negative"
2895− <*> o .: "negative_boost"
2896−
2897−instance ToJSON BoolQuery where
2898− toJSON (BoolQuery mustM notM shouldM bqMin boost disableCoord) =
2899− omitNulls base
2900− where base = [ "must" .= mustM
2901− , "must_not" .= notM
2902− , "should" .= shouldM
2903− , "minimum_should_match" .= bqMin
2904− , "boost" .= boost
2905− , "disable_coord" .= disableCoord ]
2906−
2907−instance FromJSON BoolQuery where
2908− parseJSON = withObject "BoolQuery" parse
2909− where parse o = BoolQuery
2910− <$> o .:? "must" .!= []
2911− <*> o .:? "must_not" .!= []
2912− <*> o .:? "should" .!= []
2913− <*> o .:? "minimum_should_match"
2914− <*> o .:? "boost"
2915− <*> o .:? "disable_coord"
2916−
2917−instance ToJSON MatchQuery where
2918− toJSON (MatchQuery (FieldName fieldName)
2919− (QueryString mqQueryString) booleanOperator
2920− zeroTermsQuery cutoffFrequency matchQueryType
2921− analyzer maxExpansions lenient boost) =
2922− object [ fieldName .= omitNulls base ]
2923− where base = [ "query" .= mqQueryString
2924− , "operator" .= booleanOperator
2925− , "zero_terms_query" .= zeroTermsQuery
2926− , "cutoff_frequency" .= cutoffFrequency
2927− , "type" .= matchQueryType
2928− , "analyzer" .= analyzer
2929− , "max_expansions" .= maxExpansions
2930− , "lenient" .= lenient
2931− , "boost" .= boost ]
2932−
2933−instance FromJSON MatchQuery where
2934− parseJSON = withObject "MatchQuery" parse
2935− where parse = fieldTagged $ \fn o ->
2936− MatchQuery fn
2937− <$> o .: "query"
2938− <*> o .: "operator"
2939− <*> o .: "zero_terms_query"
2940− <*> o .:? "cutoff_frequency"
2941− <*> o .:? "type"
2942− <*> o .:? "analyzer"
2943− <*> o .:? "max_expansions"
2944− <*> o .:? "lenient"
2945− <*> o .:? "boost"
2946−
2947−instance ToJSON MultiMatchQuery where
2948− toJSON (MultiMatchQuery fields (QueryString query) boolOp
2949− ztQ tb mmqt cf analyzer maxEx lenient) =
2950− object ["multi_match" .= omitNulls base]
2951− where base = [ "fields" .= fmap toJSON fields
2952− , "query" .= query
2953− , "operator" .= boolOp
2954− , "zero_terms_query" .= ztQ
2955− , "tiebreaker" .= tb
2956− , "type" .= mmqt
2957− , "cutoff_frequency" .= cf
2958− , "analyzer" .= analyzer
2959− , "max_expansions" .= maxEx
2960− , "lenient" .= lenient ]
2961−
2962−instance FromJSON MultiMatchQuery where
2963− parseJSON = withObject "MultiMatchQuery" parse
2964− where parse raw = do o <- raw .: "multi_match"
2965− MultiMatchQuery
2966− <$> o .:? "fields" .!= []
2967− <*> o .: "query"
2968− <*> o .: "operator"
2969− <*> o .: "zero_terms_query"
2970− <*> o .:? "tiebreaker"
2971− <*> o .:? "type"
2972− <*> o .:? "cutoff_frequency"
2973− <*> o .:? "analyzer"
2974− <*> o .:? "max_expansions"
2975− <*> o .:? "lenient"
2976−
2977−instance ToJSON MultiMatchQueryType where
2978− toJSON MultiMatchBestFields = "best_fields"
2979− toJSON MultiMatchMostFields = "most_fields"
2980− toJSON MultiMatchCrossFields = "cross_fields"
2981− toJSON MultiMatchPhrase = "phrase"
2982− toJSON MultiMatchPhrasePrefix = "phrase_prefix"
2983−
2984−instance FromJSON MultiMatchQueryType where
2985− parseJSON = withText "MultiMatchPhrasePrefix" parse
2986− where parse "best_fields" = pure MultiMatchBestFields
2987− parse "most_fields" = pure MultiMatchMostFields
2988− parse "cross_fields" = pure MultiMatchCrossFields
2989− parse "phrase" = pure MultiMatchPhrase
2990− parse "phrase_prefix" = pure MultiMatchPhrasePrefix
2991− parse t = fail ("Unexpected MultiMatchPhrasePrefix: " <> show t)
2992−
2993−instance ToJSON BooleanOperator where
2994− toJSON And = String "and"
2995− toJSON Or = String "or"
2996−
2997−instance FromJSON BooleanOperator where
2998− parseJSON = withText "BooleanOperator" parse
2999− where parse "and" = pure And
3000− parse "or" = pure Or
3001− parse o = fail ("Unexpected BooleanOperator: " <> show o)
3002−
3003−instance ToJSON ZeroTermsQuery where
3004− toJSON ZeroTermsNone = String "none"
3005− toJSON ZeroTermsAll = String "all"
3006−
3007−instance FromJSON ZeroTermsQuery where
3008− parseJSON = withText "ZeroTermsQuery" parse
3009− where parse "none" = pure ZeroTermsNone
3010− parse "all" = pure ZeroTermsAll
3011− parse q = fail ("Unexpected ZeroTermsQuery: " <> show q)
3012−
3013−instance ToJSON MatchQueryType where
3014− toJSON MatchPhrase = "phrase"
3015− toJSON MatchPhrasePrefix = "phrase_prefix"
3016−
3017−instance FromJSON MatchQueryType where
3018− parseJSON = withText "MatchQueryType" parse
3019− where parse "phrase" = pure MatchPhrase
3020− parse "phrase_prefix" = pure MatchPhrasePrefix
3021− parse t = fail ("Unexpected MatchQueryType: " <> show t)
3022−
3023−instance FromJSON Status where
3024− parseJSON (Object v) = Status <$>
3025− v .:? "ok" <*>
3026− (v .:? "status" .!= 200) <*>
3027− v .: "name" <*>
3028− v .: "version" <*>
3029− v .: "tagline"
3030− parseJSON _ = empty
3031−
3032−
3033−instance ToJSON IndexSettings where
3034− toJSON (IndexSettings s r) = object ["settings" .=
3035− object ["index" .=
3036− object ["number_of_shards" .= s, "number_of_replicas" .= r]
3037− ]
3038− ]
3039−
3040−instance FromJSON IndexSettings where
3041− parseJSON = withObject "IndexSettings" parse
3042− where parse o = do s <- o .: "settings"
3043− i <- s .: "index"
3044− IndexSettings <$> i .: "number_of_shards"
3045− <*> i .: "number_of_replicas"
3046−
3047−instance ToJSON UpdatableIndexSetting where
3048− toJSON (NumberOfReplicas x) = oPath ("index" :| ["number_of_replicas"]) x
3049− toJSON (AutoExpandReplicas x) = oPath ("index" :| ["auto_expand_replicas"]) x
3050− toJSON (RefreshInterval x) = oPath ("index" :| ["refresh_interval"]) (NominalDiffTimeJSON x)
3051− toJSON (IndexConcurrency x) = oPath ("index" :| ["concurrency"]) x
3052− toJSON (FailOnMergeFailure x) = oPath ("index" :| ["fail_on_merge_failure"]) x
3053− toJSON (TranslogFlushThresholdOps x) = oPath ("index" :| ["translog", "flush_threshold_ops"]) x
3054− toJSON (TranslogFlushThresholdSize x) = oPath ("index" :| ["translog", "flush_threshold_size"]) x
3055− toJSON (TranslogFlushThresholdPeriod x) = oPath ("index" :| ["translog", "flush_threshold_period"]) (NominalDiffTimeJSON x)
3056− toJSON (TranslogDisableFlush x) = oPath ("index" :| ["translog", "disable_flush"]) x
3057− toJSON (CacheFilterMaxSize x) = oPath ("index" :| ["cache", "filter", "max_size"]) x
3058− toJSON (CacheFilterExpire x) = oPath ("index" :| ["cache", "filter", "expire"]) (NominalDiffTimeJSON <$> x)
3059− toJSON (GatewaySnapshotInterval x) = oPath ("index" :| ["gateway", "snapshot_interval"]) (NominalDiffTimeJSON x)
3060− toJSON (RoutingAllocationInclude fs) = oPath ("index" :| ["routing", "allocation", "include"]) (attrFilterJSON fs)
3061− toJSON (RoutingAllocationExclude fs) = oPath ("index" :| ["routing", "allocation", "exclude"]) (attrFilterJSON fs)
3062− toJSON (RoutingAllocationRequire fs) = oPath ("index" :| ["routing", "allocation", "require"]) (attrFilterJSON fs)
3063− toJSON (RoutingAllocationEnable x) = oPath ("index" :| ["routing", "allocation", "enable"]) x
3064− toJSON (RoutingAllocationShardsPerNode x) = oPath ("index" :| ["routing", "allocation", "total_shards_per_node"]) x
3065− toJSON (RecoveryInitialShards x) = oPath ("index" :| ["recovery", "initial_shards"]) x
3066− toJSON (GCDeletes x) = oPath ("index" :| ["gc_deletes"]) (NominalDiffTimeJSON x)
3067− toJSON (TTLDisablePurge x) = oPath ("index" :| ["ttl", "disable_purge"]) x
3068− toJSON (TranslogFSType x) = oPath ("index" :| ["translog", "fs", "type"]) x
3069− toJSON (IndexCompoundFormat x) = oPath ("index" :| ["compound_format"]) x
3070− toJSON (IndexCompoundOnFlush x) = oPath ("index" :| ["compound_on_flush"]) x
3071− toJSON (WarmerEnabled x) = oPath ("index" :| ["warmer", "enabled"]) x
3072− toJSON (BlocksReadOnly x) = oPath ("blocks" :| ["read_only"]) x
3073− toJSON (BlocksRead x) = oPath ("blocks" :| ["read"]) x
3074− toJSON (BlocksWrite x) = oPath ("blocks" :| ["write"]) x
3075− toJSON (BlocksMetaData x) = oPath ("blocks" :| ["metadata"]) x
3076−
3077−instance FromJSON UpdatableIndexSetting where
3078− parseJSON = withObject "UpdatableIndexSetting" parse
3079− where parse o = numberOfReplicas `taggedAt` ["index", "number_of_replicas"]
3080− <|> autoExpandReplicas `taggedAt` ["index", "auto_expand_replicas"]
3081− <|> refreshInterval `taggedAt` ["index", "refresh_interval"]
3082− <|> indexConcurrency `taggedAt` ["index", "concurrency"]
3083− <|> failOnMergeFailure `taggedAt` ["index", "fail_on_merge_failure"]
3084− <|> translogFlushThresholdOps `taggedAt` ["index", "translog", "flush_threshold_ops"]
3085− <|> translogFlushThresholdSize `taggedAt` ["index", "translog", "flush_threshold_size"]
3086− <|> translogFlushThresholdPeriod `taggedAt` ["index", "translog", "flush_threshold_period"]
3087− <|> translogDisableFlush `taggedAt` ["index", "translog", "disable_flush"]
3088− <|> cacheFilterMaxSize `taggedAt` ["index", "cache", "filter", "max_size"]
3089− <|> cacheFilterExpire `taggedAt` ["index", "cache", "filter", "expire"]
3090− <|> gatewaySnapshotInterval `taggedAt` ["index", "gateway", "snapshot_interval"]
3091− <|> routingAllocationInclude `taggedAt` ["index", "routing", "allocation", "include"]
3092− <|> routingAllocationExclude `taggedAt` ["index", "routing", "allocation", "exclude"]
3093− <|> routingAllocationRequire `taggedAt` ["index", "routing", "allocation", "require"]
3094− <|> routingAllocationEnable `taggedAt` ["index", "routing", "allocation", "enable"]
3095− <|> routingAllocationShardsPerNode `taggedAt` ["index", "routing", "allocation", "total_shards_per_node"]
3096− <|> recoveryInitialShards `taggedAt` ["index", "recovery", "initial_shards"]
3097− <|> gcDeletes `taggedAt` ["index", "gc_deletes"]
3098− <|> ttlDisablePurge `taggedAt` ["index", "ttl", "disable_purge"]
3099− <|> translogFSType `taggedAt` ["index", "translog", "fs", "type"]
3100− <|> compoundFormat `taggedAt` ["index", "compound_format"]
3101− <|> compoundOnFlush `taggedAt` ["index", "compound_on_flush"]
3102− <|> warmerEnabled `taggedAt` ["index", "warmer", "enabled"]
3103− <|> blocksReadOnly `taggedAt` ["blocks", "read_only"]
3104− <|> blocksRead `taggedAt` ["blocks", "read"]
3105− <|> blocksWrite `taggedAt` ["blocks", "write"]
3106− <|> blocksMetaData `taggedAt` ["blocks", "metadata"]
3107− where taggedAt f ks = taggedAt' f (Object o) ks
3108− taggedAt' f v [] = f =<< (parseJSON v <|> (parseJSON (unStringlyTypeJSON v)))
3109− taggedAt' f v (k:ks) = withObject "Object" (\o -> do v' <- o .: k
3110− taggedAt' f v' ks) v
3111− numberOfReplicas = pure . NumberOfReplicas
3112− autoExpandReplicas = pure . AutoExpandReplicas
3113− refreshInterval = pure . RefreshInterval . ndtJSON
3114− indexConcurrency = pure . IndexConcurrency
3115− failOnMergeFailure = pure . FailOnMergeFailure
3116− translogFlushThresholdOps = pure . TranslogFlushThresholdOps
3117− translogFlushThresholdSize = pure . TranslogFlushThresholdSize
3118− translogFlushThresholdPeriod = pure . TranslogFlushThresholdPeriod . ndtJSON
3119− translogDisableFlush = pure . TranslogDisableFlush
3120− cacheFilterMaxSize = pure . CacheFilterMaxSize
3121− cacheFilterExpire = pure . CacheFilterExpire . fmap ndtJSON
3122− gatewaySnapshotInterval = pure . GatewaySnapshotInterval . ndtJSON
3123− routingAllocationInclude = fmap RoutingAllocationInclude . parseAttrFilter
3124− routingAllocationExclude = fmap RoutingAllocationExclude . parseAttrFilter
3125− routingAllocationRequire = fmap RoutingAllocationRequire . parseAttrFilter
3126− routingAllocationEnable = pure . RoutingAllocationEnable
3127− routingAllocationShardsPerNode = pure . RoutingAllocationShardsPerNode
3128− recoveryInitialShards = pure . RecoveryInitialShards
3129− gcDeletes = pure . GCDeletes . ndtJSON
3130− ttlDisablePurge = pure . TTLDisablePurge
3131− translogFSType = pure . TranslogFSType
3132− compoundFormat = pure . IndexCompoundFormat
3133− compoundOnFlush = pure . IndexCompoundOnFlush
3134− warmerEnabled = pure . WarmerEnabled
3135− blocksReadOnly = pure . BlocksReadOnly
3136− blocksRead = pure . BlocksRead
3137− blocksWrite = pure . BlocksWrite
3138− blocksMetaData = pure . BlocksMetaData
3139−
3140−instance FromJSON IndexSettingsSummary where
3141− parseJSON = withObject "IndexSettingsSummary" parse
3142− where parse o = case HM.toList o of
3143− [(ixn, v@(Object o'))] -> IndexSettingsSummary (IndexName ixn)
3144− <$> parseJSON v
3145− <*> (fmap (filter (not . redundant)) . parseSettings =<< o' .: "settings")
3146− _ -> fail "Expected single-key object with index name"
3147− redundant (NumberOfReplicas _) = True
3148− redundant _ = False
3149−
3150−-- | For some reason in several settings APIs, all leaf values get returned
3151−-- as strings. This function attepmts to recover from this for all
3152−-- non-recursive JSON types. If nothing can be done, the value is left alone.
3153−unStringlyTypeJSON :: Value -> Value
3154−unStringlyTypeJSON (String "true") = Bool True
3155−unStringlyTypeJSON (String "false") = Bool False
3156−unStringlyTypeJSON (String "null") = Null
3157−unStringlyTypeJSON v@(String t) = case readMay (T.unpack t) of
3158− Just n -> Number n
3159− Nothing -> v
3160−unStringlyTypeJSON v = v
3161−
3162−
3163−parseSettings :: Object -> Parser [UpdatableIndexSetting]
3164−parseSettings o = do
3165− o' <- o .: "index"
3166− -- slice the index object into singleton hashmaps and try to parse each
3167− parses <- forM (HM.toList o') $ \(k, v) -> do
3168− -- blocks are now nested into the "index" key, which is not how they're serialized
3169− let atRoot = Object (HM.singleton k v)
3170− let atIndex = Object (HM.singleton "index" atRoot)
3171− optional (parseJSON atRoot <|> parseJSON atIndex)
3172− return (catMaybes parses)
3173−
3174−oPath :: ToJSON a => NonEmpty Text -> a -> Value
3175−oPath (k :| []) v = object [k .= v]
3176−oPath (k:| (h:t)) v = object [k .= oPath (h :| t) v]
3177−
3178−attrFilterJSON :: NonEmpty NodeAttrFilter -> Value
3179−attrFilterJSON fs = object [ n .= T.intercalate "," (toList vs)
3180− | NodeAttrFilter (NodeAttrName n) vs <- toList fs]
3181−
3182−parseAttrFilter :: Value -> Parser (NonEmpty NodeAttrFilter)
3183−parseAttrFilter = withObject "NonEmpty NodeAttrFilter" parse
3184− where parse o = case HM.toList o of
3185− [] -> fail "Expected non-empty list of NodeAttrFilters"
3186− x:xs -> DT.mapM (uncurry parse') (x :| xs)
3187− parse' n = withText "Text" $ \t ->
3188− case T.splitOn "," t of
3189− fv:fvs -> return (NodeAttrFilter (NodeAttrName n) (fv :| fvs))
3190− [] -> fail "Expected non-empty list of filter values"
3191−
3192−instance ToJSON ReplicaBounds where
3193− toJSON (ReplicasBounded a b) = String (showText a <> "-" <> showText b)
3194− toJSON (ReplicasLowerBounded a) = String (showText a <> "-all")
3195− toJSON ReplicasUnbounded = Bool False
3196−
3197−instance FromJSON ReplicaBounds where
3198− parseJSON v = withText "ReplicaBounds" parseText v
3199− <|> withBool "ReplicaBounds" parseBool v
3200− where parseText t = case T.splitOn "-" t of
3201− [a, "all"] -> ReplicasLowerBounded <$> parseReadText a
3202− [a, b] -> ReplicasBounded <$> parseReadText a
3203− <*> parseReadText b
3204− _ -> fail ("Could not parse ReplicaBounds: " <> show t)
3205− parseBool False = pure ReplicasUnbounded
3206− parseBool _ = fail "ReplicasUnbounded cannot be represented with True"
3207−
3208−instance ToJSON AllocationPolicy where
3209− toJSON AllocAll = String "all"
3210− toJSON AllocPrimaries = String "primaries"
3211− toJSON AllocNewPrimaries = String "new_primaries"
3212− toJSON AllocNone = String "none"
3213−
3214−instance FromJSON AllocationPolicy where
3215− parseJSON = withText "AllocationPolicy" parse
3216− where parse "all" = pure AllocAll
3217− parse "primaries" = pure AllocPrimaries
3218− parse "new_primaries" = pure AllocNewPrimaries
3219− parse "none" = pure AllocNone
3220− parse t = fail ("Invlaid AllocationPolicy: " <> show t)
3221−
3222−instance ToJSON InitialShardCount where
3223− toJSON QuorumShards = String "quorum"
3224− toJSON QuorumMinus1Shards = String "quorum-1"
3225− toJSON FullShards = String "full"
3226− toJSON FullMinus1Shards = String "full-1"
3227− toJSON (ExplicitShards x) = toJSON x
3228−
3229−instance FromJSON InitialShardCount where
3230− parseJSON v = withText "InitialShardCount" parseText v
3231− <|> ExplicitShards <$> parseJSON v
3232− where parseText "quorum" = pure QuorumShards
3233− parseText "quorum-1" = pure QuorumMinus1Shards
3234− parseText "full" = pure FullShards
3235− parseText "full-1" = pure FullMinus1Shards
3236− parseText _ = mzero
3237−
3238−instance ToJSON FSType where
3239− toJSON FSSimple = "simple"
3240− toJSON FSBuffered = "buffered"
3241−
3242−instance FromJSON FSType where
3243− parseJSON = withText "FSType" parse
3244− where parse "simple" = pure FSSimple
3245− parse "buffered" = pure FSBuffered
3246− parse t = fail ("Invalid FSType: " <> show t)
3247−
3248−instance ToJSON CompoundFormat where
3249− toJSON (CompoundFileFormat x) = Bool x
3250− toJSON (MergeSegmentVsTotalIndex x) = toJSON x
3251−
3252−instance FromJSON CompoundFormat where
3253− parseJSON v = CompoundFileFormat <$> parseJSON v
3254− <|> MergeSegmentVsTotalIndex <$> parseJSON v
3255−
3256−instance ToJSON NominalDiffTimeJSON where
3257− toJSON (NominalDiffTimeJSON t) = String (showText (round t :: Integer) <> "s")
3258−
3259−instance FromJSON NominalDiffTimeJSON where
3260− parseJSON = withText "NominalDiffTime" parse
3261− where parse t = case T.takeEnd 1 t of
3262− "s" -> NominalDiffTimeJSON . fromInteger <$> parseReadText (T.dropEnd 1 t)
3263− _ -> fail "Invalid or missing NominalDiffTime unit (expected s)"
3264−
3265−instance ToJSON IndexTemplate where
3266− toJSON (IndexTemplate p s m) = merge
3267− (object [ "template" .= p
3268− , "mappings" .= foldl' merge (object []) m
3269− ])
3270− (toJSON s)
3271− where
3272− merge (Object o1) (Object o2) = toJSON $ HM.union o1 o2
3273− merge o Null = o
3274− merge _ _ = undefined
3275−
3276−instance (FromJSON a) => FromJSON (EsResult a) where
3277− parseJSON jsonVal@(Object v) = do
3278− found <- v .:? "found" .!= False
3279− fr <- if found
3280− then parseJSON jsonVal
3281− else return Nothing
3282− EsResult <$> v .: "_index" <*>
3283− v .: "_type" <*>
3284− v .: "_id" <*>
3285− pure fr
3286− parseJSON _ = empty
3287−
3288−instance (FromJSON a) => FromJSON (EsResultFound a) where
3289− parseJSON (Object v) = EsResultFound <$>
3290− v .: "_version" <*>
3291− v .: "_source"
3292− parseJSON _ = empty
3293−
3294−instance FromJSON EsError where
3295− parseJSON (Object v) = EsError <$>
3296− v .: "status" <*>
3297− (v .: "error" <|> (v .: "error" >>= (.: "reason")))
3298− parseJSON _ = empty
3299−
3300−instance FromJSON IndexAliasesSummary where
3301− parseJSON = withObject "IndexAliasesSummary" parse
3302− where parse o = IndexAliasesSummary . mconcat <$> mapM (uncurry go) (HM.toList o)
3303− go ixn = withObject "index aliases" $ \ia -> do
3304− aliases <- ia .:? "aliases" .!= mempty
3305− forM (HM.toList aliases) $ \(aName, v) -> do
3306− let indexAlias = IndexAlias (IndexName ixn) (IndexAliasName (IndexName aName))
3307− IndexAliasSummary indexAlias <$> parseJSON v
3308−
3309−
3310−instance ToJSON IndexAliasAction where
3311− toJSON (AddAlias ia opts) = object ["add" .= (iaObj <> optsObj)]
3312− where Object iaObj = toJSON ia
3313− Object optsObj = toJSON opts
3314− toJSON (RemoveAlias ia) = object ["remove" .= iaObj]
3315− where Object iaObj = toJSON ia
3316−
3317−instance ToJSON IndexAlias where
3318− toJSON IndexAlias {..} = object ["index" .= srcIndex
3319− , "alias" .= indexAlias
3320− ]
3321−
3322−instance ToJSON IndexAliasCreate where
3323− toJSON IndexAliasCreate {..} = Object (filterObj <> routingObj)
3324− where filterObj = maybe mempty (HM.singleton "filter" . toJSON) aliasCreateFilter
3325− Object routingObj = maybe (Object mempty) toJSON aliasCreateRouting
3326−
3327−instance ToJSON AliasRouting where
3328− toJSON (AllAliasRouting v) = object ["routing" .= v]
3329− toJSON (GranularAliasRouting srch idx) = object (catMaybes prs)
3330− where prs = [("search_routing" .=) <$> srch
3331− ,("index_routing" .=) <$> idx]
3332−
3333−instance FromJSON AliasRouting where
3334− parseJSON = withObject "AliasRouting" parse
3335− where parse o = parseAll o <|> parseGranular o
3336− parseAll o = AllAliasRouting <$> o .: "routing"
3337− parseGranular o = do
3338− sr <- o .:? "search_routing"
3339− ir <- o .:? "index_routing"
3340− if isNothing sr && isNothing ir
3341− then fail "Both search_routing and index_routing can't be blank"
3342− else return (GranularAliasRouting sr ir)
3343−
3344−instance FromJSON IndexAliasCreate where
3345− parseJSON v = withObject "IndexAliasCreate" parse v
3346− where parse o = IndexAliasCreate <$> optional (parseJSON v)
3347− <*> o .:? "filter"
3348−
3349−instance ToJSON SearchAliasRouting where
3350− toJSON (SearchAliasRouting rvs) = toJSON (T.intercalate "," (routingValue <$> toList rvs))
3351−
3352−instance FromJSON SearchAliasRouting where
3353− parseJSON = withText "SearchAliasRouting" parse
3354− where parse t = SearchAliasRouting <$> parseNEJSON (String <$> T.splitOn "," t)
3355−
3356−instance ToJSON Search where
3357− toJSON (Search query sFilter sort searchAggs highlight sTrackSortScores sFrom sSize _ sFields sSource) =
3358− omitNulls [ "query" .= query
3359− , "filter" .= sFilter
3360− , "sort" .= sort
3361− , "aggregations" .= searchAggs
3362− , "highlight" .= highlight
3363− , "from" .= sFrom
3364− , "size" .= sSize
3365− , "track_scores" .= sTrackSortScores
3366− , "fields" .= sFields
3367− , "_source" .= sSource]
3368−
3369−
3370−instance ToJSON Source where
3371− toJSON NoSource = toJSON False
3372− toJSON (SourcePatterns patterns) = toJSON patterns
3373− toJSON (SourceIncludeExclude incl excl) = object [ "include" .= incl, "exclude" .= excl ]
3374−
3375−instance ToJSON PatternOrPatterns where
3376− toJSON (PopPattern pattern) = toJSON pattern
3377− toJSON (PopPatterns patterns) = toJSON patterns
3378−
3379−instance ToJSON Include where
3380− toJSON (Include patterns) = toJSON patterns
3381−
3382−instance ToJSON Exclude where
3383− toJSON (Exclude patterns) = toJSON patterns
3384−
3385−instance ToJSON Pattern where
3386− toJSON (Pattern pattern) = toJSON pattern
3387−
3388−
3389−instance ToJSON FieldHighlight where
3390− toJSON (FieldHighlight (FieldName fName) (Just fSettings)) =
3391− object [ fName .= fSettings ]
3392− toJSON (FieldHighlight (FieldName fName) Nothing) =
3393− object [ fName .= emptyObject ]
3394−
3395−instance ToJSON Highlights where
3396− toJSON (Highlights global fields) =
3397− omitNulls (("fields" .= fields)
3398− : highlightSettingsPairs global)
3399−
3400−instance ToJSON HighlightSettings where
3401− toJSON hs = omitNulls (highlightSettingsPairs (Just hs))
3402−
3403−highlightSettingsPairs :: Maybe HighlightSettings -> [Pair]
3404−highlightSettingsPairs Nothing = []
3405−highlightSettingsPairs (Just (Plain plh)) = plainHighPairs (Just plh)
3406−highlightSettingsPairs (Just (Postings ph)) = postHighPairs (Just ph)
3407−highlightSettingsPairs (Just (FastVector fvh)) = fastVectorHighPairs (Just fvh)
3408−
3409−
3410−plainHighPairs :: Maybe PlainHighlight -> [Pair]
3411−plainHighPairs Nothing = []
3412−plainHighPairs (Just (PlainHighlight plCom plNonPost)) =
3413− [ "type" .= String "plain"]
3414− ++ commonHighlightPairs plCom
3415− ++ nonPostingsToPairs plNonPost
3416−
3417−postHighPairs :: Maybe PostingsHighlight -> [Pair]
3418−postHighPairs Nothing = []
3419−postHighPairs (Just (PostingsHighlight pCom)) =
3420− ("type" .= String "postings")
3421− : commonHighlightPairs pCom
3422−
3423−fastVectorHighPairs :: Maybe FastVectorHighlight -> [Pair]
3424−fastVectorHighPairs Nothing = []
3425−fastVectorHighPairs (Just
3426− (FastVectorHighlight fvCom fvNonPostSettings fvBoundChars
3427− fvBoundMaxScan fvFragOff fvMatchedFields
3428− fvPhraseLim)) =
3429− [ "type" .= String "fvh"
3430− , "boundary_chars" .= fvBoundChars
3431− , "boundary_max_scan" .= fvBoundMaxScan
3432− , "fragment_offset" .= fvFragOff
3433− , "matched_fields" .= fvMatchedFields
3434− , "phraseLimit" .= fvPhraseLim]
3435− ++ commonHighlightPairs fvCom
3436− ++ nonPostingsToPairs fvNonPostSettings
3437−
3438−deleteSeveral :: (Eq k, Hashable k) => [k] -> HM.HashMap k v -> HM.HashMap k v
3439−deleteSeveral ks hm = foldr HM.delete hm ks
3440−
3441−commonHighlightPairs :: Maybe CommonHighlight -> [Pair]
3442−commonHighlightPairs Nothing = []
3443−commonHighlightPairs (Just (CommonHighlight chScore chForceSource chTag chEncoder
3444− chNoMatchSize chHighlightQuery
3445− chRequireFieldMatch)) =
3446− [ "order" .= chScore
3447− , "force_source" .= chForceSource
3448− , "encoder" .= chEncoder
3449− , "no_match_size" .= chNoMatchSize
3450− , "highlight_query" .= chHighlightQuery
3451− , "require_fieldMatch" .= chRequireFieldMatch]
3452− ++ highlightTagToPairs chTag
3453−
3454−
3455−nonPostingsToPairs :: Maybe NonPostings -> [Pair]
3456−nonPostingsToPairs Nothing = []
3457−nonPostingsToPairs (Just (NonPostings npFragSize npNumOfFrags)) =
3458− [ "fragment_size" .= npFragSize
3459− , "number_of_fragments" .= npNumOfFrags]
3460−
3461−parseNEJSON :: (FromJSON a) => [Value] -> Parser (NonEmpty a)
3462−parseNEJSON [] = fail "Expected non-empty list"
3463−parseNEJSON (x:xs) = DT.mapM parseJSON (x :| xs)
3464−
3465−
3466−instance ToJSON HighlightEncoder where
3467− toJSON DefaultEncoder = String "default"
3468− toJSON HTMLEncoder = String "html"
3469−
3470−highlightTagToPairs :: Maybe HighlightTag -> [Pair]
3471−highlightTagToPairs (Just (TagSchema _)) = [ "scheme" .= String "default"]
3472−highlightTagToPairs (Just (CustomTags (pre, post))) = [ "pre_tags" .= pre
3473− , "post_tags" .= post]
3474−highlightTagToPairs Nothing = []
3475−
3476−instance ToJSON SortSpec where
3477− toJSON (DefaultSortSpec
3478− (DefaultSort (FieldName dsSortFieldName) dsSortOrder dsIgnoreUnmapped
3479− dsSortMode dsMissingSort dsNestedFilter)) =
3480− object [dsSortFieldName .= omitNulls base] where
3481− base = [ "order" .= dsSortOrder
3482− , "ignore_unmapped" .= dsIgnoreUnmapped
3483− , "mode" .= dsSortMode
3484− , "missing" .= dsMissingSort
3485− , "nested_filter" .= dsNestedFilter ]
3486−
3487− toJSON (GeoDistanceSortSpec gdsSortOrder (GeoPoint (FieldName field) gdsLatLon) units) =
3488− object [ "unit" .= units
3489− , field .= gdsLatLon
3490− , "order" .= gdsSortOrder ]
3491−
3492−
3493−instance ToJSON SortOrder where
3494− toJSON Ascending = String "asc"
3495− toJSON Descending = String "desc"
3496−
3497−
3498−instance ToJSON SortMode where
3499− toJSON SortMin = String "min"
3500− toJSON SortMax = String "max"
3501− toJSON SortSum = String "sum"
3502− toJSON SortAvg = String "avg"
3503−
3504−
3505−instance ToJSON Missing where
3506− toJSON LastMissing = String "_last"
3507− toJSON FirstMissing = String "_first"
3508− toJSON (CustomMissing txt) = String txt
3509−
3510−
3511−instance ToJSON ScoreType where
3512− toJSON ScoreTypeMax = "max"
3513− toJSON ScoreTypeAvg = "avg"
3514− toJSON ScoreTypeSum = "sum"
3515− toJSON ScoreTypeNone = "none"
3516−
3517−instance FromJSON ScoreType where
3518− parseJSON = withText "ScoreType" parse
3519− where parse "max" = pure ScoreTypeMax
3520− parse "avg" = pure ScoreTypeAvg
3521− parse "sum" = pure ScoreTypeSum
3522− parse "none" = pure ScoreTypeNone
3523− parse t = fail ("Unexpected ScoreType: " <> show t)
3524−
3525−instance ToJSON Distance where
3526− toJSON (Distance dCoefficient dUnit) =
3527− String boltedTogether where
3528− coefText = showText dCoefficient
3529− (String unitText) = toJSON dUnit
3530− boltedTogether = mappend coefText unitText
3531−
3532−instance FromJSON Distance where
3533− parseJSON = withText "Distance" parse
3534− where parse t = Distance <$> parseCoeff nT
3535− <*> parseJSON (String unitT)
3536− where (nT, unitT) = T.span validForNumber t
3537− -- may be a better way to do this
3538− validForNumber '-' = True
3539− validForNumber '.' = True
3540− validForNumber 'e' = True
3541− validForNumber c = isNumber c
3542− parseCoeff "" = fail "Empty string cannot be parsed as number"
3543− parseCoeff s = return (read (T.unpack s))
3544−
3545−instance ToJSON DistanceUnit where
3546− toJSON Miles = String "mi"
3547− toJSON Yards = String "yd"
3548− toJSON Feet = String "ft"
3549− toJSON Inches = String "in"
3550− toJSON Kilometers = String "km"
3551− toJSON Meters = String "m"
3552− toJSON Centimeters = String "cm"
3553− toJSON Millimeters = String "mm"
3554− toJSON NauticalMiles = String "nmi"
3555−
3556−
3557−instance FromJSON DistanceUnit where
3558− parseJSON = withText "DistanceUnit" parse
3559− where parse "mi" = pure Miles
3560− parse "yd" = pure Yards
3561− parse "ft" = pure Feet
3562− parse "in" = pure Inches
3563− parse "km" = pure Kilometers
3564− parse "m" = pure Meters
3565− parse "cm" = pure Centimeters
3566− parse "mm" = pure Millimeters
3567− parse "nmi" = pure NauticalMiles
3568− parse u = fail ("Unrecognized DistanceUnit: " <> show u)
3569−
3570−instance ToJSON DistanceType where
3571− toJSON Arc = String "arc"
3572− toJSON SloppyArc = String "sloppy_arc"
3573− toJSON Plane = String "plane"
3574−
3575−instance FromJSON DistanceType where
3576− parseJSON = withText "DistanceType" parse
3577− where parse "arc" = pure Arc
3578− parse "sloppy_arc" = pure SloppyArc
3579− parse "plane" = pure Plane
3580− parse t = fail ("Unrecognized DistanceType: " <> show t)
3581−
3582−
3583−instance ToJSON OptimizeBbox where
3584− toJSON NoOptimizeBbox = String "none"
3585− toJSON (OptimizeGeoFilterType gft) = toJSON gft
3586−
3587−instance FromJSON OptimizeBbox where
3588− parseJSON v = withText "NoOptimizeBbox" parseNoOptimize v
3589− <|> parseOptimize v
3590− where parseNoOptimize "none" = pure NoOptimizeBbox
3591− parseNoOptimize _ = mzero
3592− parseOptimize = fmap OptimizeGeoFilterType . parseJSON
3593−
3594−instance ToJSON GeoBoundingBoxConstraint where
3595− toJSON (GeoBoundingBoxConstraint
3596− (FieldName gbbcGeoBBField) gbbcConstraintBox cache type') =
3597− object [gbbcGeoBBField .= gbbcConstraintBox
3598− , "_cache" .= cache
3599− , "type" .= type']
3600−
3601−instance FromJSON GeoBoundingBoxConstraint where
3602− parseJSON = withObject "GeoBoundingBoxConstraint" parse
3603− where parse o = case HM.toList (deleteSeveral ["type", "_cache"] o) of
3604− [(fn, v)] -> GeoBoundingBoxConstraint (FieldName fn)
3605− <$> parseJSON v
3606− <*> o .:? "_cache" .!= defaultCache
3607− <*> o .: "type"
3608− _ -> fail "Could not find field name for GeoBoundingBoxConstraint"
3609−
3610−instance ToJSON GeoFilterType where
3611− toJSON GeoFilterMemory = String "memory"
3612− toJSON GeoFilterIndexed = String "indexed"
3613−
3614−instance FromJSON GeoFilterType where
3615− parseJSON = withText "GeoFilterType" parse
3616− where parse "memory" = pure GeoFilterMemory
3617− parse "indexed" = pure GeoFilterIndexed
3618− parse t = fail ("Unrecognized GeoFilterType: " <> show t)
3619−
3620−instance ToJSON GeoBoundingBox where
3621− toJSON (GeoBoundingBox gbbTopLeft gbbBottomRight) =
3622− object ["top_left" .= gbbTopLeft
3623− , "bottom_right" .= gbbBottomRight]
3624−
3625−instance FromJSON GeoBoundingBox where
3626− parseJSON = withObject "GeoBoundingBox" parse
3627− where parse o = GeoBoundingBox
3628− <$> o .: "top_left"
3629− <*> o .: "bottom_right"
3630−
3631−instance ToJSON LatLon where
3632− toJSON (LatLon lLat lLon) =
3633− object ["lat" .= lLat
3634− , "lon" .= lLon]
3635−
3636−instance FromJSON LatLon where
3637− parseJSON = withObject "LatLon" parse
3638− where parse o = LatLon <$> o .: "lat"
3639− <*> o .: "lon"
3640−
3641−-- index for smaller ranges, fielddata for longer ranges
3642−instance ToJSON RangeExecution where
3643− toJSON RangeExecutionIndex = "index"
3644− toJSON RangeExecutionFielddata = "fielddata"
3645−
3646−
3647−instance FromJSON RangeExecution where
3648− parseJSON = withText "RangeExecution" parse
3649− where parse "index" = pure RangeExecutionIndex
3650− parse "fielddata" = pure RangeExecutionFielddata
3651− parse t = error ("Unrecognized RangeExecution " <> show t)
3652−
3653−instance ToJSON RegexpFlags where
3654− toJSON AllRegexpFlags = String "ALL"
3655− toJSON NoRegexpFlags = String "NONE"
3656− toJSON (SomeRegexpFlags (h :| fs)) = String $ T.intercalate "|" flagStrs
3657− where flagStrs = map flagStr . nub $ h:fs
3658− flagStr AnyString = "ANYSTRING"
3659− flagStr Automaton = "AUTOMATON"
3660− flagStr Complement = "COMPLEMENT"
3661− flagStr Empty = "EMPTY"
3662− flagStr Intersection = "INTERSECTION"
3663− flagStr Interval = "INTERVAL"
3664−
3665−instance FromJSON RegexpFlags where
3666− parseJSON = withText "RegexpFlags" parse
3667− where parse "ALL" = pure AllRegexpFlags
3668− parse "NONE" = pure NoRegexpFlags
3669− parse t = SomeRegexpFlags <$> parseNEJSON (String <$> T.splitOn "|" t)
3670−
3671−instance FromJSON RegexpFlag where
3672− parseJSON = withText "RegexpFlag" parse
3673− where parse "ANYSTRING" = pure AnyString
3674− parse "AUTOMATON" = pure Automaton
3675− parse "COMPLEMENT" = pure Complement
3676− parse "EMPTY" = pure Empty
3677− parse "INTERSECTION" = pure Intersection
3678− parse "INTERVAL" = pure Interval
3679− parse f = fail ("Unknown RegexpFlag: " <> show f)
3680−
3681−instance ToJSON Term where
3682− toJSON (Term field value) = object ["term" .= object
3683− [field .= value]]
3684−
3685−instance FromJSON Term where
3686− parseJSON = withObject "Term" parse
3687− where parse o = do termObj <- o .: "term"
3688− case HM.toList termObj of
3689− [(fn, v)] -> Term fn <$> parseJSON v
3690− _ -> fail "Expected object with 1 field-named key"
3691−
3692−instance ToJSON BoolMatch where
3693− toJSON (MustMatch term cache) = object ["must" .= term,
3694− "_cache" .= cache]
3695− toJSON (MustNotMatch term cache) = object ["must_not" .= term,
3696− "_cache" .= cache]
3697− toJSON (ShouldMatch terms cache) = object ["should" .= fmap toJSON terms,
3698− "_cache" .= cache]
3699−
3700−instance FromJSON BoolMatch where
3701− parseJSON = withObject "BoolMatch" parse
3702− where parse o = mustMatch `taggedWith` "must"
3703− <|> mustNotMatch `taggedWith` "must_not"
3704− <|> shouldMatch `taggedWith` "should"
3705− where taggedWith parser k = parser =<< o .: k
3706− mustMatch t = MustMatch t <$> o .:? "_cache" .!= defaultCache
3707− mustNotMatch t = MustNotMatch t <$> o .:? "_cache" .!= defaultCache
3708− shouldMatch t = ShouldMatch t <$> o .:? "_cache" .!= defaultCache
3709
528
3710instance (FromJSON a) => FromJSON (SearchResult a) where
529instance (FromJSON a) => FromJSON (SearchResult a) where
3711 parseJSON (Object v) = SearchResult <$>
530 parseJSON (Object v) = SearchResult <$>
@@ -3714,1501 +533,10 @@ instance (FromJSON a) => FromJSON (SearchResult a) where
3714 v .: "_shards" <*>
533 v .: "_shards" <*>
3715 v .: "hits" <*>
534 v .: "hits" <*>
3716 v .:? "aggregations" <*>
535 v .:? "aggregations" <*>
3717− v .:? "_scroll_id"
536+ v .:? "_scroll_id" <*>
3718− parseJSON _ = empty
537+ v .:? "suggest"
3719−
3720−instance (FromJSON a) => FromJSON (SearchHits a) where
3721− parseJSON (Object v) = SearchHits <$>
3722− v .: "total" <*>
3723− v .: "max_score" <*>
3724− v .: "hits"
3725 parseJSON _ = empty
538 parseJSON _ = empty
3726
539
3727−instance (FromJSON a) => FromJSON (Hit a) where
540+newtype ScrollId =
3728− parseJSON (Object v) = Hit <$>
541+ ScrollId Text
3729− v .: "_index" <*>
542+ deriving (Eq, Show, Ord, ToJSON, FromJSON)
3730− v .: "_type" <*>
3731− v .: "_id" <*>
3732− v .: "_score" <*>
3733− v .:? "_source" <*>
3734− v .:? "highlight"
3735− parseJSON _ = empty
3736−
3737−instance FromJSON ShardResult where
3738− parseJSON (Object v) = ShardResult <$>
3739− v .: "total" <*>
3740− v .: "successful" <*>
3741− v .: "failed"
3742− parseJSON _ = empty
3743−
3744−
3745−instance FromJSON DocVersion where
3746− parseJSON v = do
3747− i <- parseJSON v
3748− maybe (fail "DocVersion out of range") return $ mkDocVersion i
3749−
3750−-- This insanity is because ES *sometimes* returns Replica/Shard counts as strings
3751−instance FromJSON ReplicaCount where
3752− parseJSON v = parseAsInt v
3753− <|> parseAsString v
3754− where parseAsInt = fmap ReplicaCount . parseJSON
3755− parseAsString = withText "ReplicaCount" (fmap ReplicaCount . parseReadText)
3756−
3757−instance FromJSON ShardCount where
3758− parseJSON v = parseAsInt v
3759− <|> parseAsString v
3760− where parseAsInt = fmap ShardCount . parseJSON
3761− parseAsString = withText "ShardCount" (fmap ShardCount . parseReadText)
3762−
3763−instance Bounded DocVersion where
3764− minBound = DocVersion 1
3765− maxBound = DocVersion 9200000000000000000 -- 9.2e+18
3766−
3767−instance Enum DocVersion where
3768− succ x
3769− | x /= maxBound = DocVersion (succ $ docVersionNumber x)
3770− | otherwise = succError "DocVersion"
3771− pred x
3772− | x /= minBound = DocVersion (pred $ docVersionNumber x)
3773− | otherwise = predError "DocVersion"
3774− toEnum i =
3775− fromMaybe (error $ show i ++ " out of DocVersion range") $ mkDocVersion i
3776− fromEnum = docVersionNumber
3777− enumFrom = boundedEnumFrom
3778− enumFromThen = boundedEnumFromThen
3779−
3780−-- | Username type used for HTTP Basic authentication. See 'basicAuthHook'.
3781−newtype EsUsername = EsUsername { esUsername :: Text } deriving (Read, Show, Eq)
3782−
3783−-- | Password type used for HTTP Basic authentication. See 'basicAuthHook'.
3784−newtype EsPassword = EsPassword { esPassword :: Text } deriving (Read, Show, Eq)
3785−
3786−
3787−data SnapshotRepoSelection = SnapshotRepoList (NonEmpty SnapshotRepoPattern)
3788− | AllSnapshotRepos deriving (Eq, Generic, Show, Typeable)
3789−
3790−
3791−-- | Either specifies an exact repo name or one with globs in it,
3792−-- e.g. @RepoPattern "foo*"@ __NOTE__: Patterns are not supported on ES < 1.7
3793−data SnapshotRepoPattern = ExactRepo SnapshotRepoName
3794− | RepoPattern Text
3795− deriving (Eq, Generic, Show, Typeable)
3796−
3797−-- | The unique name of a snapshot repository.
3798−newtype SnapshotRepoName = SnapshotRepoName { snapshotRepoName :: Text }
3799− deriving (Eq, Ord, Generic, Show, Typeable, ToJSON, FromJSON)
3800−
3801−
3802−-- | A generic representation of a snapshot repo. This is what gets
3803−-- sent to and parsed from the server. For repo types enabled by
3804−-- plugins that aren't exported by this library, consider making a
3805−-- custom type which implements 'SnapshotRepo'. If it is a common repo
3806−-- type, consider submitting a pull request to have it included in the
3807−-- library proper
3808−data GenericSnapshotRepo = GenericSnapshotRepo {
3809− gSnapshotRepoName :: SnapshotRepoName
3810− , gSnapshotRepoType :: SnapshotRepoType
3811− , gSnapshotRepoSettings :: GenericSnapshotRepoSettings
3812− } deriving (Eq, Generic, Show, Typeable)
3813−
3814−
3815−instance SnapshotRepo GenericSnapshotRepo where
3816− toGSnapshotRepo = id
3817− fromGSnapshotRepo = Right
3818−
3819−
3820−newtype SnapshotRepoType = SnapshotRepoType { snapshotRepoType :: Text }
3821− deriving (Eq, Ord, Generic, Show, Typeable, ToJSON, FromJSON)
3822−
3823−
3824−-- | Opaque representation of snapshot repo settings. Instances of
3825−-- 'SnapshotRepo' will produce this.
3826−newtype GenericSnapshotRepoSettings = GenericSnapshotRepoSettings { gSnapshotRepoSettingsObject :: Object }
3827− deriving (Eq, Generic, Show, Typeable, ToJSON)
3828−
3829−
3830− -- Regardless of whether you send strongly typed json, my version of
3831− -- ES sends back stringly typed json in the settings, e.g. booleans
3832− -- as strings, so we'll try to convert them.
3833−instance FromJSON GenericSnapshotRepoSettings where
3834− parseJSON = fmap (GenericSnapshotRepoSettings . fmap unStringlyTypeJSON). parseJSON
3835−
3836−-- | The result of running 'verifySnapshotRepo'.
3837−newtype SnapshotVerification = SnapshotVerification { snapshotNodeVerifications :: [SnapshotNodeVerification] }
3838− deriving (Eq, Generic, Show, Typeable)
3839−
3840−
3841−instance FromJSON SnapshotVerification where
3842− parseJSON = withObject "SnapshotVerification" parse
3843− where
3844− parse o = do
3845− o2 <- o .: "nodes"
3846− SnapshotVerification <$> mapM (uncurry parse') (HM.toList o2)
3847− parse' rawFullId = withObject "SnapshotNodeVerification" $ \o ->
3848− SnapshotNodeVerification (FullNodeId rawFullId) <$> o .: "name"
3849−
3850−
3851−-- | A node that has verified a snapshot
3852−data SnapshotNodeVerification = SnapshotNodeVerification {
3853− snvFullId :: FullNodeId
3854− , snvNodeName :: NodeName
3855− } deriving (Eq, Generic, Show, Typeable)
3856−
3857−
3858−-- | Unique, automatically-generated name assigned to nodes that are
3859−-- usually returned in node-oriented APIs.
3860−newtype FullNodeId = FullNodeId { fullNodeId :: Text }
3861− deriving (Eq, Ord, Generic, Show, Typeable, FromJSON)
3862−
3863−
3864−-- | A human-readable node name that is supplied by the user in the
3865−-- node config or automatically generated by ElasticSearch.
3866−newtype NodeName = NodeName { nodeName :: Text }
3867− deriving (Eq, Ord, Generic, Show, Typeable, FromJSON)
3868−
3869−newtype ClusterName = ClusterName { clusterName :: Text }
3870− deriving (Eq, Ord, Generic, Show, Typeable, FromJSON)
3871−
3872−data NodesInfo = NodesInfo {
3873− nodesInfo :: [NodeInfo]
3874− , nodesClusterName :: ClusterName
3875− } deriving (Eq, Show, Generic, Typeable)
3876−
3877−data NodesStats = NodesStats {
3878− nodesStats :: [NodeStats]
3879− , nodesStatsClusterName :: ClusterName
3880− } deriving (Eq, Show, Generic, Typeable)
3881−
3882−data NodeStats = NodeStats {
3883− nodeStatsName :: NodeName
3884− , nodeStatsFullId :: FullNodeId
3885− , nodeStatsBreakersStats :: Maybe NodeBreakersStats
3886− , nodeStatsHTTP :: NodeHTTPStats
3887− , nodeStatsTransport :: NodeTransportStats
3888− , nodeStatsFS :: NodeFSStats
3889− , nodeStatsNetwork :: NodeNetworkStats
3890− , nodeStatsThreadPool :: NodeThreadPoolsStats
3891− , nodeStatsJVM :: NodeJVMStats
3892− , nodeStatsProcess :: NodeProcessStats
3893− , nodeStatsOS :: NodeOSStats
3894− , nodeStatsIndices :: NodeIndicesStats
3895− } deriving (Eq, Show, Generic, Typeable)
3896−
3897−data NodeBreakersStats = NodeBreakersStats {
3898− nodeStatsParentBreaker :: NodeBreakerStats
3899− , nodeStatsRequestBreaker :: NodeBreakerStats
3900− , nodeStatsFieldDataBreaker :: NodeBreakerStats
3901− } deriving (Eq, Show, Generic, Typeable)
3902−
3903−data NodeBreakerStats = NodeBreakerStats {
3904− nodeBreakersTripped :: Int
3905− , nodeBreakersOverhead :: Double
3906− , nodeBreakersEstSize :: Bytes
3907− , nodeBreakersLimitSize :: Bytes
3908− } deriving (Eq, Show, Generic, Typeable)
3909−
3910−data NodeHTTPStats = NodeHTTPStats {
3911− nodeHTTPTotalOpened :: Int
3912− , nodeHTTPCurrentOpen :: Int
3913− } deriving (Eq, Show, Generic, Typeable)
3914−
3915−data NodeTransportStats = NodeTransportStats {
3916− nodeTransportTXSize :: Bytes
3917− , nodeTransportCount :: Int
3918− , nodeTransportRXSize :: Bytes
3919− , nodeTransportRXCount :: Int
3920− , nodeTransportServerOpen :: Int
3921− } deriving (Eq, Show, Generic, Typeable)
3922−
3923−data NodeFSStats = NodeFSStats {
3924− nodeFSDataPaths :: [NodeDataPathStats]
3925− , nodeFSTotal :: NodeFSTotalStats
3926− , nodeFSTimestamp :: UTCTime
3927− } deriving (Eq, Show, Generic, Typeable)
3928−
3929−data NodeDataPathStats = NodeDataPathStats {
3930− nodeDataPathDiskServiceTime :: Maybe Double
3931− , nodeDataPathDiskQueue :: Maybe Double
3932− , nodeDataPathIOSize :: Maybe Bytes
3933− , nodeDataPathWriteSize :: Maybe Bytes
3934− , nodeDataPathReadSize :: Maybe Bytes
3935− , nodeDataPathIOOps :: Maybe Int
3936− , nodeDataPathWrites :: Maybe Int
3937− , nodeDataPathReads :: Maybe Int
3938− , nodeDataPathAvailable :: Bytes
3939− , nodeDataPathFree :: Bytes
3940− , nodeDataPathTotal :: Bytes
3941− , nodeDataPathType :: Maybe Text
3942− , nodeDataPathDevice :: Text
3943− , nodeDataPathMount :: Text
3944− , nodeDataPathPath :: Text
3945− } deriving (Eq, Show, Generic, Typeable)
3946−
3947−data NodeFSTotalStats = NodeFSTotalStats {
3948− nodeFSTotalDiskServiceTime :: Maybe Double
3949− , nodeFSTotalDiskQueue :: Maybe Double
3950− , nodeFSTotalIOSize :: Maybe Bytes
3951− , nodeFSTotalWriteSize :: Maybe Bytes
3952− , nodeFSTotalReadSize :: Maybe Bytes
3953− , nodeFSTotalIOOps :: Maybe Int
3954− , nodeFSTotalWrites :: Maybe Int
3955− , nodeFSTotalReads :: Maybe Int
3956− , nodeFSTotalAvailable :: Bytes
3957− , nodeFSTotalFree :: Bytes
3958− , nodeFSTotalTotal :: Bytes
3959− } deriving (Eq, Show, Generic, Typeable)
3960−
3961−data NodeNetworkStats = NodeNetworkStats {
3962− nodeNetTCPOutRSTs :: Int
3963− , nodeNetTCPInErrs :: Int
3964− , nodeNetTCPAttemptFails :: Int
3965− , nodeNetTCPEstabResets :: Int
3966− , nodeNetTCPRetransSegs :: Int
3967− , nodeNetTCPOutSegs :: Int
3968− , nodeNetTCPInSegs :: Int
3969− , nodeNetTCPCurrEstab :: Int
3970− , nodeNetTCPPassiveOpens :: Int
3971− , nodeNetTCPActiveOpens :: Int
3972− } deriving (Eq, Show, Generic, Typeable)
3973−
3974−data NodeThreadPoolsStats = NodeThreadPoolsStats {
3975− nodeThreadPoolsStatsSnapshot :: NodeThreadPoolStats
3976− , nodeThreadPoolsStatsBulk :: NodeThreadPoolStats
3977− , nodeThreadPoolsStatsMerge :: NodeThreadPoolStats
3978− , nodeThreadPoolsStatsGet :: NodeThreadPoolStats
3979− , nodeThreadPoolsStatsManagement :: NodeThreadPoolStats
3980− , nodeThreadPoolsStatsFetchShardStore :: Maybe NodeThreadPoolStats
3981− , nodeThreadPoolsStatsOptimize :: NodeThreadPoolStats
3982− , nodeThreadPoolsStatsFlush :: NodeThreadPoolStats
3983− , nodeThreadPoolsStatsSearch :: NodeThreadPoolStats
3984− , nodeThreadPoolsStatsWarmer :: NodeThreadPoolStats
3985− , nodeThreadPoolsStatsGeneric :: NodeThreadPoolStats
3986− , nodeThreadPoolsStatsSuggest :: NodeThreadPoolStats
3987− , nodeThreadPoolsStatsRefresh :: NodeThreadPoolStats
3988− , nodeThreadPoolsStatsIndex :: NodeThreadPoolStats
3989− , nodeThreadPoolsStatsListener :: Maybe NodeThreadPoolStats
3990− , nodeThreadPoolsStatsFetchShardStarted :: Maybe NodeThreadPoolStats
3991− , nodeThreadPoolsStatsPercolate :: NodeThreadPoolStats
3992− } deriving (Eq, Show, Generic, Typeable)
3993−
3994−data NodeThreadPoolStats = NodeThreadPoolStats {
3995− nodeThreadPoolCompleted :: Int
3996− , nodeThreadPoolLargest :: Int
3997− , nodeThreadPoolRejected :: Int
3998− , nodeThreadPoolActive :: Int
3999− , nodeThreadPoolQueue :: Int
4000− , nodeThreadPoolThreads :: Int
4001− } deriving (Eq, Show, Generic, Typeable)
4002−
4003−data NodeJVMStats = NodeJVMStats {
4004− nodeJVMStatsMappedBufferPool :: JVMBufferPoolStats
4005− , nodeJVMStatsDirectBufferPool :: JVMBufferPoolStats
4006− , nodeJVMStatsGCOldCollector :: JVMGCStats
4007− , nodeJVMStatsGCYoungCollector :: JVMGCStats
4008− , nodeJVMStatsPeakThreadsCount :: Int
4009− , nodeJVMStatsThreadsCount :: Int
4010− , nodeJVMStatsOldPool :: JVMPoolStats
4011− , nodeJVMStatsSurvivorPool :: JVMPoolStats
4012− , nodeJVMStatsYoungPool :: JVMPoolStats
4013− , nodeJVMStatsNonHeapCommitted :: Bytes
4014− , nodeJVMStatsNonHeapUsed :: Bytes
4015− , nodeJVMStatsHeapMax :: Bytes
4016− , nodeJVMStatsHeapCommitted :: Bytes
4017− , nodeJVMStatsHeapUsedPercent :: Int
4018− , nodeJVMStatsHeapUsed :: Bytes
4019− , nodeJVMStatsUptime :: NominalDiffTime
4020− , nodeJVMStatsTimestamp :: UTCTime
4021− } deriving (Eq, Show, Generic, Typeable)
4022−
4023−data JVMBufferPoolStats = JVMBufferPoolStats {
4024− jvmBufferPoolStatsTotalCapacity :: Bytes
4025− , jvmBufferPoolStatsUsed :: Bytes
4026− , jvmBufferPoolStatsCount :: Int
4027− } deriving (Eq, Show, Generic, Typeable)
4028−
4029−data JVMGCStats = JVMGCStats {
4030− jvmGCStatsCollectionTime :: NominalDiffTime
4031− , jvmGCStatsCollectionCount :: Int
4032− } deriving (Eq, Show, Generic, Typeable)
4033−
4034−data JVMPoolStats = JVMPoolStats {
4035− jvmPoolStatsPeakMax :: Bytes
4036− , jvmPoolStatsPeakUsed :: Bytes
4037− , jvmPoolStatsMax :: Bytes
4038− , jvmPoolStatsUsed :: Bytes
4039− } deriving (Eq, Show, Generic, Typeable)
4040−
4041−data NodeProcessStats = NodeProcessStats {
4042− nodeProcessMemTotalVirtual :: Bytes
4043− , nodeProcessMemShare :: Bytes
4044− , nodeProcessMemResident :: Bytes
4045− , nodeProcessCPUTotal :: NominalDiffTime
4046− , nodeProcessCPUUser :: NominalDiffTime
4047− , nodeProcessCPUSys :: NominalDiffTime
4048− , nodeProcessCPUPercent :: Int
4049− , nodeProcessOpenFDs :: Int
4050− , nodeProcessTimestamp :: UTCTime
4051− } deriving (Eq, Show, Generic, Typeable)
4052−
4053−data NodeOSStats = NodeOSStats {
4054− nodeOSSwapFree :: Bytes
4055− , nodeOSSwapUsed :: Bytes
4056− , nodeOSMemActualUsed :: Bytes
4057− , nodeOSMemActualFree :: Bytes
4058− , nodeOSMemUsedPercent :: Int
4059− , nodeOSMemFreePercent :: Int
4060− , nodeOSMemUsed :: Bytes
4061− , nodeOSMemFree :: Bytes
4062− , nodeOSCPUStolen :: Int
4063− , nodeOSCPUUsage :: Int
4064− , nodeOSCPUIdle :: Int
4065− , nodeOSCPUUser :: Int
4066− , nodeOSCPUSys :: Int
4067− , nodeOSLoad :: LoadAvgs
4068− , nodeOSUptime :: NominalDiffTime
4069− , nodeOSTimestamp :: UTCTime
4070− } deriving (Eq, Show, Generic, Typeable)
4071−
4072−data LoadAvgs = LoadAvgs {
4073− loadAvg1Min :: Double
4074− , loadAvg5Min :: Double
4075− , loadAvg15Min :: Double
4076− } deriving (Eq, Show, Generic, Typeable)
4077−
4078−data NodeIndicesStats = NodeIndicesStats {
4079− nodeIndicesStatsRecoveryThrottleTime :: Maybe NominalDiffTime
4080− , nodeIndicesStatsRecoveryCurrentAsTarget :: Maybe Int
4081− , nodeIndicesStatsRecoveryCurrentAsSource :: Maybe Int
4082− , nodeIndicesStatsQueryCacheMisses :: Maybe Int
4083− , nodeIndicesStatsQueryCacheHits :: Maybe Int
4084− , nodeIndicesStatsQueryCacheEvictions :: Maybe Int
4085− , nodeIndicesStatsQueryCacheSize :: Maybe Bytes
4086− , nodeIndicesStatsSuggestCurrent :: Int
4087− , nodeIndicesStatsSuggestTime :: NominalDiffTime
4088− , nodeIndicesStatsSuggestTotal :: Int
4089− , nodeIndicesStatsTranslogSize :: Bytes
4090− , nodeIndicesStatsTranslogOps :: Int
4091− , nodeIndicesStatsSegFixedBitSetMemory :: Maybe Bytes
4092− , nodeIndicesStatsSegVersionMapMemory :: Bytes
4093− , nodeIndicesStatsSegIndexWriterMaxMemory :: Maybe Bytes
4094− , nodeIndicesStatsSegIndexWriterMemory :: Bytes
4095− , nodeIndicesStatsSegMemory :: Bytes
4096− , nodeIndicesStatsSegCount :: Int
4097− , nodeIndicesStatsCompletionSize :: Bytes
4098− , nodeIndicesStatsPercolateQueries :: Int
4099− , nodeIndicesStatsPercolateMemory :: Bytes
4100− , nodeIndicesStatsPercolateCurrent :: Int
4101− , nodeIndicesStatsPercolateTime :: NominalDiffTime
4102− , nodeIndicesStatsPercolateTotal :: Int
4103− , nodeIndicesStatsFieldDataEvictions :: Int
4104− , nodeIndicesStatsFieldDataMemory :: Bytes
4105− , nodeIndicesStatsIDCacheMemory :: Bytes
4106− , nodeIndicesStatsFilterCacheEvictions :: Int
4107− , nodeIndicesStatsFilterCacheMemory :: Bytes
4108− , nodeIndicesStatsWarmerTotalTime :: NominalDiffTime
4109− , nodeIndicesStatsWarmerTotal :: Int
4110− , nodeIndicesStatsWarmerCurrent :: Int
4111− , nodeIndicesStatsFlushTotalTime :: NominalDiffTime
4112− , nodeIndicesStatsFlushTotal :: Int
4113− , nodeIndicesStatsRefreshTotalTime :: NominalDiffTime
4114− , nodeIndicesStatsRefreshTotal :: Int
4115− , nodeIndicesStatsMergesTotalSize :: Bytes
4116− , nodeIndicesStatsMergesTotalDocs :: Int
4117− , nodeIndicesStatsMergesTotalTime :: NominalDiffTime
4118− , nodeIndicesStatsMergesTotal :: Int
4119− , nodeIndicesStatsMergesCurrentSize :: Bytes
4120− , nodeIndicesStatsMergesCurrentDocs :: Int
4121− , nodeIndicesStatsMergesCurrent :: Int
4122− , nodeIndicesStatsSearchFetchCurrent :: Int
4123− , nodeIndicesStatsSearchFetchTime :: NominalDiffTime
4124− , nodeIndicesStatsSearchFetchTotal :: Int
4125− , nodeIndicesStatsSearchQueryCurrent :: Int
4126− , nodeIndicesStatsSearchQueryTime :: NominalDiffTime
4127− , nodeIndicesStatsSearchQueryTotal :: Int
4128− , nodeIndicesStatsSearchOpenContexts :: Int
4129− , nodeIndicesStatsGetCurrent :: Int
4130− , nodeIndicesStatsGetMissingTime :: NominalDiffTime
4131− , nodeIndicesStatsGetMissingTotal :: Int
4132− , nodeIndicesStatsGetExistsTime :: NominalDiffTime
4133− , nodeIndicesStatsGetExistsTotal :: Int
4134− , nodeIndicesStatsGetTime :: NominalDiffTime
4135− , nodeIndicesStatsGetTotal :: Int
4136− , nodeIndicesStatsIndexingThrottleTime :: Maybe NominalDiffTime
4137− , nodeIndicesStatsIndexingIsThrottled :: Maybe Bool
4138− , nodeIndicesStatsIndexingNoopUpdateTotal :: Maybe Int
4139− , nodeIndicesStatsIndexingDeleteCurrent :: Int
4140− , nodeIndicesStatsIndexingDeleteTime :: NominalDiffTime
4141− , nodeIndicesStatsIndexingDeleteTotal :: Int
4142− , nodeIndicesStatsIndexingIndexCurrent :: Int
4143− , nodeIndicesStatsIndexingIndexTime :: NominalDiffTime
4144− , nodeIndicesStatsIndexingTotal :: Int
4145− , nodeIndicesStatsStoreThrottleTime :: NominalDiffTime
4146− , nodeIndicesStatsStoreSize :: Bytes
4147− , nodeIndicesStatsDocsDeleted :: Int
4148− , nodeIndicesStatsDocsCount :: Int
4149− } deriving (Eq, Show, Generic, Typeable)
4150−
4151−-- | A quirky address format used throughout ElasticSearch. An example
4152−-- would be inet[/1.1.1.1:9200]. inet may be a placeholder for a
4153−-- <https://en.wikipedia.org/wiki/Fully_qualified_domain_name FQDN>.
4154−newtype EsAddress = EsAddress { esAddress :: Text }
4155− deriving (Eq, Ord, Generic, Show, Typeable, FromJSON)
4156−
4157−-- | Typically a 7 character hex string.
4158−newtype BuildHash = BuildHash { buildHash :: Text }
4159− deriving (Eq, Ord, Generic, Read, Show, Typeable, FromJSON, ToJSON)
4160−
4161−newtype PluginName = PluginName { pluginName :: Text }
4162− deriving (Eq, Ord, Generic, Show, Typeable, FromJSON)
4163−
4164−data NodeInfo = NodeInfo {
4165− nodeInfoHTTPAddress :: EsAddress
4166− , nodeInfoBuild :: BuildHash
4167− , nodeInfoESVersion :: VersionNumber
4168− , nodeInfoIP :: Server
4169− , nodeInfoHost :: Server
4170− , nodeInfoTransportAddress :: EsAddress
4171− , nodeInfoName :: NodeName
4172− , nodeInfoFullId :: FullNodeId
4173− , nodeInfoPlugins :: [NodePluginInfo]
4174− , nodeInfoHTTP :: NodeHTTPInfo
4175− , nodeInfoTransport :: NodeTransportInfo
4176− , nodeInfoNetwork :: NodeNetworkInfo
4177− , nodeInfoThreadPool :: NodeThreadPoolsInfo
4178− , nodeInfoJVM :: NodeJVMInfo
4179− , nodeInfoProcess :: NodeProcessInfo
4180− , nodeInfoOS :: NodeOSInfo
4181− , nodeInfoSettings :: Object
4182− -- ^ The members of the settings objects are not consistent,
4183− -- dependent on plugins, etc.
4184− } deriving (Eq, Show, Generic, Typeable)
4185−
4186−data NodePluginInfo = NodePluginInfo {
4187− nodePluginSite :: Bool
4188− -- ^ Is this a site plugin?
4189− , nodePluginJVM :: Bool
4190− -- ^ Is this plugin running on the JVM
4191− , nodePluginDescription :: Text
4192− , nodePluginVersion :: VersionNumber
4193− , nodePluginName :: PluginName
4194− } deriving (Eq, Show, Generic, Typeable)
4195−
4196−data NodeHTTPInfo = NodeHTTPInfo {
4197− nodeHTTPMaxContentLength :: Bytes
4198− , nodeHTTPTransportAddress :: BoundTransportAddress
4199− } deriving (Eq, Show, Generic, Typeable)
4200−
4201−data NodeTransportInfo = NodeTransportInfo {
4202− nodeTransportProfiles :: [BoundTransportAddress]
4203− , nodeTransportAddress :: BoundTransportAddress
4204− } deriving (Eq, Show, Generic, Typeable)
4205−
4206−data BoundTransportAddress = BoundTransportAddress {
4207− publishAddress :: EsAddress
4208− , boundAddress :: EsAddress
4209− } deriving (Eq, Show, Generic, Typeable)
4210−
4211−data NodeNetworkInfo = NodeNetworkInfo {
4212− nodeNetworkPrimaryInterface :: NodeNetworkInterface
4213− , nodeNetworkRefreshInterval :: NominalDiffTime
4214− } deriving (Eq, Show, Generic, Typeable)
4215−
4216−newtype MacAddress = MacAddress { macAddress :: Text }
4217− deriving (Eq, Ord, Generic, Show, Typeable, FromJSON)
4218−
4219−newtype NetworkInterfaceName = NetworkInterfaceName { networkInterfaceName :: Text }
4220− deriving (Eq, Ord, Generic, Show, Typeable, FromJSON)
4221−
4222−data NodeNetworkInterface = NodeNetworkInterface {
4223− nodeNetIfaceMacAddress :: MacAddress
4224− , nodeNetIfaceName :: NetworkInterfaceName
4225− , nodeNetIfaceAddress :: Server
4226− } deriving (Eq, Show, Generic, Typeable)
4227−
4228−data NodeThreadPoolsInfo = NodeThreadPoolsInfo {
4229− nodeThreadPoolsRefresh :: NodeThreadPoolInfo
4230− , nodeThreadPoolsManagement :: NodeThreadPoolInfo
4231− , nodeThreadPoolsPercolate :: NodeThreadPoolInfo
4232− , nodeThreadPoolsListener :: Maybe NodeThreadPoolInfo
4233− , nodeThreadPoolsFetchShardStarted :: Maybe NodeThreadPoolInfo
4234− , nodeThreadPoolsSearch :: NodeThreadPoolInfo
4235− , nodeThreadPoolsFlush :: NodeThreadPoolInfo
4236− , nodeThreadPoolsWarmer :: NodeThreadPoolInfo
4237− , nodeThreadPoolsOptimize :: NodeThreadPoolInfo
4238− , nodeThreadPoolsBulk :: NodeThreadPoolInfo
4239− , nodeThreadPoolsSuggest :: NodeThreadPoolInfo
4240− , nodeThreadPoolsMerge :: NodeThreadPoolInfo
4241− , nodeThreadPoolsSnapshot :: NodeThreadPoolInfo
4242− , nodeThreadPoolsGet :: NodeThreadPoolInfo
4243− , nodeThreadPoolsFetchShardStore :: Maybe NodeThreadPoolInfo
4244− , nodeThreadPoolsIndex :: NodeThreadPoolInfo
4245− , nodeThreadPoolsGeneric :: NodeThreadPoolInfo
4246− } deriving (Eq, Show, Generic, Typeable)
4247−
4248−data NodeThreadPoolInfo = NodeThreadPoolInfo {
4249− nodeThreadPoolQueueSize :: ThreadPoolSize
4250− , nodeThreadPoolKeepalive :: Maybe NominalDiffTime
4251− , nodeThreadPoolMin :: Maybe Int
4252− , nodeThreadPoolMax :: Maybe Int
4253− , nodeThreadPoolType :: ThreadPoolType
4254− } deriving (Eq, Show, Generic, Typeable)
4255−
4256−data ThreadPoolSize = ThreadPoolBounded Int
4257− | ThreadPoolUnbounded
4258− deriving (Eq, Show, Generic, Typeable)
4259−
4260−data ThreadPoolType = ThreadPoolScaling
4261− | ThreadPoolFixed
4262− | ThreadPoolCached
4263− deriving (Eq, Show, Generic, Typeable)
4264−
4265−data NodeJVMInfo = NodeJVMInfo {
4266− nodeJVMInfoMemoryPools :: [JVMMemoryPool]
4267− , nodeJVMInfoMemoryPoolsGCCollectors :: [JVMGCCollector]
4268− , nodeJVMInfoMemoryInfo :: JVMMemoryInfo
4269− , nodeJVMInfoStartTime :: UTCTime
4270− , nodeJVMInfoVMVendor :: Text
4271− , nodeJVMVMVersion :: VersionNumber
4272− -- ^ JVM doesn't seme to follow normal version conventions
4273− , nodeJVMVMName :: Text
4274− , nodeJVMVersion :: VersionNumber
4275− , nodeJVMPID :: PID
4276− } deriving (Eq, Show, Generic, Typeable)
4277−
4278−-- | Handles quirks in the way JVM versions are rendered (1.7.0_101 -> 1.7.0.101)
4279−newtype JVMVersion = JVMVersion { unJVMVersion :: VersionNumber }
4280−
4281−data JVMMemoryInfo = JVMMemoryInfo {
4282− jvmMemoryInfoDirectMax :: Bytes
4283− , jvmMemoryInfoNonHeapMax :: Bytes
4284− , jvmMemoryInfoNonHeapInit :: Bytes
4285− , jvmMemoryInfoHeapMax :: Bytes
4286− , jvmMemoryInfoHeapInit :: Bytes
4287− } deriving (Eq, Show, Generic, Typeable)
4288−
4289−newtype JVMMemoryPool = JVMMemoryPool {
4290− jvmMemoryPool :: Text
4291− } deriving (Eq, Show, Generic, Typeable, FromJSON)
4292−
4293−newtype JVMGCCollector = JVMGCCollector {
4294− jvmGCCollector :: Text
4295− } deriving (Eq, Show, Generic, Typeable, FromJSON)
4296−
4297−newtype PID = PID {
4298− pid :: Int
4299− } deriving (Eq, Show, Generic, Typeable, FromJSON)
4300−
4301−data NodeOSInfo = NodeOSInfo {
4302− nodeOSSwap :: Bytes
4303− , nodeOSMem :: Bytes
4304− , nodeOSCPUInfo :: CPUInfo
4305− , nodeOSAvailableProcessors :: Int
4306− , nodeOSRefreshInterval :: NominalDiffTime
4307− } deriving (Eq, Show, Generic, Typeable)
4308−
4309−data CPUInfo = CPUInfo {
4310− cpuCacheSize :: Bytes
4311− , cpuCoresPerSocket :: Int
4312− , cpuTotalSockets :: Int
4313− , cpuTotalCores :: Int
4314− , cpuMHZ :: Int
4315− , cpuModel :: Text
4316− , cpuVendor :: Text
4317− } deriving (Eq, Show, Generic, Typeable)
4318−
4319−data NodeProcessInfo = NodeProcessInfo {
4320− nodeProcessMLockAll :: Bool
4321− -- ^ See <https://www.elastic.co/guide/en/elasticsearch/reference/current/setup-configuration.html>
4322− , nodeProcessMaxFileDescriptors :: Int
4323− , nodeProcessId :: PID
4324− , nodeProcessRefreshInterval :: NominalDiffTime
4325− } deriving (Eq, Show, Generic, Typeable)
4326−
4327−data SnapshotRepoUpdateSettings = SnapshotRepoUpdateSettings {
4328− repoUpdateVerify :: Bool
4329− -- ^ After creation/update, synchronously check that nodes can
4330− -- write to this repo. Defaults to True. You may use False if you
4331− -- need a faster response and plan on verifying manually later
4332− -- with 'verifySnapshotRepo'.
4333− } deriving (Eq, Show, Generic, Typeable)
4334−
4335−
4336−-- | Reasonable defaults for repo creation/update
4337−--
4338−-- * repoUpdateVerify True
4339−defaultSnapshotRepoUpdateSettings :: SnapshotRepoUpdateSettings
4340−defaultSnapshotRepoUpdateSettings = SnapshotRepoUpdateSettings True
4341−
4342−
4343−-- | A filesystem-based snapshot repo that ships with
4344−-- ElasticSearch. This is an instance of 'SnapshotRepo' so it can be
4345−-- used with 'updateSnapshotRepo'
4346−data FsSnapshotRepo = FsSnapshotRepo {
4347− fsrName :: SnapshotRepoName
4348− , fsrLocation :: FilePath
4349− , fsrCompressMetadata :: Bool
4350− , fsrChunkSize :: Maybe Bytes
4351− -- ^ Size by which to split large files during snapshotting.
4352− , fsrMaxRestoreBytesPerSec :: Maybe Bytes
4353− -- ^ Throttle node restore rate. If not supplied, defaults to 40mb/sec
4354− , fsrMaxSnapshotBytesPerSec :: Maybe Bytes
4355− -- ^ Throttle node snapshot rate. If not supplied, defaults to 40mb/sec
4356− } deriving (Eq, Generic, Show, Typeable)
4357−
4358−
4359−instance SnapshotRepo FsSnapshotRepo where
4360− toGSnapshotRepo FsSnapshotRepo {..} =
4361− GenericSnapshotRepo fsrName fsRepoType (GenericSnapshotRepoSettings settings)
4362− where
4363− Object settings = object $ [ "location" .= fsrLocation
4364− , "compress" .= fsrCompressMetadata
4365− ] ++ optionalPairs
4366− optionalPairs = catMaybes [ ("chunk_size" .=) <$> fsrChunkSize
4367− , ("max_restore_bytes_per_sec" .=) <$> fsrMaxRestoreBytesPerSec
4368− , ("max_snapshot_bytes_per_sec" .=) <$> fsrMaxSnapshotBytesPerSec
4369− ]
4370− fromGSnapshotRepo GenericSnapshotRepo {..}
4371− | gSnapshotRepoType == fsRepoType = do
4372− let o = gSnapshotRepoSettingsObject gSnapshotRepoSettings
4373− parseRepo $ do
4374− FsSnapshotRepo gSnapshotRepoName <$> o .: "location"
4375− <*> o .:? "compress" .!= False
4376− <*> o .:? "chunk_size"
4377− <*> o .:? "max_restore_bytes_per_sec"
4378− <*> o .:? "max_snapshot_bytes_per_sec"
4379− | otherwise = Left (RepoTypeMismatch fsRepoType gSnapshotRepoType)
4380−
4381−
4382−parseRepo :: Parser a -> Either SnapshotRepoConversionError a
4383−parseRepo parser = case parseEither (const parser) () of
4384− Left e -> Left (OtherRepoConversionError (T.pack e))
4385− Right a -> Right a
4386−
4387−
4388−fsRepoType :: SnapshotRepoType
4389−fsRepoType = SnapshotRepoType "fs"
4390−
4391−-- | Law: fromGSnapshotRepo (toGSnapshotRepo r) == Right r
4392−class SnapshotRepo r where
4393− toGSnapshotRepo :: r -> GenericSnapshotRepo
4394− fromGSnapshotRepo :: GenericSnapshotRepo -> Either SnapshotRepoConversionError r
4395−
4396−
4397−data SnapshotRepoConversionError = RepoTypeMismatch SnapshotRepoType SnapshotRepoType
4398− -- ^ Expected type and actual type
4399− | OtherRepoConversionError Text
4400− deriving (Show, Eq, Generic, Typeable)
4401−
4402−
4403−instance Exception SnapshotRepoConversionError
4404−
4405−
4406−data SnapshotCreateSettings = SnapshotCreateSettings {
4407− snapWaitForCompletion :: Bool
4408− -- ^ Should the API call return immediately after initializing
4409− -- the snapshot or wait until completed? Note that if this is
4410− -- enabled it could wait a long time, so you should adjust your
4411− -- 'ManagerSettings' accordingly to set long timeouts or
4412− -- explicitly handle timeouts.
4413− , snapIndices :: Maybe IndexSelection
4414− -- ^ Nothing will snapshot all indices. Just [] is permissable and
4415− -- will essentially be a no-op snapshot.
4416− , snapIgnoreUnavailable :: Bool
4417− -- ^ If set to True, any matched indices that don't exist will be
4418− -- ignored. Otherwise it will be an error and fail.
4419− , snapIncludeGlobalState :: Bool
4420− , snapPartial :: Bool
4421− -- ^ If some indices failed to snapshot (e.g. if not all primary
4422− -- shards are available), should the process proceed?
4423− } deriving (Eq, Generic, Show, Typeable)
4424−
4425−
4426−-- | Reasonable defaults for snapshot creation
4427−--
4428−-- * snapWaitForCompletion False
4429−-- * snapIndices Nothing
4430−-- * snapIgnoreUnavailable False
4431−-- * snapIncludeGlobalState True
4432−-- * snapPartial False
4433−defaultSnapshotCreateSettings :: SnapshotCreateSettings
4434−defaultSnapshotCreateSettings = SnapshotCreateSettings {
4435− snapWaitForCompletion = False
4436− , snapIndices = Nothing
4437− , snapIgnoreUnavailable = False
4438− , snapIncludeGlobalState = True
4439− , snapPartial = False
4440− }
4441−
4442−
4443−data SnapshotSelection = SnapshotList (NonEmpty SnapshotPattern)
4444− | AllSnapshots deriving (Eq, Generic, Show, Typeable)
4445−
4446−
4447−-- | Either specifies an exact snapshot name or one with globs in it,
4448−-- e.g. @SnapPattern "foo*"@ __NOTE__: Patterns are not supported on
4449−-- ES < 1.7
4450−data SnapshotPattern = ExactSnap SnapshotName
4451− | SnapPattern Text
4452− deriving (Eq, Generic, Show, Typeable)
4453−
4454−
4455−-- | General information about the state of a snapshot. Has some
4456−-- redundancies with 'SnapshotStatus'
4457−data SnapshotInfo = SnapshotInfo {
4458− snapInfoShards :: ShardResult
4459− , snapInfoFailures :: [SnapshotShardFailure]
4460− , snapInfoDuration :: NominalDiffTime
4461− , snapInfoEndTime :: UTCTime
4462− , snapInfoStartTime :: UTCTime
4463− , snapInfoState :: SnapshotState
4464− , snapInfoIndices :: [IndexName]
4465− , snapInfoName :: SnapshotName
4466− } deriving (Eq, Generic, Show, Typeable)
4467−
4468−
4469−instance FromJSON SnapshotInfo where
4470− parseJSON = withObject "SnapshotInfo" parse
4471− where
4472− parse o = SnapshotInfo <$> o .: "shards"
4473− <*> o .: "failures"
4474− <*> (unMS <$> o .: "duration_in_millis")
4475− <*> (posixMS <$> o .: "end_time_in_millis")
4476− <*> (posixMS <$> o .: "start_time_in_millis")
4477− <*> o .: "state"
4478− <*> o .: "indices"
4479− <*> o .: "snapshot"
4480−
4481−data SnapshotShardFailure = SnapshotShardFailure {
4482− snapShardFailureIndex :: IndexName
4483− , snapShardFailureNodeId :: Maybe NodeName -- I'm not 100% sure this isn't actually 'FullNodeId'
4484− , snapShardFailureReason :: Text
4485− , snapShardFailureShardId :: ShardId
4486− } deriving (Eq, Show, Generic, Typeable)
4487−
4488−
4489−instance FromJSON SnapshotShardFailure where
4490− parseJSON = withObject "SnapshotShardFailure" parse
4491− where
4492− parse o = SnapshotShardFailure <$> o .: "index"
4493− <*> o .:? "node_id"
4494− <*> o .: "reason"
4495− <*> o .: "shard_id"
4496−
4497−
4498−newtype ShardId = ShardId { shardId :: Int }
4499− deriving (Eq, Show, Generic, Typeable, FromJSON)
4500−
4501−-- | Milliseconds
4502−newtype MS = MS NominalDiffTime
4503−
4504−
4505−-- keeps the unexported constructor warnings at bay
4506−unMS :: MS -> NominalDiffTime
4507−unMS (MS t) = t
4508−
4509−
4510−instance FromJSON MS where
4511− parseJSON = withScientific "MS" (return . MS . parse)
4512− where
4513− parse n = fromInteger ((truncate n) * 1000)
4514−
4515−
4516−data SnapshotState = SnapshotInit
4517− | SnapshotStarted
4518− | SnapshotSuccess
4519− | SnapshotFailed
4520− | SnapshotAborted
4521− | SnapshotMissing
4522− | SnapshotWaiting
4523− deriving (Show, Eq, Generic, Typeable)
4524−
4525−instance FromJSON SnapshotState where
4526− parseJSON = withText "SnapshotState" parse
4527− where
4528− parse "INIT" = return SnapshotInit
4529− parse "STARTED" = return SnapshotStarted
4530− parse "SUCCESS" = return SnapshotSuccess
4531− parse "FAILED" = return SnapshotFailed
4532− parse "ABORTED" = return SnapshotAborted
4533− parse "MISSING" = return SnapshotMissing
4534− parse "WAITING" = return SnapshotWaiting
4535− parse t = fail ("Invalid snapshot state " <> T.unpack t)
4536−
4537−
4538−newtype SnapshotName = SnapshotName { snapshotName :: Text }
4539− deriving (Show, Eq, Ord, Generic, Typeable, ToJSON, FromJSON)
4540−
4541−
4542−data SnapshotRestoreSettings = SnapshotRestoreSettings {
4543− snapRestoreWaitForCompletion :: Bool
4544− -- ^ Should the API call return immediately after initializing
4545− -- the restore or wait until completed? Note that if this is
4546− -- enabled, it could wait a long time, so you should adjust your
4547− -- 'ManagerSettings' accordingly to set long timeouts or
4548− -- explicitly handle timeouts.
4549− , snapRestoreIndices :: Maybe IndexSelection
4550− -- ^ Nothing will restore all indices in the snapshot. Just [] is
4551− -- permissable and will essentially be a no-op restore.
4552− , snapRestoreIgnoreUnavailable :: Bool
4553− -- ^ If set to True, any indices that do not exist will be ignored
4554− -- during snapshot rather than failing the restore.
4555− , snapRestoreIncludeGlobalState :: Bool
4556− -- ^ If set to false, will ignore any global state in the snapshot
4557− -- and will not restore it.
4558− , snapRestoreRenamePattern :: Maybe RestoreRenamePattern
4559− -- ^ A regex pattern for matching indices. Used with
4560− -- 'snapRestoreRenameReplacement', the restore can reference the
4561− -- matched index and create a new index name upon restore.
4562− , snapRestoreRenameReplacement :: Maybe (NonEmpty RestoreRenameToken)
4563− -- ^ Expression of how index renames should be constructed.
4564− , snapRestorePartial :: Bool
4565− -- ^ If some indices fail to restore, should the process proceed?
4566− , snapRestoreIncludeAliases :: Bool
4567− -- ^ Should the restore also restore the aliases captured in the
4568− -- snapshot.
4569− , snapRestoreIndexSettingsOverrides :: Maybe RestoreIndexSettings
4570− -- ^ Settings to apply during the restore process. __NOTE:__ This
4571− -- option is not supported in ES < 1.5 and should be set to
4572− -- Nothing in that case.
4573− , snapRestoreIgnoreIndexSettings :: Maybe (NonEmpty Text)
4574− -- ^ This type could be more rich but it isn't clear which
4575− -- settings are allowed to be ignored during restore, so we're
4576− -- going with including this feature in a basic form rather than
4577− -- omitting it. One example here would be
4578− -- "index.refresh_interval". Any setting specified here will
4579− -- revert back to the server default during the restore process.
4580− } deriving (Eq, Generic, Show, Typeable)
4581−
4582−-- | Regex-stype pattern, e.g. "index_(.+)" to match index names
4583−newtype RestoreRenamePattern = RestoreRenamePattern { rrPattern :: Text }
4584− deriving (Show, Eq, Generic, Typeable, Ord, ToJSON)
4585−
4586−
4587−-- | A single token in a index renaming scheme for a restore. These
4588−-- are concatenated into a string before being sent to
4589−-- ElasticSearch. Check out these Java
4590−-- <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.
4591−data RestoreRenameToken = RRTLit Text
4592− -- ^ Just a literal string of characters
4593− | RRSubWholeMatch
4594− -- ^ Equivalent to $0. The entire matched pattern, not any subgroup
4595− | RRSubGroup RRGroupRefNum
4596− -- ^ A specific reference to a group number
4597− deriving (Show, Eq, Generic, Typeable)
4598−
4599−
4600−-- | A group number for regex matching. Only values from 1-9 are
4601−-- supported. Construct with 'mkRRGroupRefNum'
4602−newtype RRGroupRefNum = RRGroupRefNum { rrGroupRefNum :: Int }
4603− deriving (Show, Eq, Generic, Typeable, Ord)
4604−
4605−instance Bounded RRGroupRefNum where
4606− minBound = RRGroupRefNum 1
4607− maxBound = RRGroupRefNum 9
4608−
4609−
4610−-- | Only allows valid group number references (1-9).
4611−mkRRGroupRefNum :: Int -> Maybe RRGroupRefNum
4612−mkRRGroupRefNum i
4613− | i >= (rrGroupRefNum minBound) && i <= (rrGroupRefNum maxBound) =
4614− Just $ RRGroupRefNum i
4615− | otherwise = Nothing
4616−
4617−
4618−-- | Reasonable defaults for snapshot restores
4619−--
4620−-- * snapRestoreWaitForCompletion False
4621−-- * snapRestoreIndices Nothing
4622−-- * snapRestoreIgnoreUnavailable False
4623−-- * snapRestoreIncludeGlobalState True
4624−-- * snapRestoreRenamePattern Nothing
4625−-- * snapRestoreRenameReplacement Nothing
4626−-- * snapRestorePartial False
4627−-- * snapRestoreIncludeAliases True
4628−-- * snapRestoreIndexSettingsOverrides Nothing
4629−-- * snapRestoreIgnoreIndexSettings Nothing
4630−defaultSnapshotRestoreSettings :: SnapshotRestoreSettings
4631−defaultSnapshotRestoreSettings = SnapshotRestoreSettings {
4632− snapRestoreWaitForCompletion = False
4633− , snapRestoreIndices = Nothing
4634− , snapRestoreIgnoreUnavailable = False
4635− , snapRestoreIncludeGlobalState = True
4636− , snapRestoreRenamePattern = Nothing
4637− , snapRestoreRenameReplacement = Nothing
4638− , snapRestorePartial = False
4639− , snapRestoreIncludeAliases = True
4640− , snapRestoreIndexSettingsOverrides = Nothing
4641− , snapRestoreIgnoreIndexSettings = Nothing
4642− }
4643−
4644−
4645−-- | Index settings that can be overridden. The docs only mention you
4646−-- can update number of replicas, but there may be more. You
4647−-- definitely cannot override shard count.
4648−data RestoreIndexSettings = RestoreIndexSettings {
4649− restoreOverrideReplicas :: Maybe ReplicaCount
4650− } deriving (Show, Eq, Generic, Typeable)
4651−
4652−
4653−instance ToJSON RestoreIndexSettings where
4654− toJSON RestoreIndexSettings {..} = object prs
4655− where
4656− prs = catMaybes [("index.number_of_replicas" .=) <$> restoreOverrideReplicas]
4657−
4658−
4659−instance FromJSON NodesInfo where
4660− parseJSON = withObject "NodesInfo" parse
4661− where
4662− parse o = do
4663− nodes <- o .: "nodes"
4664− infos <- forM (HM.toList nodes) $ \(fullNID, v) -> do
4665− node <- parseJSON v
4666− parseNodeInfo (FullNodeId fullNID) node
4667− cn <- o .: "cluster_name"
4668− return (NodesInfo infos cn)
4669−
4670−instance FromJSON NodesStats where
4671− parseJSON = withObject "NodesStats" parse
4672− where
4673− parse o = do
4674− nodes <- o .: "nodes"
4675− stats <- forM (HM.toList nodes) $ \(fullNID, v) -> do
4676− node <- parseJSON v
4677− parseNodeStats (FullNodeId fullNID) node
4678− cn <- o .: "cluster_name"
4679− return (NodesStats stats cn)
4680−
4681−instance FromJSON NodeBreakerStats where
4682− parseJSON = withObject "NodeBreakerStats" parse
4683− where
4684− parse o = NodeBreakerStats <$> o .: "tripped"
4685− <*> o .: "overhead"
4686− <*> o .: "estimated_size_in_bytes"
4687− <*> o .: "limit_size_in_bytes"
4688−
4689−instance FromJSON NodeHTTPStats where
4690− parseJSON = withObject "NodeHTTPStats" parse
4691− where
4692− parse o = NodeHTTPStats <$> o .: "total_opened"
4693− <*> o .: "current_open"
4694−
4695−instance FromJSON NodeTransportStats where
4696− parseJSON = withObject "NodeTransportStats" parse
4697− where
4698− parse o = NodeTransportStats <$> o .: "tx_size_in_bytes"
4699− <*> o .: "tx_count"
4700− <*> o .: "rx_size_in_bytes"
4701− <*> o .: "rx_count"
4702− <*> o .: "server_open"
4703−
4704−instance FromJSON NodeFSStats where
4705− parseJSON = withObject "NodeFSStats" parse
4706− where
4707− parse o = NodeFSStats <$> o .: "data"
4708− <*> o .: "total"
4709− <*> (posixMS <$> o .: "timestamp")
4710−
4711−instance FromJSON NodeDataPathStats where
4712− parseJSON = withObject "NodeDataPathStats" parse
4713− where
4714− parse o =
4715− NodeDataPathStats <$> (fmap unStringlyTypedDouble <$> o .:? "disk_service_time")
4716− <*> (fmap unStringlyTypedDouble <$> o .:? "disk_queue")
4717− <*> o .:? "disk_io_size_in_bytes"
4718− <*> o .:? "disk_write_size_in_bytes"
4719− <*> o .:? "disk_read_size_in_bytes"
4720− <*> o .:? "disk_io_op"
4721− <*> o .:? "disk_writes"
4722− <*> o .:? "disk_reads"
4723− <*> o .: "available_in_bytes"
4724− <*> o .: "free_in_bytes"
4725− <*> o .: "total_in_bytes"
4726− <*> o .:? "type"
4727− <*> o .: "dev"
4728− <*> o .: "mount"
4729− <*> o .: "path"
4730−
4731−newtype StringlyTypedDouble = StringlyTypedDouble { unStringlyTypedDouble :: Double }
4732−
4733−
4734−instance FromJSON StringlyTypedDouble where
4735− parseJSON = fmap StringlyTypedDouble . parseJSON . unStringlyTypeJSON
4736−
4737−
4738−instance FromJSON NodeFSTotalStats where
4739− parseJSON = withObject "NodeFSTotalStats" parse
4740− where
4741− parse o = NodeFSTotalStats <$> (fmap unStringlyTypedDouble <$> o .:? "disk_service_time")
4742− <*> (fmap unStringlyTypedDouble <$> o .:? "disk_queue")
4743− <*> o .:? "disk_io_size_in_bytes"
4744− <*> o .:? "disk_write_size_in_bytes"
4745− <*> o .:? "disk_read_size_in_bytes"
4746− <*> o .:? "disk_io_op"
4747− <*> o .:? "disk_writes"
4748− <*> o .:? "disk_reads"
4749− <*> o .: "available_in_bytes"
4750− <*> o .: "free_in_bytes"
4751− <*> o .: "total_in_bytes"
4752−
4753−instance FromJSON NodeNetworkStats where
4754− parseJSON = withObject "NodeNetworkStats" parse
4755− where
4756− parse o = do
4757− tcp <- o .: "tcp"
4758− NodeNetworkStats <$> tcp .: "out_rsts"
4759− <*> tcp .: "in_errs"
4760− <*> tcp .: "attempt_fails"
4761− <*> tcp .: "estab_resets"
4762− <*> tcp .: "retrans_segs"
4763− <*> tcp .: "out_segs"
4764− <*> tcp .: "in_segs"
4765− <*> tcp .: "curr_estab"
4766− <*> tcp .: "passive_opens"
4767− <*> tcp .: "active_opens"
4768−
4769−instance FromJSON NodeThreadPoolsStats where
4770− parseJSON = withObject "NodeThreadPoolsStats" parse
4771− where
4772− parse o = NodeThreadPoolsStats <$> o .: "snapshot"
4773− <*> o .: "bulk"
4774− <*> o .: "merge"
4775− <*> o .: "get"
4776− <*> o .: "management"
4777− <*> o .:? "fetch_shard_store"
4778− <*> o .: "optimize"
4779− <*> o .: "flush"
4780− <*> o .: "search"
4781− <*> o .: "warmer"
4782− <*> o .: "generic"
4783− <*> o .: "suggest"
4784− <*> o .: "refresh"
4785− <*> o .: "index"
4786− <*> o .:? "listener"
4787− <*> o .:? "fetch_shard_started"
4788− <*> o .: "percolate"
4789−instance FromJSON NodeThreadPoolStats where
4790− parseJSON = withObject "NodeThreadPoolStats" parse
4791− where
4792− parse o = NodeThreadPoolStats <$> o .: "completed"
4793− <*> o .: "largest"
4794− <*> o .: "rejected"
4795− <*> o .: "active"
4796− <*> o .: "queue"
4797− <*> o .: "threads"
4798−
4799−instance FromJSON NodeJVMStats where
4800− parseJSON = withObject "NodeJVMStats" parse
4801− where
4802− parse o = do
4803− bufferPools <- o .: "buffer_pools"
4804− mapped <- bufferPools .: "mapped"
4805− direct <- bufferPools .: "direct"
4806− gc <- o .: "gc"
4807− collectors <- gc .: "collectors"
4808− oldC <- collectors .: "old"
4809− youngC <- collectors .: "young"
4810− threads <- o .: "threads"
4811− mem <- o .: "mem"
4812− pools <- mem .: "pools"
4813− oldM <- pools .: "old"
4814− survivorM <- pools .: "survivor"
4815− youngM <- pools .: "young"
4816− NodeJVMStats <$> pure mapped
4817− <*> pure direct
4818− <*> pure oldC
4819− <*> pure youngC
4820− <*> threads .: "peak_count"
4821− <*> threads .: "count"
4822− <*> pure oldM
4823− <*> pure survivorM
4824− <*> pure youngM
4825− <*> mem .: "non_heap_committed_in_bytes"
4826− <*> mem .: "non_heap_used_in_bytes"
4827− <*> mem .: "heap_max_in_bytes"
4828− <*> mem .: "heap_committed_in_bytes"
4829− <*> mem .: "heap_used_percent"
4830− <*> mem .: "heap_used_in_bytes"
4831− <*> (unMS <$> o .: "uptime_in_millis")
4832− <*> (posixMS <$> o .: "timestamp")
4833−
4834−instance FromJSON JVMBufferPoolStats where
4835− parseJSON = withObject "JVMBufferPoolStats" parse
4836− where
4837− parse o = JVMBufferPoolStats <$> o .: "total_capacity_in_bytes"
4838− <*> o .: "used_in_bytes"
4839− <*> o .: "count"
4840−
4841−instance FromJSON JVMGCStats where
4842− parseJSON = withObject "JVMGCStats" parse
4843− where
4844− parse o = JVMGCStats <$> (unMS <$> o .: "collection_time_in_millis")
4845− <*> o .: "collection_count"
4846−
4847−instance FromJSON JVMPoolStats where
4848− parseJSON = withObject "JVMPoolStats" parse
4849− where
4850− parse o = JVMPoolStats <$> o .: "peak_max_in_bytes"
4851− <*> o .: "peak_used_in_bytes"
4852− <*> o .: "max_in_bytes"
4853− <*> o .: "used_in_bytes"
4854−
4855−instance FromJSON NodeProcessStats where
4856− parseJSON = withObject "NodeProcessStats" parse
4857− where
4858− parse o = do
4859− mem <- o .: "mem"
4860− cpu <- o .: "cpu"
4861− NodeProcessStats <$> mem .: "total_virtual_in_bytes"
4862− <*> mem .: "share_in_bytes"
4863− <*> mem .: "resident_in_bytes"
4864− <*> (unMS <$> cpu .: "total_in_millis")
4865− <*> (unMS <$> cpu .: "user_in_millis")
4866− <*> (unMS <$> cpu .: "sys_in_millis")
4867− <*> cpu .: "percent"
4868− <*> o .: "open_file_descriptors"
4869− <*> (posixMS <$> o .: "timestamp")
4870−
4871−instance FromJSON NodeOSStats where
4872− parseJSON = withObject "NodeOSStats" parse
4873− where
4874− parse o = do
4875− swap <- o .: "swap"
4876− mem <- o .: "mem"
4877− cpu <- o .: "cpu"
4878− load <- o .: "load_average"
4879− NodeOSStats <$> swap .: "free_in_bytes"
4880− <*> swap .: "used_in_bytes"
4881− <*> mem .: "actual_used_in_bytes"
4882− <*> mem .: "actual_free_in_bytes"
4883− <*> mem .: "used_percent"
4884− <*> mem .: "free_percent"
4885− <*> mem .: "used_in_bytes"
4886− <*> mem .: "free_in_bytes"
4887− <*> cpu .: "stolen"
4888− <*> cpu .: "usage"
4889− <*> cpu .: "idle"
4890− <*> cpu .: "user"
4891− <*> cpu .: "sys"
4892− <*> pure load
4893− <*> (unMS <$> o .: "uptime_in_millis")
4894− <*> (posixMS <$> o .: "timestamp")
4895−
4896−instance FromJSON LoadAvgs where
4897− parseJSON = withArray "LoadAvgs" parse
4898− where
4899− parse v = case V.toList v of
4900− [one, five, fifteen] -> LoadAvgs <$> parseJSON one
4901− <*> parseJSON five
4902− <*> parseJSON fifteen
4903− _ -> fail "Expecting a triple of Doubles"
4904−
4905−instance FromJSON NodeIndicesStats where
4906− parseJSON = withObject "NodeIndicesStats" parse
4907− where
4908− parse o = do
4909− let (.::) mv k = case mv of
4910− Just v -> Just <$> v .: k
4911− Nothing -> pure Nothing
4912− mRecovery <- o .:? "recovery"
4913− mQueryCache <- o .:? "query_cache"
4914− suggest <- o .: "suggest"
4915− translog <- o .: "translog"
4916− segments <- o .: "segments"
4917− completion <- o .: "completion"
4918− percolate <- o .: "percolate"
4919− fielddata <- o .: "fielddata"
4920− idCache <- o .: "id_cache"
4921− filterCache <- o .: "filter_cache"
4922− warmer <- o .: "warmer"
4923− flush <- o .: "flush"
4924− refresh <- o .: "refresh"
4925− merges <- o .: "merges"
4926− search <- o .: "search"
4927− getStats <- o .: "get"
4928− indexing <- o .: "indexing"
4929− store <- o .: "store"
4930− docs <- o .: "docs"
4931− NodeIndicesStats <$> (fmap unMS <$> mRecovery .:: "throttle_time_in_millis")
4932− <*> mRecovery .:: "current_as_target"
4933− <*> mRecovery .:: "current_as_source"
4934− <*> mQueryCache .:: "miss_count"
4935− <*> mQueryCache .:: "hit_count"
4936− <*> mQueryCache .:: "evictions"
4937− <*> mQueryCache .:: "memory_size_in_bytes"
4938− <*> suggest .: "current"
4939− <*> (unMS <$> suggest .: "time_in_millis")
4940− <*> suggest .: "total"
4941− <*> translog .: "size_in_bytes"
4942− <*> translog .: "operations"
4943− <*> segments .:? "fixed_bit_set_memory_in_bytes"
4944− <*> segments .: "version_map_memory_in_bytes"
4945− <*> segments .:? "index_writer_max_memory_in_bytes"
4946− <*> segments .: "index_writer_memory_in_bytes"
4947− <*> segments .: "memory_in_bytes"
4948− <*> segments .: "count"
4949− <*> completion .: "size_in_bytes"
4950− <*> percolate .: "queries"
4951− <*> percolate .: "memory_size_in_bytes"
4952− <*> percolate .: "current"
4953− <*> (unMS <$> percolate .: "time_in_millis")
4954− <*> percolate .: "total"
4955− <*> fielddata .: "evictions"
4956− <*> fielddata .: "memory_size_in_bytes"
4957− <*> idCache .: "memory_size_in_bytes"
4958− <*> filterCache .: "evictions"
4959− <*> filterCache .: "memory_size_in_bytes"
4960− <*> (unMS <$> warmer .: "total_time_in_millis")
4961− <*> warmer .: "total"
4962− <*> warmer .: "current"
4963− <*> (unMS <$> flush .: "total_time_in_millis")
4964− <*> flush .: "total"
4965− <*> (unMS <$> refresh .: "total_time_in_millis")
4966− <*> refresh .: "total"
4967− <*> merges .: "total_size_in_bytes"
4968− <*> merges .: "total_docs"
4969− <*> (unMS <$> merges .: "total_time_in_millis")
4970− <*> merges .: "total"
4971− <*> merges .: "current_size_in_bytes"
4972− <*> merges .: "current_docs"
4973− <*> merges .: "current"
4974− <*> search .: "fetch_current"
4975− <*> (unMS <$> search .: "fetch_time_in_millis")
4976− <*> search .: "fetch_total"
4977− <*> search .: "query_current"
4978− <*> (unMS <$> search .: "query_time_in_millis")
4979− <*> search .: "query_total"
4980− <*> search .: "open_contexts"
4981− <*> getStats .: "current"
4982− <*> (unMS <$> getStats .: "missing_time_in_millis")
4983− <*> getStats .: "missing_total"
4984− <*> (unMS <$> getStats .: "exists_time_in_millis")
4985− <*> getStats .: "exists_total"
4986− <*> (unMS <$> getStats .: "time_in_millis")
4987− <*> getStats .: "total"
4988− <*> (fmap unMS <$> indexing .:? "throttle_time_in_millis")
4989− <*> indexing .:? "is_throttled"
4990− <*> indexing .:? "noop_update_total"
4991− <*> indexing .: "delete_current"
4992− <*> (unMS <$> indexing .: "delete_time_in_millis")
4993− <*> indexing .: "delete_total"
4994− <*> indexing .: "index_current"
4995− <*> (unMS <$> indexing .: "index_time_in_millis")
4996− <*> indexing .: "index_total"
4997− <*> (unMS <$> store .: "throttle_time_in_millis")
4998− <*> store .: "size_in_bytes"
4999− <*> docs .: "deleted"
5000− <*> docs .: "count"
5001−
5002−instance FromJSON NodeBreakersStats where
5003− parseJSON = withObject "NodeBreakersStats" parse
5004− where
5005− parse o = NodeBreakersStats <$> o .: "parent"
5006− <*> o .: "request"
5007− <*> o .: "fielddata"
5008−
5009−parseNodeStats :: FullNodeId -> Object -> Parser NodeStats
5010−parseNodeStats fnid o = do
5011− NodeStats <$> o .: "name"
5012− <*> pure fnid
5013− <*> o .:? "breakers"
5014− <*> o .: "http"
5015− <*> o .: "transport"
5016− <*> o .: "fs"
5017− <*> o .: "network"
5018− <*> o .: "thread_pool"
5019− <*> o .: "jvm"
5020− <*> o .: "process"
5021− <*> o .: "os"
5022− <*> o .: "indices"
5023−
5024−parseNodeInfo :: FullNodeId -> Object -> Parser NodeInfo
5025−parseNodeInfo nid o =
5026− NodeInfo <$> o .: "http_address"
5027− <*> o .: "build"
5028− <*> o .: "version"
5029− <*> o .: "ip"
5030− <*> o .: "host"
5031− <*> o .: "transport_address"
5032− <*> o .: "name"
5033− <*> pure nid
5034− <*> o .: "plugins"
5035− <*> o .: "http"
5036− <*> o .: "transport"
5037− <*> o .: "network"
5038− <*> o .: "thread_pool"
5039− <*> o .: "jvm"
5040− <*> o .: "process"
5041− <*> o .: "os"
5042− <*> o .: "settings"
5043−
5044−instance FromJSON NodePluginInfo where
5045− parseJSON = withObject "NodePluginInfo" parse
5046− where
5047− parse o = NodePluginInfo <$> o .: "site"
5048− <*> o .: "jvm"
5049− <*> o .: "description"
5050− <*> o .: "version"
5051− <*> o .: "name"
5052−
5053−instance FromJSON NodeHTTPInfo where
5054− parseJSON = withObject "NodeHTTPInfo" parse
5055− where
5056− parse o = NodeHTTPInfo <$> o .: "max_content_length_in_bytes"
5057− <*> parseJSON (Object o)
5058−
5059−instance FromJSON BoundTransportAddress where
5060− parseJSON = withObject "BoundTransportAddress" parse
5061− where
5062− parse o = BoundTransportAddress <$> o .: "publish_address"
5063− <*> o .: "bound_address"
5064−
5065−instance FromJSON NodeOSInfo where
5066− parseJSON = withObject "NodeOSInfo" parse
5067− where
5068− parse o = do
5069− swap <- o .: "swap"
5070− mem <- o .: "mem"
5071− NodeOSInfo <$> swap .: "total_in_bytes"
5072− <*> mem .: "total_in_bytes"
5073− <*> o .: "cpu"
5074− <*> o .: "available_processors"
5075− <*> (unMS <$> o .: "refresh_interval_in_millis")
5076−
5077−
5078−instance FromJSON CPUInfo where
5079− parseJSON = withObject "CPUInfo" parse
5080− where
5081− parse o = CPUInfo <$> o .: "cache_size_in_bytes"
5082− <*> o .: "cores_per_socket"
5083− <*> o .: "total_sockets"
5084− <*> o .: "total_cores"
5085− <*> o .: "mhz"
5086− <*> o .: "model"
5087− <*> o .: "vendor"
5088−
5089−instance FromJSON NodeProcessInfo where
5090− parseJSON = withObject "NodeProcessInfo" parse
5091− where
5092− parse o = NodeProcessInfo <$> o .: "mlockall"
5093− <*> o .: "max_file_descriptors"
5094− <*> o .: "id"
5095− <*> (unMS <$> o .: "refresh_interval_in_millis")
5096−
5097−instance FromJSON NodeJVMInfo where
5098− parseJSON = withObject "NodeJVMInfo" parse
5099− where
5100− parse o = NodeJVMInfo <$> o .: "memory_pools"
5101− <*> o .: "gc_collectors"
5102− <*> o .: "mem"
5103− <*> (posixMS <$> o .: "start_time_in_millis")
5104− <*> o .: "vm_vendor"
5105− <*> o .: "vm_version"
5106− <*> o .: "vm_name"
5107− <*> (unJVMVersion <$> o .: "version")
5108− <*> o .: "pid"
5109−
5110−instance FromJSON JVMVersion where
5111− parseJSON (String t) =
5112− JVMVersion <$> parseJSON (String (T.replace "_" "." t))
5113− parseJSON v = JVMVersion <$> parseJSON v
5114−
5115−instance FromJSON JVMMemoryInfo where
5116− parseJSON = withObject "JVMMemoryInfo" parse
5117− where
5118− parse o = JVMMemoryInfo <$> o .: "direct_max_in_bytes"
5119− <*> o .: "non_heap_max_in_bytes"
5120− <*> o .: "non_heap_init_in_bytes"
5121− <*> o .: "heap_max_in_bytes"
5122− <*> o .: "heap_init_in_bytes"
5123−
5124−instance FromJSON NodeThreadPoolsInfo where
5125− parseJSON = withObject "NodeThreadPoolsInfo" parse
5126− where
5127− parse o = NodeThreadPoolsInfo <$> o .: "refresh"
5128− <*> o .: "management"
5129− <*> o .: "percolate"
5130− <*> o .:? "listener"
5131− <*> o .:? "fetch_shard_started"
5132− <*> o .: "search"
5133− <*> o .: "flush"
5134− <*> o .: "warmer"
5135− <*> o .: "optimize"
5136− <*> o .: "bulk"
5137− <*> o .: "suggest"
5138− <*> o .: "merge"
5139− <*> o .: "snapshot"
5140− <*> o .: "get"
5141− <*> o .:? "fetch_shard_store"
5142− <*> o .: "index"
5143− <*> o .: "generic"
5144−
5145−instance FromJSON NodeThreadPoolInfo where
5146− parseJSON = withObject "NodeThreadPoolInfo" parse
5147− where
5148− parse o = do
5149− ka <- maybe (return Nothing) (fmap Just . parseStringInterval) =<< o .:? "keep_alive"
5150− NodeThreadPoolInfo <$> (parseJSON . unStringlyTypeJSON =<< o .: "queue_size")
5151− <*> pure ka
5152− <*> o .:? "min"
5153− <*> o .:? "max"
5154− <*> o .: "type"
5155−
5156−parseStringInterval :: (Monad m) => String -> m NominalDiffTime
5157−parseStringInterval s = case span isNumber s of
5158− ("", _) -> fail "Invalid interval"
5159− (nS, unitS) -> case (readMay nS, readMay unitS) of
5160− (Just n, Just unit) -> return (fromInteger (n * unitNDT unit))
5161− (Nothing, _) -> fail "Invalid interval number"
5162− (_, Nothing) -> fail "Invalid interval unit"
5163− where
5164− unitNDT Seconds = 1
5165− unitNDT Minutes = 60
5166− unitNDT Hours = 60 * 60
5167− unitNDT Days = 24 * 60 * 60
5168− unitNDT Weeks = 7 * 24 * 60 * 60
5169−
5170−instance FromJSON ThreadPoolSize where
5171− parseJSON v = parseAsNumber v <|> parseAsString v
5172− where
5173− parseAsNumber = parseAsInt <=< parseJSON
5174− parseAsInt (-1) = return ThreadPoolUnbounded
5175− parseAsInt n
5176− | n >= 0 = return (ThreadPoolBounded n)
5177− | otherwise = fail "Thread pool size must be >= -1."
5178− parseAsString = withText "ThreadPoolSize" $ \t ->
5179− case first (readMay . T.unpack) (T.span isNumber t) of
5180− (Just n, "k") -> return (ThreadPoolBounded (n * 1000))
5181− (Just n, "") -> return (ThreadPoolBounded n)
5182− _ -> fail ("Invalid thread pool size " <> T.unpack t)
5183−
5184−instance FromJSON ThreadPoolType where
5185− parseJSON = withText "ThreadPoolType" parse
5186− where
5187− parse "scaling" = return ThreadPoolScaling
5188− parse "fixed" = return ThreadPoolFixed
5189− parse "cached" = return ThreadPoolCached
5190− parse e = fail ("Unexpected thread pool type" <> T.unpack e)
5191−
5192−instance FromJSON NodeTransportInfo where
5193− parseJSON = withObject "NodeTransportInfo" parse
5194− where
5195− parse o = NodeTransportInfo <$> (maybe (return mempty) parseProfiles =<< o .:? "profiles")
5196− <*> parseJSON (Object o)
5197− parseProfiles (Object o) | HM.null o = return []
5198− parseProfiles v@(Array _) = parseJSON v
5199− parseProfiles Null = return []
5200− parseProfiles _ = fail "Could not parse profiles"
5201−
5202−instance FromJSON NodeNetworkInfo where
5203− parseJSON = withObject "NodeNetworkInfo" parse
5204− where
5205− parse o = NodeNetworkInfo <$> o .: "primary_interface"
5206− <*> (unMS <$> o .: "refresh_interval_in_millis")
5207−
5208−
5209−instance FromJSON NodeNetworkInterface where
5210− parseJSON = withObject "NodeNetworkInterface" parse
5211− where
5212− parse o = NodeNetworkInterface <$> o .: "mac_address"
5213− <*> o .: "name"
5214− <*> o .: "address"
src/Database/Bloodhound/Types/Class.hsdeleted−17
@@ -1,17 +0,0 @@
1−{-# LANGUAGE CPP #-}
2−module Database.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/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.Bloodhound.Types.Internal
19− ( BHEnv(..)
20− , Server(..)
21− , MonadBH(..)
22− ) where
23−
24−
25−import Control.Applicative as A
26−import Control.Monad.Reader
27−import Data.Aeson
28−import Data.Text (Text)
29−import Data.Typeable (Typeable)
30−import GHC.Generics (Generic)
31−import Network.HTTP.Client
32−
33−{-| Common environment for Elasticsearch calls. Connections will be
34− pipelined according to the provided HTTP connection manager.
35−-}
36−data BHEnv = BHEnv { bhServer :: Server
37− , bhManager :: Manager
38− , bhRequestHook :: Request -> IO Request
39− -- ^ Low-level hook that is run before every request is sent. Used to implement custom authentication strategies. Defaults to 'return' with 'mkBHEnv'.
40− }
41−
42−instance (Functor m, Applicative m, MonadIO m) => MonadBH (ReaderT BHEnv m) where
43− getBHEnv = ask
44−
45−{-| 'Server' is used with the client functions to point at the ES instance
46−-}
47−newtype Server = Server Text deriving (Eq, Show, Generic, Typeable, FromJSON)
48−
49−{-| All API calls to Elasticsearch operate within
50− MonadBH
51− . The idea is that it can be easily embedded in your
52− own monad transformer stack. A default instance for a ReaderT and
53− alias 'BH' is provided for the simple case.
54−-}
55−class (Functor m, A.Applicative m, MonadIO m) => MonadBH m where
56− getBHEnv :: m BHEnv
57−
stack-7.10.yamldeleted−16
@@ -1,16 +0,0 @@
1−flags: {}
2−packages:
3−- '.'
4−extra-deps:
5−- http-client-0.5.0
6−- aeson-0.11.1.0
7−- fail-4.9.0.0
8−- http-types-0.9
9−- attoparsec-0.13.0.1
10−- doctest-0.10.1
11−- doctest-prop-0.2.0.1
12−- quickcheck-properties-0.1
13−- semigroups-0.18.0.1
14−- uri-bytestring-0.1.9
15−- temporary-resourcet-0.1.0.0
16−resolver: lts-6.12
stack-7.8.yamldeleted−19
@@ -1,19 +0,0 @@
1−flags:
2− aeson:
3− old-locale: true
4−packages:
5−- '.'
6−extra-deps:
7−- aeson-0.11.1.0
8−- fail-4.9.0.0
9−- http-types-0.9
10−- http-client-0.5.0
11−- attoparsec-0.13.0.1
12−- doctest-0.10.1
13−- doctest-prop-0.2.0.1
14−- quickcheck-properties-0.1
15−- semigroups-0.18.0.1
16−- tagged-0.8.3
17−- uri-bytestring-0.1.9
18−- void-0.7.1
19−resolver: lts-2.18
stack-8.0.yaml+8−12
@@ -1,16 +1,12 @@
1−flags: {}
1+flags:
2+ bloodhound-examples:
3+ werror: true
4+
2packages:
5packages:
3- '.'
6- '.'
7+- './examples'
4extra-deps:
8extra-deps:
5−- doctest-prop-0.2.0.1
9+ - quickcheck-properties-0.1
6−- quickcheck-properties-0.1
10+ - quickcheck-arbitrary-template-0.2.0.0
7
11
8−# - http-client-0.5.0
9−# - fail-4.9.0.0
10−# - http-types-0.9
11−# - attoparsec-0.13.0.1
12−# - doctest-0.10.1
13−# - semigroups-0.18.0.1
14−# - uri-bytestring-0.1.9
15−# - temporary-resourcet-0.1.0.0
16−resolver: nightly-2016-08-20
12+resolver: lts-8.14
stack-8.2.yamlnew file+15
@@ -0,0 +1,15 @@
1+flags:
2+ bloodhound-examples:
3+ werror: true
4+
5+packages:
6+ - '.'
7+ - './examples'
8+
9+extra-deps:
10+ - aeson-1.3.0.0
11+ - http-types-0.12.1
12+ - quickcheck-arbitrary-template-0.2.0.0
13+ - quickcheck-properties-0.1
14+
15+resolver: lts-11.6
stack-8.2.yaml.locknew file+40
@@ -0,0 +1,40 @@
1+# This file was autogenerated by Stack.
2+# You should not edit this file by hand.
3+# For more information, please see the documentation at:
4+# https://docs.haskellstack.org/en/stable/lock_files
5+
6+packages:
7+- completed:
8+ hackage: aeson-1.3.0.0@sha256:23c353da98033eab7dca65d496df6c79c929f8d1413119648d1de01e703fbd3b,6539
9+ pantry-tree:
10+ size: 39767
11+ sha256: 68512381071165c48e123cf515c1098ee455ec75b56724e31f6d570d3c865c47
12+ original:
13+ hackage: aeson-1.3.0.0
14+- completed:
15+ hackage: http-types-0.12.1@sha256:12ce2fc081fde3cf219b630c2fb3815183a64eee236ba7aa735f666eab949610,2035
16+ pantry-tree:
17+ size: 832
18+ sha256: c66c35b8f4f1b8b82f99cf8de3711027b5d0cc64bd031ab84375100038f81310
19+ original:
20+ hackage: http-types-0.12.1
21+- completed:
22+ hackage: quickcheck-arbitrary-template-0.2.0.0@sha256:c8afad9c6e1f2a1d9813bb6c94158a99f7d6edeae8bb696b29d6c450f67811ec,2025
23+ pantry-tree:
24+ size: 625
25+ sha256: 64262d8f3365305c35babbb2f5727ea3287c3fad61d3b66c3a2c68185fe92c5a
26+ original:
27+ hackage: quickcheck-arbitrary-template-0.2.0.0
28+- completed:
29+ hackage: quickcheck-properties-0.1@sha256:3bd0890e84ec4cf1c1e6e475152c2c0d7c85915a051cf4e8bf9ec70c32df735c,1268
30+ pantry-tree:
31+ size: 550
32+ sha256: 12264d8a89883b42e78c313792f8cba9af51c8fda915fce34e9780ff6972cf7e
33+ original:
34+ hackage: quickcheck-properties-0.1
35+snapshots:
36+- completed:
37+ size: 507208
38+ url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/11/6.yaml
39+ sha256: 99d52f009dc5a53ac61ffc4e6044f910ca7b28b4596b6962135a48e8c7d3d093
40+ original: lts-11.6
stack-8.4.yamlnew file+15
@@ -0,0 +1,15 @@
1+flags:
2+ bloodhound-examples:
3+ werror: true
4+
5+packages:
6+ - '.'
7+ - './examples'
8+
9+# extra-deps:
10+# - aeson-1.3.0.0
11+# - http-types-0.12.1
12+# - quickcheck-arbitrary-template-0.2.0.0
13+# - quickcheck-properties-0.1
14+
15+resolver: lts-12.6
stack-8.4.yaml.locknew file+12
@@ -0,0 +1,12 @@
1+# This file was autogenerated by Stack.
2+# You should not edit this file by hand.
3+# For more information, please see the documentation at:
4+# https://docs.haskellstack.org/en/stable/lock_files
5+
6+packages: []
7+snapshots:
8+- completed:
9+ size: 502349
10+ url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/12/6.yaml
11+ sha256: fbce9f11b2f1c637855eb29fe952f3ac16c35d46836df0dee0cc54a85e1e33d6
12+ original: lts-12.6
stack-8.6.yamlnew file+14
@@ -0,0 +1,14 @@
1+flags:
2+ bloodhound-examples:
3+ werror: true
4+
5+packages:
6+ - '.'
7+ - './examples'
8+
9+extra-deps:
10+ - git: https://github.com/bitemyapp/quickcheck-arbitrary-template.git
11+ commit: bf9cee96a88ecce2ff920ce74c166a38712e5ed2
12+ - quickcheck-properties-0.1
13+
14+resolver: lts-13.30
stack-8.6.yaml.locknew file+33
@@ -0,0 +1,33 @@
1+# This file was autogenerated by Stack.
2+# You should not edit this file by hand.
3+# For more information, please see the documentation at:
4+# https://docs.haskellstack.org/en/stable/lock_files
5+
6+packages:
7+- completed:
8+ cabal-file:
9+ size: 2026
10+ sha256: d340ae2f3fd0b54b2f899d482072be24f41eddac8ea081f11d9db260b14264c8
11+ name: quickcheck-arbitrary-template
12+ version: 0.2.0.0
13+ git: https://github.com/bitemyapp/quickcheck-arbitrary-template.git
14+ pantry-tree:
15+ size: 859
16+ sha256: a6c70780465af154ada9481c0a5ffcda1b069d249522634c578218c3c390cbf1
17+ commit: bf9cee96a88ecce2ff920ce74c166a38712e5ed2
18+ original:
19+ git: https://github.com/bitemyapp/quickcheck-arbitrary-template.git
20+ commit: bf9cee96a88ecce2ff920ce74c166a38712e5ed2
21+- completed:
22+ hackage: quickcheck-properties-0.1@sha256:3bd0890e84ec4cf1c1e6e475152c2c0d7c85915a051cf4e8bf9ec70c32df735c,1268
23+ pantry-tree:
24+ size: 550
25+ sha256: 12264d8a89883b42e78c313792f8cba9af51c8fda915fce34e9780ff6972cf7e
26+ original:
27+ hackage: quickcheck-properties-0.1
28+snapshots:
29+- completed:
30+ size: 500539
31+ url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/13/30.yaml
32+ sha256: 59ad6b944c9903847fecdc1d4815e8500c1f9999d80fd1b4d2d66e408faec44b
33+ original: lts-13.30
stack.yaml+1−1
@@ -1 +1 @@
1−stack-7.10.yaml
1+stack-8.6.yaml
stack.yaml.locknew file+12
@@ -0,0 +1,12 @@
1+# This file was autogenerated by Stack.
2+# You should not edit this file by hand.
3+# For more information, please see the documentation at:
4+# https://docs.haskellstack.org/en/stable/lock_files
5+
6+packages: []
7+snapshots:
8+- completed:
9+ size: 500539
10+ url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/13/30.yaml
11+ sha256: 59ad6b944c9903847fecdc1d4815e8500c1f9999d80fd1b4d2d66e408faec44b
12+ original: lts-13.30
tests/Test/Aggregation.hsnew file+147
@@ -0,0 +1,147 @@
1+{-# LANGUAGE OverloadedStrings #-}
2+
3+module Test.Aggregation (spec) where
4+
5+import Test.Common
6+import Test.Import
7+
8+import Control.Error (fmapL, note)
9+import qualified Data.Map as M
10+import qualified Database.Bloodhound
11+
12+spec :: Spec
13+spec =
14+ describe "Aggregation API" $ do
15+ it "returns term aggregation results" $ withTestEnv $ do
16+ _ <- insertData
17+ let terms = TermsAgg $ mkTermsAggregation "user"
18+ let search = mkAggregateSearch Nothing $ mkAggregations "users" terms
19+ searchExpectAggs search
20+ searchValidBucketAgg search "users" toTerms
21+
22+ it "return sub-aggregation results" $ withTestEnv $ do
23+ _ <- insertData
24+ let subaggs = mkAggregations "age_agg" . TermsAgg $ mkTermsAggregation "age"
25+ agg = TermsAgg $ (mkTermsAggregation "user") { termAggs = Just subaggs}
26+ search = mkAggregateSearch Nothing $ mkAggregations "users" agg
27+ reply <- searchByIndex testIndex search
28+ let result = decode (responseBody reply) :: Maybe (SearchResult Tweet)
29+ usersAggResults = result >>= aggregations >>= toTerms "users"
30+ subAggResults = usersAggResults >>= (listToMaybe . buckets) >>= termsAggs >>= toTerms "age_agg"
31+ subAddResultsExists = isJust subAggResults
32+ liftIO $ subAddResultsExists `shouldBe` True
33+
34+ it "returns cardinality aggregation results" $ withTestEnv $ do
35+ _ <- insertData
36+ let cardinality = CardinalityAgg $ mkCardinalityAggregation $ FieldName "user"
37+ let search = mkAggregateSearch Nothing $ mkAggregations "users" cardinality
38+ let search' = search { Database.Bloodhound.from = From 0, size = Size 0 }
39+ searchExpectAggs search'
40+ let docCountPair k n = (k, object ["value" .= Number n])
41+ res <- searchTweets search'
42+ liftIO $
43+ fmap aggregations res `shouldBe` Right (Just (M.fromList [ docCountPair "users" 1]))
44+
45+ it "returns stats aggregation results" $ withTestEnv $ do
46+ _ <- insertData
47+ let stats = StatsAgg $ mkStatsAggregation $ FieldName "age"
48+ let search = mkAggregateSearch Nothing $ mkAggregations "users" stats
49+ let search' = search { Database.Bloodhound.from = From 0, size = Size 0 }
50+ searchExpectAggs search'
51+ let statsAggRes k n = (k, object [ "max" .= Number n
52+ , "avg" .= Number n
53+ , "count" .= Number 1
54+ , "min" .= Number n
55+ , "sum" .= Number n])
56+ res <- searchTweets search'
57+ liftIO $
58+ fmap aggregations res `shouldBe` Right (Just (M.fromList [ statsAggRes "users" 10000]))
59+
60+ it "can give collection hint parameters to term aggregations" $ when' (atleast es13) $ withTestEnv $ do
61+ _ <- insertData
62+ let terms = TermsAgg $ (mkTermsAggregation "user") { termCollectMode = Just BreadthFirst }
63+ let search = mkAggregateSearch Nothing $ mkAggregations "users" terms
64+ searchExpectAggs search
65+ searchValidBucketAgg search "users" toTerms
66+
67+ -- One of these fails with 1.7.3
68+ it "can give execution hint parameters to term aggregations" $ when' (atmost es11) $ withTestEnv $ do
69+ _ <- insertData
70+ searchTermsAggHint [Map, Ordinals]
71+
72+ it "can give execution hint parameters to term aggregations" $ when' (is es12) $ withTestEnv $ do
73+ _ <- insertData
74+ searchTermsAggHint [GlobalOrdinals, GlobalOrdinalsHash, GlobalOrdinalsLowCardinality, Map, Ordinals]
75+
76+ it "can give execution hint parameters to term aggregations" $ when' (atleast es12) $ withTestEnv $ do
77+ _ <- insertData
78+ searchTermsAggHint [GlobalOrdinals, GlobalOrdinalsHash, GlobalOrdinalsLowCardinality, Map]
79+ -- One of the above.
80+
81+ it "can execute value_count aggregations" $ withTestEnv $ do
82+ _ <- insertData
83+ _ <- insertOther
84+ let ags = mkAggregations "user_count" (ValueCountAgg (FieldValueCount (FieldName "user"))) <>
85+ mkAggregations "bogus_count" (ValueCountAgg (FieldValueCount (FieldName "bogus")))
86+ let search = mkAggregateSearch Nothing ags
87+ let docCountPair k n = (k, object ["value" .= Number n])
88+ res <- searchTweets search
89+ liftIO $
90+ fmap aggregations res `shouldBe` Right (Just (M.fromList [ docCountPair "user_count" 2
91+ , docCountPair "bogus_count" 0
92+ ]))
93+
94+ it "can execute date_range aggregations" $ withTestEnv $ do
95+ let now = fromGregorian 2015 3 14
96+ let ltAMonthAgo = UTCTime (fromGregorian 2015 3 1) 0
97+ let ltAWeekAgo = UTCTime (fromGregorian 2015 3 10) 0
98+ let oldDoc = exampleTweet { postDate = ltAMonthAgo }
99+ let newDoc = exampleTweet { postDate = ltAWeekAgo }
100+ _ <- indexDocument testIndex testMapping defaultIndexDocumentSettings oldDoc (DocId "1")
101+ _ <- indexDocument testIndex testMapping defaultIndexDocumentSettings newDoc (DocId "2")
102+ _ <- refreshIndex testIndex
103+ let thisMonth = DateRangeFrom (DateMathExpr (DMDate now) [SubtractTime 1 DMMonth])
104+ let thisWeek = DateRangeFrom (DateMathExpr (DMDate now) [SubtractTime 1 DMWeek])
105+ let agg = DateRangeAggregation (FieldName "postDate") Nothing (thisMonth :| [thisWeek])
106+ let ags = mkAggregations "date_ranges" (DateRangeAgg agg)
107+ let search = mkAggregateSearch Nothing ags
108+ res <- searchTweets search
109+ liftIO $ hitsTotal . searchHits <$> res `shouldBe` Right 2
110+ let bucks = do magrs <- fmapL show (aggregations <$> res)
111+ agrs <- note "no aggregations returned" magrs
112+ rawBucks <- note "no date_ranges aggregation" $ M.lookup "date_ranges" agrs
113+ parseEither parseJSON rawBucks
114+ let fromMonthT = UTCTime (fromGregorian 2015 2 14) 0
115+ let fromWeekT = UTCTime (fromGregorian 2015 3 7) 0
116+ liftIO $ buckets <$> bucks `shouldBe` Right [ DateRangeResult "2015-02-14T00:00:00.000Z-*"
117+ (Just fromMonthT)
118+ (Just "2015-02-14T00:00:00.000Z")
119+ Nothing
120+ Nothing
121+ 2
122+ Nothing
123+ , DateRangeResult "2015-03-07T00:00:00.000Z-*"
124+ (Just fromWeekT)
125+ (Just "2015-03-07T00:00:00.000Z")
126+ Nothing
127+ Nothing
128+ 1
129+ Nothing
130+ ]
131+
132+ it "returns date histogram aggregation results" $ withTestEnv $ do
133+ _ <- insertData
134+ let histogram = DateHistogramAgg $ mkDateHistogram (FieldName "postDate") Minute
135+ let search = mkAggregateSearch Nothing (mkAggregations "byDate" histogram)
136+ searchExpectAggs search
137+ searchValidBucketAgg search "byDate" toDateHistogram
138+
139+ it "can execute missing aggregations" $ withTestEnv $ do
140+ _ <- insertData
141+ _ <- insertExtra
142+ let ags = mkAggregations "missing_agg" (MissingAgg (MissingAggregation "extra"))
143+ let search = mkAggregateSearch Nothing ags
144+ let docCountPair k n = (k, object ["doc_count" .= Number n])
145+ res <- searchTweets search
146+ liftIO $
147+ fmap aggregations res `shouldBe` Right (Just (M.fromList [docCountPair "missing_agg" 1]))
tests/Test/ApproxEq.hsnew file+63
@@ -0,0 +1,63 @@
1+{-# LANGUAGE DefaultSignatures #-}
2+{-# LANGUAGE OverloadedStrings #-}
3+
4+module Test.ApproxEq where
5+
6+import Database.Bloodhound
7+
8+import Test.Import
9+
10+import qualified Data.List.NonEmpty as NE
11+
12+-- | Typeclass for "equal where it matters". Use this to specify
13+-- less-strict equivalence for things such as lists that can wind up
14+-- in an unpredictable order
15+class ApproxEq a where
16+ (=~) :: a -> a -> Bool
17+
18+ showApproxEq :: a -> String
19+ default showApproxEq :: (Show a) => a -> String
20+ showApproxEq = show
21+
22+(==~) :: (ApproxEq a) => a -> a -> Property
23+a ==~ b = counterexample (showApproxEq a ++ " !=~ " ++ showApproxEq b) (a =~ b)
24+
25+instance ApproxEq NominalDiffTime where (=~) = (==)
26+instance ApproxEq Bool where (=~) = (==)
27+instance ApproxEq Int where (=~) = (==)
28+instance (Eq a, Show a) => ApproxEq (Maybe a) where (=~) = (==)
29+instance ApproxEq Char where
30+ (=~) = (==)
31+
32+instance ApproxEq NodeAttrFilter where (=~) = (==)
33+instance ApproxEq NodeAttrName where (=~) = (==)
34+instance (Eq a, Show a) => ApproxEq (NonEmpty a) where (=~) = (==)
35+instance (ApproxEq l, Show l, ApproxEq r, Show r) => ApproxEq (Either l r) where
36+ Left a =~ Left b = a =~ b
37+ Right a =~ Right b = a =~ b
38+ _ =~ _ = False
39+ showApproxEq (Left x) = "Left " <> showApproxEq x
40+ showApproxEq (Right x) = "Right " <> showApproxEq x
41+instance (ApproxEq a, Show a) => ApproxEq [a] where
42+ as =~ bs = and (zipWith (=~) as bs)
43+instance ApproxEq ReplicaCount where (=~) = (==)
44+instance ApproxEq ReplicaBounds where (=~) = (==)
45+instance ApproxEq Bytes where (=~) = (==)
46+instance ApproxEq AllocationPolicy where (=~) = (==)
47+instance ApproxEq InitialShardCount where (=~) = (==)
48+instance ApproxEq FSType where (=~) = (==)
49+
50+-- | Due to the way nodeattrfilters get serialized here, they may come
51+-- out in a different order, but they are morally equivalent
52+instance ApproxEq UpdatableIndexSetting where
53+ RoutingAllocationInclude a =~ RoutingAllocationInclude b =
54+ NE.sort a =~ NE.sort b
55+ RoutingAllocationExclude a =~ RoutingAllocationExclude b =
56+ NE.sort a =~ NE.sort b
57+ RoutingAllocationRequire a =~ RoutingAllocationRequire b =
58+ NE.sort a =~ NE.sort b
59+ a =~ b = a == b
60+ showApproxEq (RoutingAllocationInclude xs) = show (RoutingAllocationInclude (NE.sort xs))
61+ showApproxEq (RoutingAllocationExclude xs) = show (RoutingAllocationExclude (NE.sort xs))
62+ showApproxEq (RoutingAllocationRequire xs) = show (RoutingAllocationRequire (NE.sort xs))
63+ showApproxEq x = show x
tests/Test/BulkAPI.hsnew file+95
@@ -0,0 +1,95 @@
1+{-# LANGUAGE OverloadedStrings #-}
2+
3+module Test.BulkAPI (spec) where
4+
5+import Test.Common
6+import Test.Import
7+
8+import qualified Data.Vector as V
9+import qualified Lens.Micro.Aeson as LMA
10+
11+newtype BulkTest =
12+ BulkTest Text
13+ deriving (Eq, Show)
14+
15+instance ToJSON BulkTest where
16+ toJSON (BulkTest name') =
17+ object ["name" .= name']
18+
19+instance FromJSON BulkTest where
20+ parseJSON = withObject "BulkTest" parse
21+ where
22+ parse o = do
23+ t <- o .: "name"
24+ BulkTest <$> parseJSON t
25+
26+spec :: Spec
27+spec =
28+ describe "Bulk API" $
29+ it "inserts all documents we request" $ withTestEnv $ do
30+ _ <- insertData
31+ let firstTest = BulkTest "blah"
32+ let secondTest = BulkTest "bloo"
33+ let thirdTest = BulkTest "graffle"
34+ let fourthTest = BulkTest "garabadoo"
35+ let fifthTest = BulkTest "serenity"
36+ let firstDoc = BulkIndex testIndex
37+ testMapping (DocId "2") (toJSON firstTest)
38+ let secondDoc = BulkCreate testIndex
39+ testMapping (DocId "3") (toJSON secondTest)
40+ let thirdDoc = BulkCreateEncoding testIndex
41+ testMapping (DocId "4") (toEncoding thirdTest)
42+ let fourthDoc = BulkIndexAuto testIndex
43+ testMapping (toJSON fourthTest)
44+ let fifthDoc = BulkIndexEncodingAuto testIndex
45+ testMapping (toEncoding fifthTest)
46+ let stream = V.fromList [firstDoc, secondDoc, thirdDoc, fourthDoc, fifthDoc]
47+ _ <- bulk stream
48+ -- liftIO $ pPrint bulkResp
49+ _ <- refreshIndex testIndex
50+ -- liftIO $ pPrint refreshResp
51+ fDoc <- getDocument testIndex testMapping (DocId "2")
52+ sDoc <- getDocument testIndex testMapping (DocId "3")
53+ tDoc <- getDocument testIndex testMapping (DocId "4")
54+ -- note that we cannot query for fourthDoc and fifthDoc since we
55+ -- do not know their autogenerated ids.
56+ let maybeFirst =
57+ eitherDecode
58+ $ responseBody fDoc
59+ :: Either String (EsResult BulkTest)
60+ let maybeSecond =
61+ eitherDecode
62+ $ responseBody sDoc
63+ :: Either String (EsResult BulkTest)
64+ let maybeThird =
65+ eitherDecode
66+ $ responseBody tDoc
67+ :: Either String (EsResult BulkTest)
68+ -- liftIO $ pPrint [maybeFirst, maybeSecond, maybeThird]
69+ liftIO $ do
70+ fmap getSource maybeFirst `shouldBe` Right (Just firstTest)
71+ fmap getSource maybeSecond `shouldBe` Right (Just secondTest)
72+ fmap getSource maybeThird `shouldBe` Right (Just thirdTest)
73+ -- Since we can't get the docs by doc id, we check for their existence in
74+ -- a match all query.
75+ let query = MatchAllQuery Nothing
76+ let search = mkSearch (Just query) Nothing
77+ resp <- searchByIndex testIndex search
78+ parsed <- parseEsResponse resp :: BH IO (Either EsError (SearchResult Value))
79+ case parsed of
80+ Left e ->
81+ liftIO $ expectationFailure ("Expected a script-transformed result but got: " <> show e)
82+ (Right sr) -> do
83+ liftIO $
84+ hitsTotal (searchHits sr) `shouldBe` 6
85+ let nameList :: [Text]
86+ nameList =
87+ hits (searchHits sr)
88+ ^.. traverse
89+ . to hitSource
90+ . _Just
91+ . LMA.key "name"
92+ . _String
93+ liftIO $
94+ nameList
95+ `shouldBe` ["blah","bloo","graffle","garabadoo","serenity"]
tests/Test/Common.hsnew file+292
@@ -0,0 +1,292 @@
1+{-# LANGUAGE OverloadedStrings #-}
2+{-# LANGUAGE TemplateHaskell #-}
3+
4+module Test.Common where
5+
6+import Test.Import
7+
8+import qualified Data.Map as M
9+import qualified Data.SemVer as SemVer
10+import qualified Network.HTTP.Types.Status as NHTS
11+
12+testServer :: Server
13+testServer = Server "http://localhost:9200"
14+testIndex :: IndexName
15+testIndex = IndexName "bloodhound-tests-twitter-1"
16+testMapping :: MappingName
17+testMapping = MappingName "tweet"
18+
19+withTestEnv :: BH IO a -> IO a
20+withTestEnv = withBH defaultManagerSettings testServer
21+
22+data Location = Location { lat :: Double
23+ , lon :: Double } deriving (Eq, Show)
24+
25+data Tweet = Tweet { user :: Text
26+ , postDate :: UTCTime
27+ , message :: Text
28+ , age :: Int
29+ , location :: Location
30+ , extra :: Maybe Text }
31+ deriving (Eq, Show)
32+
33+$(deriveJSON defaultOptions ''Location)
34+$(deriveJSON defaultOptions ''Tweet)
35+
36+data ParentMapping = ParentMapping deriving (Eq, Show)
37+
38+instance ToJSON ParentMapping where
39+ toJSON ParentMapping =
40+ object ["properties" .=
41+ object [ "user" .= object ["type" .= ("string" :: Text)
42+ , "fielddata" .= True
43+ ]
44+ -- Serializing the date as a date is breaking other tests, mysteriously.
45+ -- , "postDate" .= object [ "type" .= ("date" :: Text)
46+ -- , "format" .= ("YYYY-MM-dd`T`HH:mm:ss.SSSZZ" :: Text)]
47+ , "message" .= object ["type" .= ("string" :: Text)]
48+ , "age" .= object ["type" .= ("integer" :: Text)]
49+ , "location" .= object ["type" .= ("geo_point" :: Text)]
50+ , "extra" .= object ["type" .= ("keyword" :: Text)]
51+ ]]
52+
53+es11 :: SemVer.Version
54+es11 = SemVer.version 1 1 0 [] []
55+
56+es13 :: SemVer.Version
57+es13 = SemVer.version 1 3 0 [] []
58+
59+es12 :: SemVer.Version
60+es12 = SemVer.version 1 2 0 [] []
61+
62+es14 :: SemVer.Version
63+es14 = SemVer.version 1 4 0 [] []
64+
65+es15 :: SemVer.Version
66+es15 = SemVer.version 1 5 0 [] []
67+
68+es16 :: SemVer.Version
69+es16 = SemVer.version 1 6 0 [] []
70+
71+es20 :: SemVer.Version
72+es20 = SemVer.version 2 0 0 [] []
73+
74+es50 :: SemVer.Version
75+es50 = SemVer.version 5 0 0 [] []
76+
77+getServerVersion :: IO (Maybe SemVer.Version)
78+getServerVersion = fmap extractVersion <$> withTestEnv getStatus
79+ where
80+ extractVersion = versionNumber . number . version
81+
82+createExampleIndex :: (MonadBH m) => m Reply
83+createExampleIndex =
84+ createIndex (IndexSettings (ShardCount 1) (ReplicaCount 0)) testIndex
85+
86+deleteExampleIndex :: (MonadBH m) => m Reply
87+deleteExampleIndex =
88+ deleteIndex testIndex
89+
90+validateStatus :: Show body => Response body -> Int -> Expectation
91+validateStatus resp expected =
92+ if actual == expected
93+ then return ()
94+ else expectationFailure ("Expected " <> show expected <> " but got " <> show actual <> ": " <> show body)
95+ where
96+ actual = NHTS.statusCode (responseStatus resp)
97+ body = responseBody resp
98+
99+data ChildMapping = ChildMapping deriving (Eq, Show)
100+
101+instance ToJSON ChildMapping where
102+ toJSON ChildMapping =
103+ object ["_parent" .= object ["type" .= ("parent" :: Text)]
104+ , "properties" .=
105+ object [ "user" .= object ["type" .= ("string" :: Text)
106+ , "fielddata" .= True
107+ ]
108+ -- Serializing the date as a date is breaking other tests, mysteriously.
109+ -- , "postDate" .= object [ "type" .= ("date" :: Text)
110+ -- , "format" .= ("YYYY-MM-dd`T`HH:mm:ss.SSSZZ" :: Text)]
111+ , "message" .= object ["type" .= ("string" :: Text)]
112+ , "age" .= object ["type" .= ("integer" :: Text)]
113+ , "location" .= object ["type" .= ("geo_point" :: Text)]
114+ , "extra" .= object ["type" .= ("keyword" :: Text)]
115+ ]]
116+
117+data TweetMapping = TweetMapping deriving (Eq, Show)
118+
119+instance ToJSON TweetMapping where
120+ toJSON TweetMapping =
121+ object ["tweet" .=
122+ object ["properties" .=
123+ object [ "user" .= object [ "type" .= ("string" :: Text)
124+ , "fielddata" .= True
125+ ]
126+ -- Serializing the date as a date is breaking other tests, mysteriously.
127+ -- , "postDate" .= object [ "type" .= ("date" :: Text)
128+ -- , "format" .= ("YYYY-MM-dd`T`HH:mm:ss.SSSZZ" :: Text)]
129+ , "message" .= object ["type" .= ("string" :: Text)]
130+ , "age" .= object ["type" .= ("integer" :: Text)]
131+ , "location" .= object ["type" .= ("geo_point" :: Text)]
132+ , "extra" .= object ["type" .= ("keyword" :: Text)]
133+ ]]]
134+
135+exampleTweet :: Tweet
136+exampleTweet = Tweet { user = "bitemyapp"
137+ , postDate = UTCTime
138+ (ModifiedJulianDay 55000)
139+ (secondsToDiffTime 10)
140+ , message = "Use haskell!"
141+ , age = 10000
142+ , location = Location 40.12 (-71.34)
143+ , extra = Nothing }
144+
145+tweetWithExtra :: Tweet
146+tweetWithExtra = Tweet { user = "bitemyapp"
147+ , postDate = UTCTime
148+ (ModifiedJulianDay 55000)
149+ (secondsToDiffTime 10)
150+ , message = "Use haskell!"
151+ , age = 10000
152+ , location = Location 40.12 (-71.34)
153+ , extra = Just "blah blah" }
154+
155+newAge :: Int
156+newAge = 31337
157+
158+newUser :: Text
159+newUser = "someotherapp"
160+
161+tweetPatch :: Value
162+tweetPatch =
163+ object [ "age" .= newAge
164+ , "user" .= newUser
165+ ]
166+
167+patchedTweet :: Tweet
168+patchedTweet = exampleTweet{age = newAge, user = newUser}
169+
170+otherTweet :: Tweet
171+otherTweet = Tweet { user = "notmyapp"
172+ , postDate = UTCTime
173+ (ModifiedJulianDay 55000)
174+ (secondsToDiffTime 11)
175+ , message = "Use haskell!"
176+ , age = 1000
177+ , location = Location 40.12 (-71.34)
178+ , extra = Nothing }
179+
180+resetIndex :: BH IO ()
181+resetIndex = do
182+ _ <- deleteExampleIndex
183+ _ <- createExampleIndex
184+ _ <- putMapping testIndex testMapping TweetMapping
185+ return ()
186+
187+insertData :: BH IO Reply
188+insertData = do
189+ resetIndex
190+ insertData' defaultIndexDocumentSettings
191+
192+insertData' :: IndexDocumentSettings -> BH IO Reply
193+insertData' ids = do
194+ r <- indexDocument testIndex testMapping ids exampleTweet (DocId "1")
195+ _ <- refreshIndex testIndex
196+ return r
197+
198+updateData :: BH IO Reply
199+updateData = do
200+ r <- updateDocument testIndex testMapping defaultIndexDocumentSettings tweetPatch (DocId "1")
201+ _ <- refreshIndex testIndex
202+ return r
203+
204+insertOther :: BH IO ()
205+insertOther = do
206+ _ <- indexDocument testIndex testMapping defaultIndexDocumentSettings otherTweet (DocId "2")
207+ _ <- refreshIndex testIndex
208+ return ()
209+
210+insertExtra :: BH IO ()
211+insertExtra = do
212+ _ <- indexDocument testIndex testMapping defaultIndexDocumentSettings tweetWithExtra (DocId "4")
213+ _ <- refreshIndex testIndex
214+ return ()
215+
216+insertWithSpaceInId :: BH IO ()
217+insertWithSpaceInId = do
218+ _ <- indexDocument testIndex testMapping defaultIndexDocumentSettings exampleTweet (DocId "Hello World")
219+ _ <- refreshIndex testIndex
220+ return ()
221+
222+searchTweet :: Search -> BH IO (Either EsError Tweet)
223+searchTweet search = do
224+ result <- searchTweets search
225+ let myTweet :: Either EsError Tweet
226+ myTweet = grabFirst result
227+ return myTweet
228+
229+searchTweets :: Search -> BH IO (Either EsError (SearchResult Tweet))
230+searchTweets search = parseEsResponse =<< searchByIndex testIndex search
231+
232+searchExpectNoResults :: Search -> BH IO ()
233+searchExpectNoResults search = do
234+ result <- searchTweets search
235+ let emptyHits = fmap (hits . searchHits) result
236+ liftIO $
237+ emptyHits `shouldBe` Right []
238+
239+searchExpectAggs :: Search -> BH IO ()
240+searchExpectAggs search = do
241+ reply <- searchByIndex testIndex search
242+ let isEmpty x = return (M.null x)
243+ let result = decode (responseBody reply) :: Maybe (SearchResult Tweet)
244+ liftIO $
245+ (result >>= aggregations >>= isEmpty) `shouldBe` Just False
246+
247+searchValidBucketAgg :: (BucketAggregation a, FromJSON a, Show a) =>
248+ Search -> Text -> (Text -> AggregationResults -> Maybe (Bucket a)) -> BH IO ()
249+searchValidBucketAgg search aggKey extractor = do
250+ reply <- searchByIndex testIndex search
251+ let bucketDocs = docCount . head . buckets
252+ let result = decode (responseBody reply) :: Maybe (SearchResult Tweet)
253+ let count = result >>= aggregations >>= extractor aggKey >>= \x -> return (bucketDocs x)
254+ liftIO $
255+ count `shouldBe` Just 1
256+
257+searchTermsAggHint :: [ExecutionHint] -> BH IO ()
258+searchTermsAggHint hints = do
259+ let terms hint = TermsAgg $ (mkTermsAggregation "user") { termExecutionHint = Just hint }
260+ let search hint = mkAggregateSearch Nothing $ mkAggregations "users" $ terms hint
261+ forM_ hints $ searchExpectAggs . search
262+ forM_ hints (\x -> searchValidBucketAgg (search x) "users" toTerms)
263+
264+searchTweetHighlight :: Search
265+ -> BH IO (Either EsError (Maybe HitHighlight))
266+searchTweetHighlight search = do
267+ result <- searchTweets search
268+ let tweetHit :: Either EsError (Maybe (Hit Tweet))
269+ tweetHit = fmap (headMay . hits . searchHits) result
270+ myHighlight :: Either EsError (Maybe HitHighlight)
271+ myHighlight = (join . fmap hitHighlight) <$> tweetHit
272+ return myHighlight
273+
274+searchExpectSource :: Source -> Either EsError Value -> BH IO ()
275+searchExpectSource src expected = do
276+ _ <- insertData
277+ let query = QueryMatchQuery $ mkMatchQuery (FieldName "_all") (QueryString "haskell")
278+ let search = (mkSearch (Just query) Nothing) { source = Just src }
279+ reply <- searchByIndex testIndex search
280+ result <- parseEsResponse reply
281+ let value = grabFirst result
282+ liftIO $
283+ value `shouldBe` expected
284+
285+atleast :: SemVer.Version -> IO Bool
286+atleast v = getServerVersion >>= \x -> return $ x >= Just v
287+
288+atmost :: SemVer.Version -> IO Bool
289+atmost v = getServerVersion >>= \x -> return $ x <= Just v
290+
291+is :: SemVer.Version -> IO Bool
292+is v = getServerVersion >>= \x -> return $ x == Just v
tests/Test/Documents.hsnew file+51
@@ -0,0 +1,51 @@
1+{-# LANGUAGE OverloadedStrings #-}
2+
3+module Test.Documents where
4+
5+import Test.Common
6+import Test.Import
7+
8+spec :: Spec
9+spec =
10+ describe "document API" $ do
11+ it "indexes, updates, gets, and then deletes the generated document" $ withTestEnv $ do
12+ _ <- insertData
13+ _ <- updateData
14+ docInserted <- getDocument testIndex testMapping (DocId "1")
15+ let newTweet = eitherDecode
16+ (responseBody docInserted) :: Either String (EsResult Tweet)
17+ liftIO $ fmap getSource newTweet `shouldBe` Right (Just patchedTweet)
18+
19+ it "indexes, gets, and then deletes the generated document with a DocId containing a space" $ withTestEnv $ do
20+ _ <- insertWithSpaceInId
21+ docInserted <- getDocument testIndex testMapping (DocId "Hello World")
22+ let newTweet = eitherDecode
23+ (responseBody docInserted) :: Either String (EsResult Tweet)
24+ liftIO $ fmap getSource newTweet `shouldBe` Right (Just exampleTweet)
25+
26+ it "produces a parseable result when looking up a bogus document" $ withTestEnv $ do
27+ doc <- getDocument testIndex testMapping (DocId "bogus")
28+ let noTweet = eitherDecode
29+ (responseBody doc) :: Either String (EsResult Tweet)
30+ liftIO $ fmap foundResult noTweet `shouldBe` Right Nothing
31+
32+ it "can use optimistic concurrency control" $ withTestEnv $ do
33+ let ev = ExternalDocVersion minBound
34+ let cfg = defaultIndexDocumentSettings { idsVersionControl = ExternalGT ev }
35+ resetIndex
36+ res <- insertData' cfg
37+ liftIO $ isCreated res `shouldBe` True
38+ res' <- insertData' cfg
39+ liftIO $ isVersionConflict res' `shouldBe` True
40+
41+ it "indexes two documents in a parent/child relationship and checks that the child exists" $ withTestEnv $ do
42+ resetIndex
43+ _ <- putMapping testIndex (MappingName "child") ChildMapping
44+ _ <- putMapping testIndex (MappingName "parent") ParentMapping
45+ _ <- indexDocument testIndex (MappingName "parent") defaultIndexDocumentSettings exampleTweet (DocId "1")
46+ let parent = (Just . DocumentParent . DocId) "1"
47+ ids = IndexDocumentSettings NoVersionControl parent
48+ _ <- indexDocument testIndex (MappingName "child") ids otherTweet (DocId "2")
49+ _ <- refreshIndex testIndex
50+ exists <- documentExists testIndex (MappingName "child") parent (DocId "2")
51+ liftIO $ exists `shouldBe` True
tests/Test/Generators.hsnew file+563
@@ -0,0 +1,563 @@
1+{-# LANGUAGE CPP #-}
2+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
3+{-# LANGUAGE OverloadedStrings #-}
4+{-# LANGUAGE TemplateHaskell #-}
5+
6+module Test.Generators where
7+
8+import Database.Bloodhound
9+
10+import Test.Import
11+
12+import qualified Data.HashMap.Strict as HM
13+import qualified Data.List as L
14+import qualified Data.List.NonEmpty as NE
15+import qualified Data.Map as M
16+import qualified Data.Text as T
17+import qualified Data.SemVer as SemVer
18+import Test.QuickCheck.TH.Generators
19+
20+import Test.ApproxEq
21+
22+instance Arbitrary NominalDiffTime where
23+ arbitrary = fromInteger <$> arbitrary
24+
25+#if !MIN_VERSION_QuickCheck(2,8,0)
26+instance (Arbitrary k, Ord k, Arbitrary v) => Arbitrary (M.Map k v) where
27+ arbitrary = M.fromList <$> arbitrary
28+#endif
29+
30+instance Arbitrary Text where
31+ arbitrary = T.pack <$> arbitrary
32+
33+instance Arbitrary UTCTime where
34+ arbitrary = UTCTime
35+ <$> arbitrary
36+ <*> (fromRational . toRational <$> choose (0::Double, 86400))
37+
38+instance Arbitrary Day where
39+ arbitrary =
40+ ModifiedJulianDay . (2000 +) <$> arbitrary
41+ shrink =
42+ (ModifiedJulianDay <$>) . shrink . toModifiedJulianDay
43+
44+#if !MIN_VERSION_QuickCheck(2,9,0)
45+instance Arbitrary a => Arbitrary (NonEmpty a) where
46+ arbitrary = liftA2 (:|) arbitrary arbitrary
47+#endif
48+
49+arbitraryScore :: Gen Score
50+arbitraryScore = fmap getPositive <$> arbitrary
51+
52+instance (Arbitrary a, Typeable a) => Arbitrary (Hit a) where
53+ arbitrary = Hit <$> arbitrary
54+ <*> arbitrary
55+ <*> arbitrary
56+ <*> arbitraryScore
57+ <*> arbitrary
58+ <*> return Nothing
59+ <*> arbitrary
60+ <*> arbitrary
61+
62+instance Arbitrary HitFields where
63+ arbitrary = pure (HitFields M.empty)
64+ shrink = const []
65+
66+instance (Arbitrary a, Typeable a) => Arbitrary (SearchHits a) where
67+ arbitrary = reduceSize $ do
68+ tot <- getPositive <$> arbitrary
69+ score <- arbitraryScore
70+ hs <- arbitrary
71+ return $ SearchHits tot score hs
72+
73+
74+reduceSize :: Gen a -> Gen a
75+reduceSize f = sized $ \n -> resize (n `div` 2) f
76+
77+arbitraryAlphaNum :: Gen Char
78+arbitraryAlphaNum = oneof [choose ('a', 'z')
79+ ,choose ('A','Z')
80+ , choose ('0', '9')]
81+
82+instance Arbitrary RoutingValue where
83+ arbitrary = RoutingValue . T.pack <$> listOf1 arbitraryAlphaNum
84+
85+instance Arbitrary AliasRouting where
86+ arbitrary = oneof [allAlias
87+ ,one
88+ ,theOther
89+ ,both']
90+ where one = GranularAliasRouting
91+ <$> (Just <$> arbitrary)
92+ <*> pure Nothing
93+ theOther = GranularAliasRouting Nothing
94+ <$> (Just <$> arbitrary)
95+ both' = GranularAliasRouting
96+ <$> (Just <$> arbitrary)
97+ <*> (Just <$> arbitrary)
98+ allAlias = AllAliasRouting <$> arbitrary
99+
100+
101+
102+instance Arbitrary FieldName where
103+ arbitrary =
104+ FieldName
105+ . T.pack
106+ <$> listOf1 arbitraryAlphaNum
107+
108+
109+#if MIN_VERSION_base(4,10,0)
110+-- Test.QuickCheck.Modifiers
111+
112+qcNonEmptyToNonEmpty :: NonEmptyList a -> NonEmpty a
113+qcNonEmptyToNonEmpty (NonEmpty (a : xs)) = (a :| xs)
114+qcNonEmptyToNonEmpty (NonEmpty []) = error "NonEmpty was empty!"
115+
116+instance Arbitrary a => Arbitrary (NonEmpty a) where
117+ arbitrary =
118+ qcNonEmptyToNonEmpty
119+ <$> arbitrary
120+#endif
121+instance Arbitrary ScriptFields where
122+ arbitrary =
123+ pure $ ScriptFields $
124+ HM.fromList []
125+
126+ shrink = const []
127+
128+instance Arbitrary ScriptParams where
129+ arbitrary =
130+ pure $ ScriptParams $
131+ HM.fromList [ ("a", Number 42)
132+ , ("b", String "forty two")
133+ ]
134+
135+ shrink = const []
136+
137+instance Arbitrary RegexpFlags where
138+ arbitrary = oneof [ pure AllRegexpFlags
139+ , pure NoRegexpFlags
140+ , SomeRegexpFlags <$> genUniqueFlags
141+ ]
142+ where genUniqueFlags =
143+ NE.fromList . L.nub
144+ <$> listOf1 arbitrary
145+
146+instance Arbitrary IndexAliasCreate where
147+ arbitrary =
148+ IndexAliasCreate
149+ <$> arbitrary
150+ <*> reduceSize arbitrary
151+
152+instance Arbitrary Query where
153+ arbitrary =
154+ reduceSize
155+ $ oneof [ TermQuery <$> arbitrary <*> arbitrary
156+ , TermsQuery <$> arbitrary <*> arbitrary
157+ , QueryMatchQuery <$> arbitrary
158+ , QueryMultiMatchQuery <$> arbitrary
159+ , QueryBoolQuery <$> arbitrary
160+ , QueryBoostingQuery <$> arbitrary
161+ , QueryCommonTermsQuery <$> arbitrary
162+ , ConstantScoreQuery <$> arbitrary <*> arbitrary
163+ , QueryDisMaxQuery <$> arbitrary
164+ , QueryFuzzyLikeThisQuery <$> arbitrary
165+ , QueryFuzzyLikeFieldQuery <$> arbitrary
166+ , QueryFuzzyQuery <$> arbitrary
167+ , QueryHasChildQuery <$> arbitrary
168+ , QueryHasParentQuery <$> arbitrary
169+ , IdsQuery <$> arbitrary <*> arbitrary
170+ , QueryIndicesQuery <$> arbitrary
171+ , MatchAllQuery <$> arbitrary
172+ , QueryMoreLikeThisQuery <$> arbitrary
173+ , QueryMoreLikeThisFieldQuery <$> arbitrary
174+ , QueryNestedQuery <$> arbitrary
175+ , QueryPrefixQuery <$> arbitrary
176+ , QueryQueryStringQuery <$> arbitrary
177+ , QuerySimpleQueryStringQuery <$> arbitrary
178+ , QueryRangeQuery <$> arbitrary
179+ , QueryRegexpQuery <$> arbitrary
180+ , QueryTemplateQueryInline <$> arbitrary
181+ ]
182+ -- TODO: Implement shrink
183+ -- shrink = genericShrink
184+
185+instance Arbitrary Filter where
186+ arbitrary =
187+ Filter <$> arbitrary
188+ shrink (Filter q) =
189+ Filter <$> shrink q
190+
191+instance Arbitrary ReplicaBounds where
192+ arbitrary = oneof [ replicasBounded
193+ , replicasLowerBounded
194+ , pure ReplicasUnbounded
195+ ]
196+ where replicasBounded = do
197+ Positive a <- arbitrary
198+ Positive b <- arbitrary
199+ return (ReplicasBounded a b)
200+ replicasLowerBounded = do
201+ Positive a <- arbitrary
202+ return (ReplicasLowerBounded a)
203+
204+instance Arbitrary NodeAttrName where
205+ arbitrary =
206+ NodeAttrName
207+ . T.pack
208+ <$> listOf1 arbitraryAlphaNum
209+
210+
211+instance Arbitrary NodeAttrFilter where
212+ arbitrary = do
213+ n <- arbitrary
214+ xs <- listOf1 (listOf1 arbitraryAlphaNum)
215+ let (s, ss) = unpackConsPartial xs
216+ ts = T.pack <$> s :| ss
217+ return (NodeAttrFilter n ts)
218+ where -- listOf1 means this shouldn't blow up.
219+ unpackConsPartial (x : xs) = (x, xs)
220+ unpackConsPartial _ = error "unpackConsPartial failed but shouldn't have"
221+
222+instance Arbitrary VersionNumber where
223+ arbitrary = do
224+ major <- posInt
225+ minor <- posInt
226+ patch <- posInt
227+ return $ VersionNumber $ SemVer.version major minor patch [] []
228+ where
229+ posInt = getPositive <$> arbitrary
230+
231+instance Arbitrary TemplateQueryKeyValuePairs where
232+ arbitrary = TemplateQueryKeyValuePairs . HM.fromList <$> arbitrary
233+ shrink (TemplateQueryKeyValuePairs x) = map (TemplateQueryKeyValuePairs . HM.fromList) . shrink $ HM.toList x
234+
235+makeArbitrary ''IndexName
236+instance Arbitrary IndexName where arbitrary = arbitraryIndexName
237+makeArbitrary ''MappingName
238+instance Arbitrary MappingName where arbitrary = arbitraryMappingName
239+makeArbitrary ''DocId
240+instance Arbitrary DocId where arbitrary = arbitraryDocId
241+makeArbitrary ''Version
242+instance Arbitrary Version where arbitrary = arbitraryVersion
243+makeArbitrary ''BuildHash
244+instance Arbitrary BuildHash where arbitrary = arbitraryBuildHash
245+makeArbitrary ''IndexAliasRouting
246+instance Arbitrary IndexAliasRouting where arbitrary = arbitraryIndexAliasRouting
247+makeArbitrary ''ShardCount
248+instance Arbitrary ShardCount where arbitrary = arbitraryShardCount
249+makeArbitrary ''ReplicaCount
250+instance Arbitrary ReplicaCount where arbitrary = arbitraryReplicaCount
251+makeArbitrary ''TemplateName
252+instance Arbitrary TemplateName where arbitrary = arbitraryTemplateName
253+makeArbitrary ''TemplatePattern
254+instance Arbitrary TemplatePattern where arbitrary = arbitraryTemplatePattern
255+makeArbitrary ''QueryString
256+instance Arbitrary QueryString where arbitrary = arbitraryQueryString
257+makeArbitrary ''CacheName
258+instance Arbitrary CacheName where arbitrary = arbitraryCacheName
259+makeArbitrary ''CacheKey
260+instance Arbitrary CacheKey where arbitrary = arbitraryCacheKey
261+makeArbitrary ''Existence
262+instance Arbitrary Existence where arbitrary = arbitraryExistence
263+makeArbitrary ''CutoffFrequency
264+instance Arbitrary CutoffFrequency where arbitrary = arbitraryCutoffFrequency
265+makeArbitrary ''Analyzer
266+instance Arbitrary Analyzer where arbitrary = arbitraryAnalyzer
267+makeArbitrary ''MaxExpansions
268+instance Arbitrary MaxExpansions where arbitrary = arbitraryMaxExpansions
269+makeArbitrary ''Lenient
270+instance Arbitrary Lenient where arbitrary = arbitraryLenient
271+makeArbitrary ''Tiebreaker
272+instance Arbitrary Tiebreaker where arbitrary = arbitraryTiebreaker
273+makeArbitrary ''Boost
274+instance Arbitrary Boost where arbitrary = arbitraryBoost
275+makeArbitrary ''BoostTerms
276+instance Arbitrary BoostTerms where arbitrary = arbitraryBoostTerms
277+makeArbitrary ''MinimumMatch
278+instance Arbitrary MinimumMatch where arbitrary = arbitraryMinimumMatch
279+makeArbitrary ''DisableCoord
280+instance Arbitrary DisableCoord where arbitrary = arbitraryDisableCoord
281+makeArbitrary ''IgnoreTermFrequency
282+instance Arbitrary IgnoreTermFrequency where arbitrary = arbitraryIgnoreTermFrequency
283+makeArbitrary ''MinimumTermFrequency
284+instance Arbitrary MinimumTermFrequency where arbitrary = arbitraryMinimumTermFrequency
285+makeArbitrary ''MaxQueryTerms
286+instance Arbitrary MaxQueryTerms where arbitrary = arbitraryMaxQueryTerms
287+makeArbitrary ''Fuzziness
288+instance Arbitrary Fuzziness where arbitrary = arbitraryFuzziness
289+makeArbitrary ''PrefixLength
290+instance Arbitrary PrefixLength where arbitrary = arbitraryPrefixLength
291+makeArbitrary ''TypeName
292+instance Arbitrary TypeName where arbitrary = arbitraryTypeName
293+makeArbitrary ''PercentMatch
294+instance Arbitrary PercentMatch where arbitrary = arbitraryPercentMatch
295+makeArbitrary ''StopWord
296+instance Arbitrary StopWord where arbitrary = arbitraryStopWord
297+makeArbitrary ''QueryPath
298+instance Arbitrary QueryPath where arbitrary = arbitraryQueryPath
299+makeArbitrary ''AllowLeadingWildcard
300+instance Arbitrary AllowLeadingWildcard where arbitrary = arbitraryAllowLeadingWildcard
301+makeArbitrary ''LowercaseExpanded
302+instance Arbitrary LowercaseExpanded where arbitrary = arbitraryLowercaseExpanded
303+makeArbitrary ''EnablePositionIncrements
304+instance Arbitrary EnablePositionIncrements where arbitrary = arbitraryEnablePositionIncrements
305+makeArbitrary ''AnalyzeWildcard
306+instance Arbitrary AnalyzeWildcard where arbitrary = arbitraryAnalyzeWildcard
307+makeArbitrary ''GeneratePhraseQueries
308+instance Arbitrary GeneratePhraseQueries where arbitrary = arbitraryGeneratePhraseQueries
309+makeArbitrary ''Locale
310+instance Arbitrary Locale where arbitrary = arbitraryLocale
311+makeArbitrary ''MaxWordLength
312+instance Arbitrary MaxWordLength where arbitrary = arbitraryMaxWordLength
313+makeArbitrary ''MinWordLength
314+instance Arbitrary MinWordLength where arbitrary = arbitraryMinWordLength
315+makeArbitrary ''PhraseSlop
316+instance Arbitrary PhraseSlop where arbitrary = arbitraryPhraseSlop
317+makeArbitrary ''MinDocFrequency
318+instance Arbitrary MinDocFrequency where arbitrary = arbitraryMinDocFrequency
319+makeArbitrary ''MaxDocFrequency
320+instance Arbitrary MaxDocFrequency where arbitrary = arbitraryMaxDocFrequency
321+makeArbitrary ''Regexp
322+instance Arbitrary Regexp where arbitrary = arbitraryRegexp
323+makeArbitrary ''SimpleQueryStringQuery
324+instance Arbitrary SimpleQueryStringQuery where arbitrary = arbitrarySimpleQueryStringQuery
325+makeArbitrary ''FieldOrFields
326+instance Arbitrary FieldOrFields where arbitrary = arbitraryFieldOrFields
327+makeArbitrary ''SimpleQueryFlag
328+instance Arbitrary SimpleQueryFlag where arbitrary = arbitrarySimpleQueryFlag
329+makeArbitrary ''RegexpQuery
330+instance Arbitrary RegexpQuery where arbitrary = arbitraryRegexpQuery
331+makeArbitrary ''QueryStringQuery
332+instance Arbitrary QueryStringQuery where arbitrary = arbitraryQueryStringQuery
333+makeArbitrary ''RangeQuery
334+instance Arbitrary RangeQuery where arbitrary = arbitraryRangeQuery
335+makeArbitrary ''RangeValue
336+instance Arbitrary RangeValue where arbitrary = arbitraryRangeValue
337+makeArbitrary ''PrefixQuery
338+instance Arbitrary PrefixQuery where arbitrary = arbitraryPrefixQuery
339+makeArbitrary ''NestedQuery
340+instance Arbitrary NestedQuery where arbitrary = arbitraryNestedQuery
341+makeArbitrary ''MoreLikeThisFieldQuery
342+instance Arbitrary MoreLikeThisFieldQuery where arbitrary = arbitraryMoreLikeThisFieldQuery
343+makeArbitrary ''MoreLikeThisQuery
344+instance Arbitrary MoreLikeThisQuery where arbitrary = arbitraryMoreLikeThisQuery
345+makeArbitrary ''IndicesQuery
346+instance Arbitrary IndicesQuery where arbitrary = arbitraryIndicesQuery
347+makeArbitrary ''HasParentQuery
348+instance Arbitrary HasParentQuery where arbitrary = arbitraryHasParentQuery
349+makeArbitrary ''HasChildQuery
350+instance Arbitrary HasChildQuery where arbitrary = arbitraryHasChildQuery
351+makeArbitrary ''FuzzyQuery
352+instance Arbitrary FuzzyQuery where arbitrary = arbitraryFuzzyQuery
353+makeArbitrary ''FuzzyLikeFieldQuery
354+instance Arbitrary FuzzyLikeFieldQuery where arbitrary = arbitraryFuzzyLikeFieldQuery
355+makeArbitrary ''FuzzyLikeThisQuery
356+instance Arbitrary FuzzyLikeThisQuery where arbitrary = arbitraryFuzzyLikeThisQuery
357+makeArbitrary ''DisMaxQuery
358+instance Arbitrary DisMaxQuery where arbitrary = arbitraryDisMaxQuery
359+makeArbitrary ''CommonTermsQuery
360+instance Arbitrary CommonTermsQuery where arbitrary = arbitraryCommonTermsQuery
361+makeArbitrary ''DistanceRange
362+instance Arbitrary DistanceRange where arbitrary = arbitraryDistanceRange
363+makeArbitrary ''MultiMatchQuery
364+instance Arbitrary MultiMatchQuery where arbitrary = arbitraryMultiMatchQuery
365+makeArbitrary ''LessThanD
366+instance Arbitrary LessThanD where arbitrary = arbitraryLessThanD
367+makeArbitrary ''LessThanEqD
368+instance Arbitrary LessThanEqD where arbitrary = arbitraryLessThanEqD
369+makeArbitrary ''GreaterThanD
370+instance Arbitrary GreaterThanD where arbitrary = arbitraryGreaterThanD
371+makeArbitrary ''GreaterThanEqD
372+instance Arbitrary GreaterThanEqD where arbitrary = arbitraryGreaterThanEqD
373+makeArbitrary ''LessThan
374+instance Arbitrary LessThan where arbitrary = arbitraryLessThan
375+makeArbitrary ''LessThanEq
376+instance Arbitrary LessThanEq where arbitrary = arbitraryLessThanEq
377+makeArbitrary ''GreaterThan
378+instance Arbitrary GreaterThan where arbitrary = arbitraryGreaterThan
379+makeArbitrary ''GreaterThanEq
380+instance Arbitrary GreaterThanEq where arbitrary = arbitraryGreaterThanEq
381+makeArbitrary ''GeoPoint
382+instance Arbitrary GeoPoint where arbitrary = arbitraryGeoPoint
383+makeArbitrary ''NullValue
384+instance Arbitrary NullValue where arbitrary = arbitraryNullValue
385+makeArbitrary ''MinimumMatchHighLow
386+instance Arbitrary MinimumMatchHighLow where arbitrary = arbitraryMinimumMatchHighLow
387+makeArbitrary ''CommonMinimumMatch
388+instance Arbitrary CommonMinimumMatch where arbitrary = arbitraryCommonMinimumMatch
389+makeArbitrary ''BoostingQuery
390+instance Arbitrary BoostingQuery where arbitrary = arbitraryBoostingQuery
391+makeArbitrary ''BoolQuery
392+instance Arbitrary BoolQuery where arbitrary = arbitraryBoolQuery
393+makeArbitrary ''MatchQuery
394+instance Arbitrary MatchQuery where arbitrary = arbitraryMatchQuery
395+makeArbitrary ''MultiMatchQueryType
396+instance Arbitrary MultiMatchQueryType where arbitrary = arbitraryMultiMatchQueryType
397+makeArbitrary ''BooleanOperator
398+instance Arbitrary BooleanOperator where arbitrary = arbitraryBooleanOperator
399+makeArbitrary ''ZeroTermsQuery
400+instance Arbitrary ZeroTermsQuery where arbitrary = arbitraryZeroTermsQuery
401+makeArbitrary ''MatchQueryType
402+instance Arbitrary MatchQueryType where arbitrary = arbitraryMatchQueryType
403+makeArbitrary ''SearchAliasRouting
404+instance Arbitrary SearchAliasRouting where arbitrary = arbitrarySearchAliasRouting
405+makeArbitrary ''ScoreType
406+instance Arbitrary ScoreType where arbitrary = arbitraryScoreType
407+makeArbitrary ''Distance
408+instance Arbitrary Distance where arbitrary = arbitraryDistance
409+makeArbitrary ''DistanceUnit
410+instance Arbitrary DistanceUnit where arbitrary = arbitraryDistanceUnit
411+makeArbitrary ''DistanceType
412+instance Arbitrary DistanceType where arbitrary = arbitraryDistanceType
413+makeArbitrary ''OptimizeBbox
414+instance Arbitrary OptimizeBbox where arbitrary = arbitraryOptimizeBbox
415+makeArbitrary ''GeoBoundingBoxConstraint
416+instance Arbitrary GeoBoundingBoxConstraint where arbitrary = arbitraryGeoBoundingBoxConstraint
417+makeArbitrary ''GeoFilterType
418+instance Arbitrary GeoFilterType where arbitrary = arbitraryGeoFilterType
419+makeArbitrary ''GeoBoundingBox
420+instance Arbitrary GeoBoundingBox where arbitrary = arbitraryGeoBoundingBox
421+makeArbitrary ''LatLon
422+instance Arbitrary LatLon where arbitrary = arbitraryLatLon
423+makeArbitrary ''RangeExecution
424+instance Arbitrary RangeExecution where arbitrary = arbitraryRangeExecution
425+makeArbitrary ''RegexpFlag
426+instance Arbitrary RegexpFlag where arbitrary = arbitraryRegexpFlag
427+makeArbitrary ''BoolMatch
428+instance Arbitrary BoolMatch where arbitrary = arbitraryBoolMatch
429+makeArbitrary ''Term
430+instance Arbitrary Term where arbitrary = arbitraryTerm
431+makeArbitrary ''IndexSettings
432+instance Arbitrary IndexSettings where arbitrary = arbitraryIndexSettings
433+makeArbitrary ''TokenChar
434+instance Arbitrary TokenChar where arbitrary = arbitraryTokenChar
435+makeArbitrary ''Ngram
436+instance Arbitrary Ngram where arbitrary = arbitraryNgram
437+makeArbitrary ''TokenizerDefinition
438+instance Arbitrary TokenizerDefinition where arbitrary = arbitraryTokenizerDefinition
439+makeArbitrary ''TokenFilter
440+instance Arbitrary TokenFilter where arbitrary = arbitraryTokenFilter
441+makeArbitrary ''TokenFilterDefinition
442+instance Arbitrary TokenFilterDefinition where arbitrary = arbitraryTokenFilterDefinition
443+makeArbitrary ''Language
444+instance Arbitrary Language where arbitrary = arbitraryLanguage
445+makeArbitrary ''Shingle
446+instance Arbitrary Shingle where arbitrary = arbitraryShingle
447+
448+makeArbitrary ''CharFilter
449+instance Arbitrary CharFilter where arbitrary = arbitraryCharFilter
450+makeArbitrary ''AnalyzerDefinition
451+instance Arbitrary AnalyzerDefinition where arbitrary = arbitraryAnalyzerDefinition
452+
453+-- TODO: This should have a proper generator that doesn't
454+-- create garbage that has to be filtered out.
455+instance Arbitrary CharFilterDefinition where
456+ arbitrary =
457+ oneof [ CharFilterDefinitionMapping
458+ . chomp <$> arbitrary
459+ , CharFilterDefinitionPatternReplace
460+ <$> arbitrary <*> arbitrary <*> arbitrary
461+ ]
462+ where chomp =
463+ M.map T.strip
464+ . M.mapKeys (T.replace "=>" "" . T.strip)
465+
466+makeArbitrary ''Analysis
467+instance Arbitrary Analysis where arbitrary = arbitraryAnalysis
468+makeArbitrary ''Tokenizer
469+instance Arbitrary Tokenizer where arbitrary = arbitraryTokenizer
470+makeArbitrary ''Compression
471+instance Arbitrary Compression where arbitrary = arbitraryCompression
472+makeArbitrary ''Bytes
473+instance Arbitrary Bytes where arbitrary = arbitraryBytes
474+makeArbitrary ''AllocationPolicy
475+instance Arbitrary AllocationPolicy where arbitrary = arbitraryAllocationPolicy
476+makeArbitrary ''InitialShardCount
477+instance Arbitrary InitialShardCount where arbitrary = arbitraryInitialShardCount
478+makeArbitrary ''FSType
479+instance Arbitrary FSType where arbitrary = arbitraryFSType
480+makeArbitrary ''CompoundFormat
481+instance Arbitrary CompoundFormat where arbitrary = arbitraryCompoundFormat
482+makeArbitrary ''FsSnapshotRepo
483+instance Arbitrary FsSnapshotRepo where arbitrary = arbitraryFsSnapshotRepo
484+makeArbitrary ''SnapshotRepoName
485+instance Arbitrary SnapshotRepoName where arbitrary = arbitrarySnapshotRepoName
486+makeArbitrary ''TemplateQueryInline
487+instance Arbitrary TemplateQueryInline where arbitrary = arbitraryTemplateQueryInline
488+makeArbitrary ''DirectGeneratorSuggestModeTypes
489+instance Arbitrary DirectGeneratorSuggestModeTypes where arbitrary = arbitraryDirectGeneratorSuggestModeTypes
490+makeArbitrary ''DirectGenerators
491+instance Arbitrary DirectGenerators where arbitrary = arbitraryDirectGenerators
492+makeArbitrary ''PhraseSuggesterCollate
493+instance Arbitrary PhraseSuggesterCollate where arbitrary = arbitraryPhraseSuggesterCollate
494+makeArbitrary ''PhraseSuggesterHighlighter
495+instance Arbitrary PhraseSuggesterHighlighter where arbitrary = arbitraryPhraseSuggesterHighlighter
496+makeArbitrary ''Size
497+instance Arbitrary Size where arbitrary = arbitrarySize
498+makeArbitrary ''PhraseSuggester
499+instance Arbitrary PhraseSuggester where arbitrary = arbitraryPhraseSuggester
500+makeArbitrary ''SuggestType
501+instance Arbitrary SuggestType where arbitrary = arbitrarySuggestType
502+makeArbitrary ''Suggest
503+instance Arbitrary Suggest where arbitrary = arbitrarySuggest
504+
505+makeArbitrary ''FunctionScoreQuery
506+instance Arbitrary FunctionScoreQuery where arbitrary = arbitraryFunctionScoreQuery
507+
508+makeArbitrary ''FunctionScoreFunction
509+instance Arbitrary FunctionScoreFunction where arbitrary = arbitraryFunctionScoreFunction
510+makeArbitrary ''FunctionScoreFunctions
511+instance Arbitrary FunctionScoreFunctions where arbitrary = arbitraryFunctionScoreFunctions
512+makeArbitrary ''ComponentFunctionScoreFunction
513+instance Arbitrary ComponentFunctionScoreFunction where arbitrary = arbitraryComponentFunctionScoreFunction
514+makeArbitrary ''Script
515+instance Arbitrary Script where arbitrary = arbitraryScript
516+makeArbitrary ''ScriptLanguage
517+instance Arbitrary ScriptLanguage where arbitrary = arbitraryScriptLanguage
518+makeArbitrary ''ScriptInline
519+instance Arbitrary ScriptInline where arbitrary = arbitraryScriptInline
520+makeArbitrary ''ScriptId
521+instance Arbitrary ScriptId where arbitrary = arbitraryScriptId
522+makeArbitrary ''ScoreMode
523+instance Arbitrary ScoreMode where arbitrary = arbitraryScoreMode
524+makeArbitrary ''BoostMode
525+instance Arbitrary BoostMode where arbitrary = arbitraryBoostMode
526+makeArbitrary ''Seed
527+instance Arbitrary Seed where arbitrary = arbitrarySeed
528+makeArbitrary ''FieldValueFactor
529+instance Arbitrary FieldValueFactor where arbitrary = arbitraryFieldValueFactor
530+makeArbitrary ''Weight
531+instance Arbitrary Weight where arbitrary = arbitraryWeight
532+makeArbitrary ''Factor
533+instance Arbitrary Factor where arbitrary = arbitraryFactor
534+makeArbitrary ''FactorMissingFieldValue
535+instance Arbitrary FactorMissingFieldValue where arbitrary = arbitraryFactorMissingFieldValue
536+makeArbitrary ''FactorModifier
537+instance Arbitrary FactorModifier where arbitrary = arbitraryFactorModifier
538+
539+makeArbitrary ''UpdatableIndexSetting
540+instance Arbitrary UpdatableIndexSetting where
541+ arbitrary = resize 10 arbitraryUpdatableIndexSetting
542+
543+newtype UpdatableIndexSetting' =
544+ UpdatableIndexSetting' UpdatableIndexSetting
545+ deriving (Show, Eq, ToJSON, FromJSON, ApproxEq, Typeable)
546+
547+instance Arbitrary UpdatableIndexSetting' where
548+ arbitrary = do
549+ settings <- arbitrary
550+ return $ UpdatableIndexSetting' $ case settings of
551+ RoutingAllocationInclude xs ->
552+ RoutingAllocationInclude (dropDuplicateAttrNames xs)
553+ RoutingAllocationExclude xs ->
554+ RoutingAllocationExclude (dropDuplicateAttrNames xs)
555+ RoutingAllocationRequire xs ->
556+ RoutingAllocationRequire (dropDuplicateAttrNames xs)
557+ x -> x
558+ where
559+ dropDuplicateAttrNames =
560+ NE.fromList . L.nubBy sameAttrName . NE.toList
561+ sameAttrName a b =
562+ nodeAttrFilterName a == nodeAttrFilterName b
563+ shrink (UpdatableIndexSetting' x) = map UpdatableIndexSetting' (shrink x)
tests/Test/Highlights.hsnew file+32
@@ -0,0 +1,32 @@
1+{-# LANGUAGE OverloadedStrings #-}
2+
3+module Test.Highlights where
4+
5+import Test.Common
6+import Test.Import
7+
8+import qualified Data.Map as M
9+
10+initHighlights :: Text -> BH IO (Either EsError (Maybe HitHighlight))
11+initHighlights fieldName = do
12+ _ <- insertData
13+ _ <- insertOther
14+ let query = QueryMatchQuery $ mkMatchQuery (FieldName fieldName) (QueryString "haskell")
15+ let testHighlight = Highlights Nothing [FieldHighlight (FieldName fieldName) Nothing]
16+ let search = mkHighlightSearch (Just query) testHighlight
17+ searchTweetHighlight search
18+
19+spec :: Spec
20+spec =
21+ describe "Highlights API" $ do
22+ it "returns highlight from query when there should be one" $ withTestEnv $ do
23+ myHighlight <- initHighlights "message"
24+ liftIO $
25+ myHighlight `shouldBe`
26+ Right (Just (M.fromList [("message", ["Use <em>haskell</em>!"])]))
27+
28+ it "doesn't return highlight from a query when it shouldn't" $ withTestEnv $ do
29+ myHighlight <- initHighlights "user"
30+ liftIO $
31+ myHighlight `shouldBe`
32+ Right Nothing
tests/Test/Import.hsnew file+58
@@ -0,0 +1,58 @@
1+{-# LANGUAGE OverloadedStrings #-}
2+
3+module Test.Import
4+ ( module X
5+ , module Test.Import
6+ ) where
7+
8+
9+import Control.Applicative as X
10+import Control.Exception as X (evaluate)
11+import Control.Monad as X
12+import Control.Monad.Catch as X
13+import Control.Monad.Reader as X
14+import Data.Aeson as X
15+import Data.Aeson.TH as X
16+import Data.Aeson.Types as X (parseEither)
17+import Data.Maybe as X
18+import Data.List.NonEmpty as X (NonEmpty(..))
19+import Data.Monoid as X
20+import Data.Ord as X (comparing)
21+import Data.Proxy as X
22+import Data.Text as X (Text)
23+import Data.Time.Calendar as X (Day(..), fromGregorian)
24+import Data.Time.Clock as X
25+import Data.Typeable as X
26+import Database.Bloodhound as X hiding (key)
27+import Lens.Micro as X
28+import Lens.Micro.Aeson as X
29+import Network.HTTP.Client as X hiding (Proxy, fileSize)
30+import System.IO.Temp as X
31+import System.PosixCompat.Files as X
32+import Test.Hspec as X
33+import Test.Hspec.QuickCheck as X (prop)
34+import Test.QuickCheck as X hiding (Result, Success, isSuccess)
35+import Test.QuickCheck.Property.Monoid as X (T (..), eq, prop_Monoid)
36+import Text.Pretty.Simple as X (pPrint)
37+
38+import qualified Data.List as L
39+
40+noDuplicates :: Eq a => [a] -> Bool
41+noDuplicates xs = L.nub xs == xs
42+
43+getSource :: EsResult a -> Maybe a
44+getSource = fmap _source . foundResult
45+
46+grabFirst :: Either EsError (SearchResult a) -> Either EsError a
47+grabFirst r =
48+ case fmap (hitSource . head . hits . searchHits) r of
49+ (Left e) -> Left e
50+ (Right Nothing) -> Left (EsError 500 "Source was missing")
51+ (Right (Just x)) -> Right x
52+
53+when' :: Monad m => m Bool -> m () -> m ()
54+when' b f = b >>= \x -> when x f
55+
56+headMay :: [a] -> Maybe a
57+headMay (x : _) = Just x
58+headMay _ = Nothing
tests/Test/Indices.hsnew file+173
@@ -0,0 +1,173 @@
1+{-# LANGUAGE OverloadedStrings #-}
2+
3+module Test.Indices where
4+
5+import Test.Common
6+import Test.Import
7+
8+import qualified Data.List as L
9+import qualified Data.List.NonEmpty as NE
10+import qualified Data.Map as M
11+spec :: Spec
12+spec = do
13+ describe "Index create/delete API" $ do
14+ it "creates and then deletes the requested index" $ withTestEnv $ do
15+ -- priming state.
16+ _ <- deleteExampleIndex
17+ resp <- createExampleIndex
18+ deleteResp <- deleteExampleIndex
19+ liftIO $ do
20+ validateStatus resp 200
21+ validateStatus deleteResp 200
22+
23+ describe "Index aliases" $ do
24+ let aname = IndexAliasName (IndexName "bloodhound-tests-twitter-1-alias")
25+ let alias = IndexAlias (testIndex) aname
26+ let create = IndexAliasCreate Nothing Nothing
27+ let action = AddAlias alias create
28+ it "handles the simple case of aliasing an existing index" $ do
29+ withTestEnv $ do
30+ resetIndex
31+ resp <- updateIndexAliases (action :| [])
32+ liftIO $ validateStatus resp 200
33+ let cleanup = withTestEnv (updateIndexAliases (RemoveAlias alias :| []))
34+ (do aliases <- withTestEnv getIndexAliases
35+ let expected = IndexAliasSummary alias create
36+ case aliases of
37+ Right (IndexAliasesSummary summs) ->
38+ L.find ((== alias) . indexAliasSummaryAlias) summs `shouldBe` Just expected
39+ Left e -> expectationFailure ("Expected an IndexAliasesSummary but got " <> show e)) `finally` cleanup
40+ it "allows alias deletion" $ do
41+ aliases <- withTestEnv $ do
42+ resetIndex
43+ resp <- updateIndexAliases (action :| [])
44+ liftIO $ validateStatus resp 200
45+ _ <- deleteIndexAlias aname
46+ getIndexAliases
47+ -- let expected = IndexAliasSummary alias create
48+ case aliases of
49+ Right (IndexAliasesSummary summs) ->
50+ L.find ( (== aname)
51+ . indexAlias
52+ . indexAliasSummaryAlias
53+ ) summs
54+ `shouldBe` Nothing
55+ Left e -> expectationFailure ("Expected an IndexAliasesSummary but got " <> show e)
56+
57+ describe "Index Listing" $ do
58+ it "returns a list of index names" $ withTestEnv $ do
59+ _ <- createExampleIndex
60+ ixns <- listIndices
61+ liftIO (ixns `shouldContain` [testIndex])
62+
63+ describe "Index Settings" $ do
64+ it "persists settings" $ withTestEnv $ do
65+ _ <- deleteExampleIndex
66+ _ <- createExampleIndex
67+ let updates = BlocksWrite False :| []
68+ updateResp <- updateIndexSettings updates testIndex
69+ liftIO $ validateStatus updateResp 200
70+ getResp <- getIndexSettings testIndex
71+ liftIO $
72+ getResp `shouldBe` Right (IndexSettingsSummary
73+ testIndex
74+ (IndexSettings (ShardCount 1) (ReplicaCount 0))
75+ (NE.toList updates))
76+
77+ it "allows total fields to be set" $ when' (atleast es50) $ withTestEnv $ do
78+ _ <- deleteExampleIndex
79+ _ <- createExampleIndex
80+ let updates = MappingTotalFieldsLimit 2500 :| []
81+ updateResp <- updateIndexSettings updates testIndex
82+ liftIO $ validateStatus updateResp 200
83+ getResp <- getIndexSettings testIndex
84+ liftIO $
85+ getResp `shouldBe` Right (IndexSettingsSummary
86+ testIndex
87+ (IndexSettings (ShardCount 1) (ReplicaCount 0))
88+ (NE.toList updates))
89+
90+ it "accepts customer analyzers" $ when' (atleast es50) $ withTestEnv $ do
91+ _ <- deleteExampleIndex
92+ let analysis = Analysis
93+ (M.singleton "ex_analyzer"
94+ ( AnalyzerDefinition
95+ (Just (Tokenizer "ex_tokenizer"))
96+ (map TokenFilter
97+ [ "ex_filter_lowercase","ex_filter_uppercase","ex_filter_apostrophe"
98+ , "ex_filter_reverse","ex_filter_snowball"
99+ , "ex_filter_shingle"
100+ ]
101+ )
102+ (map CharFilter
103+ ["html_strip", "ex_mapping", "ex_pattern_replace"]
104+ )
105+ )
106+ )
107+ (M.singleton "ex_tokenizer"
108+ ( TokenizerDefinitionNgram
109+ ( Ngram 3 4 [TokenLetter,TokenDigit])
110+ )
111+ )
112+ (M.fromList
113+ [ ("ex_filter_lowercase",TokenFilterDefinitionLowercase (Just Greek))
114+ , ("ex_filter_uppercase",TokenFilterDefinitionUppercase Nothing)
115+ , ("ex_filter_apostrophe",TokenFilterDefinitionApostrophe)
116+ , ("ex_filter_reverse",TokenFilterDefinitionReverse)
117+ , ("ex_filter_snowball",TokenFilterDefinitionSnowball English)
118+ , ("ex_filter_shingle",TokenFilterDefinitionShingle (Shingle 3 3 True False " " "_"))
119+ , ("ex_filter_stemmer",TokenFilterDefinitionStemmer German)
120+ , ("ex_filter_stop1", TokenFilterDefinitionStop (Left French))
121+ , ("ex_filter_stop2",
122+ TokenFilterDefinitionStop
123+ (Right
124+ $ map StopWord ["a", "is", "the"]))
125+ ]
126+ )
127+ (M.fromList
128+ [ ("ex_mapping", CharFilterDefinitionMapping (M.singleton "١" "1"))
129+ , ("ex_pattern_replace", CharFilterDefinitionPatternReplace "(\\d+)-(?=\\d)" "$1_" Nothing)
130+ ]
131+ )
132+ updates = [AnalysisSetting analysis]
133+ createResp <- createIndexWith (updates ++ [NumberOfReplicas (ReplicaCount 0)]) 1 testIndex
134+ liftIO $ validateStatus createResp 200
135+ getResp <- getIndexSettings testIndex
136+ liftIO $
137+ getResp `shouldBe` Right (IndexSettingsSummary
138+ testIndex
139+ (IndexSettings (ShardCount 1) (ReplicaCount 0))
140+ updates
141+ )
142+
143+ it "accepts default compression codec" $ when' (atleast es50) $ withTestEnv $ do
144+ _ <- deleteExampleIndex
145+ let updates = [CompressionSetting CompressionDefault]
146+ createResp <- createIndexWith (updates ++ [NumberOfReplicas (ReplicaCount 0)]) 1 testIndex
147+ liftIO $ validateStatus createResp 200
148+ getResp <- getIndexSettings testIndex
149+ liftIO $ getResp `shouldBe` Right
150+ (IndexSettingsSummary testIndex (IndexSettings (ShardCount 1) (ReplicaCount 0)) updates)
151+
152+ it "accepts best compression codec" $ when' (atleast es50) $ withTestEnv $ do
153+ _ <- deleteExampleIndex
154+ let updates = [CompressionSetting CompressionBest]
155+ createResp <- createIndexWith (updates ++ [NumberOfReplicas (ReplicaCount 0)]) 1 testIndex
156+ liftIO $ validateStatus createResp 200
157+ getResp <- getIndexSettings testIndex
158+ liftIO $ getResp `shouldBe` Right
159+ (IndexSettingsSummary testIndex (IndexSettings (ShardCount 1) (ReplicaCount 0)) updates)
160+
161+
162+ describe "Index Optimization" $ do
163+ it "returns a successful response upon completion" $ withTestEnv $ do
164+ _ <- createExampleIndex
165+ resp <- forceMergeIndex (IndexList (testIndex :| [])) defaultForceMergeIndexSettings
166+ liftIO $ validateStatus resp 200
167+
168+
169+ describe "Index flushing" $ do
170+ it "returns a successful response upon flushing" $ withTestEnv $ do
171+ _ <- createExampleIndex
172+ resp <- flushIndex testIndex
173+ liftIO $ validateStatus resp 200
tests/Test/JSON.hsnew file+213
@@ -0,0 +1,213 @@
1+{-# LANGUAGE OverloadedStrings #-}
2+{-# LANGUAGE ScopedTypeVariables #-}
3+
4+module Test.JSON (spec) where
5+
6+import Test.Import
7+
8+import qualified Data.ByteString.Lazy.Char8 as BL8
9+import qualified Data.List as L
10+import Data.List.NonEmpty (NonEmpty(..))
11+import qualified Data.List.NonEmpty as NE
12+import qualified Data.HashMap.Strict as HM
13+import qualified Data.Text as T
14+import qualified Data.Vector as V
15+
16+import Test.ApproxEq
17+import Test.Generators
18+
19+propJSON :: forall a
20+ . ( Arbitrary a
21+ , ToJSON a
22+ , FromJSON a
23+ , Show a
24+ , Eq a
25+ , Typeable a
26+ )
27+ => Proxy a -> Spec
28+propJSON _ = prop testName $ \(a :: a) ->
29+ let jsonStr = "via " <> BL8.unpack (encode a)
30+ in counterexample jsonStr (parseEither parseJSON (toJSON a)
31+ === Right a)
32+ where testName = show ty <> " FromJSON/ToJSON roundtrips"
33+ ty = typeOf (undefined :: a)
34+
35+propApproxJSON :: forall a
36+ . ( Arbitrary a
37+ , ToJSON a
38+ , FromJSON a
39+ , Show a
40+ , ApproxEq a
41+ , Typeable a
42+ )
43+ => Proxy a -> Spec
44+propApproxJSON _ = prop testName $ \(a :: a) ->
45+ let jsonStr = "via " <> BL8.unpack (encode a)
46+ in counterexample jsonStr (parseEither parseJSON (toJSON a)
47+ ==~ Right a)
48+ where testName = show ty <> " FromJSON/ToJSON roundtrips"
49+ ty = typeOf (undefined :: a)
50+
51+spec :: Spec
52+spec = do
53+ describe "ToJSON RegexpFlags" $ do
54+ it "generates the correct JSON for AllRegexpFlags" $
55+ toJSON AllRegexpFlags `shouldBe` String "ALL"
56+
57+ it "generates the correct JSON for NoRegexpFlags" $
58+ toJSON NoRegexpFlags `shouldBe` String "NONE"
59+
60+ it "generates the correct JSON for SomeRegexpFlags" $
61+ let flags = AnyString :| [ Automaton
62+ , Complement
63+ , Empty
64+ , Intersection
65+ , Interval ]
66+ in toJSON (SomeRegexpFlags flags) `shouldBe` String "ANYSTRING|AUTOMATON|COMPLEMENT|EMPTY|INTERSECTION|INTERVAL"
67+
68+ prop "removes duplicates from flags" $ \(flags :: RegexpFlags) ->
69+ let String str = toJSON flags
70+ flagStrs = T.splitOn "|" str
71+ in noDuplicates flagStrs
72+
73+ describe "omitNulls" $ do
74+ it "checks that omitNulls drops list elements when it should" $
75+ let dropped = omitNulls $ [ "test1" .= (toJSON ([] :: [Int]))
76+ , "test2" .= (toJSON ("some value" :: Text))]
77+ in dropped `shouldBe` Object (HM.fromList [("test2", String "some value")])
78+
79+ it "checks that omitNulls doesn't drop list elements when it shouldn't" $
80+ let notDropped = omitNulls $ [ "test1" .= (toJSON ([1] :: [Int]))
81+ , "test2" .= (toJSON ("some value" :: Text))]
82+ in notDropped `shouldBe` Object (HM.fromList [ ("test1", Array (V.fromList [Number 1.0]))
83+ , ("test2", String "some value")])
84+ it "checks that omitNulls drops non list elements when it should" $
85+ let dropped = omitNulls $ [ "test1" .= (toJSON Null)
86+ , "test2" .= (toJSON ("some value" :: Text))]
87+ in dropped `shouldBe` Object (HM.fromList [("test2", String "some value")])
88+ it "checks that omitNulls doesn't drop non list elements when it shouldn't" $
89+ let notDropped = omitNulls $ [ "test1" .= (toJSON (1 :: Int))
90+ , "test2" .= (toJSON ("some value" :: Text))]
91+ in notDropped `shouldBe` Object (HM.fromList [ ("test1", Number 1.0)
92+ , ("test2", String "some value")])
93+
94+ describe "Exact isomorphism JSON instances" $ do
95+ propJSON (Proxy :: Proxy Version)
96+ propJSON (Proxy :: Proxy IndexName)
97+ propJSON (Proxy :: Proxy MappingName)
98+ propJSON (Proxy :: Proxy DocId)
99+ propJSON (Proxy :: Proxy IndexAliasRouting)
100+ propJSON (Proxy :: Proxy RoutingValue)
101+ propJSON (Proxy :: Proxy ShardCount)
102+ propJSON (Proxy :: Proxy ReplicaCount)
103+ propJSON (Proxy :: Proxy TemplateName)
104+ propJSON (Proxy :: Proxy TemplatePattern)
105+ propJSON (Proxy :: Proxy QueryString)
106+ propJSON (Proxy :: Proxy FieldName)
107+ propJSON (Proxy :: Proxy Script)
108+ propJSON (Proxy :: Proxy ScriptLanguage)
109+ propJSON (Proxy :: Proxy ScriptInline)
110+ propJSON (Proxy :: Proxy ScriptId)
111+ propJSON (Proxy :: Proxy ScriptParams)
112+ propJSON (Proxy :: Proxy CacheName)
113+ propJSON (Proxy :: Proxy CacheKey)
114+ propJSON (Proxy :: Proxy Existence)
115+ propJSON (Proxy :: Proxy CutoffFrequency)
116+ propJSON (Proxy :: Proxy Analyzer)
117+ propJSON (Proxy :: Proxy MaxExpansions)
118+ propJSON (Proxy :: Proxy Lenient)
119+ propJSON (Proxy :: Proxy Tiebreaker)
120+ propJSON (Proxy :: Proxy Boost)
121+ propJSON (Proxy :: Proxy BoostTerms)
122+ propJSON (Proxy :: Proxy MinimumMatch)
123+ propJSON (Proxy :: Proxy DisableCoord)
124+ propJSON (Proxy :: Proxy IgnoreTermFrequency)
125+ propJSON (Proxy :: Proxy MinimumTermFrequency)
126+ propJSON (Proxy :: Proxy MaxQueryTerms)
127+ propJSON (Proxy :: Proxy Fuzziness)
128+ propJSON (Proxy :: Proxy PrefixLength)
129+ propJSON (Proxy :: Proxy TypeName)
130+ propJSON (Proxy :: Proxy PercentMatch)
131+ propJSON (Proxy :: Proxy StopWord)
132+ propJSON (Proxy :: Proxy QueryPath)
133+ propJSON (Proxy :: Proxy AllowLeadingWildcard)
134+ propJSON (Proxy :: Proxy LowercaseExpanded)
135+ propJSON (Proxy :: Proxy EnablePositionIncrements)
136+ propJSON (Proxy :: Proxy AnalyzeWildcard)
137+ propJSON (Proxy :: Proxy GeneratePhraseQueries)
138+ propJSON (Proxy :: Proxy Locale)
139+ propJSON (Proxy :: Proxy MaxWordLength)
140+ propJSON (Proxy :: Proxy MinWordLength)
141+ propJSON (Proxy :: Proxy PhraseSlop)
142+ propJSON (Proxy :: Proxy MinDocFrequency)
143+ propJSON (Proxy :: Proxy MaxDocFrequency)
144+ propJSON (Proxy :: Proxy Filter)
145+ propJSON (Proxy :: Proxy Query)
146+ propJSON (Proxy :: Proxy SimpleQueryStringQuery)
147+ propJSON (Proxy :: Proxy FieldOrFields)
148+ propJSON (Proxy :: Proxy SimpleQueryFlag)
149+ propJSON (Proxy :: Proxy RegexpQuery)
150+ propJSON (Proxy :: Proxy QueryStringQuery)
151+ propJSON (Proxy :: Proxy RangeQuery)
152+ propJSON (Proxy :: Proxy PrefixQuery)
153+ propJSON (Proxy :: Proxy NestedQuery)
154+ propJSON (Proxy :: Proxy MoreLikeThisFieldQuery)
155+ propJSON (Proxy :: Proxy MoreLikeThisQuery)
156+ propJSON (Proxy :: Proxy IndicesQuery)
157+ propJSON (Proxy :: Proxy HasParentQuery)
158+ propJSON (Proxy :: Proxy HasChildQuery)
159+ propJSON (Proxy :: Proxy FuzzyQuery)
160+ propJSON (Proxy :: Proxy FuzzyLikeFieldQuery)
161+ propJSON (Proxy :: Proxy FuzzyLikeThisQuery)
162+ propJSON (Proxy :: Proxy FunctionScoreQuery)
163+ propJSON (Proxy :: Proxy BoostMode)
164+ propJSON (Proxy :: Proxy ScoreMode)
165+ propJSON (Proxy :: Proxy ComponentFunctionScoreFunction)
166+ propJSON (Proxy :: Proxy FieldValueFactor)
167+ propJSON (Proxy :: Proxy FactorModifier)
168+ propJSON (Proxy :: Proxy DisMaxQuery)
169+ propJSON (Proxy :: Proxy CommonTermsQuery)
170+ propJSON (Proxy :: Proxy CommonMinimumMatch)
171+ propJSON (Proxy :: Proxy BoostingQuery)
172+ propJSON (Proxy :: Proxy BoolQuery)
173+ propJSON (Proxy :: Proxy MatchQuery)
174+ propJSON (Proxy :: Proxy MultiMatchQueryType)
175+ propJSON (Proxy :: Proxy BooleanOperator)
176+ propJSON (Proxy :: Proxy ZeroTermsQuery)
177+ propJSON (Proxy :: Proxy MatchQueryType)
178+ propJSON (Proxy :: Proxy AliasRouting)
179+ propJSON (Proxy :: Proxy IndexAliasCreate)
180+ propJSON (Proxy :: Proxy SearchAliasRouting)
181+ propJSON (Proxy :: Proxy ScoreType)
182+ propJSON (Proxy :: Proxy Distance)
183+ propJSON (Proxy :: Proxy DistanceUnit)
184+ propJSON (Proxy :: Proxy DistanceType)
185+ propJSON (Proxy :: Proxy OptimizeBbox)
186+ propJSON (Proxy :: Proxy GeoBoundingBoxConstraint)
187+ propJSON (Proxy :: Proxy GeoFilterType)
188+ propJSON (Proxy :: Proxy GeoBoundingBox)
189+ propJSON (Proxy :: Proxy LatLon)
190+ propJSON (Proxy :: Proxy RangeExecution)
191+ prop "RegexpFlags FromJSON/ToJSON roundtrips, removing dups " $ \rfs ->
192+ let expected = case rfs of
193+ SomeRegexpFlags fs -> SomeRegexpFlags (NE.fromList (L.nub (NE.toList fs)))
194+ x -> x
195+ in parseEither parseJSON (toJSON rfs) === Right expected
196+ propJSON (Proxy :: Proxy BoolMatch)
197+ propJSON (Proxy :: Proxy Term)
198+ propJSON (Proxy :: Proxy MultiMatchQuery)
199+ propJSON (Proxy :: Proxy IndexSettings)
200+ propJSON (Proxy :: Proxy CompoundFormat)
201+ propJSON (Proxy :: Proxy TemplateQueryInline)
202+ propJSON (Proxy :: Proxy Suggest)
203+ propJSON (Proxy :: Proxy DirectGenerators)
204+ propJSON (Proxy :: Proxy DirectGeneratorSuggestModeTypes)
205+
206+ describe "Approximate isomorphism JSON instances" $ do
207+ propApproxJSON (Proxy :: Proxy UpdatableIndexSetting')
208+ propApproxJSON (Proxy :: Proxy ReplicaCount)
209+ propApproxJSON (Proxy :: Proxy ReplicaBounds)
210+ propApproxJSON (Proxy :: Proxy Bytes)
211+ propApproxJSON (Proxy :: Proxy AllocationPolicy)
212+ propApproxJSON (Proxy :: Proxy InitialShardCount)
213+ propApproxJSON (Proxy :: Proxy FSType)
tests/Test/Query.hsnew file+132
@@ -0,0 +1,132 @@
1+{-# LANGUAGE OverloadedStrings #-}
2+
3+module Test.Query where
4+
5+import Test.Common
6+import Test.Import
7+
8+import qualified Data.HashMap.Strict as HM
9+
10+spec :: Spec
11+spec =
12+ describe "query API" $ do
13+ it "returns document for term query and identity filter" $ withTestEnv $ do
14+ _ <- insertData
15+ let query = TermQuery (Term "user" "bitemyapp") Nothing
16+ let filter' = Filter $ MatchAllQuery Nothing
17+ let search = mkSearch (Just query) (Just filter')
18+ myTweet <- searchTweet search
19+ liftIO $
20+ myTweet `shouldBe` Right exampleTweet
21+
22+ it "handles constant score queries" $ withTestEnv $ do
23+ _ <- insertData
24+ let query = TermsQuery "user" ("bitemyapp" :| [])
25+ let cfQuery = ConstantScoreQuery query (Boost 1.0)
26+ let filter' = Filter $ MatchAllQuery Nothing
27+ let search = mkSearch (Just cfQuery) (Just filter')
28+ myTweet <- searchTweet search
29+ liftIO $
30+ myTweet `shouldBe` Right exampleTweet
31+
32+ it "returns document for terms query and identity filter" $ withTestEnv $ do
33+ _ <- insertData
34+ let query = TermsQuery "user" ("bitemyapp" :| [])
35+ let filter' = Filter $ MatchAllQuery Nothing
36+ let search = mkSearch (Just query) (Just filter')
37+ myTweet <- searchTweet search
38+ liftIO $
39+ myTweet `shouldBe` Right exampleTweet
40+
41+ it "returns document for match query" $ withTestEnv $ do
42+ _ <- insertData
43+ let query = QueryMatchQuery $ mkMatchQuery (FieldName "user") (QueryString "bitemyapp")
44+ let search = mkSearch (Just query) Nothing
45+ myTweet <- searchTweet search
46+ liftIO $
47+ myTweet `shouldBe` Right exampleTweet
48+
49+ it "returns document for match query with fuzziness" $ withTestEnv $ do
50+ _ <- insertData
51+ let match = mkMatchQuery (FieldName "user") (QueryString "bidemyapp")
52+ let query = QueryMatchQuery $ match { matchQueryFuzziness = Just FuzzinessAuto }
53+ let search = mkSearch (Just query) Nothing
54+ myTweet <- searchTweet search
55+ liftIO $
56+ myTweet `shouldBe` Right exampleTweet
57+
58+ it "returns document for multi-match query" $ withTestEnv $ do
59+ _ <- insertData
60+ let flds = [FieldName "user", FieldName "message"]
61+ let query = QueryMultiMatchQuery $ mkMultiMatchQuery flds (QueryString "bitemyapp")
62+ let search = mkSearch (Just query) Nothing
63+ myTweet <- searchTweet search
64+ liftIO $
65+ myTweet `shouldBe` Right exampleTweet
66+
67+ it "returns document for multi-match query with a custom tiebreaker" $ withTestEnv $ do
68+ _ <- insertData
69+ let tiebreaker = Just $ Tiebreaker 0.3
70+ flds = [FieldName "user", FieldName "message"]
71+ multiQuery' = mkMultiMatchQuery flds (QueryString "bitemyapp")
72+ query = QueryMultiMatchQuery $ multiQuery' { multiMatchQueryTiebreaker = tiebreaker }
73+ search = mkSearch (Just query) Nothing
74+ myTweet <- searchTweet search
75+ liftIO $
76+ myTweet `shouldBe` Right exampleTweet
77+
78+ it "returns document for bool query" $ withTestEnv $ do
79+ _ <- insertData
80+ let innerQuery = QueryMatchQuery $
81+ mkMatchQuery (FieldName "user") (QueryString "bitemyapp")
82+ let query = QueryBoolQuery $
83+ mkBoolQuery [innerQuery] [] [] []
84+ let search = mkSearch (Just query) Nothing
85+ myTweet <- searchTweet search
86+ liftIO $
87+ myTweet `shouldBe` Right exampleTweet
88+
89+ it "returns document for boosting query" $ withTestEnv $ do
90+ _ <- insertData
91+ let posQuery = QueryMatchQuery $ mkMatchQuery (FieldName "user") (QueryString "bitemyapp")
92+ let negQuery = QueryMatchQuery $ mkMatchQuery (FieldName "user") (QueryString "notmyapp")
93+ let query = QueryBoostingQuery $ BoostingQuery posQuery negQuery (Boost 0.2)
94+ let search = mkSearch (Just query) Nothing
95+ myTweet <- searchTweet search
96+ liftIO $
97+ myTweet `shouldBe` Right exampleTweet
98+
99+ it "returns document for common terms query" $ withTestEnv $ do
100+ _ <- insertData
101+ let query = QueryCommonTermsQuery $
102+ CommonTermsQuery (FieldName "user")
103+ (QueryString "bitemyapp")
104+ (CutoffFrequency 0.0001)
105+ Or Or Nothing Nothing Nothing Nothing
106+ let search = mkSearch (Just query) Nothing
107+ myTweet <- searchTweet search
108+ liftIO $
109+ myTweet `shouldBe` Right exampleTweet
110+
111+ it "returns document for for inline template query" $ withTestEnv $ do
112+ _ <- insertData
113+ let innerQuery = QueryMatchQuery $
114+ mkMatchQuery (FieldName "{{userKey}}")
115+ (QueryString "{{bitemyappKey}}")
116+ templateParams = TemplateQueryKeyValuePairs $ HM.fromList
117+ [ ("userKey", "user")
118+ , ("bitemyappKey", "bitemyapp")
119+ ]
120+ templateQuery = QueryTemplateQueryInline $
121+ TemplateQueryInline innerQuery templateParams
122+ search = mkSearch (Just templateQuery) Nothing
123+ myTweet <- searchTweet search
124+ liftIO $ myTweet `shouldBe` Right exampleTweet
125+
126+ it "returns document for wildcard query" $ withTestEnv $ do
127+ _ <- insertData
128+ let query = QueryWildcardQuery $ WildcardQuery (FieldName "user") "bitemy*" (Nothing)
129+ let search = mkSearch (Just query) Nothing
130+ myTweet <- searchTweet search
131+ liftIO $
132+ myTweet `shouldBe` Right exampleTweet
tests/Test/Script.hsnew file+36
@@ -0,0 +1,36 @@
1+{-# LANGUAGE OverloadedStrings #-}
2+
3+module Test.Script where
4+
5+import Test.Common
6+import Test.Import
7+
8+import qualified Data.HashMap.Strict as HM
9+import qualified Data.Map as M
10+
11+spec :: Spec
12+spec =
13+ describe "Script" $
14+ it "returns a transformed document based on the script field" $ withTestEnv $ do
15+ _ <- insertData
16+ let query = MatchAllQuery Nothing
17+ sfv = toJSON $
18+ Script
19+ (Just (ScriptLanguage "painless"))
20+ (Just (ScriptInline "doc['age'].value * 2"))
21+ Nothing
22+ Nothing
23+ sf = ScriptFields $
24+ HM.fromList [("test1", sfv)]
25+ search' = mkSearch (Just query) Nothing
26+ search = search' { scriptFields = Just sf }
27+ resp <- searchByIndex testIndex search
28+ parsed <- parseEsResponse resp :: BH IO (Either EsError (SearchResult Value))
29+ case parsed of
30+ Left e ->
31+ liftIO $ expectationFailure ("Expected a script-transformed result but got: " <> show e)
32+ Right sr -> do
33+ let Just results =
34+ hitFields (head (hits (searchHits sr)))
35+ liftIO $
36+ results `shouldBe` HitFields (M.fromList [("test1", [Number 20000.0])])
tests/Test/Snapshots.hsnew file+201
@@ -0,0 +1,201 @@
1+{-# LANGUAGE RecordWildCards #-}
2+{-# LANGUAGE OverloadedStrings #-}
3+
4+module Test.Snapshots (spec) where
5+
6+import Test.Common
7+import Test.Import
8+
9+import Data.Maybe (fromMaybe)
10+import qualified Data.List as L
11+import qualified Data.HashMap.Strict as HM
12+import qualified Data.Text as T
13+import qualified Data.Vector as V
14+import qualified Network.HTTP.Types.Method as NHTM
15+import qualified Network.URI as URI
16+
17+import Test.Generators ()
18+
19+spec :: Spec
20+spec = do
21+ describe "FsSnapshotRepo" $
22+ prop "SnapshotRepo laws" $ \fsr ->
23+ fromGSnapshotRepo (toGSnapshotRepo fsr) === Right (fsr :: FsSnapshotRepo)
24+
25+ describe "Snapshot repos" $ do
26+ it "always parses all snapshot repos API" $ when' canSnapshot $ withTestEnv $ do
27+ res <- getSnapshotRepos AllSnapshotRepos
28+ liftIO $ case res of
29+ Left e -> expectationFailure ("Expected a right but got Left " <> show e)
30+ Right _ -> return ()
31+
32+ it "finds an existing list of repos" $ when' canSnapshot $ withTestEnv $ do
33+ let r1n = SnapshotRepoName "bloodhound-repo1"
34+ let r2n = SnapshotRepoName "bloodhound-repo2"
35+ withSnapshotRepo r1n $ \r1 ->
36+ withSnapshotRepo r2n $ \r2 -> do
37+ repos <- getSnapshotRepos (SnapshotRepoList (ExactRepo r1n :| [ExactRepo r2n]))
38+ liftIO $ case repos of
39+ Right xs -> do
40+ let srt = L.sortBy (comparing gSnapshotRepoName)
41+ srt xs `shouldBe` srt [r1, r2]
42+ Left e -> expectationFailure (show e)
43+
44+ it "creates and updates with updateSnapshotRepo" $ when' canSnapshot $ withTestEnv $ do
45+ let r1n = SnapshotRepoName "bloodhound-repo1"
46+ withSnapshotRepo r1n $ \r1 -> do
47+ let Just (String dir) = HM.lookup "location" (gSnapshotRepoSettingsObject (gSnapshotRepoSettings r1))
48+ let noCompression = FsSnapshotRepo r1n (T.unpack dir) False Nothing Nothing Nothing
49+ resp <- updateSnapshotRepo defaultSnapshotRepoUpdateSettings noCompression
50+ liftIO (validateStatus resp 200)
51+ Right [roundtrippedNoCompression] <- getSnapshotRepos (SnapshotRepoList (ExactRepo r1n :| []))
52+ liftIO (roundtrippedNoCompression `shouldBe` toGSnapshotRepo noCompression)
53+
54+ -- verify came around in 1.4 it seems
55+ it "can verify existing repos" $ when' canSnapshot $ when' (atleast es14) $ withTestEnv $ do
56+ let r1n = SnapshotRepoName "bloodhound-repo1"
57+ withSnapshotRepo r1n $ \_ -> do
58+ res <- verifySnapshotRepo r1n
59+ liftIO $ case res of
60+ Right (SnapshotVerification vs)
61+ | null vs -> expectationFailure "Expected nonempty set of verifying nodes"
62+ | otherwise -> return ()
63+ Left e -> expectationFailure (show e)
64+
65+ describe "Snapshots" $ do
66+ it "always parses all snapshots API" $ when' canSnapshot $ withTestEnv $ do
67+ let r1n = SnapshotRepoName "bloodhound-repo1"
68+ withSnapshotRepo r1n $ \_ -> do
69+ res <- getSnapshots r1n AllSnapshots
70+ liftIO $ case res of
71+ Left e -> expectationFailure ("Expected a right but got Left " <> show e)
72+ Right _ -> return ()
73+
74+ it "can parse a snapshot that it created" $ when' canSnapshot $ withTestEnv $ do
75+ let r1n = SnapshotRepoName "bloodhound-repo1"
76+ withSnapshotRepo r1n $ \_ -> do
77+ let s1n = SnapshotName "example-snapshot"
78+ withSnapshot r1n s1n $ do
79+ res <- getSnapshots r1n (SnapshotList (ExactSnap s1n :| []))
80+ liftIO $ case res of
81+ Right [snap]
82+ | snapInfoState snap == SnapshotSuccess &&
83+ snapInfoName snap == s1n -> return ()
84+ | otherwise -> expectationFailure (show snap)
85+ Right [] -> expectationFailure "There were no snapshots"
86+ Right snaps -> expectationFailure ("Expected 1 snapshot but got" <> show (length snaps))
87+ Left e -> expectationFailure (show e)
88+
89+ describe "Snapshot restore" $ do
90+ it "can restore a snapshot that we create" $ when' canSnapshot $ withTestEnv $ do
91+ let r1n = SnapshotRepoName "bloodhound-repo1"
92+ withSnapshotRepo r1n $ \_ -> do
93+ let s1n = SnapshotName "example-snapshot"
94+ withSnapshot r1n s1n $ do
95+ let settings = defaultSnapshotRestoreSettings { snapRestoreWaitForCompletion = True }
96+ -- have to close an index to restore it
97+ resp1 <- closeIndex testIndex
98+ liftIO (validateStatus resp1 200)
99+ resp2 <- restoreSnapshot r1n s1n settings
100+ liftIO (validateStatus resp2 200)
101+
102+ it "can restore and rename" $ when' canSnapshot $ withTestEnv $ do
103+ let r1n = SnapshotRepoName "bloodhound-repo1"
104+ withSnapshotRepo r1n $ \_ -> do
105+ let s1n = SnapshotName "example-snapshot"
106+ withSnapshot r1n s1n $ do
107+ let pat = RestoreRenamePattern "bloodhound-tests-twitter-(\\d+)"
108+ let replace = RRTLit "restored-" :| [RRSubWholeMatch]
109+ let expectedIndex = IndexName "restored-bloodhound-tests-twitter-1"
110+ oldEnoughForOverrides <- liftIO (atleast es15)
111+ let overrides = RestoreIndexSettings { restoreOverrideReplicas = Just (ReplicaCount 0) }
112+ let settings = defaultSnapshotRestoreSettings { snapRestoreWaitForCompletion = True
113+ , snapRestoreRenamePattern = Just pat
114+ , snapRestoreRenameReplacement = Just replace
115+ , snapRestoreIndexSettingsOverrides = if oldEnoughForOverrides
116+ then Just overrides
117+ else Nothing
118+ }
119+ -- have to close an index to restore it
120+ let go = do
121+ resp <- restoreSnapshot r1n s1n settings
122+ liftIO (validateStatus resp 200)
123+ exists <- indexExists expectedIndex
124+ liftIO (exists `shouldBe` True)
125+ go `finally` deleteIndex expectedIndex
126+
127+-- | Get configured repo paths for snapshotting. Note that by default
128+-- this is not enabled and if we are over es 1.5, we won't be able to
129+-- test snapshotting. Note that this can and should be part of the
130+-- client functionality in a much less ad-hoc incarnation.
131+getRepoPaths :: IO [FilePath]
132+getRepoPaths = withTestEnv $ do
133+ bhe <- getBHEnv
134+ let Server s = bhServer bhe
135+ let tUrl = s <> "/" <> "_nodes"
136+ initReq <- parseRequest (URI.escapeURIString URI.isAllowedInURI (T.unpack tUrl))
137+ let req = setRequestIgnoreStatus $ initReq { method = NHTM.methodGet }
138+ Right (Object o) <- parseEsResponse =<< liftIO (httpLbs req (bhManager bhe))
139+ return $ fromMaybe mempty $ do
140+ Object nodes <- HM.lookup "nodes" o
141+ Object firstNode <- snd <$> headMay (HM.toList nodes)
142+ Object settings <- HM.lookup "settings" firstNode
143+ Object path <- HM.lookup "path" settings
144+ Array repo <- HM.lookup "repo" path
145+ return [ T.unpack t | String t <- V.toList repo]
146+
147+-- | 1.5 and earlier don't care about repo paths
148+canSnapshot :: IO Bool
149+canSnapshot = do
150+ caresAboutRepos <- atleast es16
151+ repoPaths <- getRepoPaths
152+ return (not caresAboutRepos || not (null repoPaths))
153+
154+withSnapshotRepo
155+ :: ( MonadMask m
156+ , MonadBH m
157+ )
158+ => SnapshotRepoName
159+ -> (GenericSnapshotRepo -> m a)
160+ -> m a
161+withSnapshotRepo srn@(SnapshotRepoName n) f = do
162+ repoPaths <- liftIO getRepoPaths
163+ -- we'll use the first repo path if available, otherwise system temp
164+ -- dir. Note that this will fail on ES > 1.6, so be sure you use
165+ -- @when' canSnapshot@.
166+ case repoPaths of
167+ (firstRepoPath:_) -> withTempDirectory firstRepoPath (T.unpack n) $ \dir -> bracket (alloc dir) free f
168+ [] -> withSystemTempDirectory (T.unpack n) $ \dir -> bracket (alloc dir) free f
169+ where
170+ alloc dir = do
171+ liftIO (setFileMode dir mode)
172+ let repo = FsSnapshotRepo srn "bloodhound-tests-backups" True Nothing Nothing Nothing
173+ resp <- updateSnapshotRepo defaultSnapshotRepoUpdateSettings repo
174+ liftIO (validateStatus resp 200)
175+ return (toGSnapshotRepo repo)
176+ mode = ownerModes `unionFileModes` groupModes `unionFileModes` otherModes
177+ free GenericSnapshotRepo {..} = do
178+ resp <- deleteSnapshotRepo gSnapshotRepoName
179+ liftIO (validateStatus resp 200)
180+
181+
182+withSnapshot
183+ :: ( MonadMask m
184+ , MonadBH m
185+ )
186+ => SnapshotRepoName
187+ -> SnapshotName
188+ -> m a
189+ -> m a
190+withSnapshot srn sn = bracket_ alloc free
191+ where
192+ alloc = do
193+ resp <- createSnapshot srn sn createSettings
194+ liftIO (validateStatus resp 200)
195+ -- We'll make this synchronous for testing purposes
196+ createSettings = defaultSnapshotCreateSettings { snapWaitForCompletion = True
197+ , snapIndices = Just (IndexList (testIndex :| []))
198+ -- We don't actually need to back up any data
199+ }
200+ free =
201+ deleteSnapshot srn sn
tests/Test/Sorting.hsnew file+22
@@ -0,0 +1,22 @@
1+{-# LANGUAGE OverloadedStrings #-}
2+
3+module Test.Sorting where
4+
5+import Test.Common
6+import Test.Import
7+
8+spec :: Spec
9+spec =
10+ describe "sorting" $
11+ it "returns documents in the right order" $ withTestEnv $ do
12+ _ <- insertData
13+ _ <- insertOther
14+ let sortSpec = DefaultSortSpec $ mkSort (FieldName "age") Ascending
15+ let search = Search Nothing
16+ Nothing (Just [sortSpec]) Nothing Nothing
17+ False (From 0) (Size 10) SearchTypeQueryThenFetch Nothing Nothing Nothing
18+ Nothing Nothing
19+ result <- searchTweets search
20+ let myTweet = grabFirst result
21+ liftIO $
22+ myTweet `shouldBe` Right otherTweet
tests/Test/SourceFiltering.hsnew file+38
@@ -0,0 +1,38 @@
1+{-# LANGUAGE OverloadedStrings #-}
2+
3+module Test.SourceFiltering where
4+
5+import Test.Common
6+import Test.Import
7+
8+import qualified Data.HashMap.Strict as HM
9+
10+spec :: Spec
11+spec =
12+ describe "Source filtering" $ do
13+
14+ it "doesn't include source when sources are disabled" $ withTestEnv $
15+ searchExpectSource
16+ NoSource
17+ (Left (EsError 500 "Source was missing"))
18+
19+ it "includes a source" $ withTestEnv $
20+ searchExpectSource
21+ (SourcePatterns (PopPattern (Pattern "message")))
22+ (Right (Object (HM.fromList [("message", String "Use haskell!")])))
23+
24+ it "includes sources" $ withTestEnv $
25+ searchExpectSource
26+ (SourcePatterns (PopPatterns [Pattern "user", Pattern "message"]))
27+ (Right (Object (HM.fromList [("user",String "bitemyapp"),("message", String "Use haskell!")])))
28+
29+ it "includes source patterns" $ withTestEnv $
30+ searchExpectSource
31+ (SourcePatterns (PopPattern (Pattern "*ge")))
32+ (Right (Object (HM.fromList [("age", Number 10000),("message", String "Use haskell!")])))
33+
34+ it "excludes source patterns" $ withTestEnv $
35+ searchExpectSource
36+ (SourceIncludeExclude (Include [])
37+ (Exclude [Pattern "l*", Pattern "*ge", Pattern "postDate", Pattern "extra"]))
38+ (Right (Object (HM.fromList [("user",String "bitemyapp")])))
tests/Test/Suggest.hsnew file+23
@@ -0,0 +1,23 @@
1+{-# LANGUAGE OverloadedStrings #-}
2+
3+module Test.Suggest where
4+
5+import Test.Common
6+import Test.Import
7+
8+spec :: Spec
9+spec =
10+ describe "Suggest" $
11+ it "returns a search suggestion using the phrase suggester" $ withTestEnv $ do
12+ _ <- insertData
13+ let query = QueryMatchNoneQuery
14+ phraseSuggester = mkPhraseSuggester (FieldName "message")
15+ namedSuggester = Suggest "Use haskel" "suggest_name" (SuggestTypePhraseSuggester phraseSuggester)
16+ search' = mkSearch (Just query) Nothing
17+ search = search' { suggestBody = Just namedSuggester }
18+ expectedText = Just "use haskell"
19+ resp <- searchByIndex testIndex search
20+ parsed <- parseEsResponse resp :: BH IO (Either EsError (SearchResult Tweet))
21+ case parsed of
22+ Left e -> liftIO $ expectationFailure ("Expected an search suggestion but got " <> show e)
23+ Right sr -> liftIO $ (suggestOptionsText . head . suggestResponseOptions . head . nsrResponses <$> suggest sr) `shouldBe` expectedText
tests/Test/Templates.hsnew file+26
@@ -0,0 +1,26 @@
1+{-# LANGUAGE OverloadedStrings #-}
2+
3+module Test.Templates where
4+
5+import Test.Common
6+import Test.Import
7+
8+spec :: Spec
9+spec =
10+ describe "template API" $ do
11+ it "can create a template" $ withTestEnv $ do
12+ let idxTpl = IndexTemplate (TemplatePattern "tweet-*") (Just (IndexSettings (ShardCount 1) (ReplicaCount 1))) [toJSON TweetMapping]
13+ resp <- putTemplate idxTpl (TemplateName "tweet-tpl")
14+ liftIO $ validateStatus resp 200
15+
16+ it "can detect if a template exists" $ withTestEnv $ do
17+ exists <- templateExists (TemplateName "tweet-tpl")
18+ liftIO $ exists `shouldBe` True
19+
20+ it "can delete a template" $ withTestEnv $ do
21+ resp <- deleteTemplate (TemplateName "tweet-tpl")
22+ liftIO $ validateStatus resp 200
23+
24+ it "can detect if a template doesn't exist" $ withTestEnv $ do
25+ exists <- templateExists (TemplateName "tweet-tpl")
26+ liftIO $ exists `shouldBe` False
tests/doctests.hsdeleted−4
@@ -1,4 +0,0 @@
1−import Test.DocTest
2−
3−main :: IO ()
4−main = doctest ["-i src", "Database.Bloodhound"]
tests/tests.hs+62−1744
@@ -1,910 +1,53 @@
1{-# LANGUAGE CPP #-}
1{-# LANGUAGE CPP #-}
2−{-# LANGUAGE DefaultSignatures #-}
3−{-# LANGUAGE DeriveGeneric #-}
4{-# LANGUAGE FlexibleContexts #-}
2{-# LANGUAGE FlexibleContexts #-}
5−{-# LANGUAGE GeneralizedNewtypeDeriving #-}
6{-# LANGUAGE OverloadedStrings #-}
3{-# LANGUAGE OverloadedStrings #-}
7{-# LANGUAGE RecordWildCards #-}
4{-# LANGUAGE RecordWildCards #-}
8{-# LANGUAGE ScopedTypeVariables #-}
5{-# LANGUAGE ScopedTypeVariables #-}
9−{-# LANGUAGE TemplateHaskell #-}
10{-# LANGUAGE TypeOperators #-}
6{-# LANGUAGE TypeOperators #-}
11{-# OPTIONS_GHC -fno-warn-orphans #-}
7{-# OPTIONS_GHC -fno-warn-orphans #-}
12−module Main where
8+#if __GLASGOW_HASKELL__ < 800
13−
9+{-# OPTIONS_GHC -fcontext-stack=100 #-}
14−import Control.Applicative
15−import Control.Error
16−import Control.Exception (evaluate)
17−import Control.Monad
18−import Control.Monad.Catch
19−import Control.Monad.Reader
20−import Data.Aeson
21−import Data.Aeson.Types (parseEither)
22−import qualified Data.ByteString.Lazy.Char8 as BL8
23−import Data.DeriveTH
24−import qualified Data.HashMap.Strict as HM
25−import Data.List (nub)
26−import qualified Data.List as L
27−import Data.List.NonEmpty (NonEmpty (..))
28−import qualified Data.List.NonEmpty as NE
29−import qualified Data.Map.Strict as M
30−import Data.Monoid
31−import Data.Ord (comparing)
32−import Data.Proxy
33−import Data.Text (Text)
34−import qualified Data.Text as T
35−import Data.Time.Calendar (Day (..), fromGregorian)
36−import Data.Time.Clock (NominalDiffTime, UTCTime (..),
37− secondsToDiffTime)
38−import Data.Typeable
39−import qualified Data.Vector as V
40−import qualified Data.Version as Vers
41−import Database.Bloodhound
42−import GHC.Generics as G
43−import Network.HTTP.Client hiding (Proxy)
44−import qualified Network.HTTP.Types.Method as NHTM
45−import qualified Network.HTTP.Types.Status as NHTS
46−import qualified Network.URI as URI
47−import Prelude hiding (filter)
48−import System.IO.Temp
49−import System.Posix.Files
50−import Test.Hspec
51−import Test.QuickCheck.Property.Monoid (T (..), eq, prop_Monoid)
52−
53−import Test.Hspec.QuickCheck (prop)
54−import Test.QuickCheck
55−
56−
57−testServer :: Server
58−testServer = Server "http://localhost:9200"
59−testIndex :: IndexName
60−testIndex = IndexName "bloodhound-tests-twitter-1"
61−testMapping :: MappingName
62−testMapping = MappingName "tweet"
63−
64−withTestEnv :: BH IO a -> IO a
65−withTestEnv = withBH defaultManagerSettings testServer
66−
67−validateStatus :: Show body => Response body -> Int -> Expectation
68−validateStatus resp expected =
69− if actual == expected
70− then return ()
71− else expectationFailure ("Expected " <> show expected <> " but got " <> show actual <> ": " <> show body)
72− where
73− actual = NHTS.statusCode (responseStatus resp)
74− body = responseBody resp
75−
76−createExampleIndex :: (MonadBH m) => m Reply
77−createExampleIndex = createIndex (IndexSettings (ShardCount 1) (ReplicaCount 0)) testIndex
78−deleteExampleIndex :: (MonadBH m) => m Reply
79−deleteExampleIndex = deleteIndex testIndex
80−
81−es13 :: Vers.Version
82−es13 = Vers.Version [1, 3, 0] []
83−
84−es12 :: Vers.Version
85−es12 = Vers.Version [1, 2, 0] []
86−
87−es11 :: Vers.Version
88−es11 = Vers.Version [1, 1, 0] []
89−
90−es14 :: Vers.Version
91−es14 = Vers.Version [1, 4, 0] []
92−
93−es15 :: Vers.Version
94−es15 = Vers.Version [1, 5, 0] []
95−
96−es16 :: Vers.Version
97−es16 = Vers.Version [1, 6, 0] []
98−
99−es20 :: Vers.Version
100−es20 = Vers.Version [2, 0, 0] []
101−
102−getServerVersion :: IO (Maybe Vers.Version)
103−getServerVersion = fmap extractVersion <$> withTestEnv getStatus
104− where
105− extractVersion = versionNumber . number . version
106−
107−-- | Get configured repo paths for snapshotting. Note that by default
108−-- this is not enabled and if we are over es 1.5, we won't be able to
109−-- test snapshotting. Note that this can and should be part of the
110−-- client functionality in a much less ad-hoc incarnation.
111−getRepoPaths :: IO [FilePath]
112−getRepoPaths = withTestEnv $ do
113− bhe <- getBHEnv
114− let Server s = bhServer bhe
115− let tUrl = s <> "/" <> "_nodes"
116− initReq <- parseRequest (URI.escapeURIString URI.isAllowedInURI (T.unpack tUrl))
117− let req = setRequestIgnoreStatus $ initReq { method = NHTM.methodGet }
118− Right (Object o) <- parseEsResponse =<< liftIO (httpLbs req (bhManager bhe))
119− return $ fromMaybe mempty $ do
120− Object nodes <- HM.lookup "nodes" o
121− Object firstNode <- snd <$> headMay (HM.toList nodes)
122− Object settings <- HM.lookup "settings" firstNode
123− Object path <- HM.lookup "path" settings
124− Array repo <- HM.lookup "repo" path
125− return [ T.unpack t | String t <- V.toList repo]
126−
127−-- | 1.5 and earlier don't care about repo paths
128−canSnapshot :: IO Bool
129−canSnapshot = do
130− caresAboutRepos <- atleast es16
131− repoPaths <- getRepoPaths
132− return (not caresAboutRepos || not (null (repoPaths)))
133−
134−atleast :: Vers.Version -> IO Bool
135−atleast v = getServerVersion >>= \x -> return $ x >= Just v
136−
137−atmost :: Vers.Version -> IO Bool
138−atmost v = getServerVersion >>= \x -> return $ x <= Just v
139−
140−is :: Vers.Version -> IO Bool
141−is v = getServerVersion >>= \x -> return $ x == Just v
142−
143−when' :: Monad m => m Bool -> m () -> m ()
144−when' b f = b >>= \x -> when x f
145−
146−(==~) :: (ApproxEq a, Show a) => a -> a -> Property
147−a ==~ b = counterexample (show a ++ " !=~ " ++ show b) (a =~ b)
148−
149−propJSON :: forall a. (Arbitrary a, ToJSON a, FromJSON a, Show a, ApproxEq a, Typeable a) => Proxy a -> Spec
150−propJSON _ = prop testName $ \(a :: a) ->
151− let jsonStr = "via " <> BL8.unpack (encode a)
152− in counterexample jsonStr (parseEither parseJSON (toJSON a) ==~ Right a)
153− where testName = show ty <> " FromJSON/ToJSON roundtrips"
154− ty = typeOf (undefined :: a)
155−
156−data Location = Location { lat :: Double
157− , lon :: Double } deriving (Eq, Generic, Show)
158−
159−data Tweet = Tweet { user :: Text
160− , postDate :: UTCTime
161− , message :: Text
162− , age :: Int
163− , location :: Location
164− , extra :: Maybe Text }
165− deriving (Eq, Generic, Show)
166−
167−instance ToJSON Tweet where
168− toJSON = genericToJSON defaultOptions
169−instance FromJSON Tweet where
170− parseJSON = genericParseJSON defaultOptions
171−instance ToJSON Location where
172− toJSON = genericToJSON defaultOptions
173−instance FromJSON Location where
174− parseJSON = genericParseJSON defaultOptions
175−
176−data ParentMapping = ParentMapping deriving (Eq, Show)
177−
178−instance ToJSON ParentMapping where
179− toJSON ParentMapping =
180− object ["parent" .=
181− object ["properties" .=
182− object [ "user" .= object ["type" .= ("string" :: Text)]
183− -- Serializing the date as a date is breaking other tests, mysteriously.
184− -- , "postDate" .= object [ "type" .= ("date" :: Text)
185− -- , "format" .= ("YYYY-MM-dd`T`HH:mm:ss.SSSZZ" :: Text)]
186− , "message" .= object ["type" .= ("string" :: Text)]
187− , "age" .= object ["type" .= ("integer" :: Text)]
188− , "location" .= object ["type" .= ("geo_point" :: Text)]
189− ]]]
190−
191−data ChildMapping = ChildMapping deriving (Eq, Show)
192−
193−instance ToJSON ChildMapping where
194− toJSON ChildMapping =
195− object ["child" .=
196− object ["_parent" .= object ["type" .= ("parent" :: Text)]
197− , "properties" .=
198− object [ "user" .= object ["type" .= ("string" :: Text)]
199− -- Serializing the date as a date is breaking other tests, mysteriously.
200− -- , "postDate" .= object [ "type" .= ("date" :: Text)
201− -- , "format" .= ("YYYY-MM-dd`T`HH:mm:ss.SSSZZ" :: Text)]
202− , "message" .= object ["type" .= ("string" :: Text)]
203− , "age" .= object ["type" .= ("integer" :: Text)]
204− , "location" .= object ["type" .= ("geo_point" :: Text)]
205− ]]]
206−
207−data TweetMapping = TweetMapping deriving (Eq, Show)
208−
209−instance ToJSON TweetMapping where
210− toJSON TweetMapping =
211− object ["tweet" .=
212− object ["properties" .=
213− object [ "user" .= object ["type" .= ("string" :: Text)]
214− -- Serializing the date as a date is breaking other tests, mysteriously.
215− -- , "postDate" .= object [ "type" .= ("date" :: Text)
216− -- , "format" .= ("YYYY-MM-dd`T`HH:mm:ss.SSSZZ" :: Text)]
217− , "message" .= object ["type" .= ("string" :: Text)]
218− , "age" .= object ["type" .= ("integer" :: Text)]
219− , "location" .= object ["type" .= ("geo_point" :: Text)]
220− ]]]
221−
222−exampleTweet :: Tweet
223−exampleTweet = Tweet { user = "bitemyapp"
224− , postDate = UTCTime
225− (ModifiedJulianDay 55000)
226− (secondsToDiffTime 10)
227− , message = "Use haskell!"
228− , age = 10000
229− , location = Location 40.12 (-71.34)
230− , extra = Nothing }
231−
232−tweetWithExtra :: Tweet
233−tweetWithExtra = Tweet { user = "bitemyapp"
234− , postDate = UTCTime
235− (ModifiedJulianDay 55000)
236− (secondsToDiffTime 10)
237− , message = "Use haskell!"
238− , age = 10000
239− , location = Location 40.12 (-71.34)
240− , extra = Just "blah blah" }
241−
242−newAge :: Int
243−newAge = 31337
244−
245−newUser :: Text
246−newUser = "someotherapp"
247−
248−tweetPatch :: Value
249−tweetPatch =
250− object [ "age" .= newAge
251− , "user" .= newUser
252− ]
253−
254−patchedTweet :: Tweet
255−patchedTweet = exampleTweet{age = newAge, user = newUser}
256−
257−otherTweet :: Tweet
258−otherTweet = Tweet { user = "notmyapp"
259− , postDate = UTCTime
260− (ModifiedJulianDay 55000)
261− (secondsToDiffTime 11)
262− , message = "Use haskell!"
263− , age = 1000
264− , location = Location 40.12 (-71.34)
265− , extra = Nothing }
266−
267−resetIndex :: BH IO ()
268−resetIndex = do
269− _ <- deleteExampleIndex
270− _ <- createExampleIndex
271− _ <- putMapping testIndex testMapping TweetMapping
272− return ()
273−
274−insertData :: BH IO Reply
275−insertData = do
276− resetIndex
277− insertData' defaultIndexDocumentSettings
278−
279−insertData' :: IndexDocumentSettings -> BH IO Reply
280−insertData' ids = do
281− r <- indexDocument testIndex testMapping ids exampleTweet (DocId "1")
282− _ <- refreshIndex testIndex
283− return r
284−
285−updateData :: BH IO Reply
286−updateData = do
287− r <- updateDocument testIndex testMapping defaultIndexDocumentSettings tweetPatch (DocId "1")
288− _ <- refreshIndex testIndex
289− return r
290−
291−insertOther :: BH IO ()
292−insertOther = do
293− _ <- indexDocument testIndex testMapping defaultIndexDocumentSettings otherTweet (DocId "2")
294− _ <- refreshIndex testIndex
295− return ()
296−
297−insertExtra :: BH IO ()
298−insertExtra = do
299− _ <- indexDocument testIndex testMapping defaultIndexDocumentSettings tweetWithExtra (DocId "4")
300− _ <- refreshIndex testIndex
301− return ()
302−
303−insertWithSpaceInId :: BH IO ()
304−insertWithSpaceInId = do
305− _ <- indexDocument testIndex testMapping defaultIndexDocumentSettings exampleTweet (DocId "Hello World")
306− _ <- refreshIndex testIndex
307− return ()
308−
309−searchTweet :: Search -> BH IO (Either EsError Tweet)
310−searchTweet search = do
311− result <- searchTweets search
312− let myTweet :: Either EsError Tweet
313− myTweet = grabFirst result
314− return myTweet
315−
316−searchTweets :: Search -> BH IO (Either EsError (SearchResult Tweet))
317−searchTweets search = parseEsResponse =<< searchByIndex testIndex search
318−
319−searchExpectNoResults :: Search -> BH IO ()
320−searchExpectNoResults search = do
321− result <- searchTweets search
322− let emptyHits = fmap (hits . searchHits) result
323− liftIO $
324− emptyHits `shouldBe` Right []
325−
326−searchExpectAggs :: Search -> BH IO ()
327−searchExpectAggs search = do
328− reply <- searchByIndex testIndex search
329− let isEmpty x = return (M.null x)
330− let result = decode (responseBody reply) :: Maybe (SearchResult Tweet)
331− liftIO $
332− (result >>= aggregations >>= isEmpty) `shouldBe` Just False
333−
334−searchValidBucketAgg :: (BucketAggregation a, FromJSON a, Show a) =>
335− Search -> Text -> (Text -> AggregationResults -> Maybe (Bucket a)) -> BH IO ()
336−searchValidBucketAgg search aggKey extractor = do
337− reply <- searchByIndex testIndex search
338− let bucketDocs = docCount . head . buckets
339− let result = decode (responseBody reply) :: Maybe (SearchResult Tweet)
340− let count = result >>= aggregations >>= extractor aggKey >>= \x -> return (bucketDocs x)
341− liftIO $
342− count `shouldBe` Just 1
343−
344−searchTermsAggHint :: [ExecutionHint] -> BH IO ()
345−searchTermsAggHint hints = do
346− let terms hint = TermsAgg $ (mkTermsAggregation "user") { termExecutionHint = Just hint }
347− let search hint = mkAggregateSearch Nothing $ mkAggregations "users" $ terms hint
348− forM_ hints $ searchExpectAggs . search
349− forM_ hints (\x -> searchValidBucketAgg (search x) "users" toTerms)
350−
351−searchTweetHighlight :: Search -> BH IO (Either EsError (Maybe HitHighlight))
352−searchTweetHighlight search = do
353− result <- searchTweets search
354− let myHighlight = fmap (hitHighlight . head . hits . searchHits) result
355− return myHighlight
356−
357−searchExpectSource :: Source -> Either EsError Value -> BH IO ()
358−searchExpectSource src expected = do
359− _ <- insertData
360− let query = QueryMatchQuery $ mkMatchQuery (FieldName "_all") (QueryString "haskell")
361− let search = (mkSearch (Just query) Nothing) { source = Just src }
362− reply <- searchByIndex testIndex search
363− result <- parseEsResponse reply
364− let value = grabFirst result
365− liftIO $
366− value `shouldBe` expected
367−
368−withSnapshotRepo
369− :: ( MonadMask m
370− , MonadBH m
371− )
372− => SnapshotRepoName
373− -> (GenericSnapshotRepo -> m a)
374− -> m a
375−withSnapshotRepo srn@(SnapshotRepoName n) f = do
376− repoPaths <- liftIO getRepoPaths
377− -- we'll use the first repo path if available, otherwise system temp
378− -- dir. Note that this will fail on ES > 1.6, so be sure you use
379− -- @when' canSnapshot@.
380− case repoPaths of
381− (firstRepoPath:_) -> withTempDirectory firstRepoPath (T.unpack n) $ \dir -> bracket (alloc dir) free f
382− [] -> withSystemTempDirectory (T.unpack n) $ \dir -> bracket (alloc dir) free f
383− where
384− alloc dir = do
385− liftIO (setFileMode dir mode)
386− let repo = FsSnapshotRepo srn "bloodhound-tests-backups" True Nothing Nothing Nothing
387− resp <- updateSnapshotRepo defaultSnapshotRepoUpdateSettings repo
388− liftIO (validateStatus resp 200)
389− return (toGSnapshotRepo repo)
390− mode = ownerModes `unionFileModes` groupModes `unionFileModes` otherModes
391− free GenericSnapshotRepo {..} = do
392− resp <- deleteSnapshotRepo gSnapshotRepoName
393− liftIO (validateStatus resp 200)
394−
395−
396−withSnapshot
397− :: ( MonadMask m
398− , MonadBH m
399− )
400− => SnapshotRepoName
401− -> SnapshotName
402− -> m a
403− -> m a
404−withSnapshot srn sn = bracket_ alloc free
405− where
406− alloc = do
407− resp <- createSnapshot srn sn createSettings
408− liftIO (validateStatus resp 200)
409− -- We'll make this synchronous for testing purposes
410− createSettings = defaultSnapshotCreateSettings { snapWaitForCompletion = True
411− , snapIndices = Just (IndexList (testIndex :| []))
412− -- We don't actually need to back up any data
413− }
414− free = do
415− deleteSnapshot srn sn
416−
417−
418−
419−data BulkTest = BulkTest { name :: Text } deriving (Eq, Generic, Show)
420−instance FromJSON BulkTest where
421− parseJSON = genericParseJSON defaultOptions
422−instance ToJSON BulkTest where
423− toJSON = genericToJSON defaultOptions
424−
425−class GApproxEq f where
426− gApproxEq :: f a -> f a -> Bool
427−
428−-- | Unit type
429−instance GApproxEq U1 where
430− gApproxEq U1 U1 = True
431−
432−-- | Sum type, ensure same constructors, recurse
433−instance (GApproxEq a, GApproxEq b) => GApproxEq (a :+: b) where
434− gApproxEq (L1 a) (L1 b) = gApproxEq a b
435− gApproxEq (R1 a) (R1 b) = gApproxEq a b
436− gApproxEq _ _ = False
437−
438−-- | Product type, ensure each field is approx eq
439−instance (GApproxEq a, GApproxEq b) => GApproxEq (a :*: b) where
440− gApproxEq (a1 :*: b1) (a2 :*: b2) = gApproxEq a1 a2 && gApproxEq b1 b2
441−
442−-- | Value type, actually check the values for approx equality
443−instance (ApproxEq a) => GApproxEq (K1 i a) where
444− gApproxEq (K1 a) (K1 b) = a =~ b
445−
446−instance (GApproxEq f) => GApproxEq (M1 i t f) where
447− gApproxEq (M1 a) (M1 b) = gApproxEq a b
448−
449−-- | Typeclass for "equal where it matters". Use this to specify
450−-- less-strict equivalence for things such as lists that can wind up
451−-- in an unpredictable order
452−class ApproxEq a where
453− (=~) :: a -> a -> Bool
454− default (=~) :: (Generic a, GApproxEq (Rep a)) => a -> a -> Bool
455− a =~ b = gApproxEq (G.from a) (G.from b)
456−
457−instance ApproxEq NominalDiffTime where (=~) = (==)
458−instance ApproxEq UTCTime where (=~) = (==)
459−instance ApproxEq Text where (=~) = (==)
460−instance ApproxEq Bool where (=~) = (==)
461−instance ApproxEq Int where (=~) = (==)
462−instance ApproxEq Double where (=~) = (==)
463−instance ApproxEq a => ApproxEq (NonEmpty a)
464−instance ApproxEq a => ApproxEq (Maybe a)
465−instance ApproxEq GeoPoint
466−instance ApproxEq Regexp
467−instance ApproxEq RangeValue
468−instance ApproxEq LessThan
469−instance ApproxEq LessThanEq
470−instance ApproxEq LessThanD
471−instance ApproxEq LessThanEqD
472−instance ApproxEq GreaterThan
473−instance ApproxEq GreaterThanEq
474−instance ApproxEq GreaterThanD
475−instance ApproxEq GreaterThanEqD
476−instance ApproxEq MinimumMatchHighLow
477−instance ApproxEq RegexpFlag
478−instance ApproxEq RegexpFlags
479−instance ApproxEq NullValue
480−instance ApproxEq Version
481−instance ApproxEq VersionNumber
482−instance ApproxEq DistanceRange
483−instance ApproxEq IndexName
484−instance ApproxEq MappingName
485−instance ApproxEq DocId
486−instance ApproxEq IndexAliasRouting
487−instance ApproxEq RoutingValue
488−instance ApproxEq ShardCount
489−instance ApproxEq ReplicaCount
490−instance ApproxEq TemplateName
491−instance ApproxEq TemplatePattern
492−instance ApproxEq QueryString
493−instance ApproxEq FieldName
494−instance ApproxEq CacheName
495−instance ApproxEq CacheKey
496−instance ApproxEq Existence
497−instance ApproxEq CutoffFrequency
498−instance ApproxEq Analyzer
499−instance ApproxEq Lenient
500−instance ApproxEq Tiebreaker
501−instance ApproxEq Boost
502−instance ApproxEq BoostTerms
503−instance ApproxEq MaxExpansions
504−instance ApproxEq MinimumMatch
505−instance ApproxEq DisableCoord
506−instance ApproxEq IgnoreTermFrequency
507−instance ApproxEq MinimumTermFrequency
508−instance ApproxEq MaxQueryTerms
509−instance ApproxEq Fuzziness
510−instance ApproxEq PrefixLength
511−instance ApproxEq TypeName
512−instance ApproxEq PercentMatch
513−instance ApproxEq StopWord
514−instance ApproxEq QueryPath
515−instance ApproxEq AllowLeadingWildcard
516−instance ApproxEq LowercaseExpanded
517−instance ApproxEq EnablePositionIncrements
518−instance ApproxEq AnalyzeWildcard
519−instance ApproxEq GeneratePhraseQueries
520−instance ApproxEq Locale
521−instance ApproxEq MaxWordLength
522−instance ApproxEq MinWordLength
523−instance ApproxEq PhraseSlop
524−instance ApproxEq MinDocFrequency
525−instance ApproxEq MaxDocFrequency
526−instance ApproxEq Filter
527−instance ApproxEq Query
528−instance ApproxEq SimpleQueryStringQuery
529−instance ApproxEq FieldOrFields
530−instance ApproxEq SimpleQueryFlag
531−instance ApproxEq RegexpQuery
532−instance ApproxEq QueryStringQuery
533−instance ApproxEq RangeQuery
534−instance ApproxEq PrefixQuery
535−instance ApproxEq NestedQuery
536−instance ApproxEq MoreLikeThisFieldQuery
537−instance ApproxEq MoreLikeThisQuery
538−instance ApproxEq IndicesQuery
539−instance ApproxEq HasParentQuery
540−instance ApproxEq HasChildQuery
541−instance ApproxEq FuzzyQuery
542−instance ApproxEq FuzzyLikeFieldQuery
543−instance ApproxEq FuzzyLikeThisQuery
544−instance ApproxEq FilteredQuery
545−instance ApproxEq DisMaxQuery
546−instance ApproxEq CommonTermsQuery
547−instance ApproxEq CommonMinimumMatch
548−instance ApproxEq BoostingQuery
549−instance ApproxEq BoolQuery
550−instance ApproxEq MatchQuery
551−instance ApproxEq MultiMatchQueryType
552−instance ApproxEq BooleanOperator
553−instance ApproxEq ZeroTermsQuery
554−instance ApproxEq MatchQueryType
555−instance ApproxEq AliasRouting
556−instance ApproxEq IndexAliasCreate
557−instance ApproxEq SearchAliasRouting
558−instance ApproxEq ScoreType
559−instance ApproxEq Distance
560−instance ApproxEq DistanceUnit
561−instance ApproxEq DistanceType
562−instance ApproxEq OptimizeBbox
563−instance ApproxEq GeoBoundingBoxConstraint
564−instance ApproxEq GeoFilterType
565−instance ApproxEq GeoBoundingBox
566−instance ApproxEq LatLon
567−instance ApproxEq RangeExecution
568−instance ApproxEq FSType
569−instance ApproxEq CompoundFormat
570−instance ApproxEq InitialShardCount
571−instance ApproxEq Bytes
572−instance ApproxEq ReplicaBounds
573−instance ApproxEq Term
574−instance ApproxEq BoolMatch
575−instance ApproxEq MultiMatchQuery
576−instance ApproxEq IndexSettings
577−instance ApproxEq AllocationPolicy
578−instance ApproxEq Char
579−instance ApproxEq Vers.Version where
580− (=~) = (==)
581−instance ApproxEq a => ApproxEq [a] where
582− as =~ bs = and (zipWith (=~) as bs)
583−instance (ApproxEq l, ApproxEq r) => ApproxEq (Either l r) where
584− Left a =~ Left b = a =~ b
585− Right a =~ Right b = a =~ b
586− _ =~ _ = False
587−instance ApproxEq NodeAttrFilter
588−instance ApproxEq NodeAttrName
589−instance ApproxEq BuildHash
590−
591−-- | Due to the way nodeattrfilters get serialized here, they may come
592−-- out in a different order, but they are morally equivalent
593−instance ApproxEq UpdatableIndexSetting where
594− RoutingAllocationInclude a =~ RoutingAllocationInclude b =
595− NE.sort a =~ NE.sort b
596− RoutingAllocationExclude a =~ RoutingAllocationExclude b =
597− NE.sort a =~ NE.sort b
598− RoutingAllocationRequire a =~ RoutingAllocationRequire b =
599− NE.sort a =~ NE.sort b
600− a =~ b = a == b
601−
602−
603−noDuplicates :: Eq a => [a] -> Bool
604−noDuplicates xs = nub xs == xs
605−
606−instance Arbitrary NominalDiffTime where
607− arbitrary = fromInteger <$> arbitrary
608−
609−#if !MIN_VERSION_QuickCheck(2,8,0)
610−instance (Arbitrary k, Ord k, Arbitrary v) => Arbitrary (M.Map k v) where
611− arbitrary = M.fromList <$> arbitrary
612#endif
10#endif
11+#if __GLASGOW_HASKELL__ >= 802
12+{-# LANGUAGE MonoLocalBinds #-}
13+#endif
14+module Main where
613
15
614−instance Arbitrary Text where
16+import Test.Common
615− arbitrary = T.pack <$> arbitrary
17+import Test.Import
616−
18+
617−instance Arbitrary UTCTime where
19+import Prelude
618− arbitrary = UTCTime
20+
619− <$> arbitrary
21+import qualified Data.Aeson as Aeson
620− <*> (fromRational . toRational <$> choose (0::Double, 86400))
22+import qualified Test.Aggregation as Aggregation
621−
23+import qualified Test.BulkAPI as Bulk
622−instance Arbitrary Day where
24+import qualified Test.Documents as Documents
623− arbitrary = ModifiedJulianDay <$> (2000 +) <$> arbitrary
25+import qualified Test.Highlights as Highlights
624− shrink = (ModifiedJulianDay <$>) . shrink . toModifiedJulianDay
26+import qualified Test.Indices as Indices
625−
27+import qualified Test.JSON as JSON
626−instance Arbitrary a => Arbitrary (NonEmpty a) where
28+import qualified Test.Query as Query
627− arbitrary = liftA2 (:|) arbitrary arbitrary
29+import qualified Test.Script as Script
628−
30+import qualified Test.Snapshots as Snapshots
629−arbitraryScore :: Gen Score
31+import qualified Test.Sorting as Sorting
630−arbitraryScore = fmap getPositive <$> arbitrary
32+import qualified Test.SourceFiltering as SourceFiltering
631−
33+import qualified Test.Suggest as Suggest
632−instance (Arbitrary a, Typeable a) => Arbitrary (Hit a) where
34+import qualified Test.Templates as Templates
633− arbitrary = Hit <$> arbitrary
634− <*> arbitrary
635− <*> arbitrary
636− <*> arbitraryScore
637− <*> arbitrary
638− <*> arbitrary
639− shrink = genericShrink
640−
641−
642−instance (Arbitrary a, Typeable a) => Arbitrary (SearchHits a) where
643− arbitrary = reduceSize $ do
644− tot <- getPositive <$> arbitrary
645− score <- arbitraryScore
646− hs <- arbitrary
647− return $ SearchHits tot score hs
648− shrink = genericShrink
649−
650−reduceSize :: Gen a -> Gen a
651−reduceSize f = sized $ \n -> resize (n `div` 2) f
652−
653−getSource :: EsResult a -> Maybe a
654−getSource = fmap _source . foundResult
655−
656−grabFirst :: Either EsError (SearchResult a) -> Either EsError a
657−grabFirst r =
658− case fmap (hitSource . head . hits . searchHits) r of
659− (Left e) -> Left e
660− (Right Nothing) -> Left (EsError 500 "Source was missing")
661− (Right (Just x)) -> Right x
662−
663−-------------------------------------------------------------------------------
664−arbitraryAlphaNum :: Gen Char
665−arbitraryAlphaNum = oneof [choose ('a', 'z')
666− ,choose ('A','Z')
667− , choose ('0', '9')]
668−
669−instance Arbitrary RoutingValue where
670− arbitrary = RoutingValue . T.pack <$> listOf1 arbitraryAlphaNum
671−
672−instance Arbitrary AliasRouting where
673− arbitrary = oneof [allAlias
674− ,one
675− ,theOther
676− ,both]
677− where one = GranularAliasRouting
678− <$> (Just <$> arbitrary)
679− <*> pure Nothing
680− theOther = GranularAliasRouting Nothing
681− <$> (Just <$> arbitrary)
682− both = GranularAliasRouting
683− <$> (Just <$> arbitrary)
684− <*> (Just <$> arbitrary)
685− allAlias = AllAliasRouting <$> arbitrary
686− shrink = genericShrink
687−
688−
689−instance Arbitrary FieldName where
690− arbitrary = FieldName . T.pack <$> listOf1 arbitraryAlphaNum
691− shrink = genericShrink
692−
693−
694−instance Arbitrary RegexpFlags where
695− arbitrary = oneof [ pure AllRegexpFlags
696− , pure NoRegexpFlags
697− , SomeRegexpFlags <$> genUniqueFlags
698− ]
699− where genUniqueFlags = NE.fromList . nub <$> listOf1 arbitrary
700− shrink = genericShrink
701−
702−
703−instance Arbitrary IndexAliasCreate where
704− arbitrary = IndexAliasCreate <$> arbitrary <*> reduceSize arbitrary
705− shrink = genericShrink
706−
707−instance Arbitrary Query where
708− arbitrary = reduceSize $ oneof [ TermQuery <$> arbitrary <*> arbitrary
709− , TermsQuery <$> arbitrary <*> arbitrary
710− , QueryMatchQuery <$> arbitrary
711− , QueryMultiMatchQuery <$> arbitrary
712− , QueryBoolQuery <$> arbitrary
713− , QueryBoostingQuery <$> arbitrary
714− , QueryCommonTermsQuery <$> arbitrary
715− , ConstantScoreFilter <$> arbitrary <*> arbitrary
716− , ConstantScoreQuery <$> arbitrary <*> arbitrary
717− , QueryDisMaxQuery <$> arbitrary
718− , QueryFilteredQuery <$> arbitrary
719− , QueryFuzzyLikeThisQuery <$> arbitrary
720− , QueryFuzzyLikeFieldQuery <$> arbitrary
721− , QueryFuzzyQuery <$> arbitrary
722− , QueryHasChildQuery <$> arbitrary
723− , QueryHasParentQuery <$> arbitrary
724− , IdsQuery <$> arbitrary <*> arbitrary
725− , QueryIndicesQuery <$> arbitrary
726− , MatchAllQuery <$> arbitrary
727− , QueryMoreLikeThisQuery <$> arbitrary
728− , QueryMoreLikeThisFieldQuery <$> arbitrary
729− , QueryNestedQuery <$> arbitrary
730− , QueryPrefixQuery <$> arbitrary
731− , QueryQueryStringQuery <$> arbitrary
732− , QuerySimpleQueryStringQuery <$> arbitrary
733− , QueryRangeQuery <$> arbitrary
734− , QueryRegexpQuery <$> arbitrary
735− ]
736− shrink = genericShrink
737−
738−instance Arbitrary Filter where
739− arbitrary = reduceSize $ oneof [ AndFilter <$> arbitrary <*> arbitrary
740− , OrFilter <$> arbitrary <*> arbitrary
741− , NotFilter <$> arbitrary <*> arbitrary
742− , pure IdentityFilter
743− , BoolFilter <$> arbitrary
744− , ExistsFilter <$> arbitrary
745− , GeoBoundingBoxFilter <$> arbitrary
746− , GeoDistanceFilter <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
747− , GeoDistanceRangeFilter <$> arbitrary <*> arbitrary
748− , GeoPolygonFilter <$> arbitrary <*> arbitrary
749− , IdsFilter <$> arbitrary <*> arbitrary
750− , LimitFilter <$> arbitrary
751− , MissingFilter <$> arbitrary <*> arbitrary <*> arbitrary
752− , PrefixFilter <$> arbitrary <*> arbitrary <*> arbitrary
753− , QueryFilter <$> arbitrary <*> arbitrary
754− , RangeFilter <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
755− , RegexpFilter <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
756− , TermFilter <$> arbitrary <*> arbitrary]
757− shrink = genericShrink
758−
759−instance Arbitrary ReplicaBounds where
760− arbitrary = oneof [ replicasBounded
761− , replicasLowerBounded
762− , pure ReplicasUnbounded
763− ]
764− where replicasBounded = do Positive a <- arbitrary
765− Positive b <- arbitrary
766− return (ReplicasBounded a b)
767− replicasLowerBounded = do Positive a <- arbitrary
768− return (ReplicasLowerBounded a)
769−
770−instance Arbitrary NodeAttrName where
771− arbitrary = NodeAttrName . T.pack <$> listOf1 arbitraryAlphaNum
772−
773−
774−instance Arbitrary NodeAttrFilter where
775− arbitrary = do
776− n <- arbitrary
777− s:ss <- listOf1 (listOf1 arbitraryAlphaNum)
778− let ts = T.pack <$> s :| ss
779− return (NodeAttrFilter n ts)
780− shrink = genericShrink
781−
782−instance Arbitrary VersionNumber where
783− arbitrary = mk . fmap getPositive . getNonEmpty <$> arbitrary
784− where
785− mk versions = VersionNumber (Vers.Version versions [])
786−
787−$(derive makeArbitrary ''IndexName)
788−$(derive makeArbitrary ''MappingName)
789−$(derive makeArbitrary ''DocId)
790−$(derive makeArbitrary ''Version)
791−$(derive makeArbitrary ''BuildHash)
792−$(derive makeArbitrary ''IndexAliasRouting)
793−$(derive makeArbitrary ''ShardCount)
794−$(derive makeArbitrary ''ReplicaCount)
795−$(derive makeArbitrary ''TemplateName)
796−$(derive makeArbitrary ''TemplatePattern)
797−$(derive makeArbitrary ''QueryString)
798−$(derive makeArbitrary ''CacheName)
799−$(derive makeArbitrary ''CacheKey)
800−$(derive makeArbitrary ''Existence)
801−$(derive makeArbitrary ''CutoffFrequency)
802−$(derive makeArbitrary ''Analyzer)
803−$(derive makeArbitrary ''MaxExpansions)
804−$(derive makeArbitrary ''Lenient)
805−$(derive makeArbitrary ''Tiebreaker)
806−$(derive makeArbitrary ''Boost)
807−$(derive makeArbitrary ''BoostTerms)
808−$(derive makeArbitrary ''MinimumMatch)
809−$(derive makeArbitrary ''DisableCoord)
810−$(derive makeArbitrary ''IgnoreTermFrequency)
811−$(derive makeArbitrary ''MinimumTermFrequency)
812−$(derive makeArbitrary ''MaxQueryTerms)
813−$(derive makeArbitrary ''Fuzziness)
814−$(derive makeArbitrary ''PrefixLength)
815−$(derive makeArbitrary ''TypeName)
816−$(derive makeArbitrary ''PercentMatch)
817−$(derive makeArbitrary ''StopWord)
818−$(derive makeArbitrary ''QueryPath)
819−$(derive makeArbitrary ''AllowLeadingWildcard)
820−$(derive makeArbitrary ''LowercaseExpanded)
821−$(derive makeArbitrary ''EnablePositionIncrements)
822−$(derive makeArbitrary ''AnalyzeWildcard)
823−$(derive makeArbitrary ''GeneratePhraseQueries)
824−$(derive makeArbitrary ''Locale)
825−$(derive makeArbitrary ''MaxWordLength)
826−$(derive makeArbitrary ''MinWordLength)
827−$(derive makeArbitrary ''PhraseSlop)
828−$(derive makeArbitrary ''MinDocFrequency)
829−$(derive makeArbitrary ''MaxDocFrequency)
830−$(derive makeArbitrary ''Regexp)
831−$(derive makeArbitrary ''SimpleQueryStringQuery)
832−$(derive makeArbitrary ''FieldOrFields)
833−$(derive makeArbitrary ''SimpleQueryFlag)
834−$(derive makeArbitrary ''RegexpQuery)
835−$(derive makeArbitrary ''QueryStringQuery)
836−$(derive makeArbitrary ''RangeQuery)
837−$(derive makeArbitrary ''RangeValue)
838−$(derive makeArbitrary ''PrefixQuery)
839−$(derive makeArbitrary ''NestedQuery)
840−$(derive makeArbitrary ''MoreLikeThisFieldQuery)
841−$(derive makeArbitrary ''MoreLikeThisQuery)
842−$(derive makeArbitrary ''IndicesQuery)
843−$(derive makeArbitrary ''HasParentQuery)
844−$(derive makeArbitrary ''HasChildQuery)
845−$(derive makeArbitrary ''FuzzyQuery)
846−$(derive makeArbitrary ''FuzzyLikeFieldQuery)
847−$(derive makeArbitrary ''FuzzyLikeThisQuery)
848−$(derive makeArbitrary ''FilteredQuery)
849−$(derive makeArbitrary ''DisMaxQuery)
850−$(derive makeArbitrary ''CommonTermsQuery)
851−$(derive makeArbitrary ''DistanceRange)
852−$(derive makeArbitrary ''MultiMatchQuery)
853−$(derive makeArbitrary ''LessThanD)
854−$(derive makeArbitrary ''LessThanEqD)
855−$(derive makeArbitrary ''GreaterThanD)
856−$(derive makeArbitrary ''GreaterThanEqD)
857−$(derive makeArbitrary ''LessThan)
858−$(derive makeArbitrary ''LessThanEq)
859−$(derive makeArbitrary ''GreaterThan)
860−$(derive makeArbitrary ''GreaterThanEq)
861−$(derive makeArbitrary ''GeoPoint)
862−$(derive makeArbitrary ''NullValue)
863−$(derive makeArbitrary ''MinimumMatchHighLow)
864−$(derive makeArbitrary ''CommonMinimumMatch)
865−$(derive makeArbitrary ''BoostingQuery)
866−$(derive makeArbitrary ''BoolQuery)
867−$(derive makeArbitrary ''MatchQuery)
868−$(derive makeArbitrary ''MultiMatchQueryType)
869−$(derive makeArbitrary ''BooleanOperator)
870−$(derive makeArbitrary ''ZeroTermsQuery)
871−$(derive makeArbitrary ''MatchQueryType)
872−$(derive makeArbitrary ''SearchAliasRouting)
873−$(derive makeArbitrary ''ScoreType)
874−$(derive makeArbitrary ''Distance)
875−$(derive makeArbitrary ''DistanceUnit)
876−$(derive makeArbitrary ''DistanceType)
877−$(derive makeArbitrary ''OptimizeBbox)
878−$(derive makeArbitrary ''GeoBoundingBoxConstraint)
879−$(derive makeArbitrary ''GeoFilterType)
880−$(derive makeArbitrary ''GeoBoundingBox)
881−$(derive makeArbitrary ''LatLon)
882−$(derive makeArbitrary ''RangeExecution)
883−$(derive makeArbitrary ''RegexpFlag)
884−$(derive makeArbitrary ''BoolMatch)
885−$(derive makeArbitrary ''Term)
886−$(derive makeArbitrary ''IndexSettings)
887−$(derive makeArbitrary ''UpdatableIndexSetting)
888−$(derive makeArbitrary ''Bytes)
889−$(derive makeArbitrary ''AllocationPolicy)
890−$(derive makeArbitrary ''InitialShardCount)
891−$(derive makeArbitrary ''FSType)
892−$(derive makeArbitrary ''CompoundFormat)
893−$(derive makeArbitrary ''FsSnapshotRepo)
894−$(derive makeArbitrary ''SnapshotRepoName)
895
35
896main :: IO ()
36main :: IO ()
897main = hspec $ do
37main = hspec $ do
898−
38+ Aggregation.spec
899− describe "index create/delete API" $ do
39+ Bulk.spec
900− it "creates and then deletes the requested index" $ withTestEnv $ do
40+ Documents.spec
901− -- priming state.
41+ Highlights.spec
902− _ <- deleteExampleIndex
42+ Indices.spec
903− resp <- createExampleIndex
43+ JSON.spec
904− deleteResp <- deleteExampleIndex
44+ Query.spec
905− liftIO $ do
45+ Script.spec
906− validateStatus resp 200
46+ Snapshots.spec
907− validateStatus deleteResp 200
47+ Sorting.spec
48+ SourceFiltering.spec
49+ Suggest.spec
50+ Templates.spec
908
51
909 describe "error parsing" $ do
52 describe "error parsing" $ do
910 it "can parse EsErrors for < 2.0" $ when' (atmost es16) $ withTestEnv $ do
53 it "can parse EsErrors for < 2.0" $ when' (atmost es16) $ withTestEnv $ do
@@ -917,580 +60,11 @@ main = hspec $ do
917 let errorResp = eitherDecode (responseBody res)
60 let errorResp = eitherDecode (responseBody res)
918 liftIO (errorResp `shouldBe` Right (EsError 404 "no such index"))
61 liftIO (errorResp `shouldBe` Right (EsError 404 "no such index"))
919
62
920− describe "document API" $ do
63+ describe "Monoid (SearchHits a)" $
921− it "indexes, updates, gets, and then deletes the generated document" $ withTestEnv $ do
922− _ <- insertData
923− _ <- updateData
924− docInserted <- getDocument testIndex testMapping (DocId "1")
925− let newTweet = eitherDecode
926− (responseBody docInserted) :: Either String (EsResult Tweet)
927− liftIO $ (fmap getSource newTweet `shouldBe` Right (Just patchedTweet))
928−
929− it "indexes, gets, and then deletes the generated document with a DocId containing a space" $ withTestEnv $ do
930− _ <- insertWithSpaceInId
931− docInserted <- getDocument testIndex testMapping (DocId "Hello World")
932− let newTweet = eitherDecode
933− (responseBody docInserted) :: Either String (EsResult Tweet)
934− liftIO $ (fmap getSource newTweet `shouldBe` Right (Just exampleTweet))
935−
936− it "produces a parseable result when looking up a bogus document" $ withTestEnv $ do
937− doc <- getDocument testIndex testMapping (DocId "bogus")
938− let noTweet = eitherDecode
939− (responseBody doc) :: Either String (EsResult Tweet)
940− liftIO $ fmap foundResult noTweet `shouldBe` Right Nothing
941−
942− it "can use optimistic concurrency control" $ withTestEnv $ do
943− let ev = ExternalDocVersion minBound
944− let cfg = defaultIndexDocumentSettings { idsVersionControl = ExternalGT ev }
945− resetIndex
946− res <- insertData' cfg
947− liftIO $ isCreated res `shouldBe` True
948− res' <- insertData' cfg
949− liftIO $ isVersionConflict res' `shouldBe` True
950−
951− it "indexes two documents in a parent/child relationship and checks that the child exists" $ withTestEnv $ do
952− resetIndex
953− _ <- putMapping testIndex (MappingName "child") ChildMapping
954− _ <- putMapping testIndex (MappingName "parent") ParentMapping
955− _ <- indexDocument testIndex (MappingName "parent") defaultIndexDocumentSettings exampleTweet (DocId "1")
956− let parent = (Just . DocumentParent . DocId) "1"
957− ids = IndexDocumentSettings NoVersionControl parent
958− _ <- indexDocument testIndex (MappingName "child") ids otherTweet (DocId "2")
959− _ <- refreshIndex testIndex
960− exists <- documentExists testIndex (MappingName "child") parent (DocId "2")
961− liftIO $ exists `shouldBe` True
962−
963− describe "template API" $ do
964− it "can create a template" $ withTestEnv $ do
965− let idxTpl = IndexTemplate (TemplatePattern "tweet-*") (Just (IndexSettings (ShardCount 1) (ReplicaCount 1))) [toJSON TweetMapping]
966− resp <- putTemplate idxTpl (TemplateName "tweet-tpl")
967− liftIO $ validateStatus resp 200
968−
969− it "can detect if a template exists" $ withTestEnv $ do
970− exists <- templateExists (TemplateName "tweet-tpl")
971− liftIO $ exists `shouldBe` True
972−
973− it "can delete a template" $ withTestEnv $ do
974− resp <- deleteTemplate (TemplateName "tweet-tpl")
975− liftIO $ validateStatus resp 200
976−
977− it "can detect if a template doesn't exist" $ withTestEnv $ do
978− exists <- templateExists (TemplateName "tweet-tpl")
979− liftIO $ exists `shouldBe` False
980−
981− describe "bulk API" $ do
982− it "inserts all documents we request" $ withTestEnv $ do
983− _ <- insertData
984− let firstTest = BulkTest "blah"
985− let secondTest = BulkTest "bloo"
986− let firstDoc = BulkIndex testIndex
987− testMapping (DocId "2") (toJSON firstTest)
988− let secondDoc = BulkCreate testIndex
989− testMapping (DocId "3") (toJSON secondTest)
990− let stream = V.fromList [firstDoc, secondDoc]
991− _ <- bulk stream
992− _ <- refreshIndex testIndex
993− fDoc <- getDocument testIndex testMapping (DocId "2")
994− sDoc <- getDocument testIndex testMapping (DocId "3")
995− let maybeFirst = eitherDecode $ responseBody fDoc :: Either String (EsResult BulkTest)
996− let maybeSecond = eitherDecode $ responseBody sDoc :: Either String (EsResult BulkTest)
997− liftIO $ do
998− fmap getSource maybeFirst `shouldBe` Right (Just firstTest)
999− fmap getSource maybeSecond `shouldBe` Right (Just secondTest)
1000−
1001−
1002− describe "query API" $ do
1003− it "returns document for term query and identity filter" $ withTestEnv $ do
1004− _ <- insertData
1005− let query = TermQuery (Term "user" "bitemyapp") Nothing
1006− let filter = IdentityFilter <&&> IdentityFilter
1007− let search = mkSearch (Just query) (Just filter)
1008− myTweet <- searchTweet search
1009− liftIO $
1010− myTweet `shouldBe` Right exampleTweet
1011−
1012− it "handles constant score queries" $ withTestEnv $ do
1013− _ <- insertData
1014− let query = TermsQuery "user" ("bitemyapp" :| [])
1015− let cfQuery = ConstantScoreQuery query (Boost 1.0)
1016− let filter = IdentityFilter
1017− let search = mkSearch (Just cfQuery) (Just filter)
1018− myTweet <- searchTweet search
1019− liftIO $
1020− myTweet `shouldBe` Right exampleTweet
1021− it "handles constant score filters" $ withTestEnv $ do
1022− _ <- insertData
1023− let query = TermsQuery "user" ("bitemyapp" :| [])
1024− let cfFilter = ConstantScoreFilter IdentityFilter (Boost 1.0)
1025− let boolQuery = mkBoolQuery [query, cfFilter] [] []
1026− let search = mkSearch (Just (QueryBoolQuery boolQuery)) Nothing
1027− myTweet <- searchTweet search
1028− liftIO $
1029− myTweet `shouldBe` Right exampleTweet
1030−
1031−
1032− it "returns document for terms query and identity filter" $ withTestEnv $ do
1033− _ <- insertData
1034− let query = TermsQuery "user" ("bitemyapp" :| [])
1035− let filter = IdentityFilter <&&> IdentityFilter
1036− let search = mkSearch (Just query) (Just filter)
1037− myTweet <- searchTweet search
1038− liftIO $
1039− myTweet `shouldBe` Right exampleTweet
1040−
1041− it "returns document for match query" $ withTestEnv $ do
1042− _ <- insertData
1043− let query = QueryMatchQuery $ mkMatchQuery (FieldName "user") (QueryString "bitemyapp")
1044− let search = mkSearch (Just query) Nothing
1045− myTweet <- searchTweet search
1046− liftIO $
1047− myTweet `shouldBe` Right exampleTweet
1048−
1049− it "returns document for multi-match query" $ withTestEnv $ do
1050− _ <- insertData
1051− let flds = [FieldName "user", FieldName "message"]
1052− let query = QueryMultiMatchQuery $ mkMultiMatchQuery flds (QueryString "bitemyapp")
1053− let search = mkSearch (Just query) Nothing
1054− myTweet <- searchTweet search
1055− liftIO $
1056− myTweet `shouldBe` Right exampleTweet
1057−
1058− it "returns document for bool query" $ withTestEnv $ do
1059− _ <- insertData
1060− let innerQuery = QueryMatchQuery $
1061− mkMatchQuery (FieldName "user") (QueryString "bitemyapp")
1062− let query = QueryBoolQuery $
1063− mkBoolQuery [innerQuery] [] []
1064− let search = mkSearch (Just query) Nothing
1065− myTweet <- searchTweet search
1066− liftIO $
1067− myTweet `shouldBe` Right exampleTweet
1068−
1069− it "returns document for boosting query" $ withTestEnv $ do
1070− _ <- insertData
1071− let posQuery = QueryMatchQuery $ mkMatchQuery (FieldName "user") (QueryString "bitemyapp")
1072− let negQuery = QueryMatchQuery $ mkMatchQuery (FieldName "user") (QueryString "notmyapp")
1073− let query = QueryBoostingQuery $ BoostingQuery posQuery negQuery (Boost 0.2)
1074− let search = mkSearch (Just query) Nothing
1075− myTweet <- searchTweet search
1076− liftIO $
1077− myTweet `shouldBe` Right exampleTweet
1078−
1079− it "returns document for common terms query" $ withTestEnv $ do
1080− _ <- insertData
1081− let query = QueryCommonTermsQuery $
1082− CommonTermsQuery (FieldName "user")
1083− (QueryString "bitemyapp")
1084− (CutoffFrequency 0.0001)
1085− Or Or Nothing Nothing Nothing Nothing
1086− let search = mkSearch (Just query) Nothing
1087− myTweet <- searchTweet search
1088− liftIO $
1089− myTweet `shouldBe` Right exampleTweet
1090−
1091−
1092− describe "sorting" $ do
1093− it "returns documents in the right order" $ withTestEnv $ do
1094− _ <- insertData
1095− _ <- insertOther
1096− let sortSpec = DefaultSortSpec $ mkSort (FieldName "age") Ascending
1097− let search = Search Nothing
1098− (Just IdentityFilter) (Just [sortSpec]) Nothing Nothing
1099− False (From 0) (Size 10) SearchTypeQueryThenFetch Nothing Nothing
1100− result <- searchTweets search
1101− let myTweet = grabFirst result
1102− liftIO $
1103− myTweet `shouldBe` Right otherTweet
1104−
1105−
1106− describe "filtering API" $ do
1107− it "returns document for composed boolmatch and identity" $ withTestEnv $ do
1108− _ <- insertData
1109− let queryFilter = BoolFilter (MustMatch (Term "user" "bitemyapp") False)
1110− <&&> IdentityFilter
1111− let search = mkSearch Nothing (Just queryFilter)
1112− myTweet <- searchTweet search
1113− liftIO $
1114− myTweet `shouldBe` Right exampleTweet
1115−
1116− it "returns document for term filter" $ withTestEnv $ do
1117− _ <- insertData
1118− let termFilter = TermFilter (Term "user" "bitemyapp") False
1119− let search = mkSearch Nothing (Just termFilter)
1120− myTweet <- searchTweet search
1121− liftIO $
1122− myTweet `shouldBe` Right exampleTweet
1123−
1124− it "returns document for existential filter" $ withTestEnv $ do
1125− _ <- insertData
1126− let search = mkSearch Nothing (Just (ExistsFilter (FieldName "user")))
1127− myTweet <- searchTweet search
1128− liftIO $
1129− myTweet `shouldBe` Right exampleTweet
1130−
1131− it "returns document for geo boundingbox filter" $ withTestEnv $ do
1132− _ <- insertData
1133− let box = GeoBoundingBox (LatLon 40.73 (-74.1)) (LatLon 40.10 (-71.12))
1134− let bbConstraint = GeoBoundingBoxConstraint (FieldName "tweet.location") box False GeoFilterMemory
1135− let geoFilter = GeoBoundingBoxFilter bbConstraint
1136− let search = mkSearch Nothing (Just geoFilter)
1137− myTweet <- searchTweet search
1138− liftIO $
1139− myTweet `shouldBe` Right exampleTweet
1140−
1141− it "doesn't return document for nonsensical boundingbox filter" $ withTestEnv $ do
1142− _ <- insertData
1143− let box = GeoBoundingBox (LatLon 0.73 (-4.1)) (LatLon 0.10 (-1.12))
1144− let bbConstraint = GeoBoundingBoxConstraint (FieldName "tweet.location") box False GeoFilterMemory
1145− let geoFilter = GeoBoundingBoxFilter bbConstraint
1146− let search = mkSearch Nothing (Just geoFilter)
1147− searchExpectNoResults search
1148−
1149− it "returns document for geo distance filter" $ withTestEnv $ do
1150− _ <- insertData
1151− let geoPoint = GeoPoint (FieldName "tweet.location") (LatLon 40.12 (-71.34))
1152− let distance = Distance 10.0 Miles
1153− let optimizeBbox = OptimizeGeoFilterType GeoFilterMemory
1154− let geoFilter = GeoDistanceFilter geoPoint distance SloppyArc optimizeBbox False
1155− let search = mkSearch Nothing (Just geoFilter)
1156− myTweet <- searchTweet search
1157− liftIO $
1158− myTweet `shouldBe` Right exampleTweet
1159−
1160− it "returns document for geo distance range filter" $ withTestEnv $ do
1161− _ <- insertData
1162− let geoPoint = GeoPoint (FieldName "tweet.location") (LatLon 40.12 (-71.34))
1163− let distanceRange = DistanceRange (Distance 0.0 Miles) (Distance 10.0 Miles)
1164− let geoFilter = GeoDistanceRangeFilter geoPoint distanceRange
1165− let search = mkSearch Nothing (Just geoFilter)
1166− myTweet <- searchTweet search
1167− liftIO $
1168− myTweet `shouldBe` Right exampleTweet
1169−
1170− it "doesn't return document for wild geo distance range filter" $ withTestEnv $ do
1171− _ <- insertData
1172− let geoPoint = GeoPoint (FieldName "tweet.location") (LatLon 40.12 (-71.34))
1173− let distanceRange = DistanceRange (Distance 100.0 Miles) (Distance 1000.0 Miles)
1174− let geoFilter = GeoDistanceRangeFilter geoPoint distanceRange
1175− let search = mkSearch Nothing (Just geoFilter)
1176− searchExpectNoResults search
1177−
1178− it "returns document for geo polygon filter" $ withTestEnv $ do
1179− _ <- insertData
1180− let points = [LatLon 40.0 (-70.00),
1181− LatLon 40.0 (-72.00),
1182− LatLon 41.0 (-70.00),
1183− LatLon 41.0 (-72.00)]
1184− let geoFilter = GeoPolygonFilter (FieldName "tweet.location") points
1185− let search = mkSearch Nothing (Just geoFilter)
1186− myTweet <- searchTweet search
1187− liftIO $
1188− myTweet `shouldBe` Right exampleTweet
1189−
1190− it "doesn't return document for bad geo polygon filter" $ withTestEnv $ do
1191− _ <- insertData
1192− let points = [LatLon 40.0 (-70.00),
1193− LatLon 40.0 (-71.00),
1194− LatLon 41.0 (-70.00),
1195− LatLon 41.0 (-71.00)]
1196− let geoFilter = GeoPolygonFilter (FieldName "tweet.location") points
1197− let search = mkSearch Nothing (Just geoFilter)
1198− searchExpectNoResults search
1199−
1200− it "returns document for ids filter" $ withTestEnv $ do
1201− _ <- insertData
1202− let filter = IdsFilter (MappingName "tweet") [DocId "1"]
1203− let search = mkSearch Nothing (Just filter)
1204− myTweet <- searchTweet search
1205− liftIO $
1206− myTweet `shouldBe` Right exampleTweet
1207−
1208− it "returns document for Double range filter" $ withTestEnv $ do
1209− _ <- insertData
1210− let filter = RangeFilter (FieldName "age")
1211− (RangeDoubleGtLt (GreaterThan 1000.0) (LessThan 100000.0))
1212− RangeExecutionIndex False
1213− let search = mkSearch Nothing (Just filter)
1214− myTweet <- searchTweet search
1215− liftIO $
1216− myTweet `shouldBe` Right exampleTweet
1217−
1218− it "returns document for UTCTime date filter" $ withTestEnv $ do
1219− _ <- insertData
1220− let filter = RangeFilter (FieldName "postDate")
1221− (RangeDateGtLt
1222− (GreaterThanD (UTCTime
1223− (ModifiedJulianDay 54000)
1224− (secondsToDiffTime 0)))
1225− (LessThanD (UTCTime
1226− (ModifiedJulianDay 55000)
1227− (secondsToDiffTime 11))))
1228− RangeExecutionIndex False
1229− let search = mkSearch Nothing (Just filter)
1230− myTweet <- searchTweet search
1231− liftIO $
1232− myTweet `shouldBe` Right exampleTweet
1233−
1234− it "returns document for regexp filter" $ withTestEnv $ do
1235− _ <- insertData
1236− let filter = RegexpFilter (FieldName "user") (Regexp "bite.*app")
1237− AllRegexpFlags (CacheName "test") False (CacheKey "key")
1238− let search = mkSearch Nothing (Just filter)
1239− myTweet <- searchTweet search
1240− liftIO $
1241− myTweet `shouldBe` Right exampleTweet
1242−
1243− it "doesn't return document for non-matching regexp filter" $ withTestEnv $ do
1244− _ <- insertData
1245− let filter = RegexpFilter (FieldName "user")
1246− (Regexp "boy") AllRegexpFlags
1247− (CacheName "test") False (CacheKey "key")
1248− let search = mkSearch Nothing (Just filter)
1249− searchExpectNoResults search
1250−
1251− it "returns document for query filter, uncached" $ withTestEnv $ do
1252− _ <- insertData
1253− let filter = QueryFilter (TermQuery (Term "user" "bitemyapp") Nothing) True
1254− search = mkSearch Nothing (Just filter)
1255− myTweet <- searchTweet search
1256− liftIO $ myTweet `shouldBe` Right exampleTweet
1257−
1258− it "returns document for query filter, cached" $ withTestEnv $ do
1259− _ <- insertData
1260− let filter = QueryFilter (TermQuery (Term "user" "bitemyapp") Nothing) False
1261− search = mkSearch Nothing (Just filter)
1262− myTweet <- searchTweet search
1263− liftIO $ myTweet `shouldBe` Right exampleTweet
1264−
1265− describe "Aggregation API" $ do
1266− it "returns term aggregation results" $ withTestEnv $ do
1267− _ <- insertData
1268− let terms = TermsAgg $ mkTermsAggregation "user"
1269− let search = mkAggregateSearch Nothing $ mkAggregations "users" terms
1270− searchExpectAggs search
1271− searchValidBucketAgg search "users" toTerms
1272−
1273− it "returns cardinality aggregation results" $ withTestEnv $ do
1274− _ <- insertData
1275− let cardinality = CardinalityAgg $ mkCardinalityAggregation $ FieldName "user"
1276− let search = mkAggregateSearch Nothing $ mkAggregations "users" cardinality
1277− let search' = search { Database.Bloodhound.from = From 0, size = Size 0 }
1278− searchExpectAggs search'
1279− let docCountPair k n = (k, object ["value" .= Number n])
1280− res <- searchTweets search'
1281− liftIO $
1282− fmap aggregations res `shouldBe` Right (Just (M.fromList [ docCountPair "users" 1]))
1283−
1284− it "can give collection hint parameters to term aggregations" $ when' (atleast es13) $ withTestEnv $ do
1285− _ <- insertData
1286− let terms = TermsAgg $ (mkTermsAggregation "user") { termCollectMode = Just BreadthFirst }
1287− let search = mkAggregateSearch Nothing $ mkAggregations "users" terms
1288− searchExpectAggs search
1289− searchValidBucketAgg search "users" toTerms
1290−
1291− -- One of these fails with 1.7.3
1292− it "can give execution hint parameters to term aggregations" $ when' (atmost es11) $ withTestEnv $ do
1293− _ <- insertData
1294− searchTermsAggHint [Map, Ordinals]
1295−
1296− it "can give execution hint parameters to term aggregations" $ when' (is es12) $ withTestEnv $ do
1297− _ <- insertData
1298− searchTermsAggHint [GlobalOrdinals, GlobalOrdinalsHash, GlobalOrdinalsLowCardinality, Map, Ordinals]
1299−
1300− it "can give execution hint parameters to term aggregations" $ when' (atleast es12) $ withTestEnv $ do
1301− _ <- insertData
1302− searchTermsAggHint [GlobalOrdinals, GlobalOrdinalsHash, GlobalOrdinalsLowCardinality, Map]
1303− -- One of the above.
1304−
1305− it "can execute value_count aggregations" $ withTestEnv $ do
1306− _ <- insertData
1307− _ <- insertOther
1308− let ags = mkAggregations "user_count" (ValueCountAgg (FieldValueCount (FieldName "user"))) <>
1309− mkAggregations "bogus_count" (ValueCountAgg (FieldValueCount (FieldName "bogus")))
1310− let search = mkAggregateSearch Nothing ags
1311− let docCountPair k n = (k, object ["value" .= Number n])
1312− res <- searchTweets search
1313− liftIO $
1314− fmap aggregations res `shouldBe` Right (Just (M.fromList [ docCountPair "user_count" 2
1315− , docCountPair "bogus_count" 0
1316− ]))
1317−
1318− it "can execute filter aggregations" $ withTestEnv $ do
1319− _ <- insertData
1320− _ <- insertOther
1321− let ags = mkAggregations "bitemyapps" (FilterAgg (FilterAggregation (TermFilter (Term "user" "bitemyapp") defaultCache) Nothing)) <>
1322− mkAggregations "notmyapps" (FilterAgg (FilterAggregation (TermFilter (Term "user" "notmyapp") defaultCache) Nothing))
1323− let search = mkAggregateSearch Nothing ags
1324− let docCountPair k n = (k, object ["doc_count" .= Number n])
1325− res <- searchTweets search
1326− liftIO $
1327− fmap aggregations res `shouldBe` Right (Just (M.fromList [ docCountPair "bitemyapps" 1
1328− , docCountPair "notmyapps" 1
1329− ]))
1330− it "can execute date_range aggregations" $ withTestEnv $ do
1331− let now = fromGregorian 2015 3 14
1332− let ltAMonthAgo = UTCTime (fromGregorian 2015 3 1) 0
1333− let ltAWeekAgo = UTCTime (fromGregorian 2015 3 10) 0
1334− let oldDoc = exampleTweet { postDate = ltAMonthAgo }
1335− let newDoc = exampleTweet { postDate = ltAWeekAgo }
1336− _ <- indexDocument testIndex testMapping defaultIndexDocumentSettings oldDoc (DocId "1")
1337− _ <- indexDocument testIndex testMapping defaultIndexDocumentSettings newDoc (DocId "2")
1338− _ <- refreshIndex testIndex
1339− let thisMonth = DateRangeFrom (DateMathExpr (DMDate now) [SubtractTime 1 DMMonth])
1340− let thisWeek = DateRangeFrom (DateMathExpr (DMDate now) [SubtractTime 1 DMWeek])
1341− let agg = DateRangeAggregation (FieldName "postDate") Nothing (thisMonth :| [thisWeek])
1342− let ags = mkAggregations "date_ranges" (DateRangeAgg agg)
1343− let search = mkAggregateSearch Nothing ags
1344− res <- searchTweets search
1345− liftIO $ hitsTotal . searchHits <$> res `shouldBe` Right 2
1346− let bucks = do magrs <- fmapL show (aggregations <$> res)
1347− agrs <- note "no aggregations returned" magrs
1348− rawBucks <- note "no date_ranges aggregation" $ M.lookup "date_ranges" agrs
1349− parseEither parseJSON rawBucks
1350− let fromMonthT = UTCTime (fromGregorian 2015 2 14) 0
1351− let fromWeekT = UTCTime (fromGregorian 2015 3 7) 0
1352− liftIO $ buckets <$> bucks `shouldBe` Right [ DateRangeResult "2015-02-14T00:00:00.000Z-*"
1353− (Just fromMonthT)
1354− (Just "2015-02-14T00:00:00.000Z")
1355− Nothing
1356− Nothing
1357− 2
1358− Nothing
1359− , DateRangeResult "2015-03-07T00:00:00.000Z-*"
1360− (Just fromWeekT)
1361− (Just "2015-03-07T00:00:00.000Z")
1362− Nothing
1363− Nothing
1364− 1
1365− Nothing
1366− ]
1367−
1368− it "returns date histogram aggregation results" $ withTestEnv $ do
1369− _ <- insertData
1370− let histogram = DateHistogramAgg $ mkDateHistogram (FieldName "postDate") Minute
1371− let search = mkAggregateSearch Nothing (mkAggregations "byDate" histogram)
1372− searchExpectAggs search
1373− searchValidBucketAgg search "byDate" toDateHistogram
1374−
1375− it "returns date histogram using fractional date" $ withTestEnv $ do
1376− _ <- insertData
1377− let periods = [Year, Quarter, Month, Week, Day, Hour, Minute, Second]
1378− let fractionals = map (FractionalInterval 1.5) [Weeks, Days, Hours, Minutes, Seconds]
1379− let intervals = periods ++ fractionals
1380− let histogram = mkDateHistogram (FieldName "postDate")
1381− let search interval = mkAggregateSearch Nothing $ mkAggregations "byDate" $ DateHistogramAgg (histogram interval)
1382− let expect interval = searchExpectAggs (search interval)
1383− let valid interval = searchValidBucketAgg (search interval) "byDate" toDateHistogram
1384− forM_ intervals expect
1385− forM_ intervals valid
1386−
1387− it "can execute missing aggregations" $ withTestEnv $ do
1388− _ <- insertData
1389− _ <- insertExtra
1390− let ags = mkAggregations "missing_agg" (MissingAgg (MissingAggregation "extra"))
1391− let search = mkAggregateSearch Nothing ags
1392− let docCountPair k n = (k, object ["doc_count" .= Number n])
1393− res <- searchTweets search
1394− liftIO $
1395− fmap aggregations res `shouldBe` Right (Just (M.fromList [docCountPair "missing_agg" 1]))
1396−
1397− describe "Highlights API" $ do
1398−
1399− it "returns highlight from query when there should be one" $ withTestEnv $ do
1400− _ <- insertData
1401− _ <- insertOther
1402− let query = QueryMatchQuery $ mkMatchQuery (FieldName "_all") (QueryString "haskell")
1403− let testHighlight = Highlights Nothing [FieldHighlight (FieldName "message") Nothing]
1404−
1405− let search = mkHighlightSearch (Just query) testHighlight
1406− myHighlight <- searchTweetHighlight search
1407− liftIO $
1408− myHighlight `shouldBe` Right (Just (M.fromList [("message",["Use <em>haskell</em>!"])]))
1409−
1410− it "doesn't return highlight from a query when it shouldn't" $ withTestEnv $ do
1411− _ <- insertData
1412− _ <- insertOther
1413− let query = QueryMatchQuery $ mkMatchQuery (FieldName "_all") (QueryString "haskell")
1414− let testHighlight = Highlights Nothing [FieldHighlight (FieldName "user") Nothing]
1415−
1416− let search = mkHighlightSearch (Just query) testHighlight
1417− myHighlight <- searchTweetHighlight search
1418− liftIO $
1419− myHighlight `shouldBe` Right Nothing
1420−
1421− describe "Source filtering" $ do
1422−
1423− it "doesn't include source when sources are disabled" $ withTestEnv $ do
1424− searchExpectSource
1425− NoSource
1426− (Left (EsError 500 "Source was missing"))
1427−
1428− it "includes a source" $ withTestEnv $ do
1429− searchExpectSource
1430− (SourcePatterns (PopPattern (Pattern "message")))
1431− (Right (Object (HM.fromList [("message", String "Use haskell!")])))
1432−
1433− it "includes sources" $ withTestEnv $ do
1434− searchExpectSource
1435− (SourcePatterns (PopPatterns [Pattern "user", Pattern "message"]))
1436− (Right (Object (HM.fromList [("user",String "bitemyapp"),("message", String "Use haskell!")])))
1437−
1438− it "includes source patterns" $ withTestEnv $ do
1439− searchExpectSource
1440− (SourcePatterns (PopPattern (Pattern "*ge")))
1441− (Right (Object (HM.fromList [("age", Number 10000),("message", String "Use haskell!")])))
1442−
1443− it "excludes source patterns" $ withTestEnv $ do
1444− searchExpectSource
1445− (SourceIncludeExclude (Include [])
1446− (Exclude [Pattern "l*", Pattern "*ge", Pattern "postDate", Pattern "extra"]))
1447− (Right (Object (HM.fromList [("user",String "bitemyapp")])))
1448−
1449− describe "ToJSON RegexpFlags" $ do
1450− it "generates the correct JSON for AllRegexpFlags" $
1451− toJSON AllRegexpFlags `shouldBe` String "ALL"
1452−
1453− it "generates the correct JSON for NoRegexpFlags" $
1454− toJSON NoRegexpFlags `shouldBe` String "NONE"
1455−
1456− it "generates the correct JSON for SomeRegexpFlags" $
1457− let flags = AnyString :| [ Automaton
1458− , Complement
1459− , Empty
1460− , Intersection
1461− , Interval ]
1462− in toJSON (SomeRegexpFlags flags) `shouldBe` String "ANYSTRING|AUTOMATON|COMPLEMENT|EMPTY|INTERSECTION|INTERVAL"
1463−
1464− prop "removes duplicates from flags" $ \(flags :: RegexpFlags) ->
1465− let String str = toJSON flags
1466− flagStrs = T.splitOn "|" str
1467− in noDuplicates flagStrs
1468−
1469− describe "omitNulls" $ do
1470− it "checks that omitNulls drops list elements when it should" $
1471− let dropped = omitNulls $ [ "test1" .= (toJSON ([] :: [Int]))
1472− , "test2" .= (toJSON ("some value" :: Text))]
1473− in dropped `shouldBe` Object (HM.fromList [("test2", String "some value")])
1474−
1475− it "checks that omitNulls doesn't drop list elements when it shouldn't" $
1476− let notDropped = omitNulls $ [ "test1" .= (toJSON ([1] :: [Int]))
1477− , "test2" .= (toJSON ("some value" :: Text))]
1478− in notDropped `shouldBe` Object (HM.fromList [ ("test1", Array (V.fromList [Number 1.0]))
1479− , ("test2", String "some value")])
1480− it "checks that omitNulls drops non list elements when it should" $
1481− let dropped = omitNulls $ [ "test1" .= (toJSON Null)
1482− , "test2" .= (toJSON ("some value" :: Text))]
1483− in dropped `shouldBe` Object (HM.fromList [("test2", String "some value")])
1484− it "checks that omitNulls doesn't drop non list elements when it shouldn't" $
1485− let notDropped = omitNulls $ [ "test1" .= (toJSON (1 :: Int))
1486− , "test2" .= (toJSON ("some value" :: Text))]
1487− in notDropped `shouldBe` Object (HM.fromList [ ("test1", Number 1.0)
1488− , ("test2", String "some value")])
1489− describe "Monoid (SearchHits a)" $ do
1490 prop "abides the monoid laws" $ eq $
64 prop "abides the monoid laws" $ eq $
1491 prop_Monoid (T :: T (SearchHits ()))
65 prop_Monoid (T :: T (SearchHits ()))
1492
66
1493− describe "mkDocVersion" $ do
67+ describe "mkDocVersion" $
1494 prop "can never construct an out of range docVersion" $ \i ->
68 prop "can never construct an out of range docVersion" $ \i ->
1495 let res = mkDocVersion i
69 let res = mkDocVersion i
1496 in case res of
70 in case res of
@@ -1499,113 +73,7 @@ main = hspec $ do
1499 (dv <= maxBound) .&&.
73 (dv <= maxBound) .&&.
1500 docVersionNumber dv === i
74 docVersionNumber dv === i
1501
75
1502− describe "FsSnapshotRepo" $ do
1503− prop "SnapshotRepo laws" $ \fsr ->
1504− fromGSnapshotRepo (toGSnapshotRepo fsr) === Right (fsr :: FsSnapshotRepo)
1505−
1506− describe "snapshot repos" $ do
1507− it "always parses all snapshot repos API" $ when' canSnapshot $ withTestEnv $ do
1508− res <- getSnapshotRepos AllSnapshotRepos
1509− liftIO $ case res of
1510− Left e -> expectationFailure ("Expected a right but got Left " <> show e)
1511− Right _ -> return ()
1512−
1513− it "finds an existing list of repos" $ when' canSnapshot $ withTestEnv $ do
1514− let r1n = SnapshotRepoName "bloodhound-repo1"
1515− let r2n = SnapshotRepoName "bloodhound-repo2"
1516− withSnapshotRepo r1n $ \r1 ->
1517− withSnapshotRepo r2n $ \r2 -> do
1518− repos <- getSnapshotRepos (SnapshotRepoList (ExactRepo r1n :| [ExactRepo r2n]))
1519− liftIO $ case repos of
1520− Right xs -> do
1521− let srt = L.sortBy (comparing gSnapshotRepoName)
1522− srt xs `shouldBe` srt [r1, r2]
1523− Left e -> expectationFailure (show e)
1524−
1525− it "creates and updates with updateSnapshotRepo" $ when' canSnapshot $ withTestEnv $ do
1526− let r1n = SnapshotRepoName "bloodhound-repo1"
1527− withSnapshotRepo r1n $ \r1 -> do
1528− let Just (String dir) = HM.lookup "location" (gSnapshotRepoSettingsObject (gSnapshotRepoSettings r1))
1529− let noCompression = FsSnapshotRepo r1n (T.unpack dir) False Nothing Nothing Nothing
1530− resp <- updateSnapshotRepo defaultSnapshotRepoUpdateSettings noCompression
1531− liftIO (validateStatus resp 200)
1532− Right [roundtrippedNoCompression] <- getSnapshotRepos (SnapshotRepoList (ExactRepo r1n :| []))
1533− liftIO (roundtrippedNoCompression `shouldBe` toGSnapshotRepo noCompression)
1534−
1535− -- verify came around in 1.4 it seems
1536− it "can verify existing repos" $ when' canSnapshot $ when' (atleast es14) $ withTestEnv $ do
1537− let r1n = SnapshotRepoName "bloodhound-repo1"
1538− withSnapshotRepo r1n $ \_ -> do
1539− res <- verifySnapshotRepo r1n
1540− liftIO $ case res of
1541− Right (SnapshotVerification vs)
1542− | null vs -> expectationFailure "Expected nonempty set of verifying nodes"
1543− | otherwise -> return ()
1544− Left e -> expectationFailure (show e)
1545−
1546− describe "snapshots" $ do
1547− it "always parses all snapshots API" $ when' canSnapshot $ withTestEnv $ do
1548− let r1n = SnapshotRepoName "bloodhound-repo1"
1549− withSnapshotRepo r1n $ \_ -> do
1550− res <- getSnapshots r1n AllSnapshots
1551− liftIO $ case res of
1552− Left e -> expectationFailure ("Expected a right but got Left " <> show e)
1553− Right _ -> return ()
1554−
1555− it "can parse a snapshot that it created" $ when' canSnapshot $ withTestEnv $ do
1556− let r1n = SnapshotRepoName "bloodhound-repo1"
1557− withSnapshotRepo r1n $ \_ -> do
1558− let s1n = SnapshotName "example-snapshot"
1559− withSnapshot r1n s1n $ do
1560− res <- getSnapshots r1n (SnapshotList (ExactSnap s1n :| []))
1561− liftIO $ case res of
1562− Right [snap]
1563− | snapInfoState snap == SnapshotSuccess &&
1564− snapInfoName snap == s1n -> return ()
1565− | otherwise -> expectationFailure (show snap)
1566− Right [] -> expectationFailure "There were no snapshots"
1567− Right snaps -> expectationFailure ("Expected 1 snapshot but got" <> show (length snaps))
1568− Left e -> expectationFailure (show e)
1569−
1570− describe "snapshot restore" $ do
1571− it "can restore a snapshot that we create" $ when' canSnapshot $ withTestEnv $ do
1572− let r1n = SnapshotRepoName "bloodhound-repo1"
1573− withSnapshotRepo r1n $ \_ -> do
1574− let s1n = SnapshotName "example-snapshot"
1575− withSnapshot r1n s1n $ do
1576− let settings = defaultSnapshotRestoreSettings { snapRestoreWaitForCompletion = True }
1577− -- have to close an index to restore it
1578− resp1 <- closeIndex testIndex
1579− liftIO (validateStatus resp1 200)
1580− resp2 <- restoreSnapshot r1n s1n settings
1581− liftIO (validateStatus resp2 200)
1582−
1583− it "can restore and rename" $ when' canSnapshot $ withTestEnv $ do
1584− let r1n = SnapshotRepoName "bloodhound-repo1"
1585− withSnapshotRepo r1n $ \_ -> do
1586− let s1n = SnapshotName "example-snapshot"
1587− withSnapshot r1n s1n $ do
1588− let pat = RestoreRenamePattern "bloodhound-tests-twitter-(\\d+)"
1589− let replace = RRTLit "restored-" :| [RRSubWholeMatch]
1590− let expectedIndex = IndexName "restored-bloodhound-tests-twitter-1"
1591− oldEnoughForOverrides <- liftIO (atleast es15)
1592− let overrides = RestoreIndexSettings { restoreOverrideReplicas = Just (ReplicaCount 0) }
1593− let settings = defaultSnapshotRestoreSettings { snapRestoreWaitForCompletion = True
1594− , snapRestoreRenamePattern = Just pat
1595− , snapRestoreRenameReplacement = Just replace
1596− , snapRestoreIndexSettingsOverrides = if oldEnoughForOverrides
1597− then Just overrides
1598− else Nothing
1599− }
1600− -- have to close an index to restore it
1601− let go = do
1602− resp <- restoreSnapshot r1n s1n settings
1603− liftIO (validateStatus resp 200)
1604− exists <- indexExists expectedIndex
1605− liftIO (exists `shouldBe` True)
1606− go `finally` deleteIndex expectedIndex
1607−
1608− describe "getNodesInfo" $ do
76+ describe "getNodesInfo" $
1609 it "fetches the responding node when LocalNode is used" $ withTestEnv $ do
77 it "fetches the responding node when LocalNode is used" $ withTestEnv $ do
1610 res <- getNodesInfo LocalNode
78 res <- getNodesInfo LocalNode
1611 liftIO $ case res of
79 liftIO $ case res of
@@ -1615,7 +83,7 @@ main = hspec $ do
1615 Right NodesInfo {..} -> length nodesInfo `shouldBe` 1
83 Right NodesInfo {..} -> length nodesInfo `shouldBe` 1
1616 Left e -> expectationFailure ("Expected NodesInfo but got " <> show e)
84 Left e -> expectationFailure ("Expected NodesInfo but got " <> show e)
1617
85
1618− describe "getNodesStats" $ do
86+ describe "getNodesStats" $
1619 it "fetches the responding node when LocalNode is used" $ withTestEnv $ do
87 it "fetches the responding node when LocalNode is used" $ withTestEnv $ do
1620 res <- getNodesStats LocalNode
88 res <- getNodesStats LocalNode
1621 liftIO $ case res of
89 liftIO $ case res of
@@ -1625,7 +93,7 @@ main = hspec $ do
1625 Right NodesStats {..} -> length nodesStats `shouldBe` 1
93 Right NodesStats {..} -> length nodesStats `shouldBe` 1
1626 Left e -> expectationFailure ("Expected NodesStats but got " <> show e)
94 Left e -> expectationFailure ("Expected NodesStats but got " <> show e)
1627
95
1628− describe "Enum DocVersion" $ do
96+ describe "Enum DocVersion" $
1629 it "follows the laws of Enum, Bounded" $ do
97 it "follows the laws of Enum, Bounded" $ do
1630 evaluate (succ maxBound :: DocVersion) `shouldThrow` anyErrorCall
98 evaluate (succ maxBound :: DocVersion) `shouldThrow` anyErrorCall
1631 evaluate (pred minBound :: DocVersion) `shouldThrow` anyErrorCall
99 evaluate (pred minBound :: DocVersion) `shouldThrow` anyErrorCall
@@ -1635,11 +103,14 @@ main = hspec $ do
1635 enumFrom (pred maxBound :: DocVersion) `shouldBe` [pred maxBound, maxBound]
103 enumFrom (pred maxBound :: DocVersion) `shouldBe` [pred maxBound, maxBound]
1636 enumFromThen minBound (pred maxBound :: DocVersion) `shouldBe` [minBound, pred maxBound]
104 enumFromThen minBound (pred maxBound :: DocVersion) `shouldBe` [minBound, pred maxBound]
1637
105
1638− describe "scan&scroll API" $ do
106+ describe "Scan & Scroll API" $
1639 it "returns documents using the scan&scroll API" $ withTestEnv $ do
107 it "returns documents using the scan&scroll API" $ withTestEnv $ do
1640 _ <- insertData
108 _ <- insertData
1641 _ <- insertOther
109 _ <- insertOther
110+ let search =
111+ (mkSearch
1642− let search = (mkSearch (Just $ MatchAllQuery Nothing) Nothing) { size = (Size 1) }
112+ (Just $ MatchAllQuery Nothing) Nothing)
113+ { size = Size 1 }
1643 regular_search <- searchTweet search
114 regular_search <- searchTweet search
1644 scan_search' <- scanSearch testIndex testMapping search :: BH IO [Hit Tweet]
115 scan_search' <- scanSearch testIndex testMapping search :: BH IO [Hit Tweet]
1645 let scan_search = map hitSource scan_search'
116 let scan_search = map hitSource scan_search'
@@ -1648,171 +119,18 @@ main = hspec $ do
1648 liftIO $
119 liftIO $
1649 scan_search `shouldMatchList` [Just exampleTweet, Just otherTweet]
120 scan_search `shouldMatchList` [Just exampleTweet, Just otherTweet]
1650
121
1651− describe "index aliases" $ do
122+ describe "Search After API" $
1652− it "handles the simple case of aliasing an existing index" $ do
1653− let alias = IndexAlias (testIndex) (IndexAliasName (IndexName "bloodhound-tests-twitter-1-alias"))
1654− let create = IndexAliasCreate Nothing Nothing
1655− let action = AddAlias alias create
1656−
1657− withTestEnv $ do
1658− resetIndex
1659− resp <- updateIndexAliases (action :| [])
1660− liftIO $ validateStatus resp 200
1661− let cleanup = withTestEnv (updateIndexAliases (RemoveAlias alias :| []))
1662− (do aliases <- withTestEnv getIndexAliases
1663− let expected = IndexAliasSummary alias create
1664− case aliases of
1665− Right (IndexAliasesSummary summs) ->
1666− L.find ((== alias) . indexAliasSummaryAlias) summs `shouldBe` Just expected
1667− Left e -> expectationFailure ("Expected an IndexAliasesSummary but got " <> show e)) `finally` cleanup
1668−
1669− it "handles an alias with routing and a filter" $ do
1670− let alias = IndexAlias (testIndex) (IndexAliasName (IndexName "bloodhound-tests-twitter-1-alias"))
1671− let sar = SearchAliasRouting (RoutingValue "search val" :| [])
1672− let iar = IndexAliasRouting (RoutingValue "index val")
1673− let routing = GranularAliasRouting (Just sar) (Just iar)
1674− let filter = LimitFilter 42
1675− let create = IndexAliasCreate (Just routing) (Just filter)
1676− let action = AddAlias alias create
1677−
1678− withTestEnv $ do
1679− resetIndex
1680− resp <- updateIndexAliases (action :| [])
1681− liftIO $ validateStatus resp 200
1682− let cleanup = withTestEnv (updateIndexAliases (RemoveAlias alias :| []))
1683− (do aliases <- withTestEnv getIndexAliases
1684− let expected = IndexAliasSummary alias create
1685− case aliases of
1686− Right (IndexAliasesSummary summs) ->
1687− L.find ((== alias) . indexAliasSummaryAlias) summs `shouldBe` Just expected
1688− Left e -> expectationFailure ("Expected an IndexAliasesSummary but got " <> show e)) `finally` cleanup
1689−
1690− describe "Index Listing" $ do
1691− it "returns a list of index names" $ withTestEnv $ do
123+ it "returns document for search after query" $ withTestEnv $ do
1692− _ <- createExampleIndex
124+ _ <- insertData
1693− ixns <- listIndices
125+ _ <- insertOther
1694− liftIO (ixns `shouldContain` [testIndex])
126+ let
1695−
127+ sortSpec = DefaultSortSpec $ mkSort (FieldName "user") Ascending
1696− describe "Index Settings" $ do
128+ searchAfterKey = [Aeson.toJSON ("bitemyapp" :: String)]
1697− it "persists settings" $ withTestEnv $ do
129+ search = Search Nothing
1698− _ <- deleteExampleIndex
130+ Nothing (Just [sortSpec]) Nothing Nothing
1699− _ <- createExampleIndex
131+ False (From 0) (Size 10) SearchTypeQueryThenFetch (Just searchAfterKey)
1700− let updates = BlocksWrite False :| []
132+ Nothing Nothing Nothing Nothing
1701− updateResp <- updateIndexSettings updates testIndex
133+ result <- searchTweets search
1702− liftIO $ validateStatus updateResp 200
134+ let myTweet = grabFirst result
1703− getResp <- getIndexSettings testIndex
1704 liftIO $
135 liftIO $
1705− getResp `shouldBe` Right (IndexSettingsSummary
136+ myTweet `shouldBe` Right otherTweet
1706− testIndex
1707− (IndexSettings (ShardCount 1) (ReplicaCount 0))
1708− (NE.toList updates))
1709−
1710− describe "Index Optimization" $ do
1711− it "returns a successful response upon completion" $ withTestEnv $ do
1712− _ <- createExampleIndex
1713− resp <- optimizeIndex (IndexList (testIndex :| [])) defaultIndexOptimizationSettings
1714− liftIO $ validateStatus resp 200
1715−
1716− describe "JSON instances" $ do
1717− propJSON (Proxy :: Proxy Version)
1718− propJSON (Proxy :: Proxy IndexName)
1719− propJSON (Proxy :: Proxy MappingName)
1720− propJSON (Proxy :: Proxy DocId)
1721− propJSON (Proxy :: Proxy IndexAliasRouting)
1722− propJSON (Proxy :: Proxy RoutingValue)
1723− propJSON (Proxy :: Proxy ShardCount)
1724− propJSON (Proxy :: Proxy ReplicaCount)
1725− propJSON (Proxy :: Proxy TemplateName)
1726− propJSON (Proxy :: Proxy TemplatePattern)
1727− propJSON (Proxy :: Proxy QueryString)
1728− propJSON (Proxy :: Proxy FieldName)
1729− propJSON (Proxy :: Proxy CacheName)
1730− propJSON (Proxy :: Proxy CacheKey)
1731− propJSON (Proxy :: Proxy Existence)
1732− propJSON (Proxy :: Proxy CutoffFrequency)
1733− propJSON (Proxy :: Proxy Analyzer)
1734− propJSON (Proxy :: Proxy MaxExpansions)
1735− propJSON (Proxy :: Proxy Lenient)
1736− propJSON (Proxy :: Proxy Tiebreaker)
1737− propJSON (Proxy :: Proxy Boost)
1738− propJSON (Proxy :: Proxy BoostTerms)
1739− propJSON (Proxy :: Proxy MinimumMatch)
1740− propJSON (Proxy :: Proxy DisableCoord)
1741− propJSON (Proxy :: Proxy IgnoreTermFrequency)
1742− propJSON (Proxy :: Proxy MinimumTermFrequency)
1743− propJSON (Proxy :: Proxy MaxQueryTerms)
1744− propJSON (Proxy :: Proxy Fuzziness)
1745− propJSON (Proxy :: Proxy PrefixLength)
1746− propJSON (Proxy :: Proxy TypeName)
1747− propJSON (Proxy :: Proxy PercentMatch)
1748− propJSON (Proxy :: Proxy StopWord)
1749− propJSON (Proxy :: Proxy QueryPath)
1750− propJSON (Proxy :: Proxy AllowLeadingWildcard)
1751− propJSON (Proxy :: Proxy LowercaseExpanded)
1752− propJSON (Proxy :: Proxy EnablePositionIncrements)
1753− propJSON (Proxy :: Proxy AnalyzeWildcard)
1754− propJSON (Proxy :: Proxy GeneratePhraseQueries)
1755− propJSON (Proxy :: Proxy Locale)
1756− propJSON (Proxy :: Proxy MaxWordLength)
1757− propJSON (Proxy :: Proxy MinWordLength)
1758− propJSON (Proxy :: Proxy PhraseSlop)
1759− propJSON (Proxy :: Proxy MinDocFrequency)
1760− propJSON (Proxy :: Proxy MaxDocFrequency)
1761− propJSON (Proxy :: Proxy Filter)
1762− propJSON (Proxy :: Proxy Query)
1763− propJSON (Proxy :: Proxy SimpleQueryStringQuery)
1764− propJSON (Proxy :: Proxy FieldOrFields)
1765− propJSON (Proxy :: Proxy SimpleQueryFlag)
1766− propJSON (Proxy :: Proxy RegexpQuery)
1767− propJSON (Proxy :: Proxy QueryStringQuery)
1768− propJSON (Proxy :: Proxy RangeQuery)
1769− propJSON (Proxy :: Proxy PrefixQuery)
1770− propJSON (Proxy :: Proxy NestedQuery)
1771− propJSON (Proxy :: Proxy MoreLikeThisFieldQuery)
1772− propJSON (Proxy :: Proxy MoreLikeThisQuery)
1773− propJSON (Proxy :: Proxy IndicesQuery)
1774− propJSON (Proxy :: Proxy HasParentQuery)
1775− propJSON (Proxy :: Proxy HasChildQuery)
1776− propJSON (Proxy :: Proxy FuzzyQuery)
1777− propJSON (Proxy :: Proxy FuzzyLikeFieldQuery)
1778− propJSON (Proxy :: Proxy FuzzyLikeThisQuery)
1779− propJSON (Proxy :: Proxy FilteredQuery)
1780− propJSON (Proxy :: Proxy DisMaxQuery)
1781− propJSON (Proxy :: Proxy CommonTermsQuery)
1782− propJSON (Proxy :: Proxy CommonMinimumMatch)
1783− propJSON (Proxy :: Proxy BoostingQuery)
1784− propJSON (Proxy :: Proxy BoolQuery)
1785− propJSON (Proxy :: Proxy MatchQuery)
1786− propJSON (Proxy :: Proxy MultiMatchQueryType)
1787− propJSON (Proxy :: Proxy BooleanOperator)
1788− propJSON (Proxy :: Proxy ZeroTermsQuery)
1789− propJSON (Proxy :: Proxy MatchQueryType)
1790− propJSON (Proxy :: Proxy AliasRouting)
1791− propJSON (Proxy :: Proxy IndexAliasCreate)
1792− propJSON (Proxy :: Proxy SearchAliasRouting)
1793− propJSON (Proxy :: Proxy ScoreType)
1794− propJSON (Proxy :: Proxy Distance)
1795− propJSON (Proxy :: Proxy DistanceUnit)
1796− propJSON (Proxy :: Proxy DistanceType)
1797− propJSON (Proxy :: Proxy OptimizeBbox)
1798− propJSON (Proxy :: Proxy GeoBoundingBoxConstraint)
1799− propJSON (Proxy :: Proxy GeoFilterType)
1800− propJSON (Proxy :: Proxy GeoBoundingBox)
1801− propJSON (Proxy :: Proxy LatLon)
1802− propJSON (Proxy :: Proxy RangeExecution)
1803− prop "RegexpFlags FromJSON/ToJSON roundtrips, removing dups " $ \rfs ->
1804− let expected = case rfs of
1805− SomeRegexpFlags fs -> SomeRegexpFlags (NE.fromList (nub (NE.toList fs)))
1806− x -> x
1807− in parseEither parseJSON (toJSON rfs) === Right expected
1808− propJSON (Proxy :: Proxy BoolMatch)
1809− propJSON (Proxy :: Proxy Term)
1810− propJSON (Proxy :: Proxy MultiMatchQuery)
1811− propJSON (Proxy :: Proxy IndexSettings)
1812− propJSON (Proxy :: Proxy UpdatableIndexSetting)
1813− propJSON (Proxy :: Proxy ReplicaBounds)
1814− propJSON (Proxy :: Proxy Bytes)
1815− propJSON (Proxy :: Proxy AllocationPolicy)
1816− propJSON (Proxy :: Proxy InitialShardCount)
1817− propJSON (Proxy :: Proxy FSType)
1818− propJSON (Proxy :: Proxy CompoundFormat)