1{-# LANGUAGE DeriveGeneric #-}
5import Database.Bloodhound.Client
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
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
35 , location :: Location }
36 deriving (Eq, Generic, Show)
39instance FromJSON Tweet
40instance ToJSON Location
41instance FromJSON Location
43data TweetMapping = TweetMapping deriving (Eq, Show)
45instance ToJSON TweetMapping where
48 object ["properties" .=
49 object ["location" .= object ["type" .= ("geo_point" :: Text)]]]]
51exampleTweet = Tweet { user = "bitemyapp"
53 (ModifiedJulianDay 55000)
54 (secondsToDiffTime 10)
55 , message = "Use haskell!"
57 , location = Location 40.12 (-71.34) }
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
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
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
90 describe "index create/delete API" $ do
91 it "creates and then deletes the requested index" $ do
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
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
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
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
138 let queryFilter = BoolFilter (MustMatch (Term "user" "bitemyapp") False)
140 let search = mkSearch Nothing (Just queryFilter)
141 myTweet <- searchTweet search
142 myTweet `shouldBe` Right exampleTweet
144 it "returns document for existential filter" $ do
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
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
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
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
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
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
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
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
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
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
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
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
keysesc to close
- j k
- move down, up
- enter
- open
- esc
- back, or up a level
- 1 2 3 4
- readme, files, commits, refs
- /
- filter
- y
- copy the clone command
- c
- compare the chosen commit with another (or shift-click both)
- ?
- show or hide this list