git.iko.soy/typeable/bloodhound
on 1f6b11c help sign in
typeable/bloodhound/tests/tests.hs
384 lines 15 kB history raw
1{-# LANGUAGE DeriveGeneric #-}
2{-# LANGUAGE ScopedTypeVariables #-}
4module Main where
6import Control.Applicative
7import Database.Bloodhound
8import Data.Aeson
9import Data.List (nub)
10import Data.List.NonEmpty (NonEmpty(..))
11import Data.Time.Calendar (Day(..))
12import Data.Time.Clock (secondsToDiffTime, UTCTime(..))
13import Data.Text (Text)
14import qualified Data.Text as T
15import GHC.Generics (Generic)
16import Network.HTTP.Client
17import qualified Network.HTTP.Types.Status as NHTS
18import Prelude hiding (filter, putStrLn)
19import Test.Hspec
20import Test.Hspec.QuickCheck (prop)
21import Test.QuickCheck
23testServer :: Server
24testServer = Server "http://localhost:9200"
25testIndex :: IndexName
26testIndex = IndexName "bloodhound-tests-twitter-1"
27testMapping :: MappingName
28testMapping = MappingName "tweet"
30validateStatus :: Response body -> Int -> Expectation
31validateStatus resp expected =
32 (NHTS.statusCode $ responseStatus resp)
33 `shouldBe` (expected :: Int)
35createExampleIndex :: IO Reply
36createExampleIndex = createIndex testServer defaultIndexSettings testIndex
37deleteExampleIndex :: IO Reply
38deleteExampleIndex = deleteIndex testServer testIndex
40data Location = Location { lat :: Double
41 , lon :: Double } deriving (Eq, Generic, Show)
43data Tweet = Tweet { user :: Text
44 , postDate :: UTCTime
45 , message :: Text
46 , age :: Int
47 , location :: Location }
48 deriving (Eq, Generic, Show)
50instance ToJSON Tweet
51instance FromJSON Tweet
52instance ToJSON Location
53instance FromJSON Location
55data TweetMapping = TweetMapping deriving (Eq, Show)
57instance ToJSON TweetMapping where
58 toJSON TweetMapping =
59 object ["tweet" .=
60 object ["properties" .=
61 object ["location" .= object ["type" .= ("geo_point" :: Text)]]]]
63exampleTweet :: Tweet
64exampleTweet = Tweet { user = "bitemyapp"
65 , postDate = UTCTime
66 (ModifiedJulianDay 55000)
67 (secondsToDiffTime 10)
68 , message = "Use haskell!"
69 , age = 10000
70 , location = Location 40.12 (-71.34) }
72otherTweet :: Tweet
73otherTweet = Tweet { user = "notmyapp"
74 , postDate = UTCTime
75 (ModifiedJulianDay 55000)
76 (secondsToDiffTime 11)
77 , message = "Use haskell!"
78 , age = 1000
79 , location = Location 40.12 (-71.34) }
81insertData :: IO ()
82insertData = do
83 _ <- deleteExampleIndex
84 _ <- createExampleIndex
85 _ <- putMapping testServer testIndex testMapping TweetMapping
86 _ <- indexDocument testServer testIndex testMapping exampleTweet (DocId "1")
87 _ <- refreshIndex testServer testIndex
88 return ()
90insertOther :: IO ()
91insertOther = do
92 _ <- indexDocument testServer testIndex testMapping otherTweet (DocId "2")
93 _ <- refreshIndex testServer testIndex
94 return ()
96searchTweet :: Search -> IO (Either String Tweet)
97searchTweet search = do
98 reply <- searchByIndex testServer testIndex search
99 let result = eitherDecode (responseBody reply) :: Either String (SearchResult Tweet)
100 let myTweet = fmap (hitSource . head . hits . searchHits) result
101 return myTweet
103searchExpectNoResults :: Search -> IO ()
104searchExpectNoResults search = do
105 reply <- searchByIndex testServer testIndex search
106 let result = eitherDecode (responseBody reply) :: Either String (SearchResult Tweet)
107 let emptyHits = fmap (hits . searchHits) result
108 emptyHits `shouldBe` Right []
110data BulkTest = BulkTest { name :: Text } deriving (Eq, Generic, Show)
111instance FromJSON BulkTest
112instance ToJSON BulkTest
114noDuplicates :: Eq a => [a] -> Bool
115noDuplicates xs = nub xs == xs
117instance Arbitrary RegexpFlags where
118 arbitrary = oneof [ pure AllRegexpFlags
119 , pure NoRegexpFlags
120 , SomeRegexpFlags <$> arbitrary
121 ]
123instance Arbitrary a => Arbitrary (NonEmpty a) where
124 arbitrary = liftA2 (:|) arbitrary arbitrary
126instance Arbitrary RegexpFlag where
127 arbitrary = oneof [ pure AnyString
128 , pure Automaton
129 , pure Complement
130 , pure Empty
131 , pure Intersection
132 , pure Interval
133 ]
135main :: IO ()
136main = hspec $ do
138 describe "index create/delete API" $ do
139 it "creates and then deletes the requested index" $ do
140 -- priming state.
141 _ <- deleteExampleIndex
142 resp <- createExampleIndex
143 deleteResp <- deleteExampleIndex
144 validateStatus resp 200
145 validateStatus deleteResp 200
148 describe "document API" $ do
149 it "indexes, gets, and then deletes the generated document" $ do
150 _ <- insertData
151 docInserted <- getDocument testServer testIndex testMapping (DocId "1")
152 let newTweet = eitherDecode
153 (responseBody docInserted) :: Either String (EsResult Tweet)
154 fmap _source newTweet `shouldBe` Right exampleTweet
157 describe "bulk API" $ do
158 it "inserts all documents we request" $ do
159 _ <- insertData
160 let firstTest = BulkTest "blah"
161 let secondTest = BulkTest "bloo"
162 let firstDoc = BulkIndex testIndex
163 testMapping (DocId "2") (object ["name" .= String "blah"])
164 let secondDoc = BulkCreate testIndex
165 testMapping (DocId "3") (object ["name" .= String "bloo"])
166 let stream = [firstDoc, secondDoc]
167 _ <- bulk testServer stream
168 _ <- refreshIndex testServer testIndex
169 fDoc <- getDocument testServer testIndex testMapping (DocId "2")
170 sDoc <- getDocument testServer testIndex testMapping (DocId "3")
171 let maybeFirst = eitherDecode $ responseBody fDoc :: Either String (EsResult BulkTest)
172 let maybeSecond = eitherDecode $ responseBody sDoc :: Either String (EsResult BulkTest)
173 fmap _source maybeFirst `shouldBe` Right firstTest
174 fmap _source maybeSecond `shouldBe` Right secondTest
177 describe "query API" $ do
178 it "returns document for term query and identity filter" $ do
179 _ <- insertData
180 let query = TermQuery (Term "user" "bitemyapp") Nothing
181 let filter = IdentityFilter <&&> IdentityFilter
182 let search = mkSearch (Just query) (Just filter)
183 myTweet <- searchTweet search
184 myTweet `shouldBe` Right exampleTweet
186 it "returns document for match query" $ do
187 _ <- insertData
188 let query = QueryMatchQuery $ mkMatchQuery (FieldName "user") (QueryString "bitemyapp")
189 let search = mkSearch (Just query) Nothing
190 myTweet <- searchTweet search
191 myTweet `shouldBe` Right exampleTweet
193 it "returns document for multi-match query" $ do
194 _ <- insertData
195 let fields = [FieldName "user", FieldName "message"]
196 let query = QueryMultiMatchQuery $ mkMultiMatchQuery fields (QueryString "bitemyapp")
197 let search = mkSearch (Just query) Nothing
198 myTweet <- searchTweet search
199 myTweet `shouldBe` Right exampleTweet
201 it "returns document for bool query" $ do
202 _ <- insertData
203 let innerQuery = QueryMatchQuery $
204 mkMatchQuery (FieldName "user") (QueryString "bitemyapp")
205 let query = QueryBoolQuery $
206 mkBoolQuery (Just innerQuery) Nothing Nothing
207 let search = mkSearch (Just query) Nothing
208 myTweet <- searchTweet search
209 myTweet `shouldBe` Right exampleTweet
211 it "returns document for boosting query" $ do
212 _ <- insertData
213 let posQuery = QueryMatchQuery $ mkMatchQuery (FieldName "user") (QueryString "bitemyapp")
214 let negQuery = QueryMatchQuery $ mkMatchQuery (FieldName "user") (QueryString "notmyapp")
215 let query = QueryBoostingQuery $ BoostingQuery posQuery negQuery (Boost 0.2)
216 let search = mkSearch (Just query) Nothing
217 myTweet <- searchTweet search
218 myTweet `shouldBe` Right exampleTweet
220 it "returns document for common terms query" $ do
221 _ <- insertData
222 let query = QueryCommonTermsQuery $
223 CommonTermsQuery (FieldName "user")
224 (QueryString "bitemyapp")
225 (CutoffFrequency 0.0001)
226 Or Or Nothing Nothing Nothing Nothing
227 let search = mkSearch (Just query) Nothing
228 myTweet <- searchTweet search
229 myTweet `shouldBe` Right exampleTweet
232 describe "sorting" $ do
233 it "returns documents in the right order" $ do
234 _ <- insertData
235 _ <- insertOther
236 let sortSpec = DefaultSortSpec $ mkSort (FieldName "age") Ascending
237 let search = Search Nothing
238 (Just IdentityFilter) (Just [sortSpec])
239 False 0 10
240 reply <- searchByIndex testServer testIndex search
241 let result = eitherDecode (responseBody reply) :: Either String (SearchResult Tweet)
242 let myTweet = fmap (hitSource . head . hits . searchHits) result
243 myTweet `shouldBe` Right otherTweet
246 describe "filtering API" $ do
247 it "returns document for composed boolmatch and identity" $ do
248 _ <- insertData
249 let queryFilter = BoolFilter (MustMatch (Term "user" "bitemyapp") False)
250 <&&> IdentityFilter
251 let search = mkSearch Nothing (Just queryFilter)
252 myTweet <- searchTweet search
253 myTweet `shouldBe` Right exampleTweet
255 it "returns document for term filter" $ do
256 _ <- insertData
257 let termFilter = TermFilter (Term "user" "bitemyapp") False
258 let search = mkSearch Nothing (Just termFilter)
259 myTweet <- searchTweet search
260 myTweet `shouldBe` Right exampleTweet
262 it "returns document for existential filter" $ do
263 _ <- insertData
264 let search = mkSearch Nothing (Just (ExistsFilter (FieldName "user")))
265 myTweet <- searchTweet search
266 myTweet `shouldBe` Right exampleTweet
268 it "returns document for geo boundingbox filter" $ do
269 _ <- insertData
270 let box = GeoBoundingBox (LatLon 40.73 (-74.1)) (LatLon 40.10 (-71.12))
271 let bbConstraint = GeoBoundingBoxConstraint (FieldName "tweet.location") box False GeoFilterMemory
272 let geoFilter = GeoBoundingBoxFilter bbConstraint
273 let search = mkSearch Nothing (Just geoFilter)
274 myTweet <- searchTweet search
275 myTweet `shouldBe` Right exampleTweet
277 it "doesn't return document for nonsensical boundingbox filter" $ do
278 _ <- insertData
279 let box = GeoBoundingBox (LatLon 0.73 (-4.1)) (LatLon 0.10 (-1.12))
280 let bbConstraint = GeoBoundingBoxConstraint (FieldName "tweet.location") box False GeoFilterMemory
281 let geoFilter = GeoBoundingBoxFilter bbConstraint
282 let search = mkSearch Nothing (Just geoFilter)
283 searchExpectNoResults search
285 it "returns document for geo distance filter" $ do
286 _ <- insertData
287 let geoPoint = GeoPoint (FieldName "tweet.location") (LatLon 40.12 (-71.34))
288 let distance = Distance 10.0 Miles
289 let optimizeBbox = OptimizeGeoFilterType GeoFilterMemory
290 let geoFilter = GeoDistanceFilter geoPoint distance SloppyArc optimizeBbox False
291 let search = mkSearch Nothing (Just geoFilter)
292 myTweet <- searchTweet search
293 myTweet `shouldBe` Right exampleTweet
295 it "returns document for geo distance range filter" $ do
296 _ <- insertData
297 let geoPoint = GeoPoint (FieldName "tweet.location") (LatLon 40.12 (-71.34))
298 let distanceRange = DistanceRange (Distance 0.0 Miles) (Distance 10.0 Miles)
299 let geoFilter = GeoDistanceRangeFilter geoPoint distanceRange
300 let search = mkSearch Nothing (Just geoFilter)
301 myTweet <- searchTweet search
302 myTweet `shouldBe` Right exampleTweet
304 it "doesn't return document for wild geo distance range filter" $ do
305 _ <- insertData
306 let geoPoint = GeoPoint (FieldName "tweet.location") (LatLon 40.12 (-71.34))
307 let distanceRange = DistanceRange (Distance 100.0 Miles) (Distance 1000.0 Miles)
308 let geoFilter = GeoDistanceRangeFilter geoPoint distanceRange
309 let search = mkSearch Nothing (Just geoFilter)
310 searchExpectNoResults search
312 it "returns document for geo polygon filter" $ do
313 _ <- insertData
314 let points = [LatLon 40.0 (-70.00),
315 LatLon 40.0 (-72.00),
316 LatLon 41.0 (-70.00),
317 LatLon 41.0 (-72.00)]
318 let geoFilter = GeoPolygonFilter (FieldName "tweet.location") points
319 let search = mkSearch Nothing (Just geoFilter)
320 myTweet <- searchTweet search
321 myTweet `shouldBe` Right exampleTweet
323 it "doesn't return document for bad geo polygon filter" $ do
324 _ <- insertData
325 let points = [LatLon 40.0 (-70.00),
326 LatLon 40.0 (-71.00),
327 LatLon 41.0 (-70.00),
328 LatLon 41.0 (-71.00)]
329 let geoFilter = GeoPolygonFilter (FieldName "tweet.location") points
330 let search = mkSearch Nothing (Just geoFilter)
331 searchExpectNoResults search
333 it "returns document for ids filter" $ do
334 _ <- insertData
335 let filter = IdsFilter (MappingName "tweet") [DocId "1"]
336 let search = mkSearch Nothing (Just filter)
337 myTweet <- searchTweet search
338 myTweet `shouldBe` Right exampleTweet
340 it "returns document for range filter" $ do
341 _ <- insertData
342 let filter = RangeFilter (FieldName "age")
343 (Right (RangeLtGt (LessThan 100000.0) (GreaterThan 1000.0)))
344 RangeExecutionIndex False
345 let search = mkSearch Nothing (Just filter)
346 myTweet <- searchTweet search
347 myTweet `shouldBe` Right exampleTweet
349 it "returns document for regexp filter" $ do
350 _ <- insertData
351 let filter = RegexpFilter (FieldName "user") (Regexp "bite.*app")
352 AllRegexpFlags (CacheName "test") False (CacheKey "key")
353 let search = mkSearch Nothing (Just filter)
354 myTweet <- searchTweet search
355 myTweet `shouldBe` Right exampleTweet
357 it "doesn't return document for non-matching regexp filter" $ do
358 _ <- insertData
359 let filter = RegexpFilter (FieldName "user")
360 (Regexp "boy") AllRegexpFlags
361 (CacheName "test") False (CacheKey "key")
362 let search = mkSearch Nothing (Just filter)
363 searchExpectNoResults search
366 describe "ToJSON RegexpFlags" $ do
367 it "generates the correct JSON for AllRegexpFlags" $
368 toJSON AllRegexpFlags `shouldBe` String "ALL"
370 it "generates the correct JSON for NoRegexpFlags" $
371 toJSON NoRegexpFlags `shouldBe` String "NONE"
373 it "generates the correct JSON for SomeRegexpFlags" $
374 let flags = AnyString :| [ Automaton
375 , Complement
376 , Empty
377 , Intersection
378 , Interval ]
379 in toJSON (SomeRegexpFlags flags) `shouldBe` String "ANYSTRING|AUTOMATON|COMPLEMENT|EMPTY|INTERSECTION|INTERVAL"
381 prop "removes duplicates from flags" $ \(flags :: RegexpFlags) ->
382 let String str = toJSON flags
383 flagStrs = T.splitOn "|" str
384 in noDuplicates flagStrs