typeable/bloodhound
1
0
Fork 0
mirror of https://github.com/typeable/bloodhound.git synced 2025-01-05 21:36:03 +03:00
Code Issues Projects Releases Wiki Activity

Merge pull request #126 from Soostone/snapshot-restore

Browse Source 
Snapshot restore
This commit is contained in:
Chris Allen 2016-08-05 23:25:01 -05:00 committed by GitHub
commit 4a7d9fec51
7 changed files with 921 additions and 52 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
.travis.yml
View File

@ -10,7 +10,7 @@ env:
# - GHCVER=7.6.3 ESVER=1.6.0 # Deprecated
# - GHCVER=7.8.3 ESVER=1.0.3 # Deprecated
# - GHCVER=7.8.3 ESVER=1.1.2 # Deprecated
- GHCVER=7.8 ESVER=1.2.4
# - GHCVER=7.8 ESVER=1.2.4 # deprecated
- GHCVER=7.8 ESVER=1.3.6
- GHCVER=7.8 ESVER=1.4.1
- GHCVER=7.10 ESVER=1.5.2
@ -29,6 +29,8 @@ install:
# elasticsearch
- wget --no-check-certificate https://download.elastic.co/elasticsearch/elasticsearch/elasticsearch-$ESVER.tar.gz
- tar xzf elasticsearch-$ESVER.tar.gz
# set up a repo for snapshot testing. Required in ES >= 1.6
- echo "path.repo = [\"/tmp\"]" >> ./elasticsearch-$ESVER/elasticsearch.yml
- ./elasticsearch-$ESVER/bin/elasticsearch &
script:

6
bloodhound.cabal
View File

@ -73,7 +73,11 @@ test-suite tests
mtl,
quickcheck-properties,
derive,
errors
errors,
exceptions,
temporary,
unix,
network-uri
default-language: Haskell2010
test-suite doctests

233
src/Database/Bloodhound/Client.hs
View File

