d9061cd · typeable/bloodhound

git.iko.soy/typeable/bloodhound

merged

commitd9061cdb7b2a6513b3b18f6012e2cc342729e259 authorChris Allen <cma@bitemyapp.com> dateMon 14 Sep 2015, 00:36 (11 years ago) parent50f5bfb 09074d7

3 files changed+140−43

compare with master

unifiedsplit

src/Database/Bloodhound/Client.hs+24−22 src/Database/Bloodhound/Types.hs+66−20 tests/tests.hs+50−1

src/Database/Bloodhound/Client.hs+24−22

@@ -173,16 +173,16 @@ joinPath ps = do

173173 return $ joinPath' (s:ps)

174174

175175appendSearchTypeParam :: Text -> SearchType -> Text

176−appendSearchTypeParam originalUrl st = addQuery [(keyEq, Just stParams)] originalUrl

177− where keyEq = "search_type="

178− stParams

179− | st == SearchTypeDfsQueryThenFetch = "dfs_query_then_fetch"

180− | st == SearchTypeCount = "count"

181− | st == SearchTypeScan = "scan&scroll=1m"

182− | st == SearchTypeQueryAndFetch = "query_and_fetch"

183− | st == SearchTypeDfsQueryAndFetch = "dfs_query_and_fetch"

176+appendSearchTypeParam originalUrl st = addQuery params originalUrl

177+ where stText = "search_type"

178+ params

179+ | st == SearchTypeDfsQueryThenFetch = [(stText, Just "dfs_query_then_fetch")]

180+ | st == SearchTypeCount = [(stText, Just "count")]

181+ | st == SearchTypeScan = [(stText, Just "scan"), ("scroll", Just "1m")]

182+ | st == SearchTypeQueryAndFetch = [(stText, Just "query_and_fetch")]

183+ | st == SearchTypeDfsQueryAndFetch = [(stText, Just "dfs_query_and_fetch")]

184184 -- used to catch 'SearchTypeQueryThenFetch', which is also the default

185− | otherwise = "query_then_fetch"

185+ | otherwise = [(stText, Just "query_then_fetch")]

186186

187187-- | Severely dumbed down query renderer. Assumes your data doesn't

188188-- need any encoding

@@ -543,13 +543,13 @@ searchByType (IndexName indexName)

543543 (MappingName mappingName) = bindM2 dispatchSearch url . return

544544 where url = joinPath [indexName, mappingName, "_search"]

545545

546−scanSearch' :: MonadBH m => Search -> m (Maybe ScrollId)

547−scanSearch' search = do

548− let url = joinPath ["_search"]

546+scanSearch' :: MonadBH m => IndexName -> MappingName -> Search -> m (Maybe ScrollId)

547+scanSearch' (IndexName indexName) (MappingName mappingName) search = do

548+ let url = joinPath [indexName, mappingName, "_search"]

549549 search' = search { searchType = SearchTypeScan }

550550 resp' <- bindM2 dispatchSearch url (return search')

551551 let msr = decode' $ responseBody resp' :: Maybe (SearchResult ())

552− msid = maybe Nothing scrollId msr

552+ msid = maybe Nothing scrollId msr

553553 return msid

554554

555555scroll' :: (FromJSON a, MonadBH m) => Maybe ScrollId -> m ([Hit a], Maybe ScrollId)

@@ -570,9 +570,11 @@ simpleAccumilator oldHits (newHits, msid) = do

570570 (newHits', msid') <- scroll' msid

571571 simpleAccumilator (oldHits ++ newHits) (newHits', msid')

572572

573−scanSearch :: (FromJSON a, MonadBH m) => Search -> m [Hit a]

574−scanSearch search = do

575− msid <- scanSearch' search

573+-- | 'scanSearch' uses the 'scan&scroll' API of elastic,

574+-- for a given 'IndexName' and 'MappingName',

575+scanSearch :: (FromJSON a, MonadBH m) => IndexName -> MappingName -> Search -> m [Hit a]

576+scanSearch indexName mappingName search = do

577+ msid <- scanSearch' indexName mappingName search

