git.iko.soy/typeable/bloodhound
on ce3e658 help sign in
typeable/bloodhound/tests/tests.hs
272 lines 11 kB history raw
1{-# LANGUAGE DeriveGeneric #-}
3module Main where
5import Database.Bloodhound
6import Data.Aeson
7import Data.Either (Either(..))
8import Data.Maybe (fromJust)
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 Test.Hspec
17testServer = Server "http://localhost:9200"
18testIndex = IndexName "twitter"
19testMapping = MappingName "tweet"
21validateStatus resp expected =
22 (NHTS.statusCode $ responseStatus resp)
23 `shouldBe` (expected :: Int)
25createExampleIndex = createIndex testServer defaultIndexSettings testIndex
26deleteExampleIndex = deleteIndex testServer testIndex
28data Location = Location { lat :: Double
29 , lon :: Double } deriving (Eq, Generic, Show)
31data Tweet = Tweet { user :: Text
32 , postDate :: UTCTime
33 , message :: Text
34 , age :: Int
35 , location :: Location }
36 deriving (Eq, Generic, Show)
38instance ToJSON Tweet
39instance FromJSON Tweet
40instance ToJSON Location
41instance FromJSON Location
43data TweetMapping = TweetMapping deriving (Eq, Show)
45instance ToJSON TweetMapping where
46 toJSON TweetMapping =
47 object ["tweet" .=
48 object ["properties" .=
49 object ["location" .= object ["type" .= ("geo_point" :: Text)]]]]
51exampleTweet = Tweet { user = "bitemyapp"
52 , postDate = UTCTime
53 (ModifiedJulianDay 55000)
54 (secondsToDiffTime 10)
55 , message = "Use haskell!"
56 , age = 10000
57 , location = Location 40.12 (-71.34) }
59otherTweet = Tweet { user = "notmyapp"
60 , postDate = UTCTime
61 (ModifiedJulianDay 55000)
62 (secondsToDiffTime 11)
63 , message = "Use haskell!"
64 , age = 1000
65 , location = Location 40.12 (-71.34) }
67insertData :: IO ()
68insertData = do
69 let encoded = encode exampleTweet
70 _ <- deleteExampleIndex
71 created <- createExampleIndex
72 mappingCreated <- createMapping testServer testIndex testMapping TweetMapping
73 docCreated <- indexDocument testServer testIndex testMapping exampleTweet (DocId "1")
74 _ <- refreshIndex testServer testIndex
75 return ()
77insertOther :: IO ()
78insertOther = do
79 docCreated <- indexDocument testServer testIndex testMapping otherTweet (DocId "2")
80 _ <- refreshIndex testServer testIndex
81 return ()
83searchTweet :: Search -> IO (Either String Tweet)
84searchTweet search = do
85 reply <- searchByIndex testServer testIndex search
86 let result = eitherDecode (responseBody reply) :: Either String (SearchResult Tweet)
87 let myTweet = fmap (hitSource . head . hits . searchHits) result
88 return myTweet
90searchExpectNoResults :: Search -> IO ()
91searchExpectNoResults search = do
92 reply <- searchByIndex testServer testIndex search
93 let result = eitherDecode (responseBody reply) :: Either String (SearchResult Tweet)
94 let emptyHits = fmap (hits . searchHits) result
95 emptyHits `shouldBe` Right []
97data BulkTest = BulkTest { name :: Text } deriving (Eq, Generic, Show)
98instance FromJSON BulkTest
99instance ToJSON BulkTest
101main :: IO ()
102main = hspec $ do
104 describe "index create/delete API" $ do
105 it "creates and then deletes the requested index" $ do
106 -- priming state.
107 _ <- deleteExampleIndex
108 resp <- createExampleIndex
109 deleteResp <- deleteExampleIndex
110 validateStatus resp 200
111 validateStatus deleteResp 200
113 describe "document API" $ do
114 it "indexes, gets, and then deletes the generated document" $ do
115 _ <- insertData
116 docInserted <- getDocument testServer testIndex testMapping (DocId "1")
117 let newTweet = eitherDecode
118 (responseBody docInserted) :: Either String (EsResult Tweet)
119 fmap _source newTweet `shouldBe` Right exampleTweet
121 describe "bulk API" $ do
122 it "inserts all documents we request" $ do
123 _ <- insertData
124 let firstTest = BulkTest "blah"
125 let secondTest = BulkTest "bloo"
126 let firstDoc = BulkIndex (IndexName "twitter")
127 (MappingName "tweet") (DocId "2") (object ["name" .= String "blah"])
128 let secondDoc = BulkCreate (IndexName "twitter")
129 (MappingName "tweet") (DocId "3") (object ["name" .= String "bloo"])
130 let stream = [firstDoc, secondDoc]
131 response <- bulk testServer stream
132 _ <- refreshIndex testServer testIndex
133 fDoc <- getDocument testServer testIndex testMapping (DocId "2")
134 sDoc <- getDocument testServer testIndex testMapping (DocId "3")
135 let maybeFirst = eitherDecode $ responseBody fDoc :: Either String (EsResult BulkTest)
136 let maybeSecond = eitherDecode $ responseBody sDoc :: Either String (EsResult BulkTest)
137 fmap _source maybeFirst `shouldBe` Right firstTest
138 fmap _source maybeSecond `shouldBe` Right secondTest
140 describe "query API" $ do
141 it "returns document for term query and identity filter" $ do
142 _ <- insertData
143 let query = TermQuery (Term "user" "bitemyapp") Nothing
144 let filter = IdentityFilter <&&> IdentityFilter
145 let search = mkSearch (Just query) (Just filter)
146 myTweet <- searchTweet search
147 myTweet `shouldBe` Right exampleTweet
149 describe "sorting" $ do
150 it "returns documents in the right order" $ do
151 _ <- insertData
152 _ <- insertOther
153 let sortSpec = DefaultSortSpec $ mkSort (FieldName "age") Ascending
154 let search = Search Nothing
155 (Just IdentityFilter) (Just [sortSpec])
156 False 0 10
157 reply <- searchByIndex testServer testIndex search
158 let result = eitherDecode (responseBody reply) :: Either String (SearchResult Tweet)
159 let myTweet = fmap (hitSource . head . hits . searchHits) result
160 myTweet `shouldBe` Right otherTweet
162 describe "filtering API" $ do
163 it "returns document for composed boolmatch and identity" $ do
164 _ <- insertData
165 let queryFilter = BoolFilter (MustMatch (Term "user" "bitemyapp") False)
166 <&&> IdentityFilter
167 let search = mkSearch Nothing (Just queryFilter)
168 myTweet <- searchTweet search
169 myTweet `shouldBe` Right exampleTweet
171 it "returns document for existential filter" $ do
172 _ <- insertData
173 let search = mkSearch Nothing (Just (ExistsFilter (FieldName "user")))
174 myTweet <- searchTweet search
175 myTweet `shouldBe` Right exampleTweet
177 it "returns document for geo boundingbox filter" $ do
178 _ <- insertData
179 let box = GeoBoundingBox (LatLon 40.73 (-74.1)) (LatLon 40.10 (-71.12))
180 let bbConstraint = GeoBoundingBoxConstraint (FieldName "tweet.location") box False
181 let geoFilter = GeoBoundingBoxFilter bbConstraint GeoFilterMemory
182 let search = mkSearch Nothing (Just geoFilter)
183 myTweet <- searchTweet search
184 myTweet `shouldBe` Right exampleTweet
186 it "doesn't return document for nonsensical boundingbox filter" $ do
187 _ <- insertData
188 let box = GeoBoundingBox (LatLon 0.73 (-4.1)) (LatLon 0.10 (-1.12))
189 let bbConstraint = GeoBoundingBoxConstraint (FieldName "tweet.location") box False
190 let geoFilter = GeoBoundingBoxFilter bbConstraint GeoFilterMemory
191 let search = mkSearch Nothing (Just geoFilter)
192 searchExpectNoResults search
194 it "returns document for geo distance filter" $ do
195 _ <- insertData
196 let geoPoint = GeoPoint (FieldName "tweet.location") (LatLon 40.12 (-71.34))
197 let distance = Distance 10.0 Miles
198 let optimizeBbox = OptimizeGeoFilterType GeoFilterMemory
199 let geoFilter = GeoDistanceFilter geoPoint distance SloppyArc optimizeBbox False
200 let search = mkSearch Nothing (Just geoFilter)
201 myTweet <- searchTweet search
202 myTweet `shouldBe` Right exampleTweet
204 it "returns document for geo distance range filter" $ do
205 _ <- insertData
206 let geoPoint = GeoPoint (FieldName "tweet.location") (LatLon 40.12 (-71.34))
207 let distanceRange = DistanceRange (Distance 0.0 Miles) (Distance 10.0 Miles)
208 let geoFilter = GeoDistanceRangeFilter geoPoint distanceRange
209 let search = mkSearch Nothing (Just geoFilter)
210 myTweet <- searchTweet search
211 myTweet `shouldBe` Right exampleTweet
213 it "doesn't return document for wild geo distance range filter" $ do
214 _ <- insertData
215 let geoPoint = GeoPoint (FieldName "tweet.location") (LatLon 40.12 (-71.34))
216 let distanceRange = DistanceRange (Distance 100.0 Miles) (Distance 1000.0 Miles)
217 let geoFilter = GeoDistanceRangeFilter geoPoint distanceRange
218 let search = mkSearch Nothing (Just geoFilter)
219 searchExpectNoResults search
221 it "returns document for geo polygon filter" $ do
222 _ <- insertData
223 let points = [LatLon 40.0 (-70.00),
224 LatLon 40.0 (-72.00),
225 LatLon 41.0 (-70.00),
226 LatLon 41.0 (-72.00)]
227 let geoFilter = GeoPolygonFilter (FieldName "tweet.location") points
228 let search = mkSearch Nothing (Just geoFilter)
229 myTweet <- searchTweet search
230 myTweet `shouldBe` Right exampleTweet
232 it "doesn't return document for bad geo polygon filter" $ do
233 _ <- insertData
234 let points = [LatLon 40.0 (-70.00),
235 LatLon 40.0 (-71.00),
236 LatLon 41.0 (-70.00),
237 LatLon 41.0 (-71.00)]
238 let geoFilter = GeoPolygonFilter (FieldName "tweet.location") points
239 let search = mkSearch Nothing (Just geoFilter)
240 searchExpectNoResults search
242 it "returns document for ids filter" $ do
243 _ <- insertData
244 let filter = IdsFilter (MappingName "tweet") [DocId "1"]
245 let search = mkSearch Nothing (Just filter)
246 myTweet <- searchTweet search
247 myTweet `shouldBe` Right exampleTweet
249 it "returns document for range filter" $ do
250 _ <- insertData
251 let filter = RangeFilter (FieldName "age")
252 (Right (RangeLtGt (LessThan 100000.0) (GreaterThan 1000.0)))
253 RangeExecutionIndex False
254 let search = mkSearch Nothing (Just filter)
255 myTweet <- searchTweet search
256 myTweet `shouldBe` Right exampleTweet
258 it "returns document for regexp filter" $ do
259 _ <- insertData
260 let filter = RegexpFilter (FieldName "user") (Regexp "bite.*app")
261 RegexpAll (CacheName "test") False (CacheKey "key")
262 let search = mkSearch Nothing (Just filter)
263 myTweet <- searchTweet search
264 myTweet `shouldBe` Right exampleTweet
266 it "doesn't return document for non-matching regexp filter" $ do
267 _ <- insertData
268 let filter = RegexpFilter (FieldName "user")
269 (Regexp "boy") RegexpAll
270 (CacheName "test") False (CacheKey "key")
271 let search = mkSearch Nothing (Just filter)
272 searchExpectNoResults search