git.iko.soy/typeable/bloodhound
on aef9e08 help sign in
typeable/bloodhound/tests/tests.hs
299 lines 12 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 describe "sorting" $ do
176 it "returns documents in the right order" $ do
177 _ <- insertData
178 _ <- insertOther
179 let sortSpec = DefaultSortSpec $ mkSort (FieldName "age") Ascending
180 let search = Search Nothing
181 (Just IdentityFilter) (Just [sortSpec])
182 False 0 10
183 reply <- searchByIndex testServer testIndex search
184 let result = eitherDecode (responseBody reply) :: Either String (SearchResult Tweet)
185 let myTweet = fmap (hitSource . head . hits . searchHits) result
186 myTweet `shouldBe` Right otherTweet
189 describe "filtering API" $ do
190 it "returns document for composed boolmatch and identity" $ do
191 _ <- insertData
192 let queryFilter = BoolFilter (MustMatch (Term "user" "bitemyapp") False)
193 <&&> IdentityFilter
194 let search = mkSearch Nothing (Just queryFilter)
195 myTweet <- searchTweet search
196 myTweet `shouldBe` Right exampleTweet
198 it "returns document for existential filter" $ do
199 _ <- insertData
200 let search = mkSearch Nothing (Just (ExistsFilter (FieldName "user")))
201 myTweet <- searchTweet search
202 myTweet `shouldBe` Right exampleTweet
204 it "returns document for geo boundingbox filter" $ do
205 _ <- insertData
206 let box = GeoBoundingBox (LatLon 40.73 (-74.1)) (LatLon 40.10 (-71.12))
207 let bbConstraint = GeoBoundingBoxConstraint (FieldName "tweet.location") box False
208 let geoFilter = GeoBoundingBoxFilter bbConstraint GeoFilterMemory
209 let search = mkSearch Nothing (Just geoFilter)
210 myTweet <- searchTweet search
211 myTweet `shouldBe` Right exampleTweet
213 it "doesn't return document for nonsensical boundingbox filter" $ do
214 _ <- insertData
215 let box = GeoBoundingBox (LatLon 0.73 (-4.1)) (LatLon 0.10 (-1.12))
216 let bbConstraint = GeoBoundingBoxConstraint (FieldName "tweet.location") box False
217 let geoFilter = GeoBoundingBoxFilter bbConstraint GeoFilterMemory
218 let search = mkSearch Nothing (Just geoFilter)
219 searchExpectNoResults search
221 it "returns document for geo distance filter" $ do
222 _ <- insertData
223 let geoPoint = GeoPoint (FieldName "tweet.location") (LatLon 40.12 (-71.34))
224 let distance = Distance 10.0 Miles
225 let optimizeBbox = OptimizeGeoFilterType GeoFilterMemory
226 let geoFilter = GeoDistanceFilter geoPoint distance SloppyArc optimizeBbox False
227 let search = mkSearch Nothing (Just geoFilter)
228 myTweet <- searchTweet search
229 myTweet `shouldBe` Right exampleTweet
231 it "returns document for geo distance range filter" $ do
232 _ <- insertData
233 let geoPoint = GeoPoint (FieldName "tweet.location") (LatLon 40.12 (-71.34))
234 let distanceRange = DistanceRange (Distance 0.0 Miles) (Distance 10.0 Miles)
235 let geoFilter = GeoDistanceRangeFilter geoPoint distanceRange
236 let search = mkSearch Nothing (Just geoFilter)
237 myTweet <- searchTweet search
238 myTweet `shouldBe` Right exampleTweet
240 it "doesn't return document for wild geo distance range filter" $ do
241 _ <- insertData
242 let geoPoint = GeoPoint (FieldName "tweet.location") (LatLon 40.12 (-71.34))
243 let distanceRange = DistanceRange (Distance 100.0 Miles) (Distance 1000.0 Miles)
244 let geoFilter = GeoDistanceRangeFilter geoPoint distanceRange
245 let search = mkSearch Nothing (Just geoFilter)
246 searchExpectNoResults search
248 it "returns document for geo polygon filter" $ do
249 _ <- insertData
250 let points = [LatLon 40.0 (-70.00),
251 LatLon 40.0 (-72.00),
252 LatLon 41.0 (-70.00),
253 LatLon 41.0 (-72.00)]
254 let geoFilter = GeoPolygonFilter (FieldName "tweet.location") points
255 let search = mkSearch Nothing (Just geoFilter)
256 myTweet <- searchTweet search
257 myTweet `shouldBe` Right exampleTweet
259 it "doesn't return document for bad geo polygon filter" $ do
260 _ <- insertData
261 let points = [LatLon 40.0 (-70.00),
262 LatLon 40.0 (-71.00),
263 LatLon 41.0 (-70.00),
264 LatLon 41.0 (-71.00)]
265 let geoFilter = GeoPolygonFilter (FieldName "tweet.location") points
266 let search = mkSearch Nothing (Just geoFilter)
267 searchExpectNoResults search
269 it "returns document for ids filter" $ do
270 _ <- insertData
271 let filter = IdsFilter (MappingName "tweet") [DocId "1"]
272 let search = mkSearch Nothing (Just filter)
273 myTweet <- searchTweet search
274 myTweet `shouldBe` Right exampleTweet
276 it "returns document for range filter" $ do
277 _ <- insertData
278 let filter = RangeFilter (FieldName "age")
279 (Right (RangeLtGt (LessThan 100000.0) (GreaterThan 1000.0)))
280 RangeExecutionIndex False
281 let search = mkSearch Nothing (Just filter)
282 myTweet <- searchTweet search
283 myTweet `shouldBe` Right exampleTweet
285 it "returns document for regexp filter" $ do
286 _ <- insertData
287 let filter = RegexpFilter (FieldName "user") (Regexp "bite.*app")
288 (RegexpFlags "ALL") (CacheName "test") False (CacheKey "key")
289 let search = mkSearch Nothing (Just filter)
290 myTweet <- searchTweet search
291 myTweet `shouldBe` Right exampleTweet
293 it "doesn't return document for non-matching regexp filter" $ do
294 _ <- insertData
295 let filter = RegexpFilter (FieldName "user")
296 (Regexp "boy") (RegexpFlags "ALL")
297 (CacheName "test") False (CacheKey "key")
298 let search = mkSearch Nothing (Just filter)
299 searchExpectNoResults search