git.iko.soy/typeable/bloodhound
on master help sign in
WIP: add instances and public API
b0ba889Michael Xavier
src/Database/Bloodhound/Client.hs+28−4
compare with master
unifiedsplit
@@ -1,5 +1,5 @@
1−{-# LANGUAGE OverloadedStrings #-}
1+{-# LANGUAGE OverloadedStrings #-}
2−{-# LANGUAGE RecordWildCards #-}
2+{-# LANGUAGE RecordWildCards #-}
3
3
4-------------------------------------------------------------------------------
4-------------------------------------------------------------------------------
5-- |
5-- |
@@ -24,6 +24,7 @@ module Database.Bloodhound.Client
24 withBH
24 withBH
25 , createIndex
25 , createIndex
26 , deleteIndex
26 , deleteIndex
27+ , updateIndexSettings
27 , indexExists
28 , indexExists
28 , openIndex
29 , openIndex
29 , closeIndex
30 , closeIndex
@@ -58,7 +59,7 @@ module Database.Bloodhound.Client
58 )
59 )
59 where
60 where
60
61
61−import qualified Blaze.ByteString.Builder as BB
62+import qualified Blaze.ByteString.Builder as BB
62import Control.Applicative
63import Control.Applicative
63import Control.Monad
64import Control.Monad
64import Control.Monad.Catch
65import Control.Monad.Catch
@@ -66,8 +67,11 @@ import Control.Monad.IO.Class
66import Data.Aeson
67import Data.Aeson
67import Data.ByteString.Lazy.Builder
68import Data.ByteString.Lazy.Builder
68import qualified Data.ByteString.Lazy.Char8 as L
69import qualified Data.ByteString.Lazy.Char8 as L
70+import Data.Foldable (toList)
71+import qualified Data.HashMap.Strict as HM
69import Data.Ix
72import Data.Ix
70−import qualified Data.List as LS (filter)
73+import qualified Data.List as LS (filter, foldl')
74+import Data.List.NonEmpty (NonEmpty (..))
71import Data.Maybe (fromMaybe, isJust)
75import Data.Maybe (fromMaybe, isJust)
72import Data.Monoid
76import Data.Monoid
73import Data.Text (Text)
77import Data.Text (Text)
@@ -262,6 +266,26 @@ deleteIndex :: MonadBH m => IndexName -> m Reply
262deleteIndex (IndexName indexName) =
266deleteIndex (IndexName indexName) =
263 delete =<< joinPath [indexName]
267 delete =<< joinPath [indexName]
264
268
269+-- | 'updateIndexSettings' will apply a non-empty list of setting updates to an index
270+--
271+-- >>> response <- runBH' $ updateIndexSettings (BlocksWrite False :| []) testIndex
272+-- >>> respIsTwoHunna response
273+-- True
274+updateIndexSettings :: MonadBH m => NonEmpty IndexSettingUpdate -> IndexName -> m Reply
275+updateIndexSettings updates (IndexName indexName) =
276+ bindM2 put url (return body)
277+ where url = joinPath [indexName, "_settings"]
278+ body = Just (encode jsonBody)
279+ jsonBody = Object (deepMerge [u | Object u <- toJSON <$> toList updates])
280+
281+deepMerge :: [Object] -> Object
282+deepMerge = LS.foldl' go mempty
283+ where go acc = LS.foldl' go' acc . HM.toList
284+ go' acc (k, v) = HM.insertWith merge k v acc
285+ merge (Object a) (Object b) = Object (deepMerge [a, b])
286+ merge _ b = b
287+
288+
265statusCodeIs :: Int -> Reply -> Bool
289statusCodeIs :: Int -> Reply -> Bool
266statusCodeIs n resp = NHTS.statusCode (responseStatus resp) == n
290statusCodeIs n resp = NHTS.statusCode (responseStatus resp) == n
267
291
src/Database/Bloodhound/Types.hs+111−4
@@ -57,6 +57,14 @@ module Database.Bloodhound.Types
57 , NullValue(..)
57 , NullValue(..)
58 , IndexSettings(..)
58 , IndexSettings(..)
59 , IndexSettingUpdate(..)
59 , IndexSettingUpdate(..)
60+ , AllocationPolicy(..)
61+ , ReplicaBounds(..)
62+ , Bytes(..)
63+ , FSType(..)
64+ , InitialShardCount(..)
65+ , NodeAttrFilter(..)
66+ , NodeAttrName(..)
67+ , CompoundFormat(..)
60 , IndexTemplate(..)
68 , IndexTemplate(..)
61 , Server(..)
69 , Server(..)
62 , Reply
70 , Reply
@@ -348,6 +356,10 @@ data IndexSettings =
348defaultIndexSettings :: IndexSettings
356defaultIndexSettings :: IndexSettings
349defaultIndexSettings = IndexSettings (ShardCount 3) (ReplicaCount 2)
357defaultIndexSettings = IndexSettings (ShardCount 3) (ReplicaCount 2)
350
358
359+{-| 'IndexSettingUpdate' is used to update an index' settings piecemeal.
360+
361+ <https://www.elastic.co/guide/en/elasticsearch/reference/current/indices-update-settings.html>
362+-}
351data IndexSettingUpdate = NumberOfReplicas Int
363data IndexSettingUpdate = NumberOfReplicas Int
352 | AutoExpandReplicas ReplicaBounds
364 | AutoExpandReplicas ReplicaBounds
353 | BlocksReadOnly Bool
365 | BlocksReadOnly Bool
@@ -364,17 +376,20 @@ data IndexSettingUpdate = NumberOfReplicas Int
364 | CacheFilterMaxSize (Maybe Bytes)
376 | CacheFilterMaxSize (Maybe Bytes)
365 | CacheFilterExpire (Maybe NominalDiffTime)
377 | CacheFilterExpire (Maybe NominalDiffTime)
366 | GatewaySnapshotInterval NominalDiffTime
378 | GatewaySnapshotInterval NominalDiffTime
379+ | RoutingAllocationInclude (NonEmpty NodeAttrFilter)
380+ | RoutingAllocationExclude (NonEmpty NodeAttrFilter)
381+ | RoutingAllocationRequire (NonEmpty NodeAttrFilter)
367 | RoutingAllocationDisable Bool
382 | RoutingAllocationDisable Bool
368 | RoutingAllocationDisableNew Bool
383 | RoutingAllocationDisableNew Bool
369 | RoutingAllocationDisableReplica Bool
384 | RoutingAllocationDisableReplica Bool
370 | RoutingAllocationEnable AllocationPolicy
385 | RoutingAllocationEnable AllocationPolicy
371 | RoutingAllocationShardsPerNode ShardCount
386 | RoutingAllocationShardsPerNode ShardCount
372− | RecoveryInitialShards --TODO: shard count or quorum specifications
387+ | RecoveryInitialShards InitialShardCount
373− | GCDeletes
388+ | GCDeletes NominalDiffTime
374 | TTLDisablePurge Bool
389 | TTLDisablePurge Bool
375 | TranslogFSType FSType
390 | TranslogFSType FSType
376− | TranslogCompoundFormat
391+ | IndexCompoundFormat CompoundFormat
377− | TranslogCompoundOnFlush
392+ | IndexCompoundOnFlush Bool
378 | WarmerEnabled Bool
393 | WarmerEnabled Bool
379 --TODO: figure out allocation options
394 --TODO: figure out allocation options
380
395
@@ -387,6 +402,28 @@ data ReplicaBounds = ReplicasBounded Int Int
387 | ReplicasLowerBounded Int
402 | ReplicasLowerBounded Int
388 | ReplicasUnbounded
403 | ReplicasUnbounded
389
404
405+newtype Bytes = Bytes Int deriving (Eq, Show, Ord, ToJSON)
406+
407+data FSType = FSSimple
408+ | FSBuffered deriving (Eq, Show, Ord)
409+
410+data InitialShardCount = QuorumShards
411+ | QuorumMinus1Shards
412+ | FullShards
413+ | FullMinus1Shards
414+ | ExplicitShards Int
415+
416+data NodeAttrFilter = NodeAttrFilter { nodeAttrFilterName :: NodeAttrName
417+ , nodeAttrFilterValues :: NonEmpty Text}
418+
419+newtype NodeAttrName = NodeAttrName Text
420+
421+data CompoundFormat = CompoundFileFormat Bool
422+ | MergeSegmentVsTotalIndex Double
423+ -- ^ percentage between 0 and 1 where 0 is false, 1 is true
424+
425+newtype NominalDiffTimeJSON = NominalDiffTimeJSON NominalDiffTime
426+
390{-| 'Reply' and 'Method' are type synonyms from 'Network.HTTP.Types.Method.Method' -}
427{-| 'Reply' and 'Method' are type synonyms from 'Network.HTTP.Types.Method.Method' -}
391type Reply = Network.HTTP.Client.Response L.ByteString
428type Reply = Network.HTTP.Client.Response L.ByteString
392type Method = NHTM.Method
429type Method = NHTM.Method
@@ -2144,6 +2181,76 @@ instance ToJSON IndexSettings where
2144 ]
2181 ]
2145 ]
2182 ]
2146
2183
2184+instance ToJSON IndexSettingUpdate where
2185+ toJSON (NumberOfReplicas x) = oPath ("index" :| ["number_of_replicas"]) x
2186+ toJSON (AutoExpandReplicas x) = oPath ("index" :| ["auto_expand_replicas"]) x
2187+ toJSON (BlocksReadOnly x) = oPath ("blocks" :| ["read_only"]) x
2188+ toJSON (BlocksRead x) = oPath ("blocks" :| ["read"]) x
2189+ toJSON (BlocksWrite x) = oPath ("blocks" :| ["write"]) x
2190+ toJSON (BlocksMetaData x) = oPath ("blocks" :| ["metadata"]) x
2191+ toJSON (RefreshInterval x) = oPath ("index" :| ["refresh_interval"]) (NominalDiffTimeJSON x)
2192+ toJSON (IndexConcurrency x) = oPath ("index" :| ["concurrency"]) x
2193+ toJSON (FailOnMergeFailure x) = oPath ("index" :| ["fail_on_merge_failure"]) x
2194+ toJSON (TranslogFlushThresholdOps x) = oPath ("index" :| ["translog", "flush_threshold_ops"]) x
2195+ toJSON (TranslogFlushThresholdSize x) = oPath ("index" :| ["translog", "flush_threshold_size"]) x
2196+ toJSON (TranslogFlushThresholdPeriod x) = oPath ("index" :| ["translog", "flush_threshold_period"]) (NominalDiffTimeJSON x)
2197+ toJSON (TranslogDisableFlush x) = oPath ("index" :| ["translog", "disable_flush"]) x
2198+ toJSON (CacheFilterMaxSize x) = oPath ("index" :| ["cache", "filter", "max_size"]) x
2199+ toJSON (CacheFilterExpire x) = oPath ("index" :| ["cache", "filter", "expire"]) (NominalDiffTimeJSON <$> x)
2200+ toJSON (GatewaySnapshotInterval x) = oPath ("index" :| ["gateway", "snapshot_interval"]) (NominalDiffTimeJSON x)
2201+ toJSON (RoutingAllocationInclude fs) = oPath ("index" :| ["routing", "allocation", "include"]) (attrFilterJSON fs)
2202+ toJSON (RoutingAllocationExclude fs) = oPath ("index" :| ["routing", "allocation", "exclude"]) (attrFilterJSON fs)
2203+ toJSON (RoutingAllocationRequire fs) = oPath ("index" :| ["routing", "allocation", "require"]) (attrFilterJSON fs)
2204+ toJSON (RoutingAllocationDisable x) = oPath ("index" :| ["routing", "allocation", "disable_allocation"]) x
2205+ toJSON (RoutingAllocationDisableNew x) = oPath ("index" :| ["routing", "allocation", "disable_new_allocation"]) x
2206+ toJSON (RoutingAllocationDisableReplica x) = oPath ("index" :| ["routing", "allocation", "disable_replica_allocation"]) x
2207+ toJSON (RoutingAllocationEnable x) = oPath ("index" :| ["routing", "allocation", "enable"]) x
2208+ toJSON (RoutingAllocationShardsPerNode x) = oPath ("index" :| ["routing", "allocation", "total_shards_per_node"]) x
2209+ toJSON (RecoveryInitialShards x) = oPath ("index" :| ["recovery", "initial_shards"]) x
2210+ toJSON (GCDeletes x) = oPath ("index" :| ["gc_deletes"]) (NominalDiffTimeJSON x)
2211+ toJSON (TTLDisablePurge x) = oPath ("index" :| ["ttl", "disable_purge"]) x
2212+ toJSON (TranslogFSType x) = oPath ("index" :| ["translog", "fs", "type"]) x
2213+ toJSON (IndexCompoundFormat x) = oPath ("index" :| ["compound_format"]) x
2214+ toJSON (IndexCompoundOnFlush x) = oPath ("index" :| ["compound_on_flush"]) x
2215+ toJSON (WarmerEnabled x) = oPath ("index" :| ["warmer", "enabled"]) x
2216+
2217+oPath :: ToJSON a => NonEmpty Text -> a -> Value
2218+oPath (k :| []) v = object [k .= v]
2219+oPath (k:| (h:t)) v = object [k .= oPath (h :| t) v]
2220+
2221+attrFilterJSON :: NonEmpty NodeAttrFilter -> Value
2222+attrFilterJSON fs = object [ n .= T.intercalate "," (toList vs)
2223+ | NodeAttrFilter (NodeAttrName n) vs <- toList fs]
2224+
2225+instance ToJSON ReplicaBounds where
2226+ toJSON (ReplicasBounded a b) = String (showText a <> "-" <> showText b)
2227+ toJSON (ReplicasLowerBounded a) = String (showText a <> "-all")
2228+ toJSON ReplicasUnbounded = Bool False
2229+
2230+instance ToJSON AllocationPolicy where
2231+ toJSON AllocAll = String "all"
2232+ toJSON AllocPrimaries = String "primaries"
2233+ toJSON AllocNewPrimaries = String "new_primaries"
2234+ toJSON AllocNone = String "none"
2235+
2236+instance ToJSON InitialShardCount where
2237+ toJSON QuorumShards = String "quorum"
2238+ toJSON QuorumMinus1Shards = String "quorum-1"
2239+ toJSON FullShards = String "full"
2240+ toJSON FullMinus1Shards = String "full-1"
2241+ toJSON (ExplicitShards x) = toJSON x
2242+
2243+instance ToJSON FSType where
2244+ toJSON FSSimple = "simple"
2245+ toJSON FSBuffered = "buffered"
2246+
2247+instance ToJSON CompoundFormat where
2248+ toJSON (CompoundFileFormat x) = Bool x
2249+ toJSON (MergeSegmentVsTotalIndex x) = toJSON x
2250+
2251+instance ToJSON NominalDiffTimeJSON where
2252+ toJSON (NominalDiffTimeJSON t) = String (showText (round t :: Integer) <> "s")
2253+
2147instance ToJSON IndexTemplate where
2254instance ToJSON IndexTemplate where
2148 toJSON (IndexTemplate p s m) = merge
2255 toJSON (IndexTemplate p s m) = merge
2149 (object [ "template" .= p
2256 (object [ "template" .= p