@ -59,6 +59,14 @@ module Database.Bloodhound.Client
, mkShardCount
, mkReplicaCount
, getStatus
, getSnapshotRepos
, updateSnapshotRepo
, verifySnapshotRepo
, deleteSnapshotRepo
, createSnapshot
, getSnapshots
, deleteSnapshot
, restoreSnapshot
, encodeBulkOperations
, encodeBulkOperation
-- * Authentication
@ -71,32 +79,33 @@ module Database.Bloodhound.Client
)
where
import qualified Blaze.ByteString.Builder as BB
import Control.Applicative
import qualified Blaze.ByteString.Builder as BB
import Control.Applicative as A
import Control.Monad
import Control.Monad.Catch
import Control.Monad.IO.Class
import Data.Aeson
import Data.ByteString.Lazy.Builder
import qualified Data.ByteString.Lazy.Char8 as L
import Data.Foldable (toList)
import qualified Data.HashMap.Strict as HM
import qualified Data.ByteString.Lazy.Char8 as L
import Data.Foldable (toList)
import qualified Data.HashMap.Strict as HM
import Data.Ix
import qualified Data.List as LS (filter, foldl')
import Data.List.NonEmpty (NonEmpty (..))
import Data.Maybe (catMaybes, fromMaybe, isJust)
import qualified Data.List as LS (filter, foldl')
import Data.List.NonEmpty (NonEmpty (..))
import Data.Maybe (catMaybes, fromMaybe,
isJust)
import Data.Monoid
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import Data.Time.Clock
import qualified Data.Vector as V
import qualified Data.Vector as V
import Network.HTTP.Client
import qualified Network.HTTP.Types.Method as NHTM
import qualified Network.HTTP.Types.Status as NHTS
import qualified Network.HTTP.Types.URI as NHTU
import qualified Network.URI as URI
import Prelude hiding (filter, head)
import qualified Network.HTTP.Types.Method as NHTM
import qualified Network.HTTP.Types.Status as NHTS
import qualified Network.HTTP.Types.URI as NHTU
import qualified Network.URI as URI
import Prelude hiding (filter, head)
import Database.Bloodhound.Types
@ -183,7 +192,7 @@ dispatch :: MonadBH m
-> m Reply
dispatch dMethod url body = do
initReq <- liftIO $ parseUrl' url
reqHook <- bhRequestHook <$> getBHEnv
reqHook <- bhRequestHook A.<$> getBHEnv
let reqBody = RequestBodyLBS $ fromMaybe emptyBody body
req <- liftIO $ reqHook $ setRequestIgnoreStatus $ initReq { method = dMethod
, requestBody = reqBody }
@ -260,6 +269,182 @@ getStatus = do
return $ decode (responseBody response)
where url = joinPath []
-- | 'getSnapshotRepos' gets the definitions of a subset of the
-- defined snapshot repos.
getSnapshotRepos
:: ( MonadBH m
, MonadThrow m
)
=> SnapshotRepoSelection
-> m (Either EsError [GenericSnapshotRepo])
getSnapshotRepos sel = fmap (fmap unGSRs) . parseEsResponse =<< get =<< url
where
url = joinPath ["_snapshot", selectorSeg]
selectorSeg = case sel of
AllSnapshotRepos -> "_all"
SnapshotRepoList (p :| ps) -> T.intercalate "," (renderPat <$> (p:ps))
renderPat (RepoPattern t) = t
renderPat (ExactRepo (SnapshotRepoName t)) = t
-- | Wrapper to extract the list of 'GenericSnapshotRepo' in the
-- format they're returned in
newtype GSRs = GSRs { unGSRs :: [GenericSnapshotRepo] }
instance FromJSON GSRs where
parseJSON = withObject "Collection of GenericSnapshotRepo" parse
where
parse = fmap GSRs . mapM (uncurry go) . HM.toList
go rawName = withObject "GenericSnapshotRepo" $ \o -> do
GenericSnapshotRepo (SnapshotRepoName rawName) <$> o .: "type"
<*> o .: "settings"
-- | Create or update a snapshot repo
updateSnapshotRepo
:: ( MonadBH m
, SnapshotRepo repo
)
=> SnapshotRepoUpdateSettings
-- ^ Use 'defaultSnapshotRepoUpdateSettings' if unsure
-> repo
-> m Reply
updateSnapshotRepo SnapshotRepoUpdateSettings {..} repo =
bindM2 put url (return (Just body))
where
url = addQuery params <$> joinPath ["_snapshot", snapshotRepoName gSnapshotRepoName]
params
| repoUpdateVerify = []
| otherwise = [("verify", Just "false")]
body = encode $ object [ "type" .= gSnapshotRepoType
, "settings" .= gSnapshotRepoSettings
]
GenericSnapshotRepo {..} = toGSnapshotRepo repo
-- | Verify if a snapshot repo is working. __NOTE:__ this API did not
-- make it into ElasticSearch until 1.4. If you use an older version,
-- you will get an error here.
verifySnapshotRepo
:: ( MonadBH m
, MonadThrow m
)
=> SnapshotRepoName
-> m (Either EsError SnapshotVerification)
verifySnapshotRepo (SnapshotRepoName n) =
parseEsResponse =<< bindM2 post url (return Nothing)
where
url = joinPath ["_snapshot", n, "_verify"]
deleteSnapshotRepo :: MonadBH m => SnapshotRepoName -> m Reply
deleteSnapshotRepo (SnapshotRepoName n) = delete =<< url
where
url = joinPath ["_snapshot", n]
-- | Create and start a snapshot
createSnapshot
:: (MonadBH m)
=> SnapshotRepoName
-> SnapshotName
-> SnapshotCreateSettings
-> m Reply
createSnapshot (SnapshotRepoName repoName)
(SnapshotName snapName)
SnapshotCreateSettings {..} =
bindM2 put url (return (Just body))
where
url = addQuery params <$> joinPath ["_snapshot", repoName, snapName]
params = [("wait_for_completion", Just (boolQP snapWaitForCompletion))]
body = encode $ object prs
prs = catMaybes [ ("indices" .=) . indexSelectionName <$> snapIndices
, Just ("ignore_unavailable" .= snapIgnoreUnavailable)
, Just ("ignore_global_state" .= snapIncludeGlobalState)
, Just ("partial" .= snapPartial)
]
indexSelectionName :: IndexSelection -> Text
indexSelectionName AllIndexes = "_all"
indexSelectionName (IndexList (i :| is)) = T.intercalate "," (renderIndex <$> (i:is))
where
renderIndex (IndexName n) = n
-- | Get info about known snapshots given a pattern and repo name.
getSnapshots
:: ( MonadBH m
, MonadThrow m
)
=> SnapshotRepoName
-> SnapshotSelection
-> m (Either EsError [SnapshotInfo])
getSnapshots (SnapshotRepoName repoName) sel =
fmap (fmap unSIs) . parseEsResponse =<< get =<< url
where
url = joinPath ["_snapshot", repoName, snapPath]
snapPath = case sel of
AllSnapshots -> "_all"
SnapshotList (s :| ss) -> T.intercalate "," (renderPath <$> (s:ss))
renderPath (SnapPattern t) = t
renderPath (ExactSnap (SnapshotName t)) = t
newtype SIs = SIs { unSIs :: [SnapshotInfo] }
instance FromJSON SIs where
parseJSON = withObject "Collection of SnapshotInfo" parse
where
parse o = SIs <$> o .: "snapshots"
-- | Delete a snapshot. Cancels if it is running.
deleteSnapshot :: MonadBH m => SnapshotRepoName -> SnapshotName -> m Reply
deleteSnapshot (SnapshotRepoName repoName) (SnapshotName snapName) =
delete =<< url
where
url = joinPath ["_snapshot", repoName, snapName]
-- | Restore a snapshot to the cluster See
-- <https://www.elastic.co/guide/en/elasticsearch/reference/1.7/modules-snapshots.html#_restore>
-- for more details.
restoreSnapshot
:: MonadBH m
=> SnapshotRepoName
-> SnapshotName
-> SnapshotRestoreSettings
-- ^ Start with 'defaultSnapshotRestoreSettings' and customize
-- from there for reasonable defaults.
-> m Reply
restoreSnapshot (SnapshotRepoName repoName)
(SnapshotName snapName)
SnapshotRestoreSettings {..} = bindM2 post url (return (Just body))
where
url = addQuery params <$> joinPath ["_snapshot", repoName, snapName, "_restore"]
params = [("wait_for_completion", Just (boolQP snapRestoreWaitForCompletion))]
body = encode (object prs)
prs = catMaybes [ ("indices" .=) . indexSelectionName <$> snapRestoreIndices
, Just ("ignore_unavailable" .= snapRestoreIgnoreUnavailable)
, Just ("include_global_state" .= snapRestoreIncludeGlobalState)
, ("rename_pattern" .=) <$> snapRestoreRenamePattern
, ("rename_replacement" .=) . renderTokens <$> snapRestoreRenameReplacement
, Just ("include_aliases" .= snapRestoreIncludeAliases)
, ("index_settings" .= ) <$> snapRestoreIndexSettingsOverrides
, ("ignore_index_settings" .= ) <$> snapRestoreIgnoreIndexSettings
]
renderTokens (t :| ts) = mconcat (renderToken <$> (t:ts))
renderToken (RRTLit t) = t
renderToken RRSubWholeMatch = "$0"
renderToken (RRSubGroup g) = T.pack (show (rrGroupRefNum g))
-- | 'createIndex' will create an index given a 'Server', 'IndexSettings', and an 'IndexName'.
--
-- >>> response <- runBH' $ createIndex defaultIndexSettings (IndexName "didimakeanindex")
@ -339,16 +524,9 @@ optimizeIndex ixs IndexOptimizationSettings {..} =
, Just ("flush", Just (boolQP flushAfterOptimize))
]
indexName = indexSelectionName ixs
boolQP True = "true"
boolQP False = "false"
body = Nothing
-------------------------------------------------------------------------------
indexSelectionName :: IndexSelection -> Text
indexSelectionName (IndexList names) = T.intercalate "," [n | IndexName n <- toList names]
indexSelectionName AllIndexes = "_all"
deepMerge :: [Object] -> Object
deepMerge = LS.foldl' go mempty
where go acc = LS.foldl' go' acc . HM.toList
@ -856,3 +1034,8 @@ basicAuthHook :: Monad m => EsUsername -> EsPassword -> Request -> m Request
basicAuthHook (EsUsername u) (EsPassword p) = return . applyBasicAuth u' p'
where u' = T.encodeUtf8 u
p' = T.encodeUtf8 p
boolQP :: Bool -> Text
boolQP True = "true"
boolQP False = "false"

505
src/Database/Bloodhound/Types.hs
View File

@ -5,10 +5,10 @@
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
-- {-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE NamedFieldPuns #-}
-------------------------------------------------------------------------------
-- |
@ -69,6 +69,9 @@ module Database.Bloodhound.Types
, AllocationPolicy(..)
, ReplicaBounds(..)
, Bytes(..)
, gigabytes
, megabytes
, kilobytes
, FSType(..)
, InitialShardCount(..)
, NodeAttrFilter(..)
@ -235,6 +238,38 @@ module Database.Bloodhound.Types
, CollectionMode(..)
, TermOrder(..)
, TermInclusion(..)
, SnapshotRepoSelection(..)
, GenericSnapshotRepo(..)
, SnapshotRepo(..)
, SnapshotRepoConversionError(..)
, SnapshotRepoType(..)
, GenericSnapshotRepoSettings(..)
, SnapshotRepoUpdateSettings(..)
, defaultSnapshotRepoUpdateSettings
, SnapshotRepoName(..)
, SnapshotRepoPattern(..)
, SnapshotVerification(..)
, SnapshotNodeVerification(..)
, FullNodeId(..)
, NodeName(..)
, FsSnapshotRepo(..)
, SnapshotCreateSettings(..)
, defaultSnapshotCreateSettings
, SnapshotSelection(..)
, SnapshotPattern(..)
, SnapshotInfo(..)
, SnapshotShardFailure(..)
, ShardId(..)
, SnapshotName(..)
, SnapshotState(..)
, SnapshotRestoreSettings(..)
, defaultSnapshotRestoreSettings
, RestoreRenamePattern(..)
, RestoreRenameToken(..)
, RRGroupRefNum
, rrGroupRefNum
, mkRRGroupRefNum
, RestoreIndexSettings(..)
, Aggregation(..)
, Aggregations
@ -275,7 +310,7 @@ module Database.Bloodhound.Types
, EsPassword(..)
) where
import Control.Applicative
import Control.Applicative as A
import Control.Monad.Catch
import Control.Monad.Except
import Control.Monad.Reader
@ -283,7 +318,7 @@ import Control.Monad.State
import Control.Monad.Writer
import Data.Aeson
import Data.Aeson.Types (Pair, Parser, emptyObject,
parseMaybe)
parseEither, parseMaybe)
import qualified Data.ByteString.Lazy.Char8 as L
import Data.Char
import Data.Hashable (Hashable)
@ -332,7 +367,7 @@ mkBHEnv s m = BHEnv s m return
newtype BH m a = BH {
unBH :: ReaderT BHEnv m a
} deriving ( Functor
, Applicative
, A.Applicative
, Monad
, MonadIO
, MonadState s
@ -483,8 +518,31 @@ data ReplicaBounds = ReplicasBounded Int Int
| ReplicasUnbounded
deriving (Eq, Read, Show, Generic, Typeable)
-- | A measure of bytes used for various configurations. You may want
-- to use smart constructors like 'gigabytes' for larger values.
--
-- >>> gigabytes 9
-- Bytes 9000000000
--
-- >>> megabytes 9
-- Bytes 9000000
--
-- >>> kilobytes 9
-- Bytes 9000
newtype Bytes = Bytes Int deriving (Eq, Read, Show, Generic, Typeable, Ord, ToJSON, FromJSON)
gigabytes :: Int -> Bytes
gigabytes n = megabytes (1000 * n)
megabytes :: Int -> Bytes
megabytes n = kilobytes (1000 * n)
kilobytes :: Int -> Bytes
kilobytes n = Bytes (1000 * n)
data FSType = FSSimple
| FSBuffered deriving (Eq, Read, Show, Generic, Typeable, Ord)
@ -803,6 +861,7 @@ newtype IndexName = IndexName Text deriving (Eq, Generic, Read, Show, ToJSON, Fr
{-| 'IndexSelection' is used for APIs which take a single index, a list of
indexes, or the special @_all@ index.
-}
--TODO: this does not fully support <https://www.elastic.co/guide/en/elasticsearch/reference/1.7/multi-index.html multi-index syntax>. It wouldn't be too hard to implement but you'd have to add the optional parameters (ignore_unavailable, allow_no_indices, expand_wildcards) to any APIs using it. Also would be a breaking API.
data IndexSelection = IndexList (NonEmpty IndexName)
| AllIndexes deriving (Eq, Generic, Show, Typeable)
@ -2947,7 +3006,7 @@ instance FromJSON UpdatableIndexSetting where
<|> blocksWrite `taggedAt` ["blocks", "write"]
<|> blocksMetaData `taggedAt` ["blocks", "metadata"]
where taggedAt f ks = taggedAt' f (Object o) ks
taggedAt' f v [] = f =<< (parseJSON v <|> (parseJSON =<< unStringlyTypeJSON v))
taggedAt' f v [] = f =<< (parseJSON v <|> (parseJSON (unStringlyTypeJSON v)))
taggedAt' f v (k:ks) = withObject "Object" (\o -> do v' <- o .: k
taggedAt' f v' ks) v
numberOfReplicas = pure . NumberOfReplicas
@ -2989,18 +3048,17 @@ instance FromJSON IndexSettingsSummary where
redundant (NumberOfReplicas _) = True
redundant _ = False
-- | For some reason in the settings API, all leaf values get returned
-- | For some reason in several settings APIs, all leaf values get returned
-- as strings. This function attepmts to recover from this for all
-- non-recursive JSON types. If nothing can be done or the same value
-- would be return, it returns 'mzero'
unStringlyTypeJSON :: MonadPlus m => Value -> m Value
unStringlyTypeJSON (String "true") = return (Bool True)
unStringlyTypeJSON (String "false") = return (Bool False)
unStringlyTypeJSON (String "null") = return Null
unStringlyTypeJSON (String t) = case readMay (T.unpack t) of
Just n -> return (Number n)
Nothing -> mzero
unStringlyTypeJSON _ = mzero
-- non-recursive JSON types. If nothing can be done, the value is left alone.
unStringlyTypeJSON :: Value -> Value
unStringlyTypeJSON (String "true") = Bool True
unStringlyTypeJSON (String "false") = Bool False
unStringlyTypeJSON (String "null") = Null
unStringlyTypeJSON v@(String t) = case readMay (T.unpack t) of
Just n -> Number n
Nothing -> v
unStringlyTypeJSON v = v
parseSettings :: Object -> Parser [UpdatableIndexSetting]
@ -3625,3 +3683,418 @@ newtype EsUsername = EsUsername { esUsername :: Text } deriving (Read, Show, Eq)
-- | Password type used for HTTP Basic authentication. See 'basicAuthHook'.
newtype EsPassword = EsPassword { esPassword :: Text } deriving (Read, Show, Eq)
data SnapshotRepoSelection = SnapshotRepoList (NonEmpty SnapshotRepoPattern)
| AllSnapshotRepos deriving (Eq, Generic, Show, Typeable)
-- | Either specifies an exact repo name or one with globs in it,
-- e.g. @RepoPattern "foo*"@ __NOTE__: Patterns are not supported on ES < 1.7
data SnapshotRepoPattern = ExactRepo SnapshotRepoName
| RepoPattern Text
deriving (Eq, Generic, Show, Typeable)
-- | The unique name of a snapshot repository.
newtype SnapshotRepoName = SnapshotRepoName { snapshotRepoName :: Text }
deriving (Eq, Ord, Generic, Show, Typeable, ToJSON, FromJSON)
-- | A generic representation of a snapshot repo. This is what gets
-- sent to and parsed from the server. For repo types enabled by
-- plugins that aren't exported by this library, consider making a
-- custom type which implements 'SnapshotRepo'. If it is a common repo
-- type, consider submitting a pull request to have it included in the
-- library proper
data GenericSnapshotRepo = GenericSnapshotRepo {
gSnapshotRepoName :: SnapshotRepoName
, gSnapshotRepoType :: SnapshotRepoType
, gSnapshotRepoSettings :: GenericSnapshotRepoSettings
} deriving (Eq, Generic, Show, Typeable)
instance SnapshotRepo GenericSnapshotRepo where
toGSnapshotRepo = id
fromGSnapshotRepo = Right
newtype SnapshotRepoType = SnapshotRepoType { snapshotRepoType :: Text }
deriving (Eq, Ord, Generic, Show, Typeable, ToJSON, FromJSON)
-- | Opaque representation of snapshot repo settings. Instances of
-- 'SnapshotRepo' will produce this.
newtype GenericSnapshotRepoSettings = GenericSnapshotRepoSettings { gSnapshotRepoSettingsObject :: Object }
deriving (Eq, Generic, Show, Typeable, ToJSON)
-- Regardless of whether you send strongly typed json, my version of
-- ES sends back stringly typed json in the settings, e.g. booleans
-- as strings, so we'll try to convert them.
instance FromJSON GenericSnapshotRepoSettings where
parseJSON = fmap (GenericSnapshotRepoSettings . fmap unStringlyTypeJSON). parseJSON
-- | The result of running 'verifySnapshotRepo'.
newtype SnapshotVerification = SnapshotVerification { snapshotNodeVerifications :: [SnapshotNodeVerification] }
deriving (Eq, Generic, Show, Typeable)
instance FromJSON SnapshotVerification where
parseJSON = withObject "SnapshotVerification" parse
where
parse o = do
o2 <- o .: "nodes"
SnapshotVerification <$> mapM (uncurry parse') (HM.toList o2)
parse' rawFullId = withObject "SnapshotNodeVerification" $ \o ->
SnapshotNodeVerification (FullNodeId rawFullId) <$> o .: "name"
-- | A node that has verified a snapshot
data SnapshotNodeVerification = SnapshotNodeVerification {
snvFullId :: FullNodeId
, snvNodeName :: NodeName
} deriving (Eq, Generic, Show, Typeable)
-- | Unique, automatically-generated name assigned to nodes that are
-- usually returned in node-oriented APIs.
newtype FullNodeId = FullNodeId { fullNodeId :: Text }
deriving (Eq, Ord, Generic, Show, Typeable, FromJSON)
-- | A human-readable node name that is supplied by the user in the
-- node config or automatically generated by ElasticSearch.
newtype NodeName = NodeName { nodeName :: Text }
deriving (Eq, Ord, Generic, Show, Typeable, FromJSON)
data SnapshotRepoUpdateSettings = SnapshotRepoUpdateSettings {
repoUpdateVerify :: Bool
-- ^ After creation/update, synchronously check that nodes can
-- write to this repo. Defaults to True. You may use False if you
-- need a faster response and plan on verifying manually later
-- with 'verifySnapshotRepo'.
} deriving (Eq, Show, Generic, Typeable)
-- | Reasonable defaults for repo creation/update
--
-- * repoUpdateVerify True
defaultSnapshotRepoUpdateSettings :: SnapshotRepoUpdateSettings
defaultSnapshotRepoUpdateSettings = SnapshotRepoUpdateSettings True
-- | A filesystem-based snapshot repo that ships with
-- ElasticSearch. This is an instance of 'SnapshotRepo' so it can be
-- used with 'updateSnapshotRepo'
data FsSnapshotRepo = FsSnapshotRepo {
fsrName :: SnapshotRepoName
, fsrLocation :: FilePath
, fsrCompressMetadata :: Bool
, fsrChunkSize :: Maybe Bytes
-- ^ Size by which to split large files during snapshotting.
, fsrMaxRestoreBytesPerSec :: Maybe Bytes
-- ^ Throttle node restore rate. If not supplied, defaults to 40mb/sec
, fsrMaxSnapshotBytesPerSec :: Maybe Bytes
-- ^ Throttle node snapshot rate. If not supplied, defaults to 40mb/sec
} deriving (Eq, Generic, Show, Typeable)
instance SnapshotRepo FsSnapshotRepo where
toGSnapshotRepo FsSnapshotRepo {..} =
GenericSnapshotRepo fsrName fsRepoType (GenericSnapshotRepoSettings settings)
where
Object settings = object $ [ "location" .= fsrLocation
, "compress" .= fsrCompressMetadata
] ++ optionalPairs
optionalPairs = catMaybes [ ("chunk_size" .=) <$> fsrChunkSize
, ("max_restore_bytes_per_sec" .=) <$> fsrMaxRestoreBytesPerSec
, ("max_snapshot_bytes_per_sec" .=) <$> fsrMaxSnapshotBytesPerSec
]
fromGSnapshotRepo GenericSnapshotRepo {..}
| gSnapshotRepoType == fsRepoType = do
let o = gSnapshotRepoSettingsObject gSnapshotRepoSettings
parseRepo $ do
FsSnapshotRepo gSnapshotRepoName <$> o .: "location"
<*> o .:? "compress" .!= False
<*> o .:? "chunk_size"
<*> o .:? "max_restore_bytes_per_sec"
<*> o .:? "max_snapshot_bytes_per_sec"
| otherwise = Left (RepoTypeMismatch fsRepoType gSnapshotRepoType)
parseRepo :: Parser a -> Either SnapshotRepoConversionError a
parseRepo parser = case parseEither (const parser) () of
Left e -> Left (OtherRepoConversionError (T.pack e))
Right a -> Right a
fsRepoType :: SnapshotRepoType
fsRepoType = SnapshotRepoType "fs"
-- | Law: fromGSnapshotRepo (toGSnapshotRepo r) == Right r
class SnapshotRepo r where
toGSnapshotRepo :: r -> GenericSnapshotRepo
fromGSnapshotRepo :: GenericSnapshotRepo -> Either SnapshotRepoConversionError r
data SnapshotRepoConversionError = RepoTypeMismatch SnapshotRepoType SnapshotRepoType
-- ^ Expected type and actual type
| OtherRepoConversionError Text
deriving (Show, Eq, Generic, Typeable)
instance Exception SnapshotRepoConversionError
data SnapshotCreateSettings = SnapshotCreateSettings {
snapWaitForCompletion :: Bool
-- ^ Should the API call return immediately after initializing
-- the snapshot or wait until completed? Note that if this is
-- enabled it could wait a long time, so you should adjust your
-- 'ManagerSettings' accordingly to set long timeouts or
-- explicitly handle timeouts.
, snapIndices :: Maybe IndexSelection
-- ^ Nothing will snapshot all indices. Just [] is permissable and
-- will essentially be a no-op snapshot.
, snapIgnoreUnavailable :: Bool
-- ^ If set to True, any matched indices that don't exist will be
-- ignored. Otherwise it will be an error and fail.
, snapIncludeGlobalState :: Bool
, snapPartial :: Bool
-- ^ If some indices failed to snapshot (e.g. if not all primary
-- shards are available), should the process proceed?
} deriving (Eq, Generic, Show, Typeable)
-- | Reasonable defaults for snapshot creation
--
-- * snapWaitForCompletion False
-- * snapIndices Nothing
-- * snapIgnoreUnavailable False
-- * snapIncludeGlobalState True
-- * snapPartial False
defaultSnapshotCreateSettings :: SnapshotCreateSettings
defaultSnapshotCreateSettings = SnapshotCreateSettings {
snapWaitForCompletion = False
, snapIndices = Nothing
, snapIgnoreUnavailable = False
, snapIncludeGlobalState = True
, snapPartial = False
}
data SnapshotSelection = SnapshotList (NonEmpty SnapshotPattern)
| AllSnapshots deriving (Eq, Generic, Show, Typeable)
-- | Either specifies an exact snapshot name or one with globs in it,
-- e.g. @SnapPattern "foo*"@ __NOTE__: Patterns are not supported on
-- ES < 1.7
data SnapshotPattern = ExactSnap SnapshotName
| SnapPattern Text
deriving (Eq, Generic, Show, Typeable)
-- | General information about the state of a snapshot. Has some
-- redundancies with 'SnapshotStatus'
data SnapshotInfo = SnapshotInfo {
snapInfoShards :: ShardResult
, snapInfoFailures :: [SnapshotShardFailure]
, snapInfoDuration :: NominalDiffTime
, snapInfoEndTime :: UTCTime
, snapInfoStartTime :: UTCTime
, snapInfoState :: SnapshotState
, snapInfoIndices :: [IndexName]
, snapInfoName :: SnapshotName
} deriving (Eq, Generic, Show, Typeable)
instance FromJSON SnapshotInfo where
parseJSON = withObject "SnapshotInfo" parse
where
parse o = SnapshotInfo <$> o .: "shards"
<*> o .: "failures"
<*> (unMS <$> o .: "duration_in_millis")
<*> (posixMS <$> o .: "end_time_in_millis")
<*> (posixMS <$> o .: "start_time_in_millis")
<*> o .: "state"
<*> o .: "indices"
<*> o .: "snapshot"
data SnapshotShardFailure = SnapshotShardFailure {
snapShardFailureIndex :: IndexName
, snapShardFailureNodeId :: Maybe NodeName -- I'm not 100% sure this isn't actually 'FullNodeId'
, snapShardFailureReason :: Text
, snapShardFailureShardId :: ShardId
} deriving (Eq, Show, Generic, Typeable)
instance FromJSON SnapshotShardFailure where
parseJSON = withObject "SnapshotShardFailure" parse
where
parse o = SnapshotShardFailure <$> o .: "index"
<*> o .:? "node_id"
<*> o .: "reason"
<*> o .: "shard_id"
newtype ShardId = ShardId { shardId :: Int }
deriving (Eq, Show, Generic, Typeable, FromJSON)
-- | Milliseconds
newtype MS = MS NominalDiffTime
-- keeps the unexported constructor warnings at bay
unMS :: MS -> NominalDiffTime
unMS (MS t) = t
instance FromJSON MS where
parseJSON = withScientific "MS" (return . MS . parse)
where
parse n = fromInteger ((truncate n) * 1000)
data SnapshotState = SnapshotInit
| SnapshotStarted
| SnapshotSuccess
| SnapshotFailed
| SnapshotAborted
| SnapshotMissing
| SnapshotWaiting
deriving (Show, Eq, Generic, Typeable)
instance FromJSON SnapshotState where
parseJSON = withText "SnapshotState" parse
where
parse "INIT" = return SnapshotInit
parse "STARTED" = return SnapshotStarted
parse "SUCCESS" = return SnapshotSuccess
parse "FAILED" = return SnapshotFailed
parse "ABORTED" = return SnapshotAborted
parse "MISSING" = return SnapshotMissing
parse "WAITING" = return SnapshotWaiting
parse t = fail ("Invalid snapshot state " <> T.unpack t)
newtype SnapshotName = SnapshotName { snapshotName :: Text }
deriving (Show, Eq, Ord, Generic, Typeable, ToJSON, FromJSON)
data SnapshotRestoreSettings = SnapshotRestoreSettings {
snapRestoreWaitForCompletion :: Bool
-- ^ Should the API call return immediately after initializing
-- the restore or wait until completed? Note that if this is
-- enabled, it could wait a long time, so you should adjust your
-- 'ManagerSettings' accordingly to set long timeouts or
-- explicitly handle timeouts.
, snapRestoreIndices :: Maybe IndexSelection
-- ^ Nothing will restore all indices in the snapshot. Just [] is
-- permissable and will essentially be a no-op restore.
, snapRestoreIgnoreUnavailable :: Bool
-- ^ If set to True, any indices that do not exist will be ignored
-- during snapshot rather than failing the restore.
, snapRestoreIncludeGlobalState :: Bool
-- ^ If set to false, will ignore any global state in the snapshot
-- and will not restore it.
, snapRestoreRenamePattern :: Maybe RestoreRenamePattern
-- ^ A regex pattern for matching indices. Used with
-- 'snapRestoreRenameReplacement', the restore can reference the
-- matched index and create a new index name upon restore.
, snapRestoreRenameReplacement :: Maybe (NonEmpty RestoreRenameToken)
-- ^ Expression of how index renames should be constructed.
, snapRestorePartial :: Bool
-- ^ If some indices fail to restore, should the process proceed?
, snapRestoreIncludeAliases :: Bool
-- ^ Should the restore also restore the aliases captured in the
-- snapshot.
, snapRestoreIndexSettingsOverrides :: Maybe RestoreIndexSettings
-- ^ Settings to apply during the restore process. __NOTE:__ This
-- option is not supported in ES < 1.5 and should be set to
-- Nothing in that case.
, snapRestoreIgnoreIndexSettings :: Maybe (NonEmpty Text)
-- ^ This type could be more rich but it isn't clear which
-- settings are allowed to be ignored during restore, so we're
-- going with including this feature in a basic form rather than
-- omitting it. One example here would be
-- "index.refresh_interval". Any setting specified here will
-- revert back to the server default during the restore process.
} deriving (Eq, Generic, Show, Typeable)
-- | Regex-stype pattern, e.g. "index_(.+)" to match index names
newtype RestoreRenamePattern = RestoreRenamePattern { rrPattern :: Text }
deriving (Show, Eq, Generic, Typeable, Ord, ToJSON)
-- | A single token in a index renaming scheme for a restore. These
-- are concatenated into a string before being sent to
-- ElasticSearch. Check out these Java
-- <https://docs.oracle.com/javase/7/docs/api/java/util/regex/Matcher.html docs> to find out more if you're into that sort of thing.
data RestoreRenameToken = RRTLit Text
-- ^ Just a literal string of characters
| RRSubWholeMatch
-- ^ Equivalent to $0. The entire matched pattern, not any subgroup
| RRSubGroup RRGroupRefNum
-- ^ A specific reference to a group number
deriving (Show, Eq, Generic, Typeable)
-- | A group number for regex matching. Only values from 1-9 are
-- supported. Construct with 'mkRRGroupRefNum'
newtype RRGroupRefNum = RRGroupRefNum { rrGroupRefNum :: Int }
deriving (Show, Eq, Generic, Typeable, Ord)
instance Bounded RRGroupRefNum where
minBound = RRGroupRefNum 1
maxBound = RRGroupRefNum 9
-- | Only allows valid group number references (1-9).
mkRRGroupRefNum :: Int -> Maybe RRGroupRefNum
mkRRGroupRefNum i
| i >= (rrGroupRefNum minBound) && i <= (rrGroupRefNum maxBound) =
Just $ RRGroupRefNum i
| otherwise = Nothing
-- | Reasonable defaults for snapshot restores
--
-- * snapRestoreWaitForCompletion False
-- * snapRestoreIndices Nothing
-- * snapRestoreIgnoreUnavailable False
-- * snapRestoreIncludeGlobalState True
-- * snapRestoreRenamePattern Nothing
-- * snapRestoreRenameReplacement Nothing
-- * snapRestorePartial False
-- * snapRestoreIncludeAliases True
-- * snapRestoreIndexSettingsOverrides Nothing
-- * snapRestoreIgnoreIndexSettings Nothing
defaultSnapshotRestoreSettings :: SnapshotRestoreSettings
defaultSnapshotRestoreSettings = SnapshotRestoreSettings {
snapRestoreWaitForCompletion = False
, snapRestoreIndices = Nothing
, snapRestoreIgnoreUnavailable = False
, snapRestoreIncludeGlobalState = True
, snapRestoreRenamePattern = Nothing
, snapRestoreRenameReplacement = Nothing
, snapRestorePartial = False
, snapRestoreIncludeAliases = True
, snapRestoreIndexSettingsOverrides = Nothing
, snapRestoreIgnoreIndexSettings = Nothing
}
-- | Index settings that can be overridden. The docs only mention you
-- can update number of replicas, but there may be more. You
-- definitely cannot override shard count.
data RestoreIndexSettings = RestoreIndexSettings {
restoreOverrideReplicas :: Maybe ReplicaCount
} deriving (Show, Eq, Generic, Typeable)
instance ToJSON RestoreIndexSettings where
toJSON RestoreIndexSettings {..} = object prs
where
prs = catMaybes [("index.number_of_replicas" .=) <$> restoreOverrideReplicas]

4
src/Database/Bloodhound/Types/Internal.hs
View File

@ -22,7 +22,7 @@ module Database.Bloodhound.Types.Internal
) where
import Control.Applicative
import Control.Applicative as A
import Control.Monad.Reader
import Data.Text (Text)
import Data.Typeable (Typeable)
@ -51,6 +51,6 @@ newtype Server = Server Text deriving (Eq, Show, Generic, Typeable)
own monad transformer stack. A default instance for a ReaderT and
alias 'BH' is provided for the simple case.
-}
class (Functor m, Applicative m, MonadIO m) => MonadBH m where
class (Functor m, A.Applicative m, MonadIO m) => MonadBH m where
getBHEnv :: m BHEnv

