git.iko.soy/typeable/bloodhound
on 9024fcb help sign in
typeable/bloodhound/tests/V5/Test/Aggregation.hs
147 lines 7.9 kB history raw
1{-# LANGUAGE OverloadedStrings #-}
3module Test.Aggregation (spec) where
5import Test.Common
6import Test.Import
8import Control.Error (fmapL, note)
9import qualified Data.Map as M
10import qualified Database.V5.Bloodhound
12spec :: Spec
13spec =
14 describe "Aggregation API" $ do
15 it "returns term aggregation results" $ withTestEnv $ do
16 _ <- insertData
17 let terms = TermsAgg $ mkTermsAggregation "user"
18 let search = mkAggregateSearch Nothing $ mkAggregations "users" terms
19 searchExpectAggs search
20 searchValidBucketAgg search "users" toTerms
22 it "return sub-aggregation results" $ withTestEnv $ do
23 _ <- insertData
24 let subaggs = mkAggregations "age_agg" . TermsAgg $ mkTermsAggregation "age"
25 agg = TermsAgg $ (mkTermsAggregation "user") { termAggs = Just subaggs}
26 search = mkAggregateSearch Nothing $ mkAggregations "users" agg
27 reply <- searchByIndex testIndex search
28 let result = decode (responseBody reply) :: Maybe (SearchResult Tweet)
29 usersAggResults = result >>= aggregations >>= toTerms "users"
30 subAggResults = usersAggResults >>= (listToMaybe . buckets) >>= termsAggs >>= toTerms "age_agg"
31 subAddResultsExists = isJust subAggResults
32 liftIO $ subAddResultsExists `shouldBe` True
34 it "returns cardinality aggregation results" $ withTestEnv $ do
35 _ <- insertData
36 let cardinality = CardinalityAgg $ mkCardinalityAggregation $ FieldName "user"
37 let search = mkAggregateSearch Nothing $ mkAggregations "users" cardinality
38 let search' = search { Database.V5.Bloodhound.from = From 0, size = Size 0 }
39 searchExpectAggs search'
40 let docCountPair k n = (k, object ["value" .= Number n])
41 res <- searchTweets search'
42 liftIO $
43 fmap aggregations res `shouldBe` Right (Just (M.fromList [ docCountPair "users" 1]))
45 it "returns stats aggregation results" $ withTestEnv $ do
46 _ <- insertData
47 let stats = StatsAgg $ mkStatsAggregation $ FieldName "age"
48 let search = mkAggregateSearch Nothing $ mkAggregations "users" stats
49 let search' = search { Database.V5.Bloodhound.from = From 0, size = Size 0 }
50 searchExpectAggs search'
51 let statsAggRes k n = (k, object [ "max" .= Number n
52 , "avg" .= Number n
53 , "count" .= Number 1
54 , "min" .= Number n
55 , "sum" .= Number n])
56 res <- searchTweets search'
57 liftIO $
58 fmap aggregations res `shouldBe` Right (Just (M.fromList [ statsAggRes "users" 10000]))
60 it "can give collection hint parameters to term aggregations" $ when' (atleast es13) $ withTestEnv $ do
61 _ <- insertData
62 let terms = TermsAgg $ (mkTermsAggregation "user") { termCollectMode = Just BreadthFirst }
63 let search = mkAggregateSearch Nothing $ mkAggregations "users" terms
64 searchExpectAggs search
65 searchValidBucketAgg search "users" toTerms
67 -- One of these fails with 1.7.3
68 it "can give execution hint parameters to term aggregations" $ when' (atmost es11) $ withTestEnv $ do
69 _ <- insertData
70 searchTermsAggHint [Map, Ordinals]
72 it "can give execution hint parameters to term aggregations" $ when' (is es12) $ withTestEnv $ do
73 _ <- insertData
74 searchTermsAggHint [GlobalOrdinals, GlobalOrdinalsHash, GlobalOrdinalsLowCardinality, Map, Ordinals]
76 it "can give execution hint parameters to term aggregations" $ when' (atleast es12) $ withTestEnv $ do
77 _ <- insertData
78 searchTermsAggHint [GlobalOrdinals, GlobalOrdinalsHash, GlobalOrdinalsLowCardinality, Map]
79 -- One of the above.
81 it "can execute value_count aggregations" $ withTestEnv $ do
82 _ <- insertData
83 _ <- insertOther
84 let ags = mkAggregations "user_count" (ValueCountAgg (FieldValueCount (FieldName "user"))) <>
85 mkAggregations "bogus_count" (ValueCountAgg (FieldValueCount (FieldName "bogus")))
86 let search = mkAggregateSearch Nothing ags
87 let docCountPair k n = (k, object ["value" .= Number n])
88 res <- searchTweets search
89 liftIO $
90 fmap aggregations res `shouldBe` Right (Just (M.fromList [ docCountPair "user_count" 2
91 , docCountPair "bogus_count" 0
92 ]))
94 it "can execute date_range aggregations" $ withTestEnv $ do
95 let now = fromGregorian 2015 3 14
96 let ltAMonthAgo = UTCTime (fromGregorian 2015 3 1) 0
97 let ltAWeekAgo = UTCTime (fromGregorian 2015 3 10) 0
98 let oldDoc = exampleTweet { postDate = ltAMonthAgo }
99 let newDoc = exampleTweet { postDate = ltAWeekAgo }
100 _ <- indexDocument testIndex testMapping defaultIndexDocumentSettings oldDoc (DocId "1")
101 _ <- indexDocument testIndex testMapping defaultIndexDocumentSettings newDoc (DocId "2")
102 _ <- refreshIndex testIndex
103 let thisMonth = DateRangeFrom (DateMathExpr (DMDate now) [SubtractTime 1 DMMonth])
104 let thisWeek = DateRangeFrom (DateMathExpr (DMDate now) [SubtractTime 1 DMWeek])
105 let agg = DateRangeAggregation (FieldName "postDate") Nothing (thisMonth :| [thisWeek])
106 let ags = mkAggregations "date_ranges" (DateRangeAgg agg)
107 let search = mkAggregateSearch Nothing ags
108 res <- searchTweets search
109 liftIO $ hitsTotal . searchHits <$> res `shouldBe` Right 2
110 let bucks = do magrs <- fmapL show (aggregations <$> res)
111 agrs <- note "no aggregations returned" magrs
112 rawBucks <- note "no date_ranges aggregation" $ M.lookup "date_ranges" agrs
113 parseEither parseJSON rawBucks
114 let fromMonthT = UTCTime (fromGregorian 2015 2 14) 0
115 let fromWeekT = UTCTime (fromGregorian 2015 3 7) 0
116 liftIO $ buckets <$> bucks `shouldBe` Right [ DateRangeResult "2015-02-14T00:00:00.000Z-*"
117 (Just fromMonthT)
118 (Just "2015-02-14T00:00:00.000Z")
119 Nothing
120 Nothing
121 2
122 Nothing
123 , DateRangeResult "2015-03-07T00:00:00.000Z-*"
124 (Just fromWeekT)
125 (Just "2015-03-07T00:00:00.000Z")
126 Nothing
127 Nothing
128 1
129 Nothing
130 ]
132 it "returns date histogram aggregation results" $ withTestEnv $ do
133 _ <- insertData
134 let histogram = DateHistogramAgg $ mkDateHistogram (FieldName "postDate") Minute
135 let search = mkAggregateSearch Nothing (mkAggregations "byDate" histogram)
136 searchExpectAggs search
137 searchValidBucketAgg search "byDate" toDateHistogram
139 it "can execute missing aggregations" $ withTestEnv $ do
140 _ <- insertData
141 _ <- insertExtra
142 let ags = mkAggregations "missing_agg" (MissingAgg (MissingAggregation "extra"))
143 let search = mkAggregateSearch Nothing ags
144 let docCountPair k n = (k, object ["doc_count" .= Number n])
145 res <- searchTweets search
146 liftIO $
147 fmap aggregations res `shouldBe` Right (Just (M.fromList [docCountPair "missing_agg" 1]))