06819a6 · typeable/bloodhound

git.iko.soy/typeable/bloodhound

on master help sign in

WIP snapshot-restore API

06819a6Michael Xavier10 years ago

bloodhound.cabal+3−1

compare with master

unifiedsplit

@@ -73,7 +73,9 @@ test-suite tests

73 mtl,

74 quickcheck-properties,

75 derive,

76− errors

76+ errors,

77+ resourcet,

78+ temporary-resourcet

77 default-language: Haskell2010

79 default-language: Haskell2010

79test-suite doctests

81test-suite doctests

src/Database/Bloodhound/Client.hs+79−2

@@ -59,6 +59,10 @@ module Database.Bloodhound.Client

59 , mkShardCount

60 , mkReplicaCount

61 , getStatus

62+ , getSnapshotRepos

63+ , updateSnapshotRepo

64+ , verifySnapshotRepo

65+ , deleteSnapshotRepo

62 , encodeBulkOperations

66 , encodeBulkOperations

63 , encodeBulkOperation

67 , encodeBulkOperation

64 -- * Authentication

68 -- * Authentication

@@ -72,7 +76,7 @@ module Database.Bloodhound.Client

72 where

76 where

74import qualified Blaze.ByteString.Builder as BB

78import qualified Blaze.ByteString.Builder as BB

75−import Control.Applicative

79+import Control.Applicative as A

76import Control.Monad

80import Control.Monad

77import Control.Monad.Catch

81import Control.Monad.Catch

78import Control.Monad.IO.Class

82import Control.Monad.IO.Class

@@ -183,7 +187,7 @@ dispatch :: MonadBH m

183 -> m Reply

187 -> m Reply

184dispatch dMethod url body = do

188dispatch dMethod url body = do

185 initReq <- liftIO $ parseUrl' url

189 initReq <- liftIO $ parseUrl' url

186− reqHook <- bhRequestHook <$> getBHEnv

190+ reqHook <- bhRequestHook A.<$> getBHEnv

187 let reqBody = RequestBodyLBS $ fromMaybe emptyBody body

191 let reqBody = RequestBodyLBS $ fromMaybe emptyBody body

188 req <- liftIO $ reqHook $ setRequestIgnoreStatus $ initReq { method = dMethod

192 req <- liftIO $ reqHook $ setRequestIgnoreStatus $ initReq { method = dMethod

189 , requestBody = reqBody }

193 , requestBody = reqBody }

@@ -260,6 +264,79 @@ getStatus = do

260 return $ decode (responseBody response)

264 return $ decode (responseBody response)

261 where url = joinPath []

265 where url = joinPath []

262

266

267+-- | 'getSnapshotRepos' gets the definitions of a subset of the

268+-- defined snapshot repos.

269+getSnapshotRepos

270+ :: ( MonadBH m

271+ , MonadThrow m

272+ )

273+ => SnapshotRepoSelection

274+ -> m (Either EsError [GenericSnapshotRepo])

275+getSnapshotRepos sel = fmap (fmap unGSRs) . parseEsResponse =<< get =<< url

276+ where

277+ url = joinPath ["_snapshot", selectorSeg]

278+ selectorSeg = case sel of

279+ AllSnapshotRepos -> "_all"

280+ SnapshotRepoList (p :| ps) -> T.intercalate "," (renderPat <$> (p:ps))

281+ renderPat (RepoPattern t) = t

282+ renderPat (ExactRepo (SnapshotRepoName t)) = t

283+

284+

285+-- | Wrapper to extract the list of 'GenericSnapshotRepo' in the

286+-- format they're returned in

287+newtype GSRs = GSRs { unGSRs :: [GenericSnapshotRepo] }

288+

289+

290+instance FromJSON GSRs where

291+ parseJSON = withObject "Collection of GenericSnapshotRepo" parse

292+ where

293+ parse = fmap GSRs . mapM (uncurry go) . HM.toList

294+ go rawName = withObject "GenericSnapshotRepo" $ \o ->

295+ GenericSnapshotRepo (SnapshotRepoName rawName) <$> o .: "type"