1
stack-7.10.yaml
View File

@ -12,4 +12,5 @@ extra-deps:
- quickcheck-properties-0.1
- semigroups-0.18.0.1
- uri-bytestring-0.1.9
- temporary-resourcet-0.1.0.0
resolver: lts-5.1

220
tests/tests.hs
View File

@ -3,6 +3,7 @@
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeOperators #-}
@ -11,8 +12,9 @@ module Main where
import Control.Applicative
import Control.Error
import Control.Exception
import Control.Exception (evaluate)
import Control.Monad
import Control.Monad.Catch
import Control.Monad.Reader
import Data.Aeson
import Data.Aeson.Types (parseEither)
@ -25,6 +27,7 @@ import Data.List.NonEmpty (NonEmpty (..))
import qualified Data.List.NonEmpty as NE
import qualified Data.Map.Strict as M
import Data.Monoid
import Data.Ord (comparing)
import Data.Proxy
import Data.Text (Text)
import qualified Data.Text as T
@ -36,14 +39,19 @@ import qualified Data.Vector as V
import Database.Bloodhound
import GHC.Generics as G
import Network.HTTP.Client hiding (Proxy)
import qualified Network.HTTP.Types.Method as NHTM
import qualified Network.HTTP.Types.Status as NHTS
import qualified Network.URI as URI
import Prelude hiding (filter)
import System.IO.Temp
import System.Posix.Files
import Test.Hspec
import Test.QuickCheck.Property.Monoid (T (..), eq, prop_Monoid)
import Test.Hspec.QuickCheck (prop)
import Test.QuickCheck
testServer :: Server
testServer = Server "http://localhost:9200"
testIndex :: IndexName
@ -54,14 +62,18 @@ testMapping = MappingName "tweet"
withTestEnv :: BH IO a -> IO a
withTestEnv = withBH defaultManagerSettings testServer
validateStatus :: Response body -> Int -> Expectation
validateStatus :: Show body => Response body -> Int -> Expectation
validateStatus resp expected =
(NHTS.statusCode $ responseStatus resp)
`shouldBe` (expected :: Int)
if actual == expected
then return ()
else expectationFailure ("Expected " <> show expected <> " but got " <> show actual <> ": " <> show body)
where
actual = NHTS.statusCode (responseStatus resp)
body = responseBody resp
createExampleIndex :: BH IO Reply
createExampleIndex :: (MonadBH m) => m Reply
createExampleIndex = createIndex (IndexSettings (ShardCount 1) (ReplicaCount 0)) testIndex
deleteExampleIndex :: BH IO Reply
deleteExampleIndex :: (MonadBH m) => m Reply
deleteExampleIndex = deleteIndex testIndex
data ServerVersion = ServerVersion Int Int Int deriving (Show, Eq, Ord)
@ -75,6 +87,15 @@ es12 = ServerVersion 1 2 0
es11 :: ServerVersion
es11 = ServerVersion 1 1 0
es14 :: ServerVersion
es14 = ServerVersion 1 4 0
es15 :: ServerVersion
es15 = ServerVersion 1 5 0
es16 :: ServerVersion
es16 = ServerVersion 1 6 0
serverBranch :: ServerVersion -> ServerVersion
serverBranch (ServerVersion majorVer minorVer patchVer) =
ServerVersion majorVer minorVer patchVer
@ -92,6 +113,33 @@ getServerVersion = liftM extractVersion (withTestEnv getStatus)
parseVersion v = map toInt (version' v)
extractVersion = join . liftM (mkServerVersion . parseVersion)
-- | Get configured repo paths for snapshotting. Note that by default
-- this is not enabled and if we are over es 1.5, we won't be able to
-- test snapshotting. Note that this can and should be part of the
-- client functionality in a much less ad-hoc incarnation.
getRepoPaths :: IO [FilePath]
getRepoPaths = withTestEnv $ do
bhe <- getBHEnv
let Server s = bhServer bhe
let tUrl = s <> "/" <> "_nodes"
initReq <- parseRequest (URI.escapeURIString URI.isAllowedInURI (T.unpack tUrl))
let req = setRequestIgnoreStatus $ initReq { method = NHTM.methodGet }
Right (Object o) <- parseEsResponse =<< liftIO (httpLbs req (bhManager bhe))
return $ fromMaybe mempty $ do
Object nodes <- HM.lookup "nodes" o
Object firstNode <- snd <$> headMay (HM.toList nodes)
Object settings <- HM.lookup "settings" firstNode
Object path <- HM.lookup "path" settings
Array repo <- HM.lookup "repo" path
return [ T.unpack t | String t <- V.toList repo]
-- | 1.5 and earlier don't care about repo paths
canSnapshot :: IO Bool
canSnapshot = do
caresAboutRepos <- atleast es16
repoPaths <- getRepoPaths
return (not caresAboutRepos || not (null (repoPaths)))
testServerBranch :: IO (Maybe ServerVersion)
testServerBranch = getServerVersion >>= \v -> return $ liftM serverBranch v
@ -312,6 +360,57 @@ searchExpectSource src expected = do
liftIO $
value `shouldBe` expected
withSnapshotRepo
:: ( MonadMask m
, MonadBH m
)
=> SnapshotRepoName
-> (GenericSnapshotRepo -> m a)
-> m a
withSnapshotRepo srn@(SnapshotRepoName n) f = do
repoPaths <- liftIO getRepoPaths
-- we'll use the first repo path if available, otherwise system temp
-- dir. Note that this will fail on ES > 1.6, so be sure you use
-- @when' canSnapshot@.
case repoPaths of
(firstRepoPath:_) -> withTempDirectory firstRepoPath (T.unpack n) $ \dir -> bracket (alloc dir) free f
[] -> withSystemTempDirectory (T.unpack n) $ \dir -> bracket (alloc dir) free f
where
alloc dir = do
liftIO (setFileMode dir mode)
let repo = FsSnapshotRepo srn "bloodhound-tests-backups" True Nothing Nothing Nothing
resp <- updateSnapshotRepo defaultSnapshotRepoUpdateSettings repo
liftIO (validateStatus resp 200)
return (toGSnapshotRepo repo)
mode = ownerModes `unionFileModes` groupModes `unionFileModes` otherModes
free GenericSnapshotRepo {..} = do
resp <- deleteSnapshotRepo gSnapshotRepoName
liftIO (validateStatus resp 200)
withSnapshot
:: ( MonadMask m
, MonadBH m
)
=> SnapshotRepoName
-> SnapshotName
-> m a
-> m a
withSnapshot srn sn = bracket_ alloc free
where
alloc = do
resp <- createSnapshot srn sn createSettings
liftIO (validateStatus resp 200)
-- We'll make this synchronous for testing purposes
createSettings = defaultSnapshotCreateSettings { snapWaitForCompletion = True
, snapIndices = Just (IndexList (testIndex :| []))
-- We don't actually need to back up any data
}
free = do
deleteSnapshot srn sn
data BulkTest = BulkTest { name :: Text } deriving (Eq, Generic, Show)
instance FromJSON BulkTest where
parseJSON = genericParseJSON defaultOptions
@ -773,7 +872,8 @@ $(derive makeArbitrary ''AllocationPolicy)
$(derive makeArbitrary ''InitialShardCount)
$(derive makeArbitrary ''FSType)
$(derive makeArbitrary ''CompoundFormat)
$(derive makeArbitrary ''FsSnapshotRepo)
$(derive makeArbitrary ''SnapshotRepoName)
main :: IO ()
main = hspec $ do
@ -1365,6 +1465,112 @@ main = hspec $ do
(dv <= maxBound) .&&.
docVersionNumber dv === i
describe "FsSnapshotRepo" $ do
prop "SnapshotRepo laws" $ \fsr ->
fromGSnapshotRepo (toGSnapshotRepo fsr) === Right (fsr :: FsSnapshotRepo)
describe "snapshot repos" $ do
it "always parses all snapshot repos API" $ when' canSnapshot $ withTestEnv $ do
res <- getSnapshotRepos AllSnapshotRepos
liftIO $ case res of
Left e -> expectationFailure ("Expected a right but got Left " <> show e)
Right _ -> return ()
it "finds an existing list of repos" $ when' canSnapshot $ withTestEnv $ do
let r1n = SnapshotRepoName "bloodhound-repo1"
let r2n = SnapshotRepoName "bloodhound-repo2"
withSnapshotRepo r1n $ \r1 ->
withSnapshotRepo r2n $ \r2 -> do
repos <- getSnapshotRepos (SnapshotRepoList (ExactRepo r1n :| [ExactRepo r2n]))
liftIO $ case repos of
Right xs -> do
let srt = L.sortBy (comparing gSnapshotRepoName)
srt xs `shouldBe` srt [r1, r2]
Left e -> expectationFailure (show e)
it "creates and updates with updateSnapshotRepo" $ when' canSnapshot $ withTestEnv $ do
let r1n = SnapshotRepoName "bloodhound-repo1"
withSnapshotRepo r1n $ \r1 -> do
let Just (String dir) = HM.lookup "location" (gSnapshotRepoSettingsObject (gSnapshotRepoSettings r1))
let noCompression = FsSnapshotRepo r1n (T.unpack dir) False Nothing Nothing Nothing
resp <- updateSnapshotRepo defaultSnapshotRepoUpdateSettings noCompression
liftIO (validateStatus resp 200)
Right [roundtrippedNoCompression] <- getSnapshotRepos (SnapshotRepoList (ExactRepo r1n :| []))
liftIO (roundtrippedNoCompression `shouldBe` toGSnapshotRepo noCompression)
-- verify came around in 1.4 it seems
it "can verify existing repos" $ when' canSnapshot $ when' (atleast es14) $ withTestEnv $ do
let r1n = SnapshotRepoName "bloodhound-repo1"
withSnapshotRepo r1n $ \_ -> do
res <- verifySnapshotRepo r1n
liftIO $ case res of
Right (SnapshotVerification vs)
| null vs -> expectationFailure "Expected nonempty set of verifying nodes"
| otherwise -> return ()
Left e -> expectationFailure (show e)
describe "snapshots" $ do
it "always parses all snapshots API" $ when' canSnapshot $ withTestEnv $ do
let r1n = SnapshotRepoName "bloodhound-repo1"
withSnapshotRepo r1n $ \_ -> do
res <- getSnapshots r1n AllSnapshots
liftIO $ case res of
Left e -> expectationFailure ("Expected a right but got Left " <> show e)
Right _ -> return ()
it "can parse a snapshot that it created" $ when' canSnapshot $ withTestEnv $ do
let r1n = SnapshotRepoName "bloodhound-repo1"
withSnapshotRepo r1n $ \_ -> do
let s1n = SnapshotName "example-snapshot"
withSnapshot r1n s1n $ do
res <- getSnapshots r1n (SnapshotList (ExactSnap s1n :| []))
liftIO $ case res of
Right [snap]
| snapInfoState snap == SnapshotSuccess &&
snapInfoName snap == s1n -> return ()
| otherwise -> expectationFailure (show snap)
Right [] -> expectationFailure "There were no snapshots"
Right snaps -> expectationFailure ("Expected 1 snapshot but got" <> show (length snaps))
Left e -> expectationFailure (show e)
describe "snapshot restore" $ do
it "can restore a snapshot that we create" $ when' canSnapshot $ withTestEnv $ do
let r1n = SnapshotRepoName "bloodhound-repo1"
withSnapshotRepo r1n $ \_ -> do
let s1n = SnapshotName "example-snapshot"
withSnapshot r1n s1n $ do
let settings = defaultSnapshotRestoreSettings { snapRestoreWaitForCompletion = True }
-- have to close an index to restore it
resp1 <- closeIndex testIndex
liftIO (validateStatus resp1 200)
resp2 <- restoreSnapshot r1n s1n settings
liftIO (validateStatus resp2 200)
it "can restore and rename" $ when' canSnapshot $ withTestEnv $ do
let r1n = SnapshotRepoName "bloodhound-repo1"
withSnapshotRepo r1n $ \_ -> do
let s1n = SnapshotName "example-snapshot"
withSnapshot r1n s1n $ do
let pat = RestoreRenamePattern "bloodhound-tests-twitter-(\\d+)"
let replace = RRTLit "restored-" :| [RRSubWholeMatch]
let expectedIndex = IndexName "restored-bloodhound-tests-twitter-1"
oldEnoughForOverrides <- liftIO (atleast es15)
let overrides = RestoreIndexSettings { restoreOverrideReplicas = Just (ReplicaCount 0) }
let settings = defaultSnapshotRestoreSettings { snapRestoreWaitForCompletion = True
, snapRestoreRenamePattern = Just pat
, snapRestoreRenameReplacement = Just replace
, snapRestoreIndexSettingsOverrides = if oldEnoughForOverrides
then Just overrides
else Nothing
}
-- have to close an index to restore it
let go = do
resp <- restoreSnapshot r1n s1n settings
liftIO (validateStatus resp 200)
exists <- indexExists expectedIndex
liftIO (exists `shouldBe` True)
go `finally` deleteIndex expectedIndex
describe "Enum DocVersion" $ do
it "follows the laws of Enum, Bounded" $ do
evaluate (succ maxBound :: DocVersion) `shouldThrow` anyErrorCall