diff --git a/bloodhound.cabal b/bloodhound.cabal --- a/bloodhound.cabal +++ b/bloodhound.cabal @@ -1,5 +1,5 @@ name: bloodhound -version: 0.15.0.0 +version: 0.15.0.1 synopsis: ElasticSearch client library for Haskell description: ElasticSearch made awesome for Haskell hackers homepage: https://github.com/bitemyapp/bloodhound @@ -55,7 +55,7 @@ text >= 0.11 && <1.3, mtl >= 1.0 && <2.3, transformers >= 0.2 && <0.6, - http-types >= 0.8 && <0.10, + http-types >= 0.8 && <0.12, vector >= 0.10.9 && <0.13, scientific >= 0.3.0.0 && <0.4.0.0, exceptions, diff --git a/src/Database/V5/Bloodhound/Client.hs b/src/Database/V5/Bloodhound/Client.hs --- a/src/Database/V5/Bloodhound/Client.hs +++ b/src/Database/V5/Bloodhound/Client.hs @@ -25,6 +25,7 @@ withBH -- ** Indices , createIndex + , createIndexWith , deleteIndex , updateIndexSettings , getIndexSettings @@ -512,6 +513,24 @@ where url = joinPath [indexName] body = Just $ encode indexSettings +-- | Create an index, providing it with any number of settings. This +-- is more expressive than 'createIndex' but makes is more verbose +-- for the common case of configuring only the shard count and +-- replica count. +createIndexWith :: MonadBH m + => [UpdatableIndexSetting] + -> Int -- ^ shard count + -> IndexName + -> m Reply +createIndexWith updates shards (IndexName indexName) = + bindM2 put url (return (Just body)) + where url = joinPath [indexName] + body = encode $ object + ["settings" .= deepMerge + ( HM.singleton "index.number_of_shards" (toJSON shards) : + [u | Object u <- toJSON <$> updates] + ) + ] -- | 'deleteIndex' will delete an index given a 'Server', and an 'IndexName'. -- @@ -545,7 +564,6 @@ parseEsResponse =<< get =<< url where url = joinPath [indexName, "_settings"] - -- | 'forceMergeIndex' -- -- The force merge API allows to force merging of one or more indices through @@ -787,7 +805,10 @@ -- | 'indexDocument' is the primary way to save a single document in -- Elasticsearch. The document itself is simply something we can -- convert into a JSON 'Value'. The 'DocId' will function as the --- primary key for the document. +-- primary key for the document. You are encouraged to generate +-- your own id's and not rely on ElasticSearch's automatic id +-- generation. Read more about it here: +-- https://github.com/bitemyapp/bloodhound/issues/107 -- -- >>> resp <- runBH' $ indexDocument testIndex testMapping defaultIndexDocumentSettings exampleTweet (DocId "1") -- >>> print resp diff --git a/src/Database/V5/Bloodhound/Types.hs b/src/Database/V5/Bloodhound/Types.hs --- a/src/Database/V5/Bloodhound/Types.hs +++ b/src/Database/V5/Bloodhound/Types.hs @@ -74,6 +74,7 @@ , UpdatableIndexSetting(..) , IndexSettingsSummary(..) , AllocationPolicy(..) + , Compression(..) , ReplicaBounds(..) , Bytes(..) , gigabytes @@ -202,6 +203,7 @@ , ZeroTermsQuery(..) , CutoffFrequency(..) , Analyzer(..) + , Tokenizer(..) , MaxExpansions(..) , Lenient(..) , MatchQueryType(..) @@ -376,6 +378,12 @@ , EsUsername(..) , EsPassword(..) + + , Analysis(..) + , AnalyzerDefinition(..) + , TokenizerDefinition(..) + , Ngram(..) + , TokenChar(..) ) where import Control.Applicative as A @@ -579,12 +587,94 @@ | TTLDisablePurge Bool -- ^ Disables temporarily the purge of expired docs. | TranslogFSType FSType + | CompressionSetting Compression | IndexCompoundFormat CompoundFormat | IndexCompoundOnFlush Bool | WarmerEnabled Bool | MappingTotalFieldsLimit Int + | AnalysisSetting Analysis + -- ^ Analysis is not a dynamic setting and can only be performed on a closed index. deriving (Eq, Show, Generic, Typeable) +data Analysis = Analysis + { analysisAnalyzer :: M.Map Text AnalyzerDefinition + , analysisTokenizer :: M.Map Text TokenizerDefinition + } deriving (Eq,Show,Generic,Typeable) + +instance ToJSON Analysis where + toJSON (Analysis analyzer tokenizer) = object + [ "analyzer" .= analyzer + , "tokenizer" .= tokenizer + ] + +instance FromJSON Analysis where + parseJSON = withObject "Analysis" $ \m -> Analysis + <$> m .: "analyzer" + <*> m .: "tokenizer" + +data AnalyzerDefinition = AnalyzerDefinition + { analyzerDefinitionTokenizer :: Maybe Tokenizer + } deriving (Eq,Show,Generic,Typeable) + +instance ToJSON AnalyzerDefinition where + toJSON (AnalyzerDefinition tokenizer) = object $ catMaybes + [ fmap ("tokenizer" .=) tokenizer + ] + +instance FromJSON AnalyzerDefinition where + parseJSON = withObject "AnalyzerDefinition" $ \m -> AnalyzerDefinition + <$> m .:? "tokenizer" + + +data TokenizerDefinition + = TokenizerDefinitionNgram Ngram + deriving (Eq,Show,Generic,Typeable) + +instance ToJSON TokenizerDefinition where + toJSON x = case x of + TokenizerDefinitionNgram (Ngram minGram maxGram tokenChars) -> object + [ "type" .= ("ngram" :: Text) + , "min_gram" .= minGram + , "max_gram" .= maxGram + , "token_chars" .= tokenChars + ] + +instance FromJSON TokenizerDefinition where + parseJSON = withObject "TokenizerDefinition" $ \m -> do + typ <- m .: "type" :: Parser Text + case typ of + "ngram" -> fmap TokenizerDefinitionNgram $ Ngram + <$> (fmap unStringlyTypedInt (m .: "min_gram")) + <*> (fmap unStringlyTypedInt (m .: "max_gram")) + <*> m .: "token_chars" + _ -> fail "invalid TokenizerDefinition" + +data Ngram = Ngram + { ngramMinGram :: Int + , ngramMaxGram :: Int + , ngramTokenChars :: [TokenChar] + } deriving (Eq,Show,Generic,Typeable) + +data TokenChar = TokenLetter | TokenDigit | TokenWhitespace | TokenPunctuation | TokenSymbol + deriving (Eq,Read,Show,Generic,Typeable) + +instance ToJSON TokenChar where + toJSON t = String $ case t of + TokenLetter -> "letter" + TokenDigit -> "digit" + TokenWhitespace -> "whitespace" + TokenPunctuation -> "punctuation" + TokenSymbol -> "symbol" + +instance FromJSON TokenChar where + parseJSON = withText "TokenChar" $ \t -> case t of + "letter" -> return TokenLetter + "digit" -> return TokenDigit + "whitespace" -> return TokenWhitespace + "punctuation" -> return TokenPunctuation + "symbol" -> return TokenSymbol + _ -> fail "invalid TokenChar" + data AllocationPolicy = AllocAll -- ^ Allows shard allocation for all shards. | AllocPrimaries @@ -600,6 +690,26 @@ | ReplicasUnbounded deriving (Eq, Read, Show, Generic, Typeable) +data Compression + = CompressionDefault + -- ^ Compress with LZ4 + | CompressionBest + -- ^ Compress with DEFLATE. Elastic + -- + -- that this can reduce disk use by 15%-25%. + deriving (Eq,Show,Generic,Typeable) + +instance ToJSON Compression where + toJSON x = case x of + CompressionDefault -> toJSON ("default" :: Text) + CompressionBest -> toJSON ("best_compression" :: Text) + +instance FromJSON Compression where + parseJSON = withText "Compression" $ \t -> case t of + "default" -> return CompressionDefault + "best_compression" -> return CompressionBest + _ -> fail "invalid compression codec" + -- | A measure of bytes used for various configurations. You may want -- to use smart constructors like 'gigabytes' for larger values. -- @@ -1020,6 +1130,8 @@ CutoffFrequency Double deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable) newtype Analyzer = Analyzer Text deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable) +newtype Tokenizer = + Tokenizer Text deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable) newtype MaxExpansions = MaxExpansions Int deriving (Eq, Read, Show, Generic, ToJSON, FromJSON, Typeable) @@ -1438,13 +1550,15 @@ , matchQueryAnalyzer :: Maybe Analyzer , matchQueryMaxExpansions :: Maybe MaxExpansions , matchQueryLenient :: Maybe Lenient - , matchQueryBoost :: Maybe Boost } deriving (Eq, Read, Show, Generic, Typeable) + , matchQueryBoost :: Maybe Boost + , matchQueryMinimumShouldMatch :: Maybe Text + } deriving (Eq, Read, Show, Generic, Typeable) {-| 'mkMatchQuery' is a convenience function that defaults the less common parameters, enabling you to provide only the 'FieldName' and 'QueryString' to make a 'MatchQuery' -} mkMatchQuery :: FieldName -> QueryString -> MatchQuery -mkMatchQuery field query = MatchQuery field query Or ZeroTermsNone Nothing Nothing Nothing Nothing Nothing Nothing +mkMatchQuery field query = MatchQuery field query Or ZeroTermsNone Nothing Nothing Nothing Nothing Nothing Nothing Nothing data MatchQueryType = MatchPhrase @@ -2834,7 +2948,9 @@ toJSON (MatchQuery (FieldName fieldName) (QueryString mqQueryString) booleanOperator zeroTermsQuery cutoffFrequency matchQueryType - analyzer maxExpansions lenient boost) = + analyzer maxExpansions lenient boost + minShouldMatch + ) = object [ fieldName .= omitNulls base ] where base = [ "query" .= mqQueryString , "operator" .= booleanOperator @@ -2844,7 +2960,9 @@ , "analyzer" .= analyzer , "max_expansions" .= maxExpansions , "lenient" .= lenient - , "boost" .= boost ] + , "boost" .= boost + , "minimum_should_match" .= minShouldMatch + ] instance FromJSON MatchQuery where parseJSON = withObject "MatchQuery" parse @@ -2859,6 +2977,7 @@ <*> o .:? "max_expansions" <*> o .:? "lenient" <*> o .:? "boost" + <*> o .:? "minimum_should_match" instance ToJSON MultiMatchQuery where toJSON (MultiMatchQuery fields (QueryString query) boolOp @@ -2982,6 +3101,7 @@ toJSON (GCDeletes x) = oPath ("index" :| ["gc_deletes"]) (NominalDiffTimeJSON x) toJSON (TTLDisablePurge x) = oPath ("index" :| ["ttl", "disable_purge"]) x toJSON (TranslogFSType x) = oPath ("index" :| ["translog", "fs", "type"]) x + toJSON (CompressionSetting x) = oPath ("index" :| ["codec"]) x toJSON (IndexCompoundFormat x) = oPath ("index" :| ["compound_format"]) x toJSON (IndexCompoundOnFlush x) = oPath ("index" :| ["compound_on_flush"]) x toJSON (WarmerEnabled x) = oPath ("index" :| ["warmer", "enabled"]) x @@ -2990,6 +3110,7 @@ toJSON (BlocksWrite x) = oPath ("blocks" :| ["write"]) x toJSON (BlocksMetaData x) = oPath ("blocks" :| ["metadata"]) x toJSON (MappingTotalFieldsLimit x) = oPath ("index" :| ["mapping","total_fields","limit"]) x + toJSON (AnalysisSetting x) = oPath ("index" :| ["analysis"]) x instance FromJSON UpdatableIndexSetting where parseJSON = withObject "UpdatableIndexSetting" parse @@ -3014,6 +3135,7 @@ <|> gcDeletes `taggedAt` ["index", "gc_deletes"] <|> ttlDisablePurge `taggedAt` ["index", "ttl", "disable_purge"] <|> translogFSType `taggedAt` ["index", "translog", "fs", "type"] + <|> compressionSetting `taggedAt` ["index", "codec"] <|> compoundFormat `taggedAt` ["index", "compound_format"] <|> compoundOnFlush `taggedAt` ["index", "compound_on_flush"] <|> warmerEnabled `taggedAt` ["index", "warmer", "enabled"] @@ -3022,6 +3144,7 @@ <|> blocksWrite `taggedAt` ["blocks", "write"] <|> blocksMetaData `taggedAt` ["blocks", "metadata"] <|> mappingTotalFieldsLimit `taggedAt` ["index", "mapping", "total_fields", "limit"] + <|> analysisSetting `taggedAt` ["index", "analysis"] where taggedAt f ks = taggedAt' f (Object o) ks taggedAt' f v [] = f =<< (parseJSON v <|> (parseJSON (unStringlyTypeJSON v))) taggedAt' f v (k:ks) = withObject "Object" (\o -> do v' <- o .: k @@ -3047,6 +3170,7 @@ gcDeletes = pure . GCDeletes . ndtJSON ttlDisablePurge = pure . TTLDisablePurge translogFSType = pure . TranslogFSType + compressionSetting = pure . CompressionSetting compoundFormat = pure . IndexCompoundFormat compoundOnFlush = pure . IndexCompoundOnFlush warmerEnabled = pure . WarmerEnabled @@ -3055,6 +3179,7 @@ blocksWrite = pure . BlocksWrite blocksMetaData = pure . BlocksMetaData mappingTotalFieldsLimit = pure . MappingTotalFieldsLimit + analysisSetting = pure . AnalysisSetting instance FromJSON IndexSettingsSummary where parseJSON = withObject "IndexSettingsSummary" parse @@ -4643,10 +4768,13 @@ newtype StringlyTypedDouble = StringlyTypedDouble { unStringlyTypedDouble :: Double } - instance FromJSON StringlyTypedDouble where parseJSON = fmap StringlyTypedDouble . parseJSON . unStringlyTypeJSON +newtype StringlyTypedInt = StringlyTypedInt { unStringlyTypedInt :: Int } + +instance FromJSON StringlyTypedInt where + parseJSON = fmap StringlyTypedInt . parseJSON . unStringlyTypeJSON instance FromJSON NodeFSTotalStats where parseJSON = withObject "NodeFSTotalStats" parse diff --git a/tests/V1/tests.hs b/tests/V1/tests.hs --- a/tests/V1/tests.hs +++ b/tests/V1/tests.hs @@ -717,6 +717,17 @@ shrink = genericShrink +#if MIN_VERSION_base(4,10,0) +-- Test.QuickCheck.Modifiers + +qcNonEmptyToNonEmpty :: NonEmptyList a -> NonEmpty a +qcNonEmptyToNonEmpty (NonEmpty (a : xs)) = (a :| xs) +qcNonEmptyToNonEmpty (NonEmpty []) = error "NonEmpty was empty!" + +instance Arbitrary a => Arbitrary (NonEmpty a) where + arbitrary = qcNonEmptyToNonEmpty <$> arbitrary +#endif + instance Arbitrary RegexpFlags where arbitrary = oneof [ pure AllRegexpFlags , pure NoRegexpFlags diff --git a/tests/V5/tests.hs b/tests/V5/tests.hs --- a/tests/V5/tests.hs +++ b/tests/V5/tests.hs @@ -729,12 +729,24 @@ shrink = genericShrink +#if MIN_VERSION_base(4,10,0) +-- Test.QuickCheck.Modifiers + +qcNonEmptyToNonEmpty :: NonEmptyList a -> NonEmpty a +qcNonEmptyToNonEmpty (NonEmpty (a : xs)) = (a :| xs) +qcNonEmptyToNonEmpty (NonEmpty []) = error "NonEmpty was empty!" + +instance Arbitrary a => Arbitrary (NonEmpty a) where + arbitrary = qcNonEmptyToNonEmpty <$> arbitrary +#endif + instance Arbitrary RegexpFlags where arbitrary = oneof [ pure AllRegexpFlags , pure NoRegexpFlags , SomeRegexpFlags <$> genUniqueFlags ] where genUniqueFlags = NE.fromList . nub <$> listOf1 arbitrary + shrink = genericShrink @@ -907,7 +919,14 @@ instance Arbitrary BoolMatch where arbitrary = sopArbitrary; shrink = genericShrink instance Arbitrary Term where arbitrary = sopArbitrary; shrink = genericShrink instance Arbitrary IndexSettings where arbitrary = sopArbitrary; shrink = genericShrink +instance Arbitrary TokenChar where arbitrary = sopArbitrary; shrink = genericShrink +instance Arbitrary Ngram where arbitrary = sopArbitrary; shrink = genericShrink +instance Arbitrary TokenizerDefinition where arbitrary = sopArbitrary; shrink = genericShrink +instance Arbitrary AnalyzerDefinition where arbitrary = sopArbitrary; shrink = genericShrink +instance Arbitrary Analysis where arbitrary = sopArbitrary; shrink = genericShrink +instance Arbitrary Tokenizer where arbitrary = sopArbitrary; shrink = genericShrink instance Arbitrary UpdatableIndexSetting where arbitrary = sopArbitrary; shrink = genericShrink +instance Arbitrary Compression where arbitrary = sopArbitrary; shrink = genericShrink instance Arbitrary Bytes where arbitrary = sopArbitrary; shrink = genericShrink instance Arbitrary AllocationPolicy where arbitrary = sopArbitrary; shrink = genericShrink instance Arbitrary InitialShardCount where arbitrary = sopArbitrary; shrink = genericShrink @@ -1621,6 +1640,45 @@ testIndex (IndexSettings (ShardCount 1) (ReplicaCount 0)) (NE.toList updates)) + + it "accepts customer analyzers" $ when' (atleast es50) $ withTestEnv $ do + _ <- deleteExampleIndex + let analysis = Analysis + (M.singleton "ex_analyzer" (AnalyzerDefinition (Just (Tokenizer "ex_tokenizer")))) + (M.singleton "ex_tokenizer" + ( TokenizerDefinitionNgram + ( Ngram 3 4 [TokenLetter,TokenDigit]) + ) + ) + updates = [AnalysisSetting analysis] + createResp <- createIndexWith (updates ++ [NumberOfReplicas (ReplicaCount 0)]) 1 testIndex + liftIO $ validateStatus createResp 200 + getResp <- getIndexSettings testIndex + liftIO $ + getResp `shouldBe` Right (IndexSettingsSummary + testIndex + (IndexSettings (ShardCount 1) (ReplicaCount 0)) + updates + ) + + it "accepts default compression codec" $ when' (atleast es50) $ withTestEnv $ do + _ <- deleteExampleIndex + let updates = [CompressionSetting CompressionDefault] + createResp <- createIndexWith (updates ++ [NumberOfReplicas (ReplicaCount 0)]) 1 testIndex + liftIO $ validateStatus createResp 200 + getResp <- getIndexSettings testIndex + liftIO $ getResp `shouldBe` Right + (IndexSettingsSummary testIndex (IndexSettings (ShardCount 1) (ReplicaCount 0)) updates) + + it "accepts best compression codec" $ when' (atleast es50) $ withTestEnv $ do + _ <- deleteExampleIndex + let updates = [CompressionSetting CompressionBest] + createResp <- createIndexWith (updates ++ [NumberOfReplicas (ReplicaCount 0)]) 1 testIndex + liftIO $ validateStatus createResp 200 + getResp <- getIndexSettings testIndex + liftIO $ getResp `shouldBe` Right + (IndexSettingsSummary testIndex (IndexSettings (ShardCount 1) (ReplicaCount 0)) updates) + describe "Index Optimization" $ do it "returns a successful response upon completion" $ withTestEnv $ do