git.iko.soy/typeable/bloodhound
on 5558959 help sign in
typeable/bloodhound/tests/tests.hs
328 lines 13 kB history raw
1{-# LANGUAGE DeriveGeneric #-}
3module Main where
5import Database.Bloodhound
6import Data.Aeson
7import Data.Time.Calendar (Day(..))
8import Data.Time.Clock (secondsToDiffTime, UTCTime(..))
9import Data.Text (Text)
10import GHC.Generics (Generic)
11import Network.HTTP.Client
12import qualified Network.HTTP.Types.Status as NHTS
13import Prelude hiding (filter, putStrLn)
14import Test.Hspec
16testServer :: Server
17testServer = Server "http://localhost:9200"
18testIndex :: IndexName
19testIndex = IndexName "bloodhound-tests-twitter-1"
20testMapping :: MappingName
21testMapping = MappingName "tweet"
23validateStatus :: Response body -> Int -> Expectation
24validateStatus resp expected =
25 (NHTS.statusCode $ responseStatus resp)
26 `shouldBe` (expected :: Int)
28createExampleIndex :: IO Reply
29createExampleIndex = createIndex testServer defaultIndexSettings testIndex
30deleteExampleIndex :: IO Reply
31deleteExampleIndex = deleteIndex testServer testIndex
33data Location = Location { lat :: Double
34 , lon :: Double } deriving (Eq, Generic, Show)
36data Tweet = Tweet { user :: Text
37 , postDate :: UTCTime
38 , message :: Text
39 , age :: Int
40 , location :: Location }
41 deriving (Eq, Generic, Show)
43instance ToJSON Tweet
44instance FromJSON Tweet
45instance ToJSON Location
46instance FromJSON Location
48data TweetMapping = TweetMapping deriving (Eq, Show)
50instance ToJSON TweetMapping where
51 toJSON TweetMapping =
52 object ["tweet" .=
53 object ["properties" .=
54 object ["location" .= object ["type" .= ("geo_point" :: Text)]]]]
56exampleTweet :: Tweet
57exampleTweet = Tweet { user = "bitemyapp"
58 , postDate = UTCTime
59 (ModifiedJulianDay 55000)
60 (secondsToDiffTime 10)
61 , message = "Use haskell!"
62 , age = 10000
63 , location = Location 40.12 (-71.34) }
65otherTweet :: Tweet
66otherTweet = Tweet { user = "notmyapp"
67 , postDate = UTCTime
68 (ModifiedJulianDay 55000)
69 (secondsToDiffTime 11)
70 , message = "Use haskell!"
71 , age = 1000
72 , location = Location 40.12 (-71.34) }
74insertData :: IO ()
75insertData = do
76 _ <- deleteExampleIndex
77 _ <- createExampleIndex
78 _ <- putMapping testServer testIndex testMapping TweetMapping
79 _ <- indexDocument testServer testIndex testMapping exampleTweet (DocId "1")
80 _ <- refreshIndex testServer testIndex
81 return ()
83insertOther :: IO ()
84insertOther = do
85 _ <- indexDocument testServer testIndex testMapping otherTweet (DocId "2")
86 _ <- refreshIndex testServer testIndex
87 return ()
89searchTweet :: Search -> IO (Either String Tweet)
90searchTweet search = do
91 reply <- searchByIndex testServer testIndex search
92 let result = eitherDecode (responseBody reply) :: Either String (SearchResult Tweet)
93 let myTweet = fmap (hitSource . head . hits . searchHits) result
94 return myTweet
96searchExpectNoResults :: Search -> IO ()
97searchExpectNoResults search = do
98 reply <- searchByIndex testServer testIndex search
99 let result = eitherDecode (responseBody reply) :: Either String (SearchResult Tweet)
100 let emptyHits = fmap (hits . searchHits) result
101 emptyHits `shouldBe` Right []
103data BulkTest = BulkTest { name :: Text } deriving (Eq, Generic, Show)
104instance FromJSON BulkTest
105instance ToJSON BulkTest
107main :: IO ()
108main = hspec $ do
110 describe "index create/delete API" $ do
111 it "creates and then deletes the requested index" $ do
112 -- priming state.
113 _ <- deleteExampleIndex
114 resp <- createExampleIndex
115 deleteResp <- deleteExampleIndex
116 validateStatus resp 200
117 validateStatus deleteResp 200
120 describe "document API" $ do
121 it "indexes, gets, and then deletes the generated document" $ do
122 _ <- insertData
123 docInserted <- getDocument testServer testIndex testMapping (DocId "1")
124 let newTweet = eitherDecode
125 (responseBody docInserted) :: Either String (EsResult Tweet)
126 fmap _source newTweet `shouldBe` Right exampleTweet
129 describe "bulk API" $ do
130 it "inserts all documents we request" $ do
131 _ <- insertData
132 let firstTest = BulkTest "blah"
133 let secondTest = BulkTest "bloo"
134 let firstDoc = BulkIndex testIndex
135 testMapping (DocId "2") (object ["name" .= String "blah"])
136 let secondDoc = BulkCreate testIndex
137 testMapping (DocId "3") (object ["name" .= String "bloo"])
138 let stream = [firstDoc, secondDoc]
139 _ <- bulk testServer stream
140 _ <- refreshIndex testServer testIndex
141 fDoc <- getDocument testServer testIndex testMapping (DocId "2")
142 sDoc <- getDocument testServer testIndex testMapping (DocId "3")
143 let maybeFirst = eitherDecode $ responseBody fDoc :: Either String (EsResult BulkTest)
144 let maybeSecond = eitherDecode $ responseBody sDoc :: Either String (EsResult BulkTest)
145 fmap _source maybeFirst `shouldBe` Right firstTest
146 fmap _source maybeSecond `shouldBe` Right secondTest
149 describe "query API" $ do
150 it "returns document for term query and identity filter" $ do
151 _ <- insertData
152 let query = TermQuery (Term "user" "bitemyapp") Nothing
153 let filter = IdentityFilter <&&> IdentityFilter
154 let search = mkSearch (Just query) (Just filter)
155 myTweet <- searchTweet search
156 myTweet `shouldBe` Right exampleTweet
158 it "returns document for match query" $ do
159 _ <- insertData
160 let query = QueryMatchQuery $ mkMatchQuery (FieldName "user") (QueryString "bitemyapp")
161 let search = mkSearch (Just query) Nothing
162 myTweet <- searchTweet search
163 myTweet `shouldBe` Right exampleTweet
165 it "returns document for multi-match query" $ do
166 _ <- insertData
167 let fields = [FieldName "user", FieldName "message"]
168 let query = QueryMultiMatchQuery $ mkMultiMatchQuery fields (QueryString "bitemyapp")
169 let search = mkSearch (Just query) Nothing
170 myTweet <- searchTweet search
171 myTweet `shouldBe` Right exampleTweet
173 it "returns document for bool query" $ do
174 _ <- insertData
175 let innerQuery = QueryMatchQuery $
176 mkMatchQuery (FieldName "user") (QueryString "bitemyapp")
177 let query = QueryBoolQuery $
178 mkBoolQuery (Just innerQuery) Nothing Nothing
179 let search = mkSearch (Just query) Nothing
180 myTweet <- searchTweet search
181 myTweet `shouldBe` Right exampleTweet
183 it "returns document for boosting query" $ do
184 _ <- insertData
185 let posQuery = QueryMatchQuery $ mkMatchQuery (FieldName "user") (QueryString "bitemyapp")
186 let negQuery = QueryMatchQuery $ mkMatchQuery (FieldName "user") (QueryString "notmyapp")
187 let query = QueryBoostingQuery $ BoostingQuery posQuery negQuery (Boost 0.2)
188 let search = mkSearch (Just query) Nothing
189 myTweet <- searchTweet search
190 myTweet `shouldBe` Right exampleTweet
192 it "returns document for common terms query" $ do
193 _ <- insertData
194 let query = QueryCommonTermsQuery $
195 CommonTermsQuery (FieldName "user")
196 (QueryString "bitemyapp")
197 (CutoffFrequency 0.0001)
198 Or Or Nothing Nothing Nothing Nothing
199 let search = mkSearch (Just query) Nothing
200 myTweet <- searchTweet search
201 myTweet `shouldBe` Right exampleTweet
204 describe "sorting" $ do
205 it "returns documents in the right order" $ do
206 _ <- insertData
207 _ <- insertOther
208 let sortSpec = DefaultSortSpec $ mkSort (FieldName "age") Ascending
209 let search = Search Nothing
210 (Just IdentityFilter) (Just [sortSpec])
211 False 0 10
212 reply <- searchByIndex testServer testIndex search
213 let result = eitherDecode (responseBody reply) :: Either String (SearchResult Tweet)
214 let myTweet = fmap (hitSource . head . hits . searchHits) result
215 myTweet `shouldBe` Right otherTweet
218 describe "filtering API" $ do
219 it "returns document for composed boolmatch and identity" $ do
220 _ <- insertData
221 let queryFilter = BoolFilter (MustMatch (Term "user" "bitemyapp") False)
222 <&&> IdentityFilter
223 let search = mkSearch Nothing (Just queryFilter)
224 myTweet <- searchTweet search
225 myTweet `shouldBe` Right exampleTweet
227 it "returns document for existential filter" $ do
228 _ <- insertData
229 let search = mkSearch Nothing (Just (ExistsFilter (FieldName "user")))
230 myTweet <- searchTweet search
231 myTweet `shouldBe` Right exampleTweet
233 it "returns document for geo boundingbox filter" $ do
234 _ <- insertData
235 let box = GeoBoundingBox (LatLon 40.73 (-74.1)) (LatLon 40.10 (-71.12))
236 let bbConstraint = GeoBoundingBoxConstraint (FieldName "tweet.location") box False
237 let geoFilter = GeoBoundingBoxFilter bbConstraint GeoFilterMemory
238 let search = mkSearch Nothing (Just geoFilter)
239 myTweet <- searchTweet search
240 myTweet `shouldBe` Right exampleTweet
242 it "doesn't return document for nonsensical boundingbox filter" $ do
243 _ <- insertData
244 let box = GeoBoundingBox (LatLon 0.73 (-4.1)) (LatLon 0.10 (-1.12))
245 let bbConstraint = GeoBoundingBoxConstraint (FieldName "tweet.location") box False
246 let geoFilter = GeoBoundingBoxFilter bbConstraint GeoFilterMemory
247 let search = mkSearch Nothing (Just geoFilter)
248 searchExpectNoResults search
250 it "returns document for geo distance filter" $ do
251 _ <- insertData
252 let geoPoint = GeoPoint (FieldName "tweet.location") (LatLon 40.12 (-71.34))
253 let distance = Distance 10.0 Miles
254 let optimizeBbox = OptimizeGeoFilterType GeoFilterMemory
255 let geoFilter = GeoDistanceFilter geoPoint distance SloppyArc optimizeBbox False
256 let search = mkSearch Nothing (Just geoFilter)
257 myTweet <- searchTweet search
258 myTweet `shouldBe` Right exampleTweet
260 it "returns document for geo distance range filter" $ do
261 _ <- insertData
262 let geoPoint = GeoPoint (FieldName "tweet.location") (LatLon 40.12 (-71.34))
263 let distanceRange = DistanceRange (Distance 0.0 Miles) (Distance 10.0 Miles)
264 let geoFilter = GeoDistanceRangeFilter geoPoint distanceRange
265 let search = mkSearch Nothing (Just geoFilter)
266 myTweet <- searchTweet search
267 myTweet `shouldBe` Right exampleTweet
269 it "doesn't return document for wild geo distance range filter" $ do
270 _ <- insertData
271 let geoPoint = GeoPoint (FieldName "tweet.location") (LatLon 40.12 (-71.34))
272 let distanceRange = DistanceRange (Distance 100.0 Miles) (Distance 1000.0 Miles)
273 let geoFilter = GeoDistanceRangeFilter geoPoint distanceRange
274 let search = mkSearch Nothing (Just geoFilter)
275 searchExpectNoResults search
277 it "returns document for geo polygon filter" $ do
278 _ <- insertData
279 let points = [LatLon 40.0 (-70.00),
280 LatLon 40.0 (-72.00),
281 LatLon 41.0 (-70.00),
282 LatLon 41.0 (-72.00)]
283 let geoFilter = GeoPolygonFilter (FieldName "tweet.location") points
284 let search = mkSearch Nothing (Just geoFilter)
285 myTweet <- searchTweet search
286 myTweet `shouldBe` Right exampleTweet
288 it "doesn't return document for bad geo polygon filter" $ do
289 _ <- insertData
290 let points = [LatLon 40.0 (-70.00),
291 LatLon 40.0 (-71.00),
292 LatLon 41.0 (-70.00),
293 LatLon 41.0 (-71.00)]
294 let geoFilter = GeoPolygonFilter (FieldName "tweet.location") points
295 let search = mkSearch Nothing (Just geoFilter)
296 searchExpectNoResults search
298 it "returns document for ids filter" $ do
299 _ <- insertData
300 let filter = IdsFilter (MappingName "tweet") [DocId "1"]
301 let search = mkSearch Nothing (Just filter)
302 myTweet <- searchTweet search
303 myTweet `shouldBe` Right exampleTweet
305 it "returns document for range filter" $ do
306 _ <- insertData
307 let filter = RangeFilter (FieldName "age")
308 (Right (RangeLtGt (LessThan 100000.0) (GreaterThan 1000.0)))
309 RangeExecutionIndex False
310 let search = mkSearch Nothing (Just filter)
311 myTweet <- searchTweet search
312 myTweet `shouldBe` Right exampleTweet
314 it "returns document for regexp filter" $ do
315 _ <- insertData
316 let filter = RegexpFilter (FieldName "user") (Regexp "bite.*app")
317 (RegexpFlags "ALL") (CacheName "test") False (CacheKey "key")
318 let search = mkSearch Nothing (Just filter)
319 myTweet <- searchTweet search
320 myTweet `shouldBe` Right exampleTweet
322 it "doesn't return document for non-matching regexp filter" $ do
323 _ <- insertData
324 let filter = RegexpFilter (FieldName "user")
325 (Regexp "boy") (RegexpFlags "ALL")
326 (CacheName "test") False (CacheKey "key")
327 let search = mkSearch Nothing (Just filter)
328 searchExpectNoResults search