576578 (hits, msid') <- scroll' msid

577579 (totalHits, _) <- simpleAccumilator [] (hits, msid')

578580 return totalHits

@@ -584,9 +586,9 @@ scanSearch search = do

584586--

585587-- >>> let query = TermQuery (Term "user" "bitemyapp") Nothing

586588-- >>> mkSearch (Just query) Nothing

587−-- Search {queryBody = Just (TermQuery (Term {termField = "user", termValue = "bitemyapp"}) Nothing), filterBody = Nothing, sortBody = Nothing, aggBody = Nothing, highlight = Nothing, trackSortScores = False, from = From 0, size = Size 10, searchType = SearchTypeQueryThenFetch, fields = Nothing}

589+-- Search {queryBody = Just (TermQuery (Term {termField = "user", termValue = "bitemyapp"}) Nothing), filterBody = Nothing, sortBody = Nothing, aggBody = Nothing, highlight = Nothing, trackSortScores = False, from = From 0, size = Size 10, searchType = SearchTypeQueryThenFetch, fields = Nothing, source = Nothing}

588590mkSearch :: Maybe Query -> Maybe Filter -> Search

589−mkSearch query filter = Search query filter Nothing Nothing Nothing False (From 0) (Size 10) SearchTypeQueryThenFetch Nothing

591+mkSearch query filter = Search query filter Nothing Nothing Nothing False (From 0) (Size 10) SearchTypeQueryThenFetch Nothing Nothing

590592

591593-- | 'mkAggregateSearch' is a helper function that defaults everything in a 'Search' except for

592594-- the 'Query' and the 'Aggregation'.

@@ -596,7 +598,7 @@ mkSearch query filter = Search query filter Nothing Nothing Nothing False (From

596598-- TermsAgg (TermsAggregation {term = Left "user", termInclude = Nothing, termExclude = Nothing, termOrder = Nothing, termMinDocCount = Nothing, termSize = Nothing, termShardSize = Nothing, termCollectMode = Just BreadthFirst, termExecutionHint = Nothing, termAggs = Nothing})

597599-- >>> let myAggregation = mkAggregateSearch Nothing $ mkAggregations "users" terms

598600mkAggregateSearch :: Maybe Query -> Aggregations -> Search

599−mkAggregateSearch query mkSearchAggs = Search query Nothing Nothing (Just mkSearchAggs) Nothing False (From 0) (Size 0) SearchTypeQueryThenFetch Nothing

601+mkAggregateSearch query mkSearchAggs = Search query Nothing Nothing (Just mkSearchAggs) Nothing False (From 0) (Size 0) SearchTypeQueryThenFetch Nothing Nothing

600602

601603-- | 'mkHighlightSearch' is a helper function that defaults everything in a 'Search' except for

602604-- the 'Query' and the 'Aggregation'.

@@ -605,7 +607,7 @@ mkAggregateSearch query mkSearchAggs = Search query Nothing Nothing (Just mkSear

605607-- >>> let testHighlight = Highlights Nothing [FieldHighlight (FieldName "message") Nothing]

606608-- >>> let search = mkHighlightSearch (Just query) testHighlight

607609mkHighlightSearch :: Maybe Query -> Highlights -> Search

608−mkHighlightSearch query searchHighlights = Search query Nothing Nothing Nothing (Just searchHighlights) False (From 0) (Size 10) SearchTypeQueryThenFetch Nothing

610+mkHighlightSearch query searchHighlights = Search query Nothing Nothing Nothing (Just searchHighlights) False (From 0) (Size 10) SearchTypeQueryThenFetch Nothing Nothing

609611

610612-- | 'pageSearch' is a helper function that takes a search and assigns the from

611613-- and size fields for the search. The from parameter defines the offset

@@ -615,9 +617,9 @@ mkHighlightSearch query searchHighlights = Search query Nothing Nothing Nothing

615617-- >>> let query = QueryMatchQuery $ mkMatchQuery (FieldName "_all") (QueryString "haskell")

616618-- >>> let search = mkSearch (Just query) Nothing

617619-- >>> search

618−-- Search {queryBody = Just (QueryMatchQuery (MatchQuery {matchQueryField = FieldName "_all", matchQueryQueryString = QueryString "haskell", matchQueryOperator = Or, matchQueryZeroTerms = ZeroTermsNone, matchQueryCutoffFrequency = Nothing, matchQueryMatchType = Nothing, matchQueryAnalyzer = Nothing, matchQueryMaxExpansions = Nothing, matchQueryLenient = Nothing})), filterBody = Nothing, sortBody = Nothing, aggBody = Nothing, highlight = Nothing, trackSortScores = False, from = From 0, size = Size 10, searchType = SearchTypeQueryThenFetch, fields = Nothing}

620+-- Search {queryBody = Just (QueryMatchQuery (MatchQuery {matchQueryField = FieldName "_all", matchQueryQueryString = QueryString "haskell", matchQueryOperator = Or, matchQueryZeroTerms = ZeroTermsNone, matchQueryCutoffFrequency = Nothing, matchQueryMatchType = Nothing, matchQueryAnalyzer = Nothing, matchQueryMaxExpansions = Nothing, matchQueryLenient = Nothing, matchQueryBoost = Nothing})), filterBody = Nothing, sortBody = Nothing, aggBody = Nothing, highlight = Nothing, trackSortScores = False, from = From 0, size = Size 10, searchType = SearchTypeQueryThenFetch, fields = Nothing, source = Nothing}

619621-- >>> pageSearch (From 10) (Size 100) search

620−-- Search {queryBody = Just (QueryMatchQuery (MatchQuery {matchQueryField = FieldName "_all", matchQueryQueryString = QueryString "haskell", matchQueryOperator = Or, matchQueryZeroTerms = ZeroTermsNone, matchQueryCutoffFrequency = Nothing, matchQueryMatchType = Nothing, matchQueryAnalyzer = Nothing, matchQueryMaxExpansions = Nothing, matchQueryLenient = Nothing})), filterBody = Nothing, sortBody = Nothing, aggBody = Nothing, highlight = Nothing, trackSortScores = False, from = From 10, size = Size 100, searchType = SearchTypeQueryThenFetch, fields = Nothing}

622+-- Search {queryBody = Just (QueryMatchQuery (MatchQuery {matchQueryField = FieldName "_all", matchQueryQueryString = QueryString "haskell", matchQueryOperator = Or, matchQueryZeroTerms = ZeroTermsNone, matchQueryCutoffFrequency = Nothing, matchQueryMatchType = Nothing, matchQueryAnalyzer = Nothing, matchQueryMaxExpansions = Nothing, matchQueryLenient = Nothing, matchQueryBoost = Nothing})), filterBody = Nothing, sortBody = Nothing, aggBody = Nothing, highlight = Nothing, trackSortScores = False, from = From 10, size = Size 100, searchType = SearchTypeQueryThenFetch, fields = Nothing, source = Nothing}

621623pageSearch :: From -- ^ The result offset

622624 -> Size -- ^ The number of results to return

623625 -> Search -- ^ The current seach

src/Database/Bloodhound/Types.hs+66−20

@@ -47,7 +47,7 @@ module Database.Bloodhound.Types

4747 , toTerms

4848 , toDateHistogram

4949 , omitNulls

50− , BH

50+ , BH(..)

5151 , runBH

5252 , BHEnv(..)

5353 , MonadBH(..)

@@ -75,6 +75,11 @@ module Database.Bloodhound.Types

7575 , TrackSortScores

7676 , From(..)

7777 , Size(..)

78+ , Source(..)

79+ , PatternOrPatterns(..)

80+ , Include(..)

81+ , Exclude(..)

82+ , Pattern(..)

7883 , ShardResult(..)

7984 , Hit(..)

8085 , Filter(..)

@@ -225,6 +230,7 @@ module Database.Bloodhound.Types

225230 ) where

226231

227232import Control.Applicative

233+import Control.Monad.Catch

228234import Control.Monad.Error

229235import Control.Monad.Reader

230236import Control.Monad.State

@@ -232,9 +238,9 @@ import Control.Monad.Writer

232238import Data.Aeson

233239import Data.Aeson.Types (Pair, emptyObject, parseMaybe)

234240import qualified Data.ByteString.Lazy.Char8 as L

235−import Data.List (nub, foldl')

236−import Data.List.NonEmpty (NonEmpty (..), toList)

237241import qualified Data.HashMap.Strict as HM (union)

242+import Data.List (foldl', nub)

243+import Data.List.NonEmpty (NonEmpty (..), toList)

238244import qualified Data.Map.Strict as M

239245import Data.Maybe

240246import Data.Text (Text)

@@ -285,7 +291,10 @@ newtype BH m a = BH {

285291 , MonadError e

286292 , Alternative

287293 , MonadPlus

288− , MonadFix)

294+ , MonadFix

295+ , MonadThrow

296+ , MonadCatch

297+ , MonadMask)

289298

290299instance MonadTrans BH where

291300 lift = BH . lift

@@ -368,7 +377,7 @@ data FieldDefinition =

368377 https://www.elastic.co/guide/en/elasticsearch/reference/1.7/indices-templates.html

369378-}

370379data IndexTemplate =

371− IndexTemplate { templatePattern :: TemplatePattern

380+ IndexTemplate { templatePattern :: TemplatePattern

372381 , templateSettings :: Maybe IndexSettings

373382 , templateMappings :: [Value]

374383 }

@@ -402,9 +411,9 @@ data BulkOperation =

402411{-| 'EsResult' describes the standard wrapper JSON document that you see in

403412 successful Elasticsearch lookups or lookups that couldn't find the document.

404413-}

405−data EsResult a = EsResult { _index :: Text

406− , _type :: Text

407− , _id :: Text

414+data EsResult a = EsResult { _index :: Text

415+ , _type :: Text

416+ , _id :: Text

408417 , foundResult :: Maybe (EsResultFound a)} deriving (Eq, Show)

409418

410419

@@ -412,7 +421,7 @@ data EsResult a = EsResult { _index :: Text

412421 'EsResult' when the document was successfully found.

413422-}

414423data EsResultFound a = EsResultFound { _version :: DocVersion

415− , _source :: a } deriving (Eq, Show)

424+ , _source :: a } deriving (Eq, Show)

416425

417426

418427

@@ -733,11 +742,12 @@ data Search = Search { queryBody :: Maybe Query

733742 -- default False

734743 , trackSortScores :: TrackSortScores

735744 , from :: From

736− , size :: Size

745+ , size :: Size

737746 , searchType :: SearchType

738− , fields :: Maybe [FieldName] } deriving (Eq, Show)

747+ , fields :: Maybe [FieldName]

748+ , source :: Maybe Source } deriving (Eq, Show)

739749

740−data SearchType = SearchTypeQueryThenFetch

750+data SearchType = SearchTypeQueryThenFetch

741751 | SearchTypeDfsQueryThenFetch

742752 | SearchTypeCount

743753 | SearchTypeScan

@@ -745,6 +755,20 @@ data SearchType = SearchTypeQueryThenFetch

745755 | SearchTypeDfsQueryAndFetch

746756 deriving (Eq, Show)

747757

758+data Source =

759+ NoSource

760+ | SourcePatterns PatternOrPatterns

761+ | SourceIncludeExclude Include Exclude

762+ deriving (Show, Eq)

763+

764+data PatternOrPatterns = PopPattern Pattern

765+ | PopPatterns [Pattern] deriving (Eq, Show)

766+

767+data Include = Include [Pattern] deriving (Eq, Show)

768+data Exclude = Exclude [Pattern] deriving (Eq, Show)

769+

770+newtype Pattern = Pattern Text deriving (Eq, Show)

771+

748772data Highlights = Highlights { globalsettings :: Maybe HighlightSettings

749773 , highlightFields :: [FieldHighlight]

750774 } deriving (Show, Eq)

@@ -1031,13 +1055,14 @@ data MatchQuery =

10311055 , matchQueryMatchType :: Maybe MatchQueryType

10321056 , matchQueryAnalyzer :: Maybe Analyzer

10331057 , matchQueryMaxExpansions :: Maybe MaxExpansions

1034− , matchQueryLenient :: Maybe Lenient } deriving (Eq, Show)

1058+ , matchQueryLenient :: Maybe Lenient

1059+ , matchQueryBoost :: Maybe Boost } deriving (Eq, Show)

10351060

10361061{-| 'mkMatchQuery' is a convenience function that defaults the less common parameters,

10371062 enabling you to provide only the 'FieldName' and 'QueryString' to make a 'MatchQuery'

10381063-}

10391064mkMatchQuery :: FieldName -> QueryString -> MatchQuery

1040−mkMatchQuery field query = MatchQuery field query Or ZeroTermsNone Nothing Nothing Nothing Nothing Nothing

1065+mkMatchQuery field query = MatchQuery field query Or ZeroTermsNone Nothing Nothing Nothing Nothing Nothing Nothing

10411066

10421067data MatchQueryType =

10431068 MatchPhrase

@@ -1256,7 +1281,7 @@ data SearchResult a =

12561281 , timedOut :: Bool

12571282 , shards :: ShardResult

12581283 , searchHits :: SearchHits a

1259− , aggregations :: Maybe AggregationResults

1284+ , aggregations :: Maybe AggregationResults

12601285 , scrollId :: Maybe ScrollId } deriving (Eq, Show)

