@@ -39,7 +39,9 @@ import qualified Data.Vector as V
3939import Database.Bloodhound
4040import GHC.Generics as G
4141import Network.HTTP.Client hiding (Proxy)
42+import qualified Network.HTTP.Types.Method as NHTM
4243import qualified Network.HTTP.Types.Status as NHTS
44+import qualified Network.URI as URI
4345import Prelude hiding (filter)
4446import System.IO.Temp
4547import System.Posix.Files
@@ -49,6 +51,7 @@ import Test.QuickCheck.Property.Monoid (T (..), eq, prop_Monoid)
4951import Test.Hspec.QuickCheck (prop)
5052import Test.QuickCheck
5153
54+
5255testServer :: Server
5356testServer = Server "http://localhost:9200"
5457testIndex :: IndexName
@@ -84,6 +87,12 @@ es12 = ServerVersion 1 2 0
8487es11 :: ServerVersion
8588es11 = ServerVersion 1 1 0
8689
90+es15 :: ServerVersion
91+es15 = ServerVersion 1 5 0
92+
93+es16 :: ServerVersion
94+es16 = ServerVersion 1 6 0
95+
8796serverBranch :: ServerVersion -> ServerVersion
8897serverBranch (ServerVersion majorVer minorVer patchVer) =
8998 ServerVersion majorVer minorVer patchVer
@@ -101,6 +110,33 @@ getServerVersion = liftM extractVersion (withTestEnv getStatus)
101110 parseVersion v = map toInt (version' v)
102111 extractVersion = join . liftM (mkServerVersion . parseVersion)
103112
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+
104140testServerBranch :: IO (Maybe ServerVersion)
105141testServerBranch = getServerVersion >>= \v -> return $ liftM serverBranch v
106142
@@ -328,12 +364,18 @@ withSnapshotRepo
328364 => SnapshotRepoName
329365 -> (GenericSnapshotRepo -> m a)
330366 -> m a
331−withSnapshotRepo srn@(SnapshotRepoName n) f =
332− withSystemTempDirectory (T.unpack n) $ \dir -> bracket (alloc dir) free 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
374+ [] -> withSystemTempDirectory (T.unpack n) $ \dir -> bracket (alloc dir) free f
333375 where
334376 alloc dir = do
335377 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
337379 resp <- updateSnapshotRepo defaultSnapshotRepoUpdateSettings repo
338380 liftIO (validateStatus resp 200)
339381 return (toGSnapshotRepo repo)
@@ -1425,13 +1467,13 @@ main = hspec $ do
14251467 fromGSnapshotRepo (toGSnapshotRepo fsr) === Right (fsr :: FsSnapshotRepo)
14261468
14271469 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
14291471 res <- getSnapshotRepos AllSnapshotRepos
14301472 liftIO $ case res of
14311473 Left e -> expectationFailure ("Expected a right but got Left " <> show e)
14321474 Right _ -> return ()
14331475
1434− it "finds an existing list of repos" $ withTestEnv $ do
1476+ it "finds an existing list of repos" $ when' canSnapshot $ withTestEnv $ do
14351477 let r1n = SnapshotRepoName "bloodhound-repo1"
14361478 let r2n = SnapshotRepoName "bloodhound-repo2"
14371479 withSnapshotRepo r1n $ \r1 ->
@@ -1443,7 +1485,7 @@ main = hspec $ do
14431485 srt xs `shouldBe` srt [r1, r2]
14441486 Left e -> expectationFailure (show e)
14451487
1446− it "creates and updates with updateSnapshotRepo" $ withTestEnv $ do
1488+ it "creates and updates with updateSnapshotRepo" $ when' canSnapshot $ withTestEnv $ do
14471489 let r1n = SnapshotRepoName "bloodhound-repo1"
14481490 withSnapshotRepo r1n $ \r1 -> do
14491491 let Just (String dir) = HM.lookup "location" (gSnapshotRepoSettingsObject (gSnapshotRepoSettings r1))
@@ -1453,7 +1495,7 @@ main = hspec $ do
14531495 Right [roundtrippedNoCompression] <- getSnapshotRepos (SnapshotRepoList (ExactRepo r1n :| []))
14541496 liftIO (roundtrippedNoCompression `shouldBe` toGSnapshotRepo noCompression)
14551497
1456− it "can verify existing repos" $ withTestEnv $ do
1498+ it "can verify existing repos" $ when' canSnapshot $ withTestEnv $ do
14571499 let r1n = SnapshotRepoName "bloodhound-repo1"
14581500 withSnapshotRepo r1n $ \_ -> do
14591501 res <- verifySnapshotRepo r1n
@@ -1464,7 +1506,7 @@ main = hspec $ do
14641506 Left e -> expectationFailure (show e)
14651507
14661508 describe "snapshots" $ do
1467− it "always parses all snapshots API" $ withTestEnv $ do
1509+ it "always parses all snapshots API" $ when' canSnapshot $ withTestEnv $ do
14681510 let r1n = SnapshotRepoName "bloodhound-repo1"
14691511 withSnapshotRepo r1n $ \_ -> do
14701512 res <- getSnapshots r1n AllSnapshots
@@ -1472,7 +1514,7 @@ main = hspec $ do
14721514 Left e -> expectationFailure ("Expected a right but got Left " <> show e)
14731515 Right _ -> return ()
14741516
1475− it "can parse a snapshot that it created" $ withTestEnv $ do
1517+ it "can parse a snapshot that it created" $ when' canSnapshot $ withTestEnv $ do
14761518 let r1n = SnapshotRepoName "bloodhound-repo1"
14771519 withSnapshotRepo r1n $ \_ -> do
14781520 let s1n = SnapshotName "example-snapshot"
@@ -1488,7 +1530,7 @@ main = hspec $ do
14881530 Left e -> expectationFailure (show e)
14891531
14901532 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
14921534 let r1n = SnapshotRepoName "bloodhound-repo1"
14931535 withSnapshotRepo r1n $ \_ -> do
14941536 let s1n = SnapshotName "example-snapshot"
@@ -1500,7 +1542,7 @@ main = hspec $ do
15001542 resp2 <- restoreSnapshot r1n s1n settings
15011543 liftIO (validateStatus resp2 200)
15021544
1503− it "can restore and rename" $ withTestEnv $ do
1545+ it "can restore and rename" $ when' canSnapshot $ withTestEnv $ do
15041546 let r1n = SnapshotRepoName "bloodhound-repo1"
15051547 withSnapshotRepo r1n $ \_ -> do
15061548 let s1n = SnapshotName "example-snapshot"
@@ -1508,11 +1550,14 @@ main = hspec $ do
15081550 let pat = RestoreRenamePattern "bloodhound-tests-twitter-(\\d+)"
15091551 let replace = RRTLit "restored-" :| [RRSubWholeMatch]
15101552 let expectedIndex = IndexName "restored-bloodhound-tests-twitter-1"
1553+ oldEnoughForOverrides <- liftIO (atleast es15)
15111554 let overrides = RestoreIndexSettings { restoreOverrideReplicas = Just (ReplicaCount 0) }
15121555 let settings = defaultSnapshotRestoreSettings { snapRestoreWaitForCompletion = True
15131556 , snapRestoreRenamePattern = Just pat
15141557 , snapRestoreRenameReplacement = Just replace
1515− , snapRestoreIndexSettingsOverrides = Just overrides
1558+ , snapRestoreIndexSettingsOverrides = if oldEnoughForOverrides
1559+ then Just overrides
1560+ else Nothing
15161561 }
15171562 -- have to close an index to restore it
15181563 let go = do