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