0164535 · typeable/bloodhound

git.iko.soy/typeable/bloodhound

on master help sign in

Do some toggling in test around version:

0164535Michael Xavier10 years ago

.travis.yml+2

compare with master

unifiedsplit

@@ -29,6 +29,8 @@ install:

29 # elasticsearch

30 - wget --no-check-certificate https://download.elastic.co/elasticsearch/elasticsearch/elasticsearch-$ESVER.tar.gz

31 - tar xzf elasticsearch-$ESVER.tar.gz

32+ # set up a repo for snapshot testing. Required in ES >= 1.6

33+ - echo "path.repo = [\"/tmp\"]" >> ./elasticsearch-$ESVER/elasticsearch.yml

32 - ./elasticsearch-$ESVER/bin/elasticsearch &

34 - ./elasticsearch-$ESVER/bin/elasticsearch &

34script:

36script:

bloodhound.cabal+2−1

@@ -76,7 +76,8 @@ test-suite tests

76 errors,

77 exceptions,

78 temporary,

79− unix

79+ unix,

80+ network-uri

80 default-language: Haskell2010

81 default-language: Haskell2010

82test-suite doctests

83test-suite doctests

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

@@ -4011,7 +4011,9 @@ data SnapshotRestoreSettings = SnapshotRestoreSettings {

4011 -- ^ Should the restore also restore the aliases captured in the

4012 -- snapshot.

4013 , snapRestoreIndexSettingsOverrides :: Maybe RestoreIndexSettings

4014− -- ^ Settings to apply during the restore process.

4014+ -- ^ Settings to apply during the restore process. __NOTE:__ This

4015+ -- option is not supported in ES < 1.5 and should be set to

4016+ -- Nothing in that case.

4015 , snapRestoreIgnoreIndexSettings :: Maybe (NonEmpty Text)

4017 , snapRestoreIgnoreIndexSettings :: Maybe (NonEmpty Text)

4016 -- ^ This type could be more rich but it isn't clear which

4018 -- ^ This type could be more rich but it isn't clear which

4017 -- settings are allowed to be ignored during restore, so we're

4019 -- settings are allowed to be ignored during restore, so we're

tests/tests.hs+57−12

@@ -39,7 +39,9 @@ import qualified Data.Vector as V

39import Database.Bloodhound

40import GHC.Generics as G

41import Network.HTTP.Client hiding (Proxy)

42+import qualified Network.HTTP.Types.Method as NHTM

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

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

44+import qualified Network.URI as URI

43import Prelude hiding (filter)

45import Prelude hiding (filter)

44import System.IO.Temp

46import System.IO.Temp

45import System.Posix.Files

47import System.Posix.Files

@@ -49,6 +51,7 @@ import Test.QuickCheck.Property.Monoid (T (..), eq, prop_Monoid)

49import Test.Hspec.QuickCheck (prop)

51import Test.Hspec.QuickCheck (prop)

50import Test.QuickCheck

52import Test.QuickCheck

54+

52testServer :: Server

55testServer :: Server

53testServer = Server "http://localhost:9200"

56testServer = Server "http://localhost:9200"

54testIndex :: IndexName

57testIndex :: IndexName

@@ -84,6 +87,12 @@ es12 = ServerVersion 1 2 0

84es11 :: ServerVersion

87es11 :: ServerVersion

85es11 = ServerVersion 1 1 0

88es11 = ServerVersion 1 1 0

90+es15 :: ServerVersion

91+es15 = ServerVersion 1 5 0

92+

93+es16 :: ServerVersion

94+es16 = ServerVersion 1 6 0

95+

87serverBranch :: ServerVersion -> ServerVersion

96serverBranch :: ServerVersion -> ServerVersion

88serverBranch (ServerVersion majorVer minorVer patchVer) =

97serverBranch (ServerVersion majorVer minorVer patchVer) =

89 ServerVersion majorVer minorVer patchVer

98 ServerVersion majorVer minorVer patchVer

@@ -101,6 +110,33 @@ getServerVersion = liftM extractVersion (withTestEnv getStatus)

101 parseVersion v = map toInt (version' v)

110 parseVersion v = map toInt (version' v)

102 extractVersion = join . liftM (mkServerVersion . parseVersion)

111 extractVersion = join . liftM (mkServerVersion . parseVersion)

103

112

113+-- | Get configured repo paths for snapshotting. Note that by default

114+-- this is not enabled and if we are over es 1.5, we won't be able to

115+-- test snapshotting. Note that this can and should be part of the

116+-- client functionality in a much less ad-hoc incarnation.

117+getRepoPaths :: IO [FilePath]

118+getRepoPaths = withTestEnv $ do

119+ bhe <- getBHEnv

120+ let Server s = bhServer bhe

121+ let tUrl = s <> "/" <> "_nodes"

122+ initReq <- parseRequest (URI.escapeURIString URI.isAllowedInURI (T.unpack tUrl))

123+ let req = setRequestIgnoreStatus $ initReq { method = NHTM.methodGet }

124+ Right (Object o) <- parseEsResponse =<< liftIO (httpLbs req (bhManager bhe))

125+ return $ fromMaybe mempty $ do

126+ Object nodes <- HM.lookup "nodes" o

127+ Object firstNode <- snd <$> headMay (HM.toList nodes)

128+ Object settings <- HM.lookup "settings" firstNode

129+ Object path <- HM.lookup "path" settings

130+ Array repo <- HM.lookup "repo" path

131+ return [ T.unpack t | String t <- V.toList repo]

132+

133+-- | 1.5 and earlier don't care about repo paths

134+canSnapshot :: IO Bool

135+canSnapshot = do

136+ caresAboutRepos <- atleast es16

137+ repoPaths <- getRepoPaths

138+ return (not caresAboutRepos || not (null (repoPaths)))

139+

104testServerBranch :: IO (Maybe ServerVersion)

140testServerBranch :: IO (Maybe ServerVersion)

105testServerBranch = getServerVersion >>= \v -> return $ liftM serverBranch v

141testServerBranch = getServerVersion >>= \v -> return $ liftM serverBranch v

106

142

@@ -328,12 +364,18 @@ withSnapshotRepo

328 => SnapshotRepoName

364 => SnapshotRepoName

329 -> (GenericSnapshotRepo -> m a)

365 -> (GenericSnapshotRepo -> m a)

330 -> m a

366 -> m a

331−withSnapshotRepo srn@(SnapshotRepoName n) f =

367+withSnapshotRepo srn@(SnapshotRepoName n) f = do

368+ repoPaths <- liftIO getRepoPaths

369+ -- we'll use the first repo path if available, otherwise system temp

370+ -- dir. Note that this will fail on ES > 1.6, so be sure you use

371+ -- @when' canSnapshot@.

372+ case repoPaths of

373+ (firstRepoPath:_) -> withTempDirectory firstRepoPath (T.unpack n) $ \dir -> bracket (alloc dir) free f

332− withSystemTempDirectory (T.unpack n) $ \dir -> bracket (alloc dir) free f

374+ [] -> withSystemTempDirectory (T.unpack n) $ \dir -> bracket (alloc dir) free f

333 where

375 where

334 alloc dir = do

376 alloc dir = do

335 liftIO (setFileMode dir mode)

377 liftIO (setFileMode dir mode)

336− let repo = FsSnapshotRepo srn dir True Nothing Nothing Nothing

378+ let repo = FsSnapshotRepo srn "bloodhound-tests-backups" True Nothing Nothing Nothing

337 resp <- updateSnapshotRepo defaultSnapshotRepoUpdateSettings repo

379 resp <- updateSnapshotRepo defaultSnapshotRepoUpdateSettings repo

338 liftIO (validateStatus resp 200)

380 liftIO (validateStatus resp 200)

339 return (toGSnapshotRepo repo)

381 return (toGSnapshotRepo repo)

@@ -1425,13 +1467,13 @@ main = hspec $ do

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

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

1426

1468

1427 describe "snapshot repos" $ do

1469 describe "snapshot repos" $ do

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

1470+ it "always parses all snapshot repos API" $ when' canSnapshot $ withTestEnv $ do

1429 res <- getSnapshotRepos AllSnapshotRepos

1471 res <- getSnapshotRepos AllSnapshotRepos

1430 liftIO $ case res of

1472 liftIO $ case res of

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

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

1432 Right _ -> return ()

1474 Right _ -> return ()

1433

1475

1434− it "finds an existing list of repos" $ withTestEnv $ do

1476+ it "finds an existing list of repos" $ when' canSnapshot $ withTestEnv $ do

1435 let r1n = SnapshotRepoName "bloodhound-repo1"

1477 let r1n = SnapshotRepoName "bloodhound-repo1"

1436 let r2n = SnapshotRepoName "bloodhound-repo2"

1478 let r2n = SnapshotRepoName "bloodhound-repo2"

1437 withSnapshotRepo r1n $ \r1 ->

1479 withSnapshotRepo r1n $ \r1 ->

@@ -1443,7 +1485,7 @@ main = hspec $ do

1443 srt xs `shouldBe` srt [r1, r2]

1485 srt xs `shouldBe` srt [r1, r2]

1444 Left e -> expectationFailure (show e)

1486 Left e -> expectationFailure (show e)

1445

1487

1446− it "creates and updates with updateSnapshotRepo" $ withTestEnv $ do

1488+ it "creates and updates with updateSnapshotRepo" $ when' canSnapshot $ withTestEnv $ do

1447 let r1n = SnapshotRepoName "bloodhound-repo1"

1489 let r1n = SnapshotRepoName "bloodhound-repo1"

1448 withSnapshotRepo r1n $ \r1 -> do

1490 withSnapshotRepo r1n $ \r1 -> do

1449 let Just (String dir) = HM.lookup "location" (gSnapshotRepoSettingsObject (gSnapshotRepoSettings r1))

1491 let Just (String dir) = HM.lookup "location" (gSnapshotRepoSettingsObject (gSnapshotRepoSettings r1))

@@ -1453,7 +1495,7 @@ main = hspec $ do

1453 Right [roundtrippedNoCompression] <- getSnapshotRepos (SnapshotRepoList (ExactRepo r1n :| []))

1495 Right [roundtrippedNoCompression] <- getSnapshotRepos (SnapshotRepoList (ExactRepo r1n :| []))

1454 liftIO (roundtrippedNoCompression `shouldBe` toGSnapshotRepo noCompression)

1496 liftIO (roundtrippedNoCompression `shouldBe` toGSnapshotRepo noCompression)

1455

1497

1456− it "can verify existing repos" $ withTestEnv $ do

1498+ it "can verify existing repos" $ when' canSnapshot $ withTestEnv $ do

1457 let r1n = SnapshotRepoName "bloodhound-repo1"

1499 let r1n = SnapshotRepoName "bloodhound-repo1"

1458 withSnapshotRepo r1n $ \_ -> do

1500 withSnapshotRepo r1n $ \_ -> do

1459 res <- verifySnapshotRepo r1n

1501 res <- verifySnapshotRepo r1n

@@ -1464,7 +1506,7 @@ main = hspec $ do

1464 Left e -> expectationFailure (show e)

1506 Left e -> expectationFailure (show e)

1465

1507

1466 describe "snapshots" $ do

1508 describe "snapshots" $ do

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

1509+ it "always parses all snapshots API" $ when' canSnapshot $ withTestEnv $ do

1468 let r1n = SnapshotRepoName "bloodhound-repo1"

1510 let r1n = SnapshotRepoName "bloodhound-repo1"

1469 withSnapshotRepo r1n $ \_ -> do

1511 withSnapshotRepo r1n $ \_ -> do

1470 res <- getSnapshots r1n AllSnapshots

1512 res <- getSnapshots r1n AllSnapshots

@@ -1472,7 +1514,7 @@ main = hspec $ do

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

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

1473 Right _ -> return ()

1515 Right _ -> return ()

1474

1516

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

1517+ it "can parse a snapshot that it created" $ when' canSnapshot $ withTestEnv $ do

1476 let r1n = SnapshotRepoName "bloodhound-repo1"

1518 let r1n = SnapshotRepoName "bloodhound-repo1"

1477 withSnapshotRepo r1n $ \_ -> do

1519 withSnapshotRepo r1n $ \_ -> do

1478 let s1n = SnapshotName "example-snapshot"

1520 let s1n = SnapshotName "example-snapshot"

@@ -1488,7 +1530,7 @@ main = hspec $ do

1488 Left e -> expectationFailure (show e)

1530 Left e -> expectationFailure (show e)

1489

1531

1490 describe "snapshot restore" $ do

1532 describe "snapshot restore" $ do

1491− it "can restore a snapshot that we create" $ withTestEnv $ do

1533+ it "can restore a snapshot that we create" $ when' canSnapshot $ withTestEnv $ do

1492 let r1n = SnapshotRepoName "bloodhound-repo1"

1534 let r1n = SnapshotRepoName "bloodhound-repo1"

1493 withSnapshotRepo r1n $ \_ -> do

1535 withSnapshotRepo r1n $ \_ -> do

1494 let s1n = SnapshotName "example-snapshot"

1536 let s1n = SnapshotName "example-snapshot"

@@ -1500,7 +1542,7 @@ main = hspec $ do

1500 resp2 <- restoreSnapshot r1n s1n settings

1542 resp2 <- restoreSnapshot r1n s1n settings

1501 liftIO (validateStatus resp2 200)

1543 liftIO (validateStatus resp2 200)

1502

1544

1503− it "can restore and rename" $ withTestEnv $ do

1545+ it "can restore and rename" $ when' canSnapshot $ withTestEnv $ do

1504 let r1n = SnapshotRepoName "bloodhound-repo1"

1546 let r1n = SnapshotRepoName "bloodhound-repo1"

1505 withSnapshotRepo r1n $ \_ -> do

1547 withSnapshotRepo r1n $ \_ -> do

1506 let s1n = SnapshotName "example-snapshot"

1548 let s1n = SnapshotName "example-snapshot"

@@ -1508,11 +1550,14 @@ main = hspec $ do

1508 let pat = RestoreRenamePattern "bloodhound-tests-twitter-(\\d+)"

1550 let pat = RestoreRenamePattern "bloodhound-tests-twitter-(\\d+)"

1509 let replace = RRTLit "restored-" :| [RRSubWholeMatch]

1551 let replace = RRTLit "restored-" :| [RRSubWholeMatch]

1510 let expectedIndex = IndexName "restored-bloodhound-tests-twitter-1"

1552 let expectedIndex = IndexName "restored-bloodhound-tests-twitter-1"

1553+ oldEnoughForOverrides <- liftIO (atleast es15)

1511 let overrides = RestoreIndexSettings { restoreOverrideReplicas = Just (ReplicaCount 0) }

1554 let overrides = RestoreIndexSettings { restoreOverrideReplicas = Just (ReplicaCount 0) }

1512 let settings = defaultSnapshotRestoreSettings { snapRestoreWaitForCompletion = True

1555 let settings = defaultSnapshotRestoreSettings { snapRestoreWaitForCompletion = True

1513 , snapRestoreRenamePattern = Just pat

1556 , snapRestoreRenamePattern = Just pat

1514 , snapRestoreRenameReplacement = Just replace

1557 , snapRestoreRenameReplacement = Just replace

1515− , snapRestoreIndexSettingsOverrides = Just overrides

1558+ , snapRestoreIndexSettingsOverrides = if oldEnoughForOverrides

1559+ then Just overrides

1560+ else Nothing

1516 }

1561 }

1517 -- have to close an index to restore it

1562 -- have to close an index to restore it

1518 let go = do

1563 let go = do