296+ <*> o .: "settings"

297+

298+

299+-- | Create or update a snapshot repo

300+updateSnapshotRepo

301+ :: ( MonadBH m

302+ , SnapshotRepo repo

303+ )

304+ => SnapshotRepoUpdateSettings

305+ -- ^ Use 'defaultSnapshotRepoUpdateSettings' if unsure

306+ -> repo

307+ -> m Reply --TODO: more specific?

308+updateSnapshotRepo SnapshotRepoUpdateSettings {..} repo = bindM2 post url (return (Just body))

309+ where

310+ url = addQuery params <$> joinPath ["_snapshots", snapshotRepoName gSnapshotRepoName]

311+ params

312+ | repoUpdateVerify = []

313+ | otherwise = [("verify", Just "false")]

314+ body = encode $ object [ "types" .= gSnapshotRepoName

315+ , "settings" .= gSnapshotRepoSettings

316+ ]

317+ GenericSnapshotRepo {..} = toGSnapshotRepo repo

318+

319+

320+

321+-- | Verify if a snapshot repo is working.

322+verifySnapshotRepo

323+ :: ( MonadBH m

324+ , MonadThrow m

325+ )

326+ => SnapshotRepoName

327+ -> m (Either EsError SnapshotVerification)

328+verifySnapshotRepo (SnapshotRepoName n) =

329+ parseEsResponse =<< bindM2 post url (return Nothing)

330+ where

331+ url = joinPath ["_snapshot", n, "_verify"]

332+

333+

334+deleteSnapshotRepo :: MonadBH m => SnapshotRepoName -> m Reply

335+deleteSnapshotRepo (SnapshotRepoName n) = delete =<< url

336+ where

337+ url = joinPath ["_snapshot", n]

338+

339+

263-- | 'createIndex' will create an index given a 'Server', 'IndexSettings', and an 'IndexName'.

340-- | 'createIndex' will create an index given a 'Server', 'IndexSettings', and an 'IndexName'.

264--

341--

265-- >>> response <- runBH' $ createIndex defaultIndexSettings (IndexName "didimakeanindex")

342-- >>> response <- runBH' $ createIndex defaultIndexSettings (IndexName "didimakeanindex")

src/Database/Bloodhound/Types.hs+191−4

@@ -5,10 +5,10 @@