12611286

12621287type ScrollId = Text -- Fixme: Newtype

@@ -1367,7 +1392,7 @@ data ValueCountAggregation = FieldValueCount FieldName

13671392

13681393-- | Single-bucket filter aggregations. See <https://www.elastic.co/guide/en/elasticsearch/reference/current/search-aggregations-bucket-filter-aggregation.html#search-aggregations-bucket-filter-aggregation> for more information.

13691394data FilterAggregation = FilterAggregation { faFilter :: Filter

1370− , faAggs :: Maybe Aggregations} deriving (Eq, Show)

1395+ , faAggs :: Maybe Aggregations} deriving (Eq, Show)

13711396

13721397mkTermsAggregation :: Text -> TermsAggregation

13731398mkTermsAggregation t = TermsAggregation (Left t) Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing

@@ -1967,7 +1992,7 @@ instance ToJSON MatchQuery where

19671992 toJSON (MatchQuery (FieldName fieldName)

19681993 (QueryString mqQueryString) booleanOperator

19691994 zeroTermsQuery cutoffFrequency matchQueryType

1970− analyzer maxExpansions lenient) =

1995+ analyzer maxExpansions lenient boost) =

19711996 object [ fieldName .= omitNulls base ]

19721997 where base = [ "query" .= mqQueryString

19731998 , "operator" .= booleanOperator

@@ -1976,7 +2001,8 @@ instance ToJSON MatchQuery where

19762001 , "type" .= matchQueryType

19772002 , "analyzer" .= analyzer

19782003 , "max_expansions" .= maxExpansions

1979− , "lenient" .= lenient ]

