mirror of
https://github.com/typeable/bloodhound.git
synced 2024-12-16 10:39:45 +03:00
329 lines
13 KiB
Haskell
329 lines
13 KiB
Haskell
{-# LANGUAGE DeriveGeneric #-}
|
|
|
|
module Main where
|
|
|
|
import Database.Bloodhound
|
|
import Data.Aeson
|
|
import Data.Time.Calendar (Day(..))
|
|
import Data.Time.Clock (secondsToDiffTime, UTCTime(..))
|
|
import Data.Text (Text)
|
|
import GHC.Generics (Generic)
|
|
import Network.HTTP.Client
|
|
import qualified Network.HTTP.Types.Status as NHTS
|
|
import Prelude hiding (filter, putStrLn)
|
|
import Test.Hspec
|
|
|
|
testServer :: Server
|
|
testServer = Server "http://localhost:9200"
|
|
testIndex :: IndexName
|
|
testIndex = IndexName "bloodhound-tests-twitter-1"
|
|
testMapping :: MappingName
|
|
testMapping = MappingName "tweet"
|
|
|
|
validateStatus :: Response body -> Int -> Expectation
|
|
validateStatus resp expected =
|
|
(NHTS.statusCode $ responseStatus resp)
|
|
`shouldBe` (expected :: Int)
|
|
|
|
createExampleIndex :: IO Reply
|
|
createExampleIndex = createIndex testServer defaultIndexSettings testIndex
|
|
deleteExampleIndex :: IO Reply
|
|
deleteExampleIndex = deleteIndex testServer testIndex
|
|
|
|
data Location = Location { lat :: Double
|
|
, lon :: Double } deriving (Eq, Generic, Show)
|
|
|
|
data Tweet = Tweet { user :: Text
|
|
, postDate :: UTCTime
|
|
, message :: Text
|
|
, age :: Int
|
|
, location :: Location }
|
|
deriving (Eq, Generic, Show)
|
|
|
|
instance ToJSON Tweet
|
|
instance FromJSON Tweet
|
|
instance ToJSON Location
|
|
instance FromJSON Location
|
|
|
|
data TweetMapping = TweetMapping deriving (Eq, Show)
|
|
|
|
instance ToJSON TweetMapping where
|
|
toJSON TweetMapping =
|
|
object ["tweet" .=
|
|
object ["properties" .=
|
|
object ["location" .= object ["type" .= ("geo_point" :: Text)]]]]
|
|
|
|
exampleTweet :: Tweet
|
|
exampleTweet = Tweet { user = "bitemyapp"
|
|
, postDate = UTCTime
|
|
(ModifiedJulianDay 55000)
|
|
(secondsToDiffTime 10)
|
|
, message = "Use haskell!"
|
|
, age = 10000
|
|
, location = Location 40.12 (-71.34) }
|
|
|
|
otherTweet :: Tweet
|
|
otherTweet = Tweet { user = "notmyapp"
|
|
, postDate = UTCTime
|
|
(ModifiedJulianDay 55000)
|
|
(secondsToDiffTime 11)
|
|
, message = "Use haskell!"
|
|
, age = 1000
|
|
, location = Location 40.12 (-71.34) }
|
|
|
|
insertData :: IO ()
|
|
insertData = do
|
|
_ <- deleteExampleIndex
|
|
_ <- createExampleIndex
|
|
_ <- createMapping testServer testIndex testMapping TweetMapping
|
|
_ <- indexDocument testServer testIndex testMapping exampleTweet (DocId "1")
|
|
_ <- refreshIndex testServer testIndex
|
|
return ()
|
|
|
|
insertOther :: IO ()
|
|
insertOther = do
|
|
_ <- indexDocument testServer testIndex testMapping otherTweet (DocId "2")
|
|
_ <- refreshIndex testServer testIndex
|
|
return ()
|
|
|
|
searchTweet :: Search -> IO (Either String Tweet)
|
|
searchTweet search = do
|
|
reply <- searchByIndex testServer testIndex search
|
|
let result = eitherDecode (responseBody reply) :: Either String (SearchResult Tweet)
|
|
let myTweet = fmap (hitSource . head . hits . searchHits) result
|
|
return myTweet
|
|
|
|
searchExpectNoResults :: Search -> IO ()
|
|
searchExpectNoResults search = do
|
|
reply <- searchByIndex testServer testIndex search
|
|
let result = eitherDecode (responseBody reply) :: Either String (SearchResult Tweet)
|
|
let emptyHits = fmap (hits . searchHits) result
|
|
emptyHits `shouldBe` Right []
|
|
|
|
data BulkTest = BulkTest { name :: Text } deriving (Eq, Generic, Show)
|
|
instance FromJSON BulkTest
|
|
instance ToJSON BulkTest
|
|
|
|
main :: IO ()
|
|
main = hspec $ do
|
|
|
|
describe "index create/delete API" $ do
|
|
it "creates and then deletes the requested index" $ do
|
|
-- priming state.
|
|
_ <- deleteExampleIndex
|
|
resp <- createExampleIndex
|
|
deleteResp <- deleteExampleIndex
|
|
validateStatus resp 200
|
|
validateStatus deleteResp 200
|
|
|
|
|
|
describe "document API" $ do
|
|
it "indexes, gets, and then deletes the generated document" $ do
|
|
_ <- insertData
|
|
docInserted <- getDocument testServer testIndex testMapping (DocId "1")
|
|
let newTweet = eitherDecode
|
|
(responseBody docInserted) :: Either String (EsResult Tweet)
|
|
fmap _source newTweet `shouldBe` Right exampleTweet
|
|
|
|
|
|
describe "bulk API" $ do
|
|
it "inserts all documents we request" $ do
|
|
_ <- insertData
|
|
let firstTest = BulkTest "blah"
|
|
let secondTest = BulkTest "bloo"
|
|
let firstDoc = BulkIndex testIndex
|
|
testMapping (DocId "2") (object ["name" .= String "blah"])
|
|
let secondDoc = BulkCreate testIndex
|
|
testMapping (DocId "3") (object ["name" .= String "bloo"])
|
|
let stream = [firstDoc, secondDoc]
|
|
_ <- bulk testServer stream
|
|
_ <- refreshIndex testServer testIndex
|
|
fDoc <- getDocument testServer testIndex testMapping (DocId "2")
|
|
sDoc <- getDocument testServer testIndex testMapping (DocId "3")
|
|
let maybeFirst = eitherDecode $ responseBody fDoc :: Either String (EsResult BulkTest)
|
|
let maybeSecond = eitherDecode $ responseBody sDoc :: Either String (EsResult BulkTest)
|
|
fmap _source maybeFirst `shouldBe` Right firstTest
|
|
fmap _source maybeSecond `shouldBe` Right secondTest
|
|
|
|
|
|
describe "query API" $ do
|
|
it "returns document for term query and identity filter" $ do
|
|
_ <- insertData
|
|
let query = TermQuery (Term "user" "bitemyapp") Nothing
|
|
let filter = IdentityFilter <&&> IdentityFilter
|
|
let search = mkSearch (Just query) (Just filter)
|
|
myTweet <- searchTweet search
|
|
myTweet `shouldBe` Right exampleTweet
|
|
|
|
it "returns document for match query" $ do
|
|
_ <- insertData
|
|
let query = QueryMatchQuery $ mkMatchQuery (FieldName "user") (QueryString "bitemyapp")
|
|
let search = mkSearch (Just query) Nothing
|
|
myTweet <- searchTweet search
|
|
myTweet `shouldBe` Right exampleTweet
|
|
|
|
it "returns document for multi-match query" $ do
|
|
_ <- insertData
|
|
let fields = [FieldName "user", FieldName "message"]
|
|
let query = QueryMultiMatchQuery $ mkMultiMatchQuery fields (QueryString "bitemyapp")
|
|
let search = mkSearch (Just query) Nothing
|
|
myTweet <- searchTweet search
|
|
myTweet `shouldBe` Right exampleTweet
|
|
|
|
it "returns document for bool query" $ do
|
|
_ <- insertData
|
|
let innerQuery = QueryMatchQuery $
|
|
mkMatchQuery (FieldName "user") (QueryString "bitemyapp")
|
|
let query = QueryBoolQuery $
|
|
mkBoolQuery (Just innerQuery) Nothing Nothing
|
|
let search = mkSearch (Just query) Nothing
|
|
myTweet <- searchTweet search
|
|
myTweet `shouldBe` Right exampleTweet
|
|
|
|
it "returns document for boosting query" $ do
|
|
_ <- insertData
|
|
let posQuery = QueryMatchQuery $ mkMatchQuery (FieldName "user") (QueryString "bitemyapp")
|
|
let negQuery = QueryMatchQuery $ mkMatchQuery (FieldName "user") (QueryString "notmyapp")
|
|
let query = QueryBoostingQuery $ BoostingQuery posQuery negQuery (Boost 0.2)
|
|
let search = mkSearch (Just query) Nothing
|
|
myTweet <- searchTweet search
|
|
myTweet `shouldBe` Right exampleTweet
|
|
|
|
it "returns document for common terms query" $ do
|
|
_ <- insertData
|
|
let query = QueryCommonTermsQuery $
|
|
CommonTermsQuery (FieldName "user")
|
|
(QueryString "bitemyapp")
|
|
(CutoffFrequency 0.0001)
|
|
Or Or Nothing Nothing Nothing Nothing
|
|
let search = mkSearch (Just query) Nothing
|
|
myTweet <- searchTweet search
|
|
myTweet `shouldBe` Right exampleTweet
|
|
|
|
|
|
describe "sorting" $ do
|
|
it "returns documents in the right order" $ do
|
|
_ <- insertData
|
|
_ <- insertOther
|
|
let sortSpec = DefaultSortSpec $ mkSort (FieldName "age") Ascending
|
|
let search = Search Nothing
|
|
(Just IdentityFilter) (Just [sortSpec])
|
|
False 0 10
|
|
reply <- searchByIndex testServer testIndex search
|
|
let result = eitherDecode (responseBody reply) :: Either String (SearchResult Tweet)
|
|
let myTweet = fmap (hitSource . head . hits . searchHits) result
|
|
myTweet `shouldBe` Right otherTweet
|
|
|
|
|
|
describe "filtering API" $ do
|
|
it "returns document for composed boolmatch and identity" $ do
|
|
_ <- insertData
|
|
let queryFilter = BoolFilter (MustMatch (Term "user" "bitemyapp") False)
|
|
<&&> IdentityFilter
|
|
let search = mkSearch Nothing (Just queryFilter)
|
|
myTweet <- searchTweet search
|
|
myTweet `shouldBe` Right exampleTweet
|
|
|
|
it "returns document for existential filter" $ do
|
|
_ <- insertData
|
|
let search = mkSearch Nothing (Just (ExistsFilter (FieldName "user")))
|
|
myTweet <- searchTweet search
|
|
myTweet `shouldBe` Right exampleTweet
|
|
|
|
it "returns document for geo boundingbox filter" $ do
|
|
_ <- insertData
|
|
let box = GeoBoundingBox (LatLon 40.73 (-74.1)) (LatLon 40.10 (-71.12))
|
|
let bbConstraint = GeoBoundingBoxConstraint (FieldName "tweet.location") box False
|
|
let geoFilter = GeoBoundingBoxFilter bbConstraint GeoFilterMemory
|
|
let search = mkSearch Nothing (Just geoFilter)
|
|
myTweet <- searchTweet search
|
|
myTweet `shouldBe` Right exampleTweet
|
|
|
|
it "doesn't return document for nonsensical boundingbox filter" $ do
|
|
_ <- insertData
|
|
let box = GeoBoundingBox (LatLon 0.73 (-4.1)) (LatLon 0.10 (-1.12))
|
|
let bbConstraint = GeoBoundingBoxConstraint (FieldName "tweet.location") box False
|
|
let geoFilter = GeoBoundingBoxFilter bbConstraint GeoFilterMemory
|
|
let search = mkSearch Nothing (Just geoFilter)
|
|
searchExpectNoResults search
|
|
|
|
it "returns document for geo distance filter" $ do
|
|
_ <- insertData
|
|
let geoPoint = GeoPoint (FieldName "tweet.location") (LatLon 40.12 (-71.34))
|
|
let distance = Distance 10.0 Miles
|
|
let optimizeBbox = OptimizeGeoFilterType GeoFilterMemory
|
|
let geoFilter = GeoDistanceFilter geoPoint distance SloppyArc optimizeBbox False
|
|
let search = mkSearch Nothing (Just geoFilter)
|
|
myTweet <- searchTweet search
|
|
myTweet `shouldBe` Right exampleTweet
|
|
|
|
it "returns document for geo distance range filter" $ do
|
|
_ <- insertData
|
|
let geoPoint = GeoPoint (FieldName "tweet.location") (LatLon 40.12 (-71.34))
|
|
let distanceRange = DistanceRange (Distance 0.0 Miles) (Distance 10.0 Miles)
|
|
let geoFilter = GeoDistanceRangeFilter geoPoint distanceRange
|
|
let search = mkSearch Nothing (Just geoFilter)
|
|
myTweet <- searchTweet search
|
|
myTweet `shouldBe` Right exampleTweet
|
|
|
|
it "doesn't return document for wild geo distance range filter" $ do
|
|
_ <- insertData
|
|
let geoPoint = GeoPoint (FieldName "tweet.location") (LatLon 40.12 (-71.34))
|
|
let distanceRange = DistanceRange (Distance 100.0 Miles) (Distance 1000.0 Miles)
|
|
let geoFilter = GeoDistanceRangeFilter geoPoint distanceRange
|
|
let search = mkSearch Nothing (Just geoFilter)
|
|
searchExpectNoResults search
|
|
|
|
it "returns document for geo polygon filter" $ do
|
|
_ <- insertData
|
|
let points = [LatLon 40.0 (-70.00),
|
|
LatLon 40.0 (-72.00),
|
|
LatLon 41.0 (-70.00),
|
|
LatLon 41.0 (-72.00)]
|
|
let geoFilter = GeoPolygonFilter (FieldName "tweet.location") points
|
|
let search = mkSearch Nothing (Just geoFilter)
|
|
myTweet <- searchTweet search
|
|
myTweet `shouldBe` Right exampleTweet
|
|
|
|
it "doesn't return document for bad geo polygon filter" $ do
|
|
_ <- insertData
|
|
let points = [LatLon 40.0 (-70.00),
|
|
LatLon 40.0 (-71.00),
|
|
LatLon 41.0 (-70.00),
|
|
LatLon 41.0 (-71.00)]
|
|
let geoFilter = GeoPolygonFilter (FieldName "tweet.location") points
|
|
let search = mkSearch Nothing (Just geoFilter)
|
|
searchExpectNoResults search
|
|
|
|
it "returns document for ids filter" $ do
|
|
_ <- insertData
|
|
let filter = IdsFilter (MappingName "tweet") [DocId "1"]
|
|
let search = mkSearch Nothing (Just filter)
|
|
myTweet <- searchTweet search
|
|
myTweet `shouldBe` Right exampleTweet
|
|
|
|
it "returns document for range filter" $ do
|
|
_ <- insertData
|
|
let filter = RangeFilter (FieldName "age")
|
|
(Right (RangeLtGt (LessThan 100000.0) (GreaterThan 1000.0)))
|
|
RangeExecutionIndex False
|
|
let search = mkSearch Nothing (Just filter)
|
|
myTweet <- searchTweet search
|
|
myTweet `shouldBe` Right exampleTweet
|
|
|
|
it "returns document for regexp filter" $ do
|
|
_ <- insertData
|
|
let filter = RegexpFilter (FieldName "user") (Regexp "bite.*app")
|
|
(RegexpFlags "ALL") (CacheName "test") False (CacheKey "key")
|
|
let search = mkSearch Nothing (Just filter)
|
|
myTweet <- searchTweet search
|
|
myTweet `shouldBe` Right exampleTweet
|
|
|
|
it "doesn't return document for non-matching regexp filter" $ do
|
|
_ <- insertData
|
|
let filter = RegexpFilter (FieldName "user")
|
|
(Regexp "boy") (RegexpFlags "ALL")
|
|
(CacheName "test") False (CacheKey "key")
|
|
let search = mkSearch Nothing (Just filter)
|
|
searchExpectNoResults search
|