841dfa7 · typeable/bloodhound

git.iko.soy/typeable/bloodhound

on master help sign in

Add and test snapshot apis

841dfa7Michael Xavier10 years ago

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

compare with master

unifiedsplit

@@ -63,6 +63,9 @@ module Database.Bloodhound.Client

63 , updateSnapshotRepo

64 , verifySnapshotRepo

65 , deleteSnapshotRepo

66+ , createSnapshot

67+ , getSnapshots

68+ , deleteSnapshot

66 , encodeBulkOperations

69 , encodeBulkOperations

67 , encodeBulkOperation

70 , encodeBulkOperation

68 -- * Authentication

71 -- * Authentication

@@ -306,7 +309,8 @@ updateSnapshotRepo

306 -- ^ Use 'defaultSnapshotRepoUpdateSettings' if unsure

309 -- ^ Use 'defaultSnapshotRepoUpdateSettings' if unsure

307 -> repo

310 -> repo

308 -> m Reply

311 -> m Reply

309−updateSnapshotRepo SnapshotRepoUpdateSettings {..} repo = bindM2 post url (return (Just body))

312+updateSnapshotRepo SnapshotRepoUpdateSettings {..} repo =

313+ bindM2 put url (return (Just body))

310 where

314 where

311 url = addQuery params <$> joinPath ["_snapshot", snapshotRepoName gSnapshotRepoName]

315 url = addQuery params <$> joinPath ["_snapshot", snapshotRepoName gSnapshotRepoName]

312 params

316 params

@@ -338,6 +342,64 @@ deleteSnapshotRepo (SnapshotRepoName n) = delete =<< url

338 url = joinPath ["_snapshot", n]

342 url = joinPath ["_snapshot", n]

339

343

340

344

345+createSnapshot

346+ :: (MonadBH m)

347+ => SnapshotRepoName

348+ -> SnapshotName

349+ -> SnapshotCreateSettings

350+ -> m Reply

351+createSnapshot (SnapshotRepoName repoName)

352+ (SnapshotName snapName)

353+ SnapshotCreateSettings {..} =

354+ bindM2 put url (return (Just body))

355+ where

356+ url = addQuery params <$> joinPath ["_snapshot", repoName, snapName]

357+ params = [("wait_for_completion", Just (boolQP snapWaitForCompletion))]

358+ body = encode $ object prs

359+ prs = catMaybes [ ("indices" .=) . renderIndices <$> snapIndices

360+ , Just ("ignore_unavailable" .= snapIgnoreUnavailable)

361+ , Just ("ignore_global_state" .= snapIncludeGlobalState)

362+ , Just ("partial" .= snapPartial)

363+ ]

364+ renderIndices (i :| is) = T.intercalate "," (renderIndex <$> (i:is))

365+ renderIndex (IndexName n) = n

366+

367+

368+getSnapshots

369+ :: ( MonadBH m

370+ , MonadThrow m

371+ )

372+ => SnapshotRepoName

373+ -> SnapshotSelection

374+ -> m (Either EsError

375+ [SnapshotInfo])

376+getSnapshots (SnapshotRepoName repoName) sel =

377+ fmap (fmap unSIs) . parseEsResponse =<< get =<< url

378+ where

379+ url = joinPath ["_snapshot", repoName, snapPath]

380+ snapPath = case sel of

381+ AllSnapshots -> "_all"

382+ SnapshotList (s :| ss) -> T.intercalate "," (renderPath <$> (s:ss))

383+ renderPath (SnapPattern t) = t

384+ renderPath (ExactSnap (SnapshotName t)) = t

385+

386+

387+newtype SIs = SIs { unSIs :: [SnapshotInfo] }

388+

389+

390+instance FromJSON SIs where

391+ parseJSON = withObject "Collection of SnapshotInfo" parse

392+ where

393+ parse o = SIs <$> o .: "snapshots"

394+

395+

396+deleteSnapshot :: MonadBH m => SnapshotRepoName -> SnapshotName -> m Reply

397+deleteSnapshot (SnapshotRepoName repoName) (SnapshotName snapName) =

398+ delete =<< url

399+ where

400+ url = joinPath ["_snapshot", repoName, snapName]

401+

402+

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

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

342--

404--

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

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

@@ -417,8 +479,6 @@ optimizeIndex ixs IndexOptimizationSettings {..} =

417 , Just ("flush", Just (boolQP flushAfterOptimize))

