git.iko.soy/typeable/bloodhound
on bf3c2a5 help sign in
245 lines 10 kB history raw
1{-# LANGUAGE DeriveGeneric #-}
3module Main where
5import Database.Bloodhound.Client
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) }
59insertData :: IO ()
60insertData = do
61 let encoded = encode exampleTweet
62 _ <- deleteExampleIndex
63 created <- createExampleIndex
64 mappingCreated <- createMapping testServer testIndex testMapping TweetMapping
65 docCreated <- indexDocument testServer testIndex testMapping exampleTweet (DocId "1")
66 _ <- refreshIndex testServer testIndex
67 return ()
69searchTweet :: Search -> IO (Either String Tweet)
70searchTweet search = do
71 reply <- searchByIndex testServer testIndex search
72 let result = eitherDecode (responseBody reply) :: Either String (SearchResult Tweet)
73 let myTweet = fmap (hitSource . head . hits . searchHits) result
74 return myTweet
76searchExpectNoResults :: Search -> IO ()
77searchExpectNoResults search = do
78 reply <- searchByIndex testServer testIndex search
79 let result = eitherDecode (responseBody reply) :: Either String (SearchResult Tweet)
80 let emptyHits = fmap (hits . searchHits) result
81 emptyHits `shouldBe` Right []
83data BulkTest = BulkTest { name :: Text } deriving (Eq, Generic, Show)
84instance FromJSON BulkTest
85instance ToJSON BulkTest
87main :: IO ()
88main = hspec $ do
90 describe "index create/delete API" $ do
91 it "creates and then deletes the requested index" $ do
92 -- priming state.
93 _ <- deleteExampleIndex
94 resp <- createExampleIndex
95 deleteResp <- deleteExampleIndex
96 validateStatus resp 200
97 validateStatus deleteResp 200
99 describe "document API" $ do
100 it "indexes, gets, and then deletes the generated document" $ do
101 _ <- insertData
102 docInserted <- getDocument testServer testIndex testMapping (DocId "1")
103 let newTweet = eitherDecode
104 (responseBody docInserted) :: Either String (EsResult Tweet)
105 fmap _source newTweet `shouldBe` Right exampleTweet
107 describe "bulk API" $ do
108 it "inserts all documents we request" $ do
109 _ <- insertData
110 let firstTest = BulkTest "blah"
111 let secondTest = BulkTest "bloo"
112 let firstDoc = BulkIndex (IndexName "twitter")
113 (MappingName "tweet") (DocId "2") (object ["name" .= String "blah"])
114 let secondDoc = BulkCreate (IndexName "twitter")
115 (MappingName "tweet") (DocId "3") (object ["name" .= String "bloo"])
116 let stream = [firstDoc, secondDoc]
117 response <- bulk testServer stream
118 _ <- refreshIndex testServer testIndex
119 fDoc <- getDocument testServer testIndex testMapping (DocId "2")
120 sDoc <- getDocument testServer testIndex testMapping (DocId "3")
121 let maybeFirst = eitherDecode $ responseBody fDoc :: Either String (EsResult BulkTest)
122 let maybeSecond = eitherDecode $ responseBody sDoc :: Either String (EsResult BulkTest)
123 fmap _source maybeFirst `shouldBe` Right firstTest
124 fmap _source maybeSecond `shouldBe` Right secondTest
126 describe "query API" $ do
127 it "returns document for term query and identity filter" $ do
128 _ <- insertData
129 let query = TermQuery (Term "user" "bitemyapp") Nothing
130 let filter = IdentityFilter <&&> IdentityFilter
131 let search = mkSearch (Just query) (Just filter)
132 myTweet <- searchTweet search
133 myTweet `shouldBe` Right exampleTweet
135 describe "filtering API" $ do
136 it "returns document for composed boolmatch and identity" $ do
137 _ <- insertData
138 let queryFilter = BoolFilter (MustMatch (Term "user" "bitemyapp") False)
139 <&&> IdentityFilter
140 let search = mkSearch Nothing (Just queryFilter)
141 myTweet <- searchTweet search
142 myTweet `shouldBe` Right exampleTweet
144 it "returns document for existential filter" $ do
145 _ <- insertData
146 let search = mkSearch Nothing (Just (ExistsFilter (FieldName "user")))
147 myTweet <- searchTweet search
148 myTweet `shouldBe` Right exampleTweet
150 it "returns document for geo boundingbox filter" $ do
151 _ <- insertData
152 let box = GeoBoundingBox (LatLon 40.73 (-74.1)) (LatLon 40.10 (-71.12))
153 let bbConstraint = GeoBoundingBoxConstraint (FieldName "tweet.location") box False
154 let geoFilter = GeoBoundingBoxFilter bbConstraint GeoFilterMemory
155 let search = mkSearch Nothing (Just geoFilter)
156 myTweet <- searchTweet search
157 myTweet `shouldBe` Right exampleTweet
159 it "doesn't return document for nonsensical boundingbox filter" $ do
160 _ <- insertData
161 let box = GeoBoundingBox (LatLon 0.73 (-4.1)) (LatLon 0.10 (-1.12))
162 let bbConstraint = GeoBoundingBoxConstraint (FieldName "tweet.location") box False
163 let geoFilter = GeoBoundingBoxFilter bbConstraint GeoFilterMemory
164 let search = mkSearch Nothing (Just geoFilter)
165 searchExpectNoResults search
167 it "returns document for geo distance filter" $ do
168 _ <- insertData
169 let geoPoint = GeoPoint (FieldName "tweet.location") (LatLon 40.12 (-71.34))
170 let distance = Distance 10.0 Miles
171 let optimizeBbox = OptimizeGeoFilterType GeoFilterMemory
172 let geoFilter = GeoDistanceFilter geoPoint distance SloppyArc optimizeBbox False
173 let search = mkSearch Nothing (Just geoFilter)
174 myTweet <- searchTweet search
175 myTweet `shouldBe` Right exampleTweet
177 it "returns document for geo distance range filter" $ do
178 _ <- insertData
179 let geoPoint = GeoPoint (FieldName "tweet.location") (LatLon 40.12 (-71.34))
180 let distanceRange = DistanceRange (Distance 0.0 Miles) (Distance 10.0 Miles)
181 let geoFilter = GeoDistanceRangeFilter geoPoint distanceRange
182 let search = mkSearch Nothing (Just geoFilter)
183 myTweet <- searchTweet search
184 myTweet `shouldBe` Right exampleTweet
186 it "doesn't return document for wild geo distance range filter" $ do
187 _ <- insertData
188 let geoPoint = GeoPoint (FieldName "tweet.location") (LatLon 40.12 (-71.34))
189 let distanceRange = DistanceRange (Distance 100.0 Miles) (Distance 1000.0 Miles)
190 let geoFilter = GeoDistanceRangeFilter geoPoint distanceRange
191 let search = mkSearch Nothing (Just geoFilter)
192 searchExpectNoResults search
194 it "returns document for geo polygon filter" $ do
195 _ <- insertData
196 let points = [LatLon 40.0 (-70.00),
197 LatLon 40.0 (-72.00),
198 LatLon 41.0 (-70.00),
199 LatLon 41.0 (-72.00)]
200 let geoFilter = GeoPolygonFilter (FieldName "tweet.location") points
201 let search = mkSearch Nothing (Just geoFilter)
202 myTweet <- searchTweet search
203 myTweet `shouldBe` Right exampleTweet
205 it "doesn't return document for bad geo polygon filter" $ do
206 _ <- insertData
207 let points = [LatLon 40.0 (-70.00),
208 LatLon 40.0 (-71.00),
209 LatLon 41.0 (-70.00),
210 LatLon 41.0 (-71.00)]
211 let geoFilter = GeoPolygonFilter (FieldName "tweet.location") points
212 let search = mkSearch Nothing (Just geoFilter)
213 searchExpectNoResults search
215 it "returns document for ids filter" $ do
216 _ <- insertData
217 let filter = IdsFilter (MappingName "tweet") [DocId "1"]
218 let search = mkSearch Nothing (Just filter)
219 myTweet <- searchTweet search
220 myTweet `shouldBe` Right exampleTweet
222 it "returns document for range filter" $ do
223 _ <- insertData
224 let filter = RangeFilter (FieldName "age")
225 (Right (RangeLtGt (LessThan 100000.0) (GreaterThan 1000.0)))
226 RangeExecutionIndex False
227 let search = mkSearch Nothing (Just filter)
228 myTweet <- searchTweet search
229 myTweet `shouldBe` Right exampleTweet
231 it "returns document for regexp filter" $ do
232 _ <- insertData
233 let filter = RegexpFilter (FieldName "user") (Regexp "bite.*app")
234 RegexpAll (CacheName "test") False (CacheKey "key")
235 let search = mkSearch Nothing (Just filter)
236 myTweet <- searchTweet search
237 myTweet `shouldBe` Right exampleTweet
239 it "doesn't return document for non-matching regexp filter" $ do
240 _ <- insertData
241 let filter = RegexpFilter (FieldName "user")
242 (Regexp "boy") RegexpAll
243 (CacheName "test") False (CacheKey "key")
244 let search = mkSearch Nothing (Just filter)
245 searchExpectNoResults search