2004+ , "lenient" .= lenient

2005+ , "boost" .= boost ]

19802006

19812007

19822008instance ToJSON MultiMatchQuery where

@@ -2108,7 +2134,7 @@ instance (FromJSON a) => FromJSON (EsResultFound a) where

21082134 parseJSON _ = empty

21092135

21102136instance ToJSON Search where

2111− toJSON (Search query sFilter sort searchAggs highlight sTrackSortScores sFrom sSize _ sFields) =

2137+ toJSON (Search query sFilter sort searchAggs highlight sTrackSortScores sFrom sSize _ sFields sSource) =

21122138 omitNulls [ "query" .= query

21132139 , "filter" .= sFilter

21142140 , "sort" .= sort

@@ -2117,7 +2143,27 @@ instance ToJSON Search where

21172143 , "from" .= sFrom

21182144 , "size" .= sSize

21192145 , "track_scores" .= sTrackSortScores

2120− , "fields" .= sFields]

2146+ , "fields" .= sFields

2147+ , "_source" .= sSource]

2148+

2149+

2150+instance ToJSON Source where

2151+ toJSON NoSource = toJSON False

2152+ toJSON (SourcePatterns patterns) = toJSON patterns

2153+ toJSON (SourceIncludeExclude incl excl) = object [ "include" .= incl, "exclude" .= excl ]