479 , Just ("flush", Just (boolQP flushAfterOptimize))

418 ]

480 ]

419 indexName = indexSelectionName ixs

481 indexName = indexSelectionName ixs

420− boolQP True = "true"

421− boolQP False = "false"

422 body = Nothing

482 body = Nothing

423

483

424

484

@@ -934,3 +994,8 @@ basicAuthHook :: Monad m => EsUsername -> EsPassword -> Request -> m Request

934basicAuthHook (EsUsername u) (EsPassword p) = return . applyBasicAuth u' p'

994basicAuthHook (EsUsername u) (EsPassword p) = return . applyBasicAuth u' p'

935 where u' = T.encodeUtf8 u

995 where u' = T.encodeUtf8 u

936 p' = T.encodeUtf8 p

996 p' = T.encodeUtf8 p

997+

998+

999+boolQP :: Bool -> Text

1000+boolQP True = "true"

1001+boolQP False = "false"

src/Database/Bloodhound/Types.hs+119−3

@@ -253,6 +253,13 @@ module Database.Bloodhound.Types

253 , FullNodeId(..)

254 , NodeName(..)

255 , FsSnapshotRepo(..)

256+ , SnapshotCreateSettings(..)

257+ , defaultSnapshotCreateSettings

258+ , SnapshotSelection(..)

259+ , SnapshotPattern(..)

260+ , SnapshotInfo(..)

261+ , SnapshotName(..)

262+ , SnapshotState(..)

256

263

257 , Aggregation(..)

264 , Aggregation(..)

258 , Aggregations

265 , Aggregations

@@ -3672,7 +3679,7 @@ data SnapshotRepoSelection = SnapshotRepoList (NonEmpty SnapshotRepoPattern)

3672

3679

3673

3680

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

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

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

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

3676data SnapshotRepoPattern = ExactRepo SnapshotRepoName

3683data SnapshotRepoPattern = ExactRepo SnapshotRepoName

3677 | RepoPattern Text

3684 | RepoPattern Text

3678 deriving (Eq, Generic, Show, Typeable)

3685 deriving (Eq, Generic, Show, Typeable)

