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

WIP snapshot-restore API

Browse Source 
Snapshots API partly implemented. First trivial test case is passing.

This could get tricky as our test suite spans many versions. For
instance, 1.7 is when patterns got introduced.
This commit is contained in:
Michael Xavier 2016-07-19 16:15:17 -07:00
parent 26d4e547dd
commit 06819a6b44
6 changed files with 291 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
bloodhound.cabal
View File

@ -73,7 +73,9 @@ test-suite tests
mtl,
quickcheck-properties,
derive,
errors
errors,
resourcet,
temporary-resourcet
default-language: Haskell2010
test-suite doctests

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

@ -59,6 +59,10 @@ module Database.Bloodhound.Client
, mkShardCount
, mkReplicaCount
, getStatus
, getSnapshotRepos
, updateSnapshotRepo
, verifySnapshotRepo
, deleteSnapshotRepo
, encodeBulkOperations
, encodeBulkOperation
-- * Authentication
@ -72,7 +76,7 @@ module Database.Bloodhound.Client
where
import qualified Blaze.ByteString.Builder as BB
import Control.Applicative
import Control.Applicative as A
import Control.Monad
import Control.Monad.Catch
import Control.Monad.IO.Class
@ -183,7 +187,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 +264,79 @@ 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 ->
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 --TODO: more specific?
updateSnapshotRepo SnapshotRepoUpdateSettings {..} repo = bindM2 post url (return (Just body))
where
url = addQuery params <$> joinPath ["_snapshots", snapshotRepoName gSnapshotRepoName]
params
| repoUpdateVerify = []
| otherwise = [("verify", Just "false")]
body = encode $ object [ "types" .= gSnapshotRepoName
, "settings" .= gSnapshotRepoSettings
]
GenericSnapshotRepo {..} = toGSnapshotRepo repo
-- | Verify if a snapshot repo is working.
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]
-- | 'createIndex' will create an index given a 'Server', 'IndexSettings', and an 'IndexName'.
--
-- >>> response <- runBH' $ createIndex defaultIndexSettings (IndexName "didimakeanindex")

195
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,21 @@ module Database.Bloodhound.Types
, CollectionMode(..)
, TermOrder(..)
, TermInclusion(..)
, SnapshotRepoSelection(..)
, GenericSnapshotRepo(..)
, SnapshotRepo(..)
, SnapshotRepoConversionError(..)
, SnapshotRepoType(..)
, GenericSnapshotRepoSettings(..)
, SnapshotRepoUpdateSettings(..)
, defaultSnapshotRepoUpdateSettings
, SnapshotRepoName(..)
, SnapshotRepoPattern(..)
, SnapshotVerification(..)
, SnapshotNodeVerification(..)
, FullNodeId(..)
, NodeName(..)
, FsSnapshotRepo(..)
, Aggregation(..)
, Aggregations
@ -275,7 +293,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 +301,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 +350,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 +501,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)
@ -3625,3 +3666,149 @@ 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, 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)
newtype SnapshotRepoType = SnapshotRepoType { snapshotRepoType :: Text }
deriving (Eq, 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, FromJSON)
-- | The result of running 'verifySnapshotRepo'. --TODO: more detail once you know what a failure looks like
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"
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, Generic, Show, Typeable, FromJSON)
newtype NodeName = NodeName { nodeName :: Text }
deriving (Eq, 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.
data FsSnapshotRepo = FsSnapshotRepo {
fsrName :: SnapshotRepoName
, fsrLocation :: FilePath
, fsrCompressMetadata :: Bool
, fsrChunkSize :: Maybe Bytes
, fsrMaxRestoreBytesPerSec :: Maybe Bytes
, fsrMaxSnapshotBytesPerSec :: Maybe Bytes
} 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)
--TODO: test what error case looks like
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
-- ^ Expected type
SnapshotRepoType
-- ^ Actual type
| OtherRepoConversionError Text
deriving (Show, Eq, Generic, Typeable)
instance Exception SnapshotRepoConversionError

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

@ -13,4 +13,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

16
tests/tests.hs
View File

@ -14,6 +14,7 @@ import Control.Error
import Control.Exception
import Control.Monad
import Control.Monad.Reader
import Control.Monad.Trans.Resource
import Data.Aeson
import Data.Aeson.Types (parseEither)
import qualified Data.ByteString.Lazy.Char8 as BL8
@ -38,6 +39,7 @@ import GHC.Generics as G
import Network.HTTP.Client hiding (Proxy)
import qualified Network.HTTP.Types.Status as NHTS
import Prelude hiding (filter)
import System.IO.Temp
import Test.Hspec
import Test.QuickCheck.Property.Monoid (T (..), eq, prop_Monoid)
@ -773,7 +775,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 +1368,17 @@ 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 snapshots API" $ withTestEnv $ do
res <- getSnapshotRepos AllSnapshotRepos
liftIO $ case res of
Left e -> expectationFailure ("Expected a right but got Left " <> show e)
Right _ -> return ()
describe "Enum DocVersion" $ do
it "follows the laws of Enum, Bounded" $ do
evaluate (succ maxBound :: DocVersion) `shouldThrow` anyErrorCall