@@ -62,6 +62,16 @@ module Database.Bloodhound.Types
6262 , EsResult(..)
6363 , EsResultFound(..)
6464 , EsError(..)
65+ , IndexAlias(..)
66+ , IndexAliasName(..)
67+ , IndexAliasAction(..)
68+ , IndexAliasCreate(..)
69+ , IndexAliasSummary(..)
70+ , IndexAliasesSummary(..)
71+ , AliasRouting(..)
72+ , SearchAliasRouting(..)
73+ , IndexAliasRouting(..)
74+ , RoutingValue(..)
6575 , DocVersion
6676 , ExternalDocVersion(..)
6777 , VersionControl(..)
@@ -237,9 +247,11 @@ import Control.Monad.Reader
237247import Control.Monad.State
238248import Control.Monad.Writer
239249import Data.Aeson
240−import Data.Aeson.Types (Pair, emptyObject, parseMaybe)
250+import Data.Aeson.Types (Pair, Parser, emptyObject,
251+ parseMaybe)
241252import qualified Data.ByteString.Lazy.Char8 as L
242−import qualified Data.HashMap.Strict as HM (union)
253+import Data.Char
254+import qualified Data.HashMap.Strict as HM
243255import Data.List (foldl', nub)
244256import Data.List.NonEmpty (NonEmpty (..), toList)
245257import qualified Data.Map.Strict as M
@@ -247,6 +259,7 @@ import Data.Maybe
247259import Data.Text (Text)
248260import qualified Data.Text as T
249261import Data.Time.Clock (UTCTime)
262+import qualified Data.Traversable as DT
250263import qualified Data.Vector as V
251264import GHC.Enum
252265import GHC.Generics (Generic)
@@ -430,6 +443,32 @@ data EsResultFound a = EsResultFound { _version :: DocVersion
430443data EsError = EsError { errorStatus :: Int
431444 , errorMessage :: Text } deriving (Eq, Show)
432445
446+data IndexAlias = IndexAlias { srcIndex :: IndexName
447+ , indexAlias :: IndexAliasName } deriving (Eq, Show)
448+
449+newtype IndexAliasName = IndexAliasName { indexAliasName :: IndexName } deriving (Eq, Show, ToJSON)
450+
451+data IndexAliasAction = AddAlias IndexAlias IndexAliasCreate
452+ | RemoveAlias IndexAlias deriving (Show, Eq)
453+
454+data IndexAliasCreate = IndexAliasCreate { aliasCreateRouting :: Maybe AliasRouting
455+ , aliasCreateFilter :: Maybe Filter}
456+ deriving (Show, Eq)
457+
458+data AliasRouting = AllAliasRouting RoutingValue
459+ | GranularAliasRouting (Maybe SearchAliasRouting) (Maybe IndexAliasRouting)
460+ deriving (Show, Eq)
461+
462+newtype SearchAliasRouting = SearchAliasRouting (NonEmpty RoutingValue) deriving (Show, Eq)
463+
464+newtype IndexAliasRouting = IndexAliasRouting RoutingValue deriving (Show, Eq, ToJSON, FromJSON)
465+
466+newtype RoutingValue = RoutingValue { routingValue :: Text } deriving (Show, Eq, ToJSON, FromJSON)
467+
468+newtype IndexAliasesSummary = IndexAliasesSummary [IndexAliasSummary]
469+
470+data IndexAliasSummary = IndexAliasSummary { indexAliasSummaryAlias :: IndexAlias
471+ , indexAliasSummaryCreate :: IndexAliasCreate}
433472
434473{-| 'DocVersion' is an integer version number for a document between 1
435474and 9.2e+18 used for <<https://www.elastic.co/guide/en/elasticsearch/guide/current/optimistic-concurrency-control.html optimistic concurrency control>>.
@@ -625,7 +664,7 @@ newtype QueryString = QueryString Text deriving (Eq, Generic, Show)
625664{-| 'FieldName' is used all over the place wherever a specific field within
626665 a document needs to be specified, usually in 'Query's or 'Filter's.
627666-}
628−newtype FieldName = FieldName Text deriving (Eq, Show)
667+newtype FieldName = FieldName Text deriving (Eq, Show, FromJSON)
629668
630669
631670{-| 'Script' is often used in place of 'FieldName' to specify more
@@ -636,16 +675,16 @@ newtype Script = Script { scriptText :: Text } deriving (Eq, Show)
636675{-| 'CacheName' is used in 'RegexpFilter' for describing the
637676 'CacheKey' keyed caching behavior.
638677-}
639−newtype CacheName = CacheName Text deriving (Eq, Show)
678+newtype CacheName = CacheName Text deriving (Eq, Show, FromJSON)
640679
641680{-| 'CacheKey' is used in 'RegexpFilter' to key regex caching.
642681-}
643682newtype CacheKey =
644− CacheKey Text deriving (Eq, Show)
683+ CacheKey Text deriving (Eq, Show, FromJSON)
645684newtype Existence =
646− Existence Bool deriving (Eq, Show)
685+ Existence Bool deriving (Eq, Show, FromJSON)
647686newtype NullValue =
648− NullValue Bool deriving (Eq, Show)
687+ NullValue Bool deriving (Eq, Show, FromJSON)
649688newtype CutoffFrequency =
650689 CutoffFrequency Double deriving (Eq, Show, Generic)
651690newtype Analyzer =
@@ -1168,7 +1207,7 @@ data ZeroTermsQuery = ZeroTermsNone
11681207data RangeExecution = RangeExecutionIndex
11691208 | RangeExecutionFielddata deriving (Eq, Show)
11701209
1171−newtype Regexp = Regexp Text deriving (Eq, Show)
1210+newtype Regexp = Regexp Text deriving (Eq, Show, FromJSON)
11721211
11731212data RegexpFlags = AllRegexpFlags
11741213 | NoRegexpFlags
@@ -1641,6 +1680,75 @@ instance ToJSON Filter where
16411680 , "_cache" .= cache
16421681 , "_cache_key" .= cacheKey]]
16431682
1683+instance FromJSON Filter where
1684+ parseJSON = withObject "Filter" parse
1685+ where parse o = andFilter `taggedWith` "and"
1686+ <|> orFilter `taggedWith` "or"
1687+ <|> notFilter `taggedWith` "not"
1688+ <|> identityFilter `taggedWith` "match_all"
1689+ <|> boolFilter `taggedWith` "bool"
1690+ <|> existsFilter `taggedWith` "exists"
1691+ <|> geoBoundingBoxFilter `taggedWith` "geo_bounding_box"
1692+ <|> geoDistanceFilter `taggedWith` "geo_distance"
1693+ <|> geoDistanceRangeFilter `taggedWith` "geo_distance_range"
1694+ <|> geoPolygonFilter `taggedWith` "geo_polygon"
1695+ <|> idsFilter `taggedWith` "ids"
1696+ <|> limitFilter `taggedWith` "limit"
1697+ <|> missingFilter `taggedWith` "missing"
1698+ <|> prefixFilter `taggedWith` "prefix"
1699+ <|> queryFilter `taggedWith` "query"
1700+ <|> fqueryFilter `taggedWith` "fquery"
1701+ <|> rangeFilter `taggedWith` "range"
1702+ <|> regexpFilter `taggedWith` "regexp"
1703+ <|> termFilter `taggedWith` "term"
1704+ where taggedWith parser k = parser =<< o .: k
1705+ andFilter o = AndFilter <$> o .: "filters"
1706+ <*> o .:? "_cache" .!= defaultCache
1707+ orFilter o = OrFilter <$> o .: "filters"
1708+ <*> o .:? "_cache" .!= defaultCache
1709+ notFilter o = NotFilter <$> o .: "filters"
1710+ <*> o .: "_cache" .!= defaultCache
1711+ identityFilter () = pure IdentityFilter
1712+ boolFilter = pure . BoolFilter
1713+ existsFilter o = ExistsFilter <$> o .: "field"
1714+ geoBoundingBoxFilter = pure . GeoBoundingBoxFilter
1715+ geoDistanceFilter o = flip fieldTagged o $ \fn o' -> do
1716+ gp <- GeoPoint fn <$> parseJSON (Object o')
1717+ GeoDistanceFilter gp <$> o .: "distance"
1718+ <*> o .: "distance_type"
1719+ <*> o .: "optimize_bbox"
1720+ <*> o .:? "_cache" .!= defaultCache
1721+ geoDistanceRangeFilter o = flip fieldTagged o $ \fn o' -> do
1722+ gp <- GeoPoint fn <$> parseJSON (Object o')
1723+ rng <- DistanceRange <$> o .: "from" <*> o .: "to"
1724+ return (GeoDistanceRangeFilter gp rng)
1725+ geoPolygonFilter = fieldTagged $ \fn o -> GeoPolygonFilter fn <$> o .: "points"
1726+ idsFilter o = IdsFilter <$> o .: "type"
1727+ <*> o .: "values"
1728+ limitFilter o = LimitFilter <$> o .: "value"
1729+ missingFilter o = MissingFilter <$> o .: "field"
1730+ <*> o .: "existence"
1731+ <*> o .: "null_value"
1732+ prefixFilter o = fieldTagged $ \fn o' -> PrefixFilter fn <$> parseJSON (Object o')
1733+ <*> o .:? "_cache" .!= defaultCache
1734+ queryFilter q = pure (QueryFilter q False)
1735+ fqueryFilter o = QueryFilter <$> o .: "query" <*> pure True
1736+ rangeFilter o = fieldTagged $ \fn o' -> RangeFilter fn <$> parseJSON (Object o')
1737+ <*> o .: "execution"
1738+ <*> o .:? "_cache" .!= defaultCache
1739+ regexpFilter = fieldTagged $ \fn o -> RegexpFilter fn <$> o .: "value"
1740+ <*> o .: "flags"
1741+ <*> o .: "_name"
1742+ <*> o .:? "_cache" .!= defaultCache
1743+ <*> o .: "_cache_key"
1744+ termFilter o = flip fieldTagged o $ \(FieldName fn) o' -> do
1745+ trm <- Term fn <$> parseJSON (Object o')
1746+ TermFilter trm <$> o .: "_cache" .!= defaultCache
1747+ --TODO: should this enforce there only being 1 key?
1748+ fieldTagged f o = case HM.toList o of
1749+ [(k, Object o')] -> f (FieldName k) o'
1750+ _ -> fail "Expected object with 1 field named key"
1751+
16441752instance ToJSON GeoPoint where
16451753 toJSON (GeoPoint (FieldName geoPointField) geoPointLatLon) =
16461754 object [ geoPointField .= geoPointLatLon ]
@@ -1827,6 +1935,9 @@ instance ToJSON RangeQuery where
18271935 object [ fieldName .= conjoined ]
18281936 where conjoined = [ "boost" .= boost ] ++ (rangeValueToPair range)
18291937
1938+instance FromJSON RangeValue where
1939+ parseJSON = withObject "RangeValue" parse
1940+ where parse o = undefined
18301941
18311942instance ToJSON PrefixQuery where
18321943 toJSON (PrefixQuery (FieldName fieldName) queryValue boost) =
@@ -2135,7 +2246,6 @@ instance FromJSON MappingName where
21352246instance FromJSON DocId where
21362247 parseJSON = genericParseJSON defaultOptions
21372248
2138−
21392249instance FromJSON Status where
21402250 parseJSON (Object v) = Status <$>
21412251 v .:? "ok" <*>
@@ -2188,6 +2298,58 @@ instance FromJSON EsError where
21882298 v .: "error"
21892299 parseJSON _ = empty
21902300
2301+instance FromJSON IndexAliasesSummary where
2302+ parseJSON = withObject "IndexAliasesSummary" parse
2303+ where parse o = IndexAliasesSummary . mconcat <$> mapM (uncurry go) (HM.toList o)
2304+ go ixn = withObject "index aliases" $ \ia -> do
2305+ aliases <- ia .: "aliases"
2306+ forM (HM.toList aliases) $ \(aName, v) -> do
2307+ let indexAlias = IndexAlias (IndexName ixn) (IndexAliasName (IndexName aName))
2308+ IndexAliasSummary indexAlias <$> parseJSON v
2309+
2310+
2311+instance ToJSON IndexAliasAction where
2312+ toJSON (AddAlias ia opts) = object ["add" .= (iaObj <> optsObj)]
2313+ where Object iaObj = toJSON ia
2314+ Object optsObj = toJSON opts
2315+ toJSON (RemoveAlias ia) = object ["remove" .= iaObj]
2316+ where Object iaObj = toJSON ia
2317+
2318+instance ToJSON IndexAlias where
2319+ toJSON IndexAlias {..} = object ["index" .= srcIndex
2320+ , "alias" .= indexAlias
2321+ ]
2322+
2323+instance ToJSON IndexAliasCreate where
2324+ toJSON IndexAliasCreate {..} = Object (filterObj <> routingObj)
2325+ where filterObj = maybe mempty (HM.singleton "filter" . toJSON) aliasCreateFilter
2326+ Object routingObj = maybe (Object mempty) toJSON aliasCreateRouting
2327+
2328+instance ToJSON AliasRouting where
2329+ toJSON (AllAliasRouting v) = object ["routing" .= v]
2330+ toJSON (GranularAliasRouting srch idx) = object (catMaybes prs)
2331+ where prs = [("search_routing" .=) <$> srch
2332+ ,("index_routing" .=) <$> idx]
2333+
2334+instance FromJSON AliasRouting where
2335+ parseJSON = withObject "AliasRouting" parse
2336+ where parse o = parseAll o <|> parseGranular o
2337+ parseAll o = AllAliasRouting <$> o .: "routing"
2338+ parseGranular o = GranularAliasRouting <$> o .:? "search_routing"
2339+ <*> o .:? "index_routing"
2340+
2341+instance FromJSON IndexAliasCreate where
2342+ parseJSON v = withObject "IndexAliasCreate" parse v
2343+ where parse o = IndexAliasCreate <$> parseJSON v
2344+ <*> o .:? "filter"
2345+
2346+instance ToJSON SearchAliasRouting where
2347+ toJSON (SearchAliasRouting rvs) = toJSON (T.intercalate "," (routingValue <$> toList rvs))
2348+
2349+instance FromJSON SearchAliasRouting where
2350+ parseJSON = withText "SearchAliasRouting" parse
2351+ where parse t = SearchAliasRouting <$> parseNEJSON (String <$> T.splitOn "," t)
2352+
21912353instance ToJSON Search where
21922354 toJSON (Search query sFilter sort searchAggs highlight sTrackSortScores sFrom sSize _ sFields sSource) =
21932355 omitNulls [ "query" .= query
@@ -2290,6 +2452,9 @@ nonPostingsToPairs (Just (NonPostings npFragSize npNumOfFrags)) =
22902452 [ "fragment_size" .= npFragSize
22912453 , "number_of_fragments" .= npNumOfFrags]
22922454
2455+parseNEJSON :: (FromJSON a) => [Value] -> Parser (NonEmpty a)
2456+parseNEJSON [] = fail "Expected non-empty list"
2457+parseNEJSON (x:xs) = DT.mapM parseJSON (x :| xs)
22932458
22942459
22952460instance ToJSON HighlightEncoder where
@@ -2351,6 +2516,13 @@ instance ToJSON Distance where
23512516 (String unitText) = toJSON dUnit
23522517 boltedTogether = mappend coefText unitText
23532518
2519+instance FromJSON Distance where
2520+ parseJSON = withText "Distance" parse
2521+ where parse t = Distance <$> parseCoeff nT
2522+ <*> parseJSON (String unitT)
2523+ where (nT, unitT) = T.span isNumber t
2524+ parseCoeff "" = fail "Empty string cannot be parsed as number"
2525+ parseCoeff s = return (read (T.unpack s))
23542526
23552527instance ToJSON DistanceUnit where
23562528 toJSON Miles = String "mi"
@@ -2364,16 +2536,42 @@ instance ToJSON DistanceUnit where
23642536 toJSON NauticalMiles = String "nmi"
23652537
23662538
2539+instance FromJSON DistanceUnit where
2540+ parseJSON = withText "DistanceUnit" parse
2541+ where parse "mi" = pure Miles
2542+ parse "yd" = pure Yards
2543+ parse "ft" = pure Feet
2544+ parse "in" = pure Inches
2545+ parse "km" = pure Kilometers
2546+ parse "m" = pure Meters
2547+ parse "cm" = pure Centimeters
2548+ parse "mm" = pure Millimeters
2549+ parse "nmi" = pure NauticalMiles
2550+ parse u = fail ("Unrecognized DistanceUnit: " <> show u)
2551+
23672552instance ToJSON DistanceType where
23682553 toJSON Arc = String "arc"
23692554 toJSON SloppyArc = String "sloppy_arc"
23702555 toJSON Plane = String "plane"
23712556
2557+instance FromJSON DistanceType where
2558+ parseJSON = withText "DistanceType" parse
2559+ where parse "arc" = pure Arc
2560+ parse "sloppy_arc" = pure SloppyArc
2561+ parse "plane" = pure Plane
2562+ parse t = fail ("Unrecognized DistanceType: " <> show t)
2563+
23722564
23732565instance ToJSON OptimizeBbox where
23742566 toJSON NoOptimizeBbox = String "none"
23752567 toJSON (OptimizeGeoFilterType gft) = toJSON gft
23762568
2569+instance FromJSON OptimizeBbox where
2570+ parseJSON v = withText "NoOptimizeBbox" parseNoOptimize v
2571+ <|> parseOptimize v
2572+ where parseNoOptimize "none" = pure NoOptimizeBbox
2573+ parseNoOptimize _ = mzero
2574+ parseOptimize = fmap OptimizeGeoFilterType . parseJSON
23772575
23782576instance ToJSON GeoBoundingBoxConstraint where
23792577 toJSON (GeoBoundingBoxConstraint
@@ -2387,6 +2585,11 @@ instance ToJSON GeoFilterType where
23872585 toJSON GeoFilterMemory = String "memory"
23882586 toJSON GeoFilterIndexed = String "indexed"
23892587
2588+instance FromJSON GeoFilterType where
2589+ parseJSON = withText "GeoFilterType" parse
2590+ where parse "memory" = pure GeoFilterMemory
2591+ parse "indexed" = pure GeoFilterIndexed
2592+ parse t = fail ("Unrecognized GeoFilterType: " <> show t)
23902593
23912594instance ToJSON GeoBoundingBox where
23922595 toJSON (GeoBoundingBox gbbTopLeft gbbBottomRight) =
@@ -2399,6 +2602,10 @@ instance ToJSON LatLon where
23992602 object ["lat" .= lLat
24002603 , "lon" .= lLon]
24012604
2605+instance FromJSON LatLon where
2606+ parseJSON = withObject "LatLon" parse
2607+ where parse o = LatLon <$> o .: "lat"
2608+ <*> o .: "lon"
24022609
24032610-- index for smaller ranges, fielddata for longer ranges
24042611instance ToJSON RangeExecution where
@@ -2406,6 +2613,12 @@ instance ToJSON RangeExecution where
24062613 toJSON RangeExecutionFielddata = "fielddata"
24072614
24082615
2616+instance FromJSON RangeExecution where
2617+ parseJSON = withText "RangeExecution" parse
2618+ where parse "index" = pure RangeExecutionIndex
2619+ parse "fielddata" = pure RangeExecutionFielddata
2620+ parse t = error ("Unrecognized RangeExecution " <> show t)
2621+
24092622instance ToJSON RegexpFlags where
24102623 toJSON AllRegexpFlags = String "ALL"
24112624 toJSON NoRegexpFlags = String "NONE"
@@ -2418,6 +2631,23 @@ instance ToJSON RegexpFlags where
24182631 flagStr Intersection = "INTERSECTION"
24192632 flagStr Interval = "INTERVAL"
24202633
2634+instance FromJSON RegexpFlags where
2635+ parseJSON = withText "RegexpFlags" parse
2636+ where parse "ALL" = pure AllRegexpFlags
2637+ parse "NONE" = pure NoRegexpFlags
2638+ parse t = SomeRegexpFlags <$> parseNEJSON (String <$> T.splitOn "|" t)
2639+
2640+instance FromJSON RegexpFlag where
2641+ parseJSON = withText "RegexpFlag" parse
2642+ where parse "ANYSTRING" = pure AnyString
2643+ parse "ANYSTRING" = pure AnyString
2644+ parse "AUTOMATON" = pure Automaton
2645+ parse "COMPLEMENT" = pure Complement
2646+ parse "EMPTY" = pure Empty
2647+ parse "INTERSECTION" = pure Intersection
2648+ parse "INTERVAL" = pure Interval
2649+ parse f = fail ("Unknown RegexpFlag: " <> show f)
2650+
24212651instance ToJSON Term where
24222652 toJSON (Term field value) = object ["term" .= object
24232653 [field .= value]]