2154+

2155+instance ToJSON PatternOrPatterns where

2156+ toJSON (PopPattern pattern) = toJSON pattern

2157+ toJSON (PopPatterns patterns) = toJSON patterns

2158+

2159+instance ToJSON Include where

2160+ toJSON (Include patterns) = toJSON patterns

2161+

2162+instance ToJSON Exclude where

2163+ toJSON (Exclude patterns) = toJSON patterns

2164+

2165+instance ToJSON Pattern where

2166+ toJSON (Pattern pattern) = toJSON pattern

21212167

21222168

21232169instance ToJSON FieldHighlight where

tests/tests.hs+50−1

@@ -220,6 +220,17 @@ searchTweetHighlight search = do

220220 let myHighlight = fmap (hitHighlight . head . hits . searchHits) result

221221 return myHighlight

222222

223+searchExpectSource :: Source -> Either String Value -> BH IO ()

224+searchExpectSource src expected = do

225+ _ <- insertData

226+ let query = QueryMatchQuery $ mkMatchQuery (FieldName "_all") (QueryString "haskell")

227+ let search = (mkSearch (Just query) Nothing) { source = Just src }

228+ reply <- searchAll search

229+ let result = eitherDecode (responseBody reply) :: Either String (SearchResult Value)

230+ let value = fmap (hitSource . head . hits . searchHits) result