5{-# LANGUAGE GeneralizedNewtypeDeriving #-}

6{-# LANGUAGE MultiParamTypeClasses #-}

7-- {-# LANGUAGE NoMonomorphismRestriction #-}

8+{-# LANGUAGE NamedFieldPuns #-}

8{-# LANGUAGE OverloadedStrings #-}

9{-# LANGUAGE OverloadedStrings #-}

9{-# LANGUAGE RecordWildCards #-}

10{-# LANGUAGE RecordWildCards #-}

10{-# LANGUAGE UndecidableInstances #-}

11{-# LANGUAGE UndecidableInstances #-}

11−{-# LANGUAGE NamedFieldPuns #-}

13-------------------------------------------------------------------------------

14-- |

@@ -69,6 +69,9 @@ module Database.Bloodhound.Types

69 , AllocationPolicy(..)

70 , ReplicaBounds(..)

71 , Bytes(..)

72+ , gigabytes

73+ , megabytes

74+ , kilobytes

72 , FSType(..)

75 , FSType(..)

73 , InitialShardCount(..)

76 , InitialShardCount(..)

74 , NodeAttrFilter(..)

77 , NodeAttrFilter(..)

@@ -235,6 +238,21 @@ module Database.Bloodhound.Types

235 , CollectionMode(..)

238 , CollectionMode(..)

236 , TermOrder(..)

239 , TermOrder(..)

237 , TermInclusion(..)

240 , TermInclusion(..)

241+ , SnapshotRepoSelection(..)

242+ , GenericSnapshotRepo(..)

243+ , SnapshotRepo(..)

244+ , SnapshotRepoConversionError(..)

245+ , SnapshotRepoType(..)

246+ , GenericSnapshotRepoSettings(..)

247+ , SnapshotRepoUpdateSettings(..)

248+ , defaultSnapshotRepoUpdateSettings

249+ , SnapshotRepoName(..)

250+ , SnapshotRepoPattern(..)

251+ , SnapshotVerification(..)

252+ , SnapshotNodeVerification(..)

253+ , FullNodeId(..)

254+ , NodeName(..)

255+ , FsSnapshotRepo(..)

238

256

239 , Aggregation(..)

257 , Aggregation(..)

240 , Aggregations

258 , Aggregations

@@ -275,7 +293,7 @@ module Database.Bloodhound.Types

275 , EsPassword(..)

293 , EsPassword(..)

276 ) where

294 ) where

277

295

278−import Control.Applicative

296+import Control.Applicative as A

279import Control.Monad.Catch

297import Control.Monad.Catch

280import Control.Monad.Except

298import Control.Monad.Except

281import Control.Monad.Reader

299import Control.Monad.Reader

@@ -283,7 +301,7 @@ import Control.Monad.State

283import Control.Monad.Writer

301import Control.Monad.Writer

284import Data.Aeson

302import Data.Aeson

285import Data.Aeson.Types (Pair, Parser, emptyObject,

303import Data.Aeson.Types (Pair, Parser, emptyObject,

286− parseMaybe)

304+ parseEither, parseMaybe)

287import qualified Data.ByteString.Lazy.Char8 as L

305import qualified Data.ByteString.Lazy.Char8 as L

288import Data.Char

306import Data.Char

289import Data.Hashable (Hashable)

307import Data.Hashable (Hashable)

@@ -332,7 +350,7 @@ mkBHEnv s m = BHEnv s m return

332newtype BH m a = BH {

350newtype BH m a = BH {

333 unBH :: ReaderT BHEnv m a

351 unBH :: ReaderT BHEnv m a

334 } deriving ( Functor

352 } deriving ( Functor

335− , Applicative

353+ , A.Applicative

336 , Monad

354 , Monad

337 , MonadIO

355 , MonadIO

338 , MonadState s

356 , MonadState s

@@ -483,8 +501,31 @@ data ReplicaBounds = ReplicasBounded Int Int

483 | ReplicasUnbounded

501 | ReplicasUnbounded

484 deriving (Eq, Read, Show, Generic, Typeable)

502 deriving (Eq, Read, Show, Generic, Typeable)

485

503

504+-- | A measure of bytes used for various configurations. You may want

505+-- to use smart constructors like 'gigabytes' for larger values.

506+--

507+-- >>> gigabytes 9

508+-- Bytes 9000000000

509+--

510+-- >>> megabytes 9

511+-- Bytes 9000000

512+--

513+-- >>> kilobytes 9

514+-- Bytes 9000

486newtype Bytes = Bytes Int deriving (Eq, Read, Show, Generic, Typeable, Ord, ToJSON, FromJSON)

515newtype Bytes = Bytes Int deriving (Eq, Read, Show, Generic, Typeable, Ord, ToJSON, FromJSON)

487

516

517+gigabytes :: Int -> Bytes

518+gigabytes n = megabytes (1000 * n)

519+

520+

521+megabytes :: Int -> Bytes

522+megabytes n = kilobytes (1000 * n)

523+

524+

525+kilobytes :: Int -> Bytes

526+kilobytes n = Bytes (1000 * n)

527+

528+

488data FSType = FSSimple

529data FSType = FSSimple

489 | FSBuffered deriving (Eq, Read, Show, Generic, Typeable, Ord)

530 | FSBuffered deriving (Eq, Read, Show, Generic, Typeable, Ord)

490

531

@@ -3625,3 +3666,149 @@ newtype EsUsername = EsUsername { esUsername :: Text } deriving (Read, Show, Eq)

3625

3666

3626-- | Password type used for HTTP Basic authentication. See 'basicAuthHook'.

3667-- | Password type used for HTTP Basic authentication. See 'basicAuthHook'.

3627newtype EsPassword = EsPassword { esPassword :: Text } deriving (Read, Show, Eq)

3668newtype EsPassword = EsPassword { esPassword :: Text } deriving (Read, Show, Eq)

3669+

3670+

3671+data SnapshotRepoSelection = SnapshotRepoList (NonEmpty SnapshotRepoPattern)

3672+ | AllSnapshotRepos deriving (Eq, Generic, Show, Typeable)

3673+

3674+

3675+-- | Either specifies an exact repo name or one with globs in it,

3676+-- e.g. @RepoPattern "foo*"@ __NOTE__: Patterns are not supported on ES < 1.7

3677+data SnapshotRepoPattern = ExactRepo SnapshotRepoName

3678+ | RepoPattern Text

3679+ deriving (Eq, Generic, Show, Typeable)

3680+

3681+-- | The unique name of a snapshot repository.

3682+newtype SnapshotRepoName = SnapshotRepoName { snapshotRepoName :: Text }

3683+ deriving (Eq, Generic, Show, Typeable, ToJSON, FromJSON)

3684+

3685+

3686+-- | A generic representation of a snapshot repo. This is what gets

3687+-- sent to and parsed from the server. For repo types enabled by

3688+-- plugins that aren't exported by this library, consider making a

3689+-- custom type which implements 'SnapshotRepo'. If it is a common repo

3690+-- type, consider submitting a pull request to have it included in the

3691+-- library proper

3692+data GenericSnapshotRepo = GenericSnapshotRepo {

3693+ gSnapshotRepoName :: SnapshotRepoName

3694+ , gSnapshotRepoType :: SnapshotRepoType

3695+ , gSnapshotRepoSettings :: GenericSnapshotRepoSettings

3696+ } deriving (Eq, Generic, Show, Typeable)

3697+

3698+

3699+newtype SnapshotRepoType = SnapshotRepoType { snapshotRepoType :: Text }

3700+ deriving (Eq, Generic, Show, Typeable, ToJSON, FromJSON)

3701+

3702+

3703+-- | Opaque representation of snapshot repo settings. Instances of

3704+-- 'SnapshotRepo' will produce this.

3705+newtype GenericSnapshotRepoSettings = GenericSnapshotRepoSettings { gSnapshotRepoSettingsObject :: Object }

3706+ deriving (Eq, Generic, Show, Typeable, ToJSON, FromJSON)

3707+

3708+

3709+-- | The result of running 'verifySnapshotRepo'. --TODO: more detail once you know what a failure looks like

3710+newtype SnapshotVerification = SnapshotVerification { snapshotNodeVerifications :: [SnapshotNodeVerification] }

3711+ deriving (Eq, Generic, Show, Typeable)

3712+

3713+

3714+instance FromJSON SnapshotVerification where

3715+ parseJSON = withObject "SnapshotVerification" parse

3716+ where

3717+ parse o = do

3718+ o2 <- o .: "nodes"

3719+ SnapshotVerification <$> mapM (uncurry parse') (HM.toList o2)

3720+ parse' rawFullId = withObject "SnapshotNodeVerification" $ \o ->

3721+ SnapshotNodeVerification (FullNodeId rawFullId) <$> o .: "name"

3722+

3723+

3724+data SnapshotNodeVerification = SnapshotNodeVerification {

3725+ snvFullId :: FullNodeId

3726+ , snvNodeName :: NodeName

3727+ } deriving (Eq, Generic, Show, Typeable)

3728+

3729+

3730+-- | Unique, automatically-generated name assigned to nodes that are

3731+-- usually returned in node-oriented APIs.

3732+newtype FullNodeId = FullNodeId { fullNodeId :: Text }

3733+ deriving (Eq, Generic, Show, Typeable, FromJSON)

3734+

3735+

3736+newtype NodeName = NodeName { nodeName :: Text }

3737+ deriving (Eq, Generic, Show, Typeable, FromJSON)

3738+

3739+

3740+data SnapshotRepoUpdateSettings = SnapshotRepoUpdateSettings {

3741+ repoUpdateVerify :: Bool

3742+ -- ^ After creation/update, synchronously check that nodes can

3743+ -- write to this repo. Defaults to True. You may use False if you

3744+ -- need a faster response and plan on verifying manually later

3745+ -- with 'verifySnapshotRepo'.

3746+ } deriving (Eq, Show, Generic, Typeable)

3747+

3748+

3749+-- | Reasonable defaults for repo creation/update

3750+--

3751+-- * repoUpdateVerify True

3752+defaultSnapshotRepoUpdateSettings :: SnapshotRepoUpdateSettings

3753+defaultSnapshotRepoUpdateSettings = SnapshotRepoUpdateSettings True

3754+

3755+

3756+-- | A filesystem-based snapshot repo that ships with elasticsearch.

3757+data FsSnapshotRepo = FsSnapshotRepo {

3758+ fsrName :: SnapshotRepoName

3759+ , fsrLocation :: FilePath

3760+ , fsrCompressMetadata :: Bool

3761+ , fsrChunkSize :: Maybe Bytes

3762+ , fsrMaxRestoreBytesPerSec :: Maybe Bytes

3763+ , fsrMaxSnapshotBytesPerSec :: Maybe Bytes

3764+ } deriving (Eq, Generic, Show, Typeable)

3765+

3766+

3767+instance SnapshotRepo FsSnapshotRepo where

3768+ toGSnapshotRepo FsSnapshotRepo {..} =

3769+ GenericSnapshotRepo fsrName fsRepoType (GenericSnapshotRepoSettings settings)

3770+ where

3771+ Object settings = object $ [ "location" .= fsrLocation

3772+ , "compress" .= fsrCompressMetadata

3773+ ] ++ optionalPairs

3774+ optionalPairs = catMaybes [ ("chunk_size" .=) <$> fsrChunkSize

3775+ , ("max_restore_bytes_per_sec" .=) <$> fsrMaxRestoreBytesPerSec

3776+ , ("max_snapshot_bytes_per_sec" .=) <$> fsrMaxSnapshotBytesPerSec

3777+ ]

3778+ fromGSnapshotRepo GenericSnapshotRepo {..}

3779+ | gSnapshotRepoType == fsRepoType = do

3780+ let o = gSnapshotRepoSettingsObject gSnapshotRepoSettings

3781+ parseRepo $ do

3782+ FsSnapshotRepo gSnapshotRepoName <$> o .: "location"

3783+ <*> o .:? "compress" .!= False

3784+ <*> o .:? "chunk_size"

3785+ <*> o .:? "max_restore_bytes_per_sec"

3786+ <*> o .:? "max_snapshot_bytes_per_sec"

3787+ | otherwise = Left (RepoTypeMismatch fsRepoType gSnapshotRepoType)

3788+

3789+

3790+--TODO: test what error case looks like

3791+parseRepo :: Parser a -> Either SnapshotRepoConversionError a

3792+parseRepo parser = case parseEither (const parser) () of

3793+ Left e -> Left (OtherRepoConversionError (T.pack e))

3794+ Right a -> Right a

3795+

3796+

3797+fsRepoType :: SnapshotRepoType

3798+fsRepoType = SnapshotRepoType "fs"

3799+

3800+-- | Law: fromGSnapshotRepo (toGSnapshotRepo r) == Right r

3801+class SnapshotRepo r where

3802+ toGSnapshotRepo :: r -> GenericSnapshotRepo

3803+ fromGSnapshotRepo :: GenericSnapshotRepo -> Either SnapshotRepoConversionError r

3804+

3805+

3806+data SnapshotRepoConversionError = RepoTypeMismatch SnapshotRepoType

3807+ -- ^ Expected type

3808+ SnapshotRepoType

3809+ -- ^ Actual type

3810+ | OtherRepoConversionError Text

3811+ deriving (Show, Eq, Generic, Typeable)

3812+

3813+

3814+instance Exception SnapshotRepoConversionError

src/Database/Bloodhound/Types/Internal.hs+2−2

@@ -22,7 +22,7 @@ module Database.Bloodhound.Types.Internal

22 ) where

25−import Control.Applicative

25+import Control.Applicative as A

26import Control.Monad.Reader

27import Data.Text (Text)

28import Data.Typeable (Typeable)

@@ -51,6 +51,6 @@ newtype Server = Server Text deriving (Eq, Show, Generic, Typeable)

51 own monad transformer stack. A default instance for a ReaderT and

52 alias 'BH' is provided for the simple case.

53-}

54−class (Functor m, Applicative m, MonadIO m) => MonadBH m where

54+class (Functor m, A.Applicative m, MonadIO m) => MonadBH m where

55 getBHEnv :: m BHEnv

stack-7.10.yaml+1

@@ -13,4 +13,5 @@ extra-deps:

13- quickcheck-properties-0.1

14- semigroups-0.18.0.1

15- uri-bytestring-0.1.9

16+- temporary-resourcet-0.1.0.0

16resolver: lts-5.1

17resolver: lts-5.1

tests/tests.hs+15−1

@@ -14,6 +14,7 @@ import Control.Error

14import Control.Exception

15import Control.Monad

16import Control.Monad.Reader

17+import Control.Monad.Trans.Resource

17import Data.Aeson

18import Data.Aeson

18import Data.Aeson.Types (parseEither)

19import Data.Aeson.Types (parseEither)

19import qualified Data.ByteString.Lazy.Char8 as BL8

20import qualified Data.ByteString.Lazy.Char8 as BL8

@@ -38,6 +39,7 @@ import GHC.Generics as G

38import Network.HTTP.Client hiding (Proxy)

39import Network.HTTP.Client hiding (Proxy)

39import qualified Network.HTTP.Types.Status as NHTS

40import qualified Network.HTTP.Types.Status as NHTS

40import Prelude hiding (filter)

41import Prelude hiding (filter)

42+import System.IO.Temp

41import Test.Hspec

43import Test.Hspec

42import Test.QuickCheck.Property.Monoid (T (..), eq, prop_Monoid)

44import Test.QuickCheck.Property.Monoid (T (..), eq, prop_Monoid)

@@ -773,7 +775,8 @@ $(derive makeArbitrary ''AllocationPolicy)

773$(derive makeArbitrary ''InitialShardCount)

775$(derive makeArbitrary ''InitialShardCount)

774$(derive makeArbitrary ''FSType)

776$(derive makeArbitrary ''FSType)

775$(derive makeArbitrary ''CompoundFormat)

777$(derive makeArbitrary ''CompoundFormat)

776−

778+$(derive makeArbitrary ''FsSnapshotRepo)

779+$(derive makeArbitrary ''SnapshotRepoName)

777

780

778main :: IO ()

781main :: IO ()

779main = hspec $ do

782main = hspec $ do

@@ -1365,6 +1368,17 @@ main = hspec $ do

1365 (dv <= maxBound) .&&.

1368 (dv <= maxBound) .&&.

1366 docVersionNumber dv === i

1369 docVersionNumber dv === i

1367

1370

1371+ describe "FsSnapshotRepo" $ do

1372+ prop "SnapshotRepo laws" $ \fsr ->

1373+ fromGSnapshotRepo (toGSnapshotRepo fsr) === Right (fsr :: FsSnapshotRepo)

1374+

1375+ describe "snapshot repos" $ do

1376+ it "always parses all snapshots API" $ withTestEnv $ do

1377+ res <- getSnapshotRepos AllSnapshotRepos

1378+ liftIO $ case res of

1379+ Left e -> expectationFailure ("Expected a right but got Left " <> show e)

1380+ Right _ -> return ()

1381+

1368 describe "Enum DocVersion" $ do

1382 describe "Enum DocVersion" $ do

1369 it "follows the laws of Enum, Bounded" $ do

1383 it "follows the laws of Enum, Bounded" $ do

1370 evaluate (succ maxBound :: DocVersion) `shouldThrow` anyErrorCall

1384 evaluate (succ maxBound :: DocVersion) `shouldThrow` anyErrorCall