@@ -3716,7 +3723,7 @@ newtype GenericSnapshotRepoSettings = GenericSnapshotRepoSettings { gSnapshotRep

3716instance FromJSON GenericSnapshotRepoSettings where

3723instance FromJSON GenericSnapshotRepoSettings where

3717 parseJSON = fmap (GenericSnapshotRepoSettings . fmap unStringlyTypeJSON). parseJSON

3724 parseJSON = fmap (GenericSnapshotRepoSettings . fmap unStringlyTypeJSON). parseJSON

3718

3725

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

3726+-- | The result of running 'verifySnapshotRepo'.

3720newtype SnapshotVerification = SnapshotVerification { snapshotNodeVerifications :: [SnapshotNodeVerification] }

3727newtype SnapshotVerification = SnapshotVerification { snapshotNodeVerifications :: [SnapshotNodeVerification] }

3721 deriving (Eq, Generic, Show, Typeable)

3728 deriving (Eq, Generic, Show, Typeable)

3722

3729

@@ -3797,7 +3804,6 @@ instance SnapshotRepo FsSnapshotRepo where

3797 | otherwise = Left (RepoTypeMismatch fsRepoType gSnapshotRepoType)

3804 | otherwise = Left (RepoTypeMismatch fsRepoType gSnapshotRepoType)

3798

3805

3799

3806

3800−--TODO: test what error case looks like

3801parseRepo :: Parser a -> Either SnapshotRepoConversionError a

3807parseRepo :: Parser a -> Either SnapshotRepoConversionError a

3802parseRepo parser = case parseEither (const parser) () of

3808parseRepo parser = case parseEither (const parser) () of

3803 Left e -> Left (OtherRepoConversionError (T.pack e))

3809 Left e -> Left (OtherRepoConversionError (T.pack e))

@@ -3822,3 +3828,113 @@ data SnapshotRepoConversionError = RepoTypeMismatch SnapshotRepoType

3822

3828

3823

3829

3824instance Exception SnapshotRepoConversionError

3830instance Exception SnapshotRepoConversionError

3831+

3832+

3833+data SnapshotCreateSettings = SnapshotCreateSettings {

3834+ snapWaitForCompletion :: Bool

3835+ -- ^ Should the API call return immediately after initializing

3836+ -- the snapshot or wait until completed. Note that if this is

3837+ -- enabled it could wait a long time, so you should adjust your

3838+ -- 'ManagerSettings' accordingly to set long timeouts or

3839+ -- explicitly handle timeouts.

3840+ , snapIndices :: Maybe (NonEmpty IndexName)

3841+ -- ^ Nothing will snapshot all indices. Just [] is permissable and

3842+ -- will essentially be a no-op snapshot.

3843+ , snapIgnoreUnavailable :: Bool

3844+ -- ^ If set to True, any matched indices that don't exist will be

3845+ -- ignored. Otherwise it will be an error and fail.

3846+ , snapIncludeGlobalState :: Bool

3847+ , snapPartial :: Bool

3848+ -- ^ If some indices failed to snapshot (e.g. if not all primary

3849+ -- shards are available), should the process proceed?

3850+ }

3851+

3852+

3853+-- | Reasonable defaults for snapshot creation

3854+--

3855+-- * snapWaitForCompletion False

3856+-- * snapIndices Nothing

3857+-- * snapIgnoreUnavailable False

3858+-- * snapIncludeGlobalState True

3859+-- * snapPartial False

3860+defaultSnapshotCreateSettings :: SnapshotCreateSettings

3861+defaultSnapshotCreateSettings =

3862+ SnapshotCreateSettings False Nothing False True False

3863+

3864+

3865+data SnapshotSelection = SnapshotList (NonEmpty SnapshotPattern)

3866+ | AllSnapshots deriving (Eq, Generic, Show, Typeable)

3867+

3868+

3869+-- | Either specifies an exact snapshot name or one with globs in it,

3870+-- e.g. @SnapPattern "foo*"@ __NOTE__: Patterns are not supported on

3871+-- ES < 1.7

3872+data SnapshotPattern = ExactSnap SnapshotName

3873+ | SnapPattern Text

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

3875+

3876+

3877+-- | General information about the state of a snapshot. Has some

3878+-- redundancies with 'SnapshotStatus'

3879+data SnapshotInfo = SnapshotInfo {

3880+ snapInfoShards :: ShardResult

3881+ --TODO: what does failures produce? list of what?

3882+ , snapInfoDuration :: NominalDiffTime

3883+ , snapInfoEndTime :: UTCTime

3884+ , snapInfoStartTime :: UTCTime

3885+ , snapInfoState :: SnapshotState

3886+ , snapInfoIndices :: [IndexName]

3887+ , snapInfoName :: SnapshotName

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

3889+

3890+

3891+instance FromJSON SnapshotInfo where

3892+ parseJSON = withObject "SnapshotInfo" parse

3893+ where

3894+ parse o = SnapshotInfo <$> o .: "shards"

3895+ <*> (unMS <$> o .: "duration_in_millis")

3896+ <*> (posixMS <$> o .: "end_time_in_millis")

3897+ <*> (posixMS <$> o .: "start_time_in_millis")

3898+ <*> o .: "state"

3899+ <*> o .: "indices"

3900+ <*> o .: "snapshot"

3901+

3902+-- | Milliseconds

3903+newtype MS = MS NominalDiffTime

3904+

3905+

3906+-- keeps the unexported constructor warnings at bay

3907+unMS :: MS -> NominalDiffTime

3908+unMS (MS t) = t

3909+

3910+

3911+instance FromJSON MS where

3912+ parseJSON = withScientific "MS" (return . MS . parse)

3913+ where

3914+ parse n = fromInteger ((truncate n) * 1000)

3915+

3916+

3917+data SnapshotState = SnapshotInit

3918+ | SnapshotStarted

3919+ | SnapshotSuccess

3920+ | SnapshotFailed

3921+ | SnapshotAborted

3922+ | SnapshotMissing

3923+ | SnapshotWaiting

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

3925+

3926+instance FromJSON SnapshotState where

3927+ parseJSON = withText "SnapshotState" parse

3928+ where

3929+ parse "INIT" = return SnapshotInit

3930+ parse "STARTED" = return SnapshotStarted

3931+ parse "SUCCESS" = return SnapshotSuccess

3932+ parse "FAILED" = return SnapshotFailed

3933+ parse "ABORTED" = return SnapshotAborted

3934+ parse "MISSING" = return SnapshotMissing

3935+ parse "WAITING" = return SnapshotWaiting

3936+ parse t = fail ("Invalid snapshot state " <> T.unpack t)

3937+

3938+

3939+newtype SnapshotName = SnapshotName { snapshotName :: Text }

3940+ deriving (Show, Eq, Ord, Generic, Typeable, ToJSON, FromJSON)

tests/tests.hs+50−3

@@ -68,9 +68,9 @@ validateStatus resp expected =

68 actual = NHTS.statusCode (responseStatus resp)

69 body = responseBody resp

71−createExampleIndex :: BH IO Reply

71+createExampleIndex :: (MonadBH m) => m Reply

72createExampleIndex = createIndex (IndexSettings (ShardCount 1) (ReplicaCount 0)) testIndex

73−deleteExampleIndex :: BH IO Reply

73+deleteExampleIndex :: (MonadBH m) => m Reply

74deleteExampleIndex = deleteIndex testIndex

76data ServerVersion = ServerVersion Int Int Int deriving (Show, Eq, Ord)

@@ -343,6 +343,29 @@ withSnapshotRepo srn@(SnapshotRepoName n) f =

343 liftIO (validateStatus resp 200)

344

345

346+withSnapshot

347+ :: ( MonadMask m

348+ , MonadBH m

349+ )

350+ => SnapshotRepoName

351+ -> SnapshotName

352+ -> m a

353+ -> m a

354+withSnapshot srn sn = bracket_ alloc free

355+ where

356+ alloc = do

357+ resp <- createSnapshot srn sn createSettings

358+ liftIO (validateStatus resp 200)

359+ -- We'll make this synchronous for testing purposes

360+ createSettings = defaultSnapshotCreateSettings { snapWaitForCompletion = True

361+ , snapIndices = Just (testIndex :| [])

362+ -- We don't actually need to back up any data

363+ }

364+ free = do

365+ deleteSnapshot srn sn

366+

367+

368+

346data BulkTest = BulkTest { name :: Text } deriving (Eq, Generic, Show)

369data BulkTest = BulkTest { name :: Text } deriving (Eq, Generic, Show)

347instance FromJSON BulkTest where

370instance FromJSON BulkTest where

348 parseJSON = genericParseJSON defaultOptions

371 parseJSON = genericParseJSON defaultOptions

@@ -1402,7 +1425,7 @@ main = hspec $ do

1402 fromGSnapshotRepo (toGSnapshotRepo fsr) === Right (fsr :: FsSnapshotRepo)

1425 fromGSnapshotRepo (toGSnapshotRepo fsr) === Right (fsr :: FsSnapshotRepo)

1403

1426

1404 describe "snapshot repos" $ do

1427 describe "snapshot repos" $ do

1405− it "always parses all snapshots API" $ withTestEnv $ do

1428+ it "always parses all snapshot repos API" $ withTestEnv $ do

1406 res <- getSnapshotRepos AllSnapshotRepos

1429 res <- getSnapshotRepos AllSnapshotRepos

1407 liftIO $ case res of

1430 liftIO $ case res of

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

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

@@ -1440,6 +1463,30 @@ main = hspec $ do

1440 | otherwise -> return ()

1463 | otherwise -> return ()

1441 Left e -> expectationFailure (show e)

1464 Left e -> expectationFailure (show e)

1442

1465

1466+ describe "snapshots" $ do

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

1468+ let r1n = SnapshotRepoName "bloodhound-repo1"

1469+ withSnapshotRepo r1n $ \_ -> do

1470+ res <- getSnapshots r1n AllSnapshots

1471+ liftIO $ case res of

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

1473+ Right _ -> return ()

1474+

1475+ it "can parse a snapshot that it created" $ withTestEnv $ do

1476+ let r1n = SnapshotRepoName "bloodhound-repo1"

1477+ withSnapshotRepo r1n $ \_ -> do

1478+ let s1n = SnapshotName "example-snapshot"

1479+ withSnapshot r1n s1n $ do

1480+ res <- getSnapshots r1n (SnapshotList (ExactSnap s1n :| []))

1481+ liftIO $ case res of

1482+ Right [snap]

1483+ | snapInfoState snap == SnapshotSuccess &&

1484+ snapInfoName snap == s1n -> return ()

1485+ | otherwise -> expectationFailure (show snap)

1486+ Right [] -> expectationFailure "There were no snapshots"

1487+ Right snaps -> expectationFailure ("Expected 1 snapshot but got" <> show (length snaps))

1488+ Left e -> expectationFailure (show e)

1489+

1443 describe "Enum DocVersion" $ do

1490 describe "Enum DocVersion" $ do

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

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

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

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