e28dd02 · typeable/bloodhound

git.iko.soy/typeable/bloodhound

on master help sign in

WIP index settings parser tests

e28dd02Michael Xavier11 years ago

src/Database/Bloodhound/Client.hs+5−3

compare with master

unifiedsplit

@@ -295,9 +295,11 @@ updateIndexSettings updates (IndexName indexName) =

295

296--TODO: This feels a little nicer than returning a reply and coyly

297--implying that it *should* be an IndexSettingsSummary

298+getIndexSettings :: (MonadBH m, MonadThrow m) => IndexName

298−getIndexSettings :: MonadBH m => IndexName -> m (Either EsError IndexSettingsSummary)

299+ -> m (Either EsError IndexSettingsSummary)

299−getIndexSettings (IndexName indexName) = undefined

300+getIndexSettings (IndexName indexName) =

300−

301+ parseEsResponse =<< get =<< url

302+ where url = joinPath [indexName, "_settings"]

301

303

302

304

303deepMerge :: [Object] -> Object

305deepMerge :: [Object] -> Object

src/Database/Bloodhound/Types.hs+148−7

@@ -453,7 +453,7 @@ data ReplicaBounds = ReplicasBounded Int Int

453 | ReplicasUnbounded

454 deriving (Eq, Show)

455

456−newtype Bytes = Bytes Int deriving (Eq, Show, Ord, ToJSON)

456+newtype Bytes = Bytes Int deriving (Eq, Show, Ord, ToJSON, FromJSON)

457

458data FSType = FSSimple

459 | FSBuffered deriving (Eq, Show, Ord)

@@ -476,9 +476,10 @@ data CompoundFormat = CompoundFileFormat Bool

476 -- ^ percentage between 0 and 1 where 0 is false, 1 is true

477 deriving (Eq, Show)

478

479−newtype NominalDiffTimeJSON = NominalDiffTimeJSON NominalDiffTime

479+newtype NominalDiffTimeJSON = NominalDiffTimeJSON { ndtJSON :: NominalDiffTime }

480

481−data IndexSettingsSummary = IndexSettingsSummary { sSummaryShardCount :: ShardCount

481+data IndexSettingsSummary = IndexSettingsSummary { sSummaryIndexName :: IndexName

482+ , sSummaryFixedSettings :: IndexSettings

482 , sSummaryUpdateable :: [UpdatableIndexSetting]}

483 , sSummaryUpdateable :: [UpdatableIndexSetting]}

483 deriving (Eq, Show)

484 deriving (Eq, Show)

484

485

@@ -1486,6 +1487,14 @@ type HitHighlight = M.Map Text [Text]

1486showText :: Show a => a -> Text

1487showText :: Show a => a -> Text

1487showText = T.pack . show

1488showText = T.pack . show

1488

1489

1490+readMay :: Read a => String -> Maybe a

1491+readMay s = case reads s of

1492+ (a, ""):_ -> Just a

1493+ _ -> Nothing

1494+

1495+parseReadText :: Read a => Text -> Parser a

1496+parseReadText = maybe mzero return . readMay . T.unpack

1497+

1489type Aggregations = M.Map Text Aggregation

1498type Aggregations = M.Map Text Aggregation

1490

1499

1491emptyAggregations :: Aggregations

1500emptyAggregations :: Aggregations

@@ -2784,13 +2793,16 @@ instance ToJSON IndexSettings where

2784 ]

2793 ]

2785 ]

2794 ]

2786

2795

2796+instance FromJSON IndexSettings where

2797+ parseJSON = withObject "IndexSettings" parse

2798+ where parse o = do s <- o .: "settings"

2799+ i <- s .: "index"

2800+ IndexSettings <$> i .: "number_of_shards"

2801+ <*> i .: "number_of_replicas"

2802+

2787instance ToJSON UpdatableIndexSetting where

2803instance ToJSON UpdatableIndexSetting where

2788 toJSON (NumberOfReplicas x) = oPath ("index" :| ["number_of_replicas"]) x