231+ liftIO $

232+ value `shouldBe` expected

233+

223234data BulkTest = BulkTest { name :: Text } deriving (Eq, Generic, Show)

224235instance FromJSON BulkTest

225236instance ToJSON BulkTest

@@ -435,7 +446,7 @@ main = hspec $ do

435446 let sortSpec = DefaultSortSpec $ mkSort (FieldName "age") Ascending

436447 let search = Search Nothing

437448 (Just IdentityFilter) (Just [sortSpec]) Nothing Nothing

438− False (From 0) (Size 10) SearchTypeQueryThenFetch Nothing

449+ False (From 0) (Size 10) SearchTypeQueryThenFetch Nothing Nothing

439450 result <- searchTweets search

440451 let myTweet = fmap (hitSource . head . hits . searchHits) result

441452 liftIO $

@@ -698,7 +709,32 @@ main = hspec $ do

698709 liftIO $

699710 myHighlight `shouldBe` Right Nothing

700711

712+ describe "Source filtering" $ do

713+

714+ it "doesn't include source when sources are disabled" $ withTestEnv $ do

715+ searchExpectSource

716+ NoSource

717+ (Left "key \"_source\" not present")

718+

719+ it "includes a source" $ withTestEnv $ do

720+ searchExpectSource

721+ (SourcePatterns (PopPattern (Pattern "message")))

722+ (Right (Object (HM.fromList [("message", String "Use haskell!")])))

723+

724+ it "includes sources" $ withTestEnv $ do

725+ searchExpectSource

726+ (SourcePatterns (PopPatterns [Pattern "user", Pattern "message"]))

727+ (Right (Object (HM.fromList [("user",String "bitemyapp"),("message", String "Use haskell!")])))

701728

729+ it "includes source patterns" $ withTestEnv $ do

730+ searchExpectSource

731+ (SourcePatterns (PopPattern (Pattern "*ge")))

732+ (Right (Object (HM.fromList [("age", Number 10000),("message", String "Use haskell!")])))

733+

734+ it "excludes source patterns" $ withTestEnv $ do

735+ searchExpectSource

736+ (SourceIncludeExclude (Include []) (Exclude [Pattern "l*", Pattern "*ge", Pattern "postDate"]))

737+ (Right (Object (HM.fromList [("user",String "bitemyapp")])))

702738

703739 describe "ToJSON RegexpFlags" $ do

704740 it "generates the correct JSON for AllRegexpFlags" $

@@ -762,3 +798,16 @@ main = hspec $ do

762798 enumFrom (pred maxBound :: DocVersion) `shouldBe` [pred maxBound, maxBound]

763799 enumFrom (pred maxBound :: DocVersion) `shouldBe` [pred maxBound, maxBound]

764800 enumFromThen minBound (pred maxBound :: DocVersion) `shouldBe` [minBound, pred maxBound]

801+

802+ describe "scan&scroll API" $ do

803+ it "returns documents using the scan&scroll API" $ withTestEnv $ do

804+ _ <- insertData

805+ _ <- insertOther

806+ let search = (mkSearch (Just $ MatchAllQuery Nothing) Nothing) { size = (Size 1) }

807+ regular_search <- searchTweet search

808+ scan_search' <- scanSearch testIndex testMapping search :: BH IO [Hit Tweet]

809+ let scan_search = map hitSource scan_search'

810+ liftIO $

811+ regular_search `shouldBe` Right exampleTweet -- Check that the size restrtiction is being honored

812+ liftIO $

813+ scan_search `shouldMatchList` [exampleTweet, otherTweet]