bloodhound-0.1.0.2: tests/tests.hs
{-# 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