2804 toJSON (NumberOfReplicas x) = oPath ("index" :| ["number_of_replicas"]) x

2789 toJSON (AutoExpandReplicas x) = oPath ("index" :| ["auto_expand_replicas"]) x

2805 toJSON (AutoExpandReplicas x) = oPath ("index" :| ["auto_expand_replicas"]) x

2790− toJSON (BlocksReadOnly x) = oPath ("blocks" :| ["read_only"]) x

2791− toJSON (BlocksRead x) = oPath ("blocks" :| ["read"]) x

2792− toJSON (BlocksWrite x) = oPath ("blocks" :| ["write"]) x

2793− toJSON (BlocksMetaData x) = oPath ("blocks" :| ["metadata"]) x

2794 toJSON (RefreshInterval x) = oPath ("index" :| ["refresh_interval"]) (NominalDiffTimeJSON x)

2806 toJSON (RefreshInterval x) = oPath ("index" :| ["refresh_interval"]) (NominalDiffTimeJSON x)

2795 toJSON (IndexConcurrency x) = oPath ("index" :| ["concurrency"]) x

2807 toJSON (IndexConcurrency x) = oPath ("index" :| ["concurrency"]) x

2796 toJSON (FailOnMergeFailure x) = oPath ("index" :| ["fail_on_merge_failure"]) x

2808 toJSON (FailOnMergeFailure x) = oPath ("index" :| ["fail_on_merge_failure"]) x

@@ -2813,6 +2825,81 @@ instance ToJSON UpdatableIndexSetting where

2813 toJSON (IndexCompoundFormat x) = oPath ("index" :| ["compound_format"]) x

2825 toJSON (IndexCompoundFormat x) = oPath ("index" :| ["compound_format"]) x

2814 toJSON (IndexCompoundOnFlush x) = oPath ("index" :| ["compound_on_flush"]) x

2826 toJSON (IndexCompoundOnFlush x) = oPath ("index" :| ["compound_on_flush"]) x

2815 toJSON (WarmerEnabled x) = oPath ("index" :| ["warmer", "enabled"]) x

2827 toJSON (WarmerEnabled x) = oPath ("index" :| ["warmer", "enabled"]) x

2828+ toJSON (BlocksReadOnly x) = oPath ("blocks" :| ["read_only"]) x

2829+ toJSON (BlocksRead x) = oPath ("blocks" :| ["read"]) x

2830+ toJSON (BlocksWrite x) = oPath ("blocks" :| ["write"]) x

2831+ toJSON (BlocksMetaData x) = oPath ("blocks" :| ["metadata"]) x

2832+

2833+instance FromJSON UpdatableIndexSetting where

2834+ parseJSON = withObject "UpdatableIndexSetting" parse

2835+ where parse o = numberOfReplicas `taggedAt` ["index", "number_of_replicas"]

2836+ <|> autoExpandReplicas `taggedAt` ["index", "auto_expand_replicas"]

2837+ <|> refreshInterval `taggedAt` ["index", "refresh_interval"]

2838+ <|> indexConcurrency `taggedAt` ["index", "concurrency"]

2839+ <|> failOnMergeFailure `taggedAt` ["index", "fail_on_merge_failure"]

2840+ <|> translogFlushThresholdOps `taggedAt` ["index", "translog", "flush_threshold_ops"]

2841+ <|> translogFlushThresholdSize `taggedAt` ["index", "translog", "flush_threshold_size"]

2842+ <|> translogFlushThresholdPeriod `taggedAt` ["index", "translog", "flush_threshold_period"]

2843+ <|> translogDisableFlush `taggedAt` ["index", "translog", "disable_flush"]

2844+ <|> cacheFilterMaxSize `taggedAt` ["index", "cache", "filter", "max_size"]

2845+ <|> cacheFilterExpire `taggedAt` ["index", "cache", "filter", "expire"]

2846+ <|> gatewaySnapshotInterval `taggedAt` ["index", "gateway", "snapshot_interval"]

2847+ <|> routingAllocationInclude `taggedAt` ["index", "routing", "allocation", "include"]

2848+ <|> routingAllocationExclude `taggedAt` ["index", "routing", "allocation", "exclude"]

2849+ <|> routingAllocationRequire `taggedAt` ["index", "routing", "allocation", "require"]

2850+ <|> routingAllocationEnable `taggedAt` ["index", "routing", "allocation", "enable"]

2851+ <|> routingAllocationShardsPerNode `taggedAt` ["index", "routing", "allocation", "total_shards_per_node"]

2852+ <|> recoveryInitialShards `taggedAt` ["index", "recovery", "initial_shards"]

2853+ <|> gcDeletes `taggedAt` ["index", "gc_deletes"]

2854+ <|> ttlDisablePurge `taggedAt` ["index", "ttl", "disable_purge"]

2855+ <|> translogFSType `taggedAt` ["index", "translog", "fs", "type"]

2856+ <|> compoundFormat `taggedAt` ["index", "compound_format"]

2857+ <|> compoundOnFlush `taggedAt` ["index", "compound_on_flush"]

2858+ <|> warmerEnabled `taggedAt` ["index", "warmer", "enabled"]

2859+ <|> blocksReadOnly `taggedAt` ["blocks", "read_only"]

2860+ <|> blocksRead `taggedAt` ["blocks", "read"]

2861+ <|> blocksWrite `taggedAt` ["blocks", "write"]

2862+ <|> blocksMetaData `taggedAt` ["blocks", "metadata"]

2863+ where taggedAt f ks = taggedAt' f (Object o) ks

2864+ taggedAt' f v [] = f =<< parseJSON v

2865+ taggedAt' f v (k:ks) = withObject "Object" (\o -> do v' <- o .: k

2866+ taggedAt' f v' ks) v

2867+ numberOfReplicas = pure . NumberOfReplicas

2868+ autoExpandReplicas = pure . AutoExpandReplicas

2869+ refreshInterval = pure . RefreshInterval . ndtJSON

2870+ indexConcurrency = pure . IndexConcurrency

2871+ failOnMergeFailure = pure . FailOnMergeFailure

2872+ translogFlushThresholdOps = pure . TranslogFlushThresholdOps

2873+ translogFlushThresholdSize = pure . TranslogFlushThresholdSize

2874+ translogFlushThresholdPeriod = pure . TranslogFlushThresholdPeriod . ndtJSON

2875+ translogDisableFlush = pure . TranslogDisableFlush

2876+ cacheFilterMaxSize = pure . CacheFilterMaxSize

2877+ cacheFilterExpire = pure . CacheFilterExpire . fmap ndtJSON

2878+ gatewaySnapshotInterval = pure . GatewaySnapshotInterval . ndtJSON

2879+ routingAllocationInclude = fmap RoutingAllocationInclude . parseAttrFilter

2880+ routingAllocationExclude = fmap RoutingAllocationExclude . parseAttrFilter

2881+ routingAllocationRequire = fmap RoutingAllocationRequire . parseAttrFilter

2882+ routingAllocationEnable = pure . RoutingAllocationEnable

2883+ routingAllocationShardsPerNode = pure . RoutingAllocationShardsPerNode

2884+ recoveryInitialShards = pure . RecoveryInitialShards

2885+ gcDeletes = pure . GCDeletes . ndtJSON

2886+ ttlDisablePurge = pure . TTLDisablePurge

2887+ translogFSType = pure . TranslogFSType

2888+ compoundFormat = pure . IndexCompoundFormat

2889+ compoundOnFlush = pure . IndexCompoundOnFlush

2890+ warmerEnabled = pure . WarmerEnabled

2891+ blocksReadOnly = pure . BlocksReadOnly

2892+ blocksRead = pure . BlocksRead

2893+ blocksWrite = pure . BlocksWrite

2894+ blocksMetaData = pure . BlocksMetaData

2895+

2896+instance FromJSON IndexSettingsSummary where

2897+ parseJSON = withObject "IndexSettingsSummary" parse

2898+ where parse o = case HM.toList o of

2899+ [(ixn, v)] -> IndexSettingsSummary (IndexName ixn)

2900+ <$> parseJSON v

2901+ <*> parseJSON v

2902+ _ -> fail "Expected single-key object with index name"

2816

2903

2817oPath :: ToJSON a => NonEmpty Text -> a -> Value

2904oPath :: ToJSON a => NonEmpty Text -> a -> Value

2818oPath (k :| []) v = object [k .= v]

2905oPath (k :| []) v = object [k .= v]

@@ -2822,17 +2909,46 @@ attrFilterJSON :: NonEmpty NodeAttrFilter -> Value

2822attrFilterJSON fs = object [ n .= T.intercalate "," (toList vs)

2909attrFilterJSON fs = object [ n .= T.intercalate "," (toList vs)

2823 | NodeAttrFilter (NodeAttrName n) vs <- toList fs]

2910 | NodeAttrFilter (NodeAttrName n) vs <- toList fs]

2824

2911

2912+parseAttrFilter :: Value -> Parser (NonEmpty NodeAttrFilter)

2913+parseAttrFilter = withObject "NonEmpty NodeAttrFilter" parse

2914+ where parse o = case HM.toList o of

2915+ [] -> fail "Expected non-empty list of NodeAttrFilters"

2916+ x:xs -> DT.mapM (uncurry parse') (x :| xs)

2917+ parse' n = withText "Text" $ \t ->

2918+ case T.splitOn "," t of

2919+ fv:fvs -> return (NodeAttrFilter (NodeAttrName n) (fv :| fvs))

2920+ [] -> fail "Expected non-empty list of filter values"

2921+

2825instance ToJSON ReplicaBounds where

2922instance ToJSON ReplicaBounds where

2826 toJSON (ReplicasBounded a b) = String (showText a <> "-" <> showText b)

2923 toJSON (ReplicasBounded a b) = String (showText a <> "-" <> showText b)

2827 toJSON (ReplicasLowerBounded a) = String (showText a <> "-all")

2924 toJSON (ReplicasLowerBounded a) = String (showText a <> "-all")

2828 toJSON ReplicasUnbounded = Bool False

2925 toJSON ReplicasUnbounded = Bool False

2829

2926

2927+instance FromJSON ReplicaBounds where

2928+ parseJSON v = withText "ReplicaBounds" parseText v

2929+ <|> withBool "ReplicaBounds" parseBool v

2930+ where parseText t = case T.splitOn "-" t of

2931+ [a, "all"] -> ReplicasLowerBounded <$> parseReadText a

2932+ [a, b] -> ReplicasBounded <$> parseReadText a

2933+ <*> parseReadText b

2934+ _ -> fail ("Could not parse ReplicaBounds: " <> show t)

2935+ parseBool False = pure ReplicasUnbounded

2936+ parseBool _ = fail "ReplicasUnbounded cannot be represented with True"

2937+

2830instance ToJSON AllocationPolicy where

2938instance ToJSON AllocationPolicy where

2831 toJSON AllocAll = String "all"

2939 toJSON AllocAll = String "all"

2832 toJSON AllocPrimaries = String "primaries"

2940 toJSON AllocPrimaries = String "primaries"

2833 toJSON AllocNewPrimaries = String "new_primaries"

2941 toJSON AllocNewPrimaries = String "new_primaries"

2834 toJSON AllocNone = String "none"

2942 toJSON AllocNone = String "none"

2835

2943

2944+instance FromJSON AllocationPolicy where

2945+ parseJSON = withText "AllocationPolicy" parse

2946+ where parse "all" = pure AllocAll

2947+ parse "primaries" = pure AllocPrimaries

2948+ parse "new_primaries" = pure AllocNewPrimaries

2949+ parse "none" = pure AllocNone

2950+ parse t = fail ("Invlaid AllocationPolicy: " <> show t)

2951+

2836instance ToJSON InitialShardCount where

2952instance ToJSON InitialShardCount where

2837 toJSON QuorumShards = String "quorum"

2953 toJSON QuorumShards = String "quorum"

2838 toJSON QuorumMinus1Shards = String "quorum-1"

2954 toJSON QuorumMinus1Shards = String "quorum-1"

@@ -2840,17 +2956,42 @@ instance ToJSON InitialShardCount where

2840 toJSON FullMinus1Shards = String "full-1"

2956 toJSON FullMinus1Shards = String "full-1"

2841 toJSON (ExplicitShards x) = toJSON x

2957 toJSON (ExplicitShards x) = toJSON x

2842

2958

2959+instance FromJSON InitialShardCount where

2960+ parseJSON v = withText "InitialShardCount" parseText v

2961+ <|> ExplicitShards <$> parseJSON v

2962+ where parseText "quorum" = pure QuorumShards

2963+ parseText "quorum-1" = pure QuorumMinus1Shards

2964+ parseText "full" = pure FullShards

2965+ parseText "full-1" = pure FullMinus1Shards

2966+ parseText _ = mzero

2967+

2843instance ToJSON FSType where

2968instance ToJSON FSType where

2844 toJSON FSSimple = "simple"

2969 toJSON FSSimple = "simple"

2845 toJSON FSBuffered = "buffered"

2970 toJSON FSBuffered = "buffered"

2846

2971

2972+instance FromJSON FSType where

2973+ parseJSON = withText "FSType" parse

2974+ where parse "simple" = pure FSSimple

2975+ parse "buffered" = pure FSBuffered

2976+ parse t = fail ("Invalid FSType: " <> show t)

2977+

2847instance ToJSON CompoundFormat where

2978instance ToJSON CompoundFormat where

2848 toJSON (CompoundFileFormat x) = Bool x

2979 toJSON (CompoundFileFormat x) = Bool x

2849 toJSON (MergeSegmentVsTotalIndex x) = toJSON x

2980 toJSON (MergeSegmentVsTotalIndex x) = toJSON x

2850

2981

2982+instance FromJSON CompoundFormat where

2983+ parseJSON v = CompoundFileFormat <$> parseJSON v

2984+ <|> MergeSegmentVsTotalIndex <$> parseJSON v

2985+

2851instance ToJSON NominalDiffTimeJSON where

2986instance ToJSON NominalDiffTimeJSON where

2852 toJSON (NominalDiffTimeJSON t) = String (showText (round t :: Integer) <> "s")

2987 toJSON (NominalDiffTimeJSON t) = String (showText (round t :: Integer) <> "s")

2853

2988

2989+instance FromJSON NominalDiffTimeJSON where

2990+ parseJSON = withText "NominalDiffTime" parse

2991+ where parse t = case T.takeEnd 1 t of

2992+ "s" -> NominalDiffTimeJSON . fromInteger <$> parseReadText t

2993+ _ -> fail "Invalid or missing NominalDiffTime unit (expected s)"

2994+

2854instance ToJSON IndexTemplate where

2995instance ToJSON IndexTemplate where

2855 toJSON (IndexTemplate p s m) = merge

2996 toJSON (IndexTemplate p s m) = merge

2856 (object [ "template" .= p

2997 (object [ "template" .= p

tests/tests.hs+40−1

@@ -13,6 +13,7 @@ import Control.Monad

13import Control.Monad.Reader

14import Data.Aeson

15import Data.Aeson.Types (parseEither)

16+import qualified Data.ByteString.Lazy.Char8 as BL8

16import Data.DeriveTH

17import Data.DeriveTH

17import qualified Data.HashMap.Strict as HM

18import qualified Data.HashMap.Strict as HM

18import Data.List (nub)

19import Data.List (nub)

@@ -112,7 +113,8 @@ when' b f = b >>= \x -> when x f

112

113

113propJSON :: forall a. (Arbitrary a, ToJSON a, FromJSON a, Show a, Eq a, Typeable a) => Proxy a -> Spec

114propJSON :: forall a. (Arbitrary a, ToJSON a, FromJSON a, Show a, Eq a, Typeable a) => Proxy a -> Spec

114propJSON _ = prop testName $ \(a :: a) ->

115propJSON _ = prop testName $ \(a :: a) ->

116+ let jsonStr = "via " <> BL8.unpack (encode a)

115− parseEither parseJSON (toJSON a) === Right a

117+ in counterexample jsonStr (parseEither parseJSON (toJSON a) === Right a)

116 where testName = show ty <> " FromJSON/ToJSON roundtrips"

118 where testName = show ty <> " FromJSON/ToJSON roundtrips"

117 ty = typeOf (undefined :: a)

119 ty = typeOf (undefined :: a)

118

120

@@ -402,6 +404,28 @@ instance Arbitrary Filter where

402 , RegexpFilter <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary

404 , RegexpFilter <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary

403 , TermFilter <$> arbitrary <*> arbitrary]

405 , TermFilter <$> arbitrary <*> arbitrary]

404

406

407+instance Arbitrary ReplicaBounds where

408+ arbitrary = oneof [ replicasBounded

409+ , replicasLowerBounded

410+ , pure ReplicasUnbounded

411+ ]

412+ where replicasBounded = do Positive a <- arbitrary

413+ Positive b <- arbitrary

414+ return (ReplicasBounded a b)

415+ replicasLowerBounded = do Positive a <- arbitrary

416+ return (ReplicasLowerBounded a)

417+

418+instance Arbitrary NodeAttrName where

419+ arbitrary = NodeAttrName . T.pack . getNonEmpty <$> arbitrary

420+

421+

422+instance Arbitrary NodeAttrFilter where

423+ arbitrary = do

424+ n <- arbitrary

425+ s:ss <- listOf1 (listOf1 arbitraryAlphaNum)

426+ let ts = T.pack <$> s :| ss

427+ return (NodeAttrFilter n ts)

428+

405$(derive makeArbitrary ''IndexName)

429$(derive makeArbitrary ''IndexName)

406$(derive makeArbitrary ''MappingName)

430$(derive makeArbitrary ''MappingName)

407$(derive makeArbitrary ''DocId)

431$(derive makeArbitrary ''DocId)

@@ -500,6 +524,13 @@ $(derive makeArbitrary ''RangeExecution)

500$(derive makeArbitrary ''RegexpFlag)

524$(derive makeArbitrary ''RegexpFlag)

501$(derive makeArbitrary ''BoolMatch)

525$(derive makeArbitrary ''BoolMatch)

502$(derive makeArbitrary ''Term)

526$(derive makeArbitrary ''Term)

527+$(derive makeArbitrary ''IndexSettings)

528+$(derive makeArbitrary ''UpdatableIndexSetting)

529+$(derive makeArbitrary ''Bytes)

530+$(derive makeArbitrary ''AllocationPolicy)

531+$(derive makeArbitrary ''InitialShardCount)

532+$(derive makeArbitrary ''FSType)

533+$(derive makeArbitrary ''CompoundFormat)

503

534

504

535

505main :: IO ()

536main :: IO ()

@@ -1237,3 +1268,11 @@ main = hspec $ do

1237 propJSON (Proxy :: Proxy BoolMatch)

1268 propJSON (Proxy :: Proxy BoolMatch)

1238 propJSON (Proxy :: Proxy Term)

1269 propJSON (Proxy :: Proxy Term)

1239 propJSON (Proxy :: Proxy MultiMatchQuery)

1270 propJSON (Proxy :: Proxy MultiMatchQuery)

1271+ propJSON (Proxy :: Proxy IndexSettings)

1272+ propJSON (Proxy :: Proxy UpdatableIndexSetting)

1273+ propJSON (Proxy :: Proxy ReplicaBounds)

1274+ propJSON (Proxy :: Proxy Bytes)

1275+ propJSON (Proxy :: Proxy AllocationPolicy)

1276+ propJSON (Proxy :: Proxy InitialShardCount)

1277+ propJSON (Proxy :: Proxy FSType)

1278+ propJSON (Proxy :: Proxy CompoundFormat)