git.iko.soy/typeable/bloodhound
on 5c7caa6 help sign in
typeable/bloodhound/tests/V5/Test/Snapshots.hs
201 lines 9.1 kB history raw
1{-# LANGUAGE RecordWildCards #-}
2{-# LANGUAGE OverloadedStrings #-}
4module Test.Snapshots (spec) where
6import Test.Common
7import Test.Import
9import Data.Maybe (fromMaybe)
10import qualified Data.List as L
11import qualified Data.HashMap.Strict as HM
12import qualified Data.Text as T
13import qualified Data.Vector as V
14import qualified Network.HTTP.Types.Method as NHTM
15import qualified Network.URI as URI
17import Test.Generators ()
19spec :: Spec
20spec = do
21 describe "FsSnapshotRepo" $
22 prop "SnapshotRepo laws" $ \fsr ->
23 fromGSnapshotRepo (toGSnapshotRepo fsr) === Right (fsr :: FsSnapshotRepo)
25 describe "Snapshot repos" $ do
26 it "always parses all snapshot repos API" $ when' canSnapshot $ withTestEnv $ do
27 res <- getSnapshotRepos AllSnapshotRepos
28 liftIO $ case res of
29 Left e -> expectationFailure ("Expected a right but got Left " <> show e)
30 Right _ -> return ()
32 it "finds an existing list of repos" $ when' canSnapshot $ withTestEnv $ do
33 let r1n = SnapshotRepoName "bloodhound-repo1"
34 let r2n = SnapshotRepoName "bloodhound-repo2"
35 withSnapshotRepo r1n $ \r1 ->
36 withSnapshotRepo r2n $ \r2 -> do
37 repos <- getSnapshotRepos (SnapshotRepoList (ExactRepo r1n :| [ExactRepo r2n]))
38 liftIO $ case repos of
39 Right xs -> do
40 let srt = L.sortBy (comparing gSnapshotRepoName)
41 srt xs `shouldBe` srt [r1, r2]
42 Left e -> expectationFailure (show e)
44 it "creates and updates with updateSnapshotRepo" $ when' canSnapshot $ withTestEnv $ do
45 let r1n = SnapshotRepoName "bloodhound-repo1"
46 withSnapshotRepo r1n $ \r1 -> do
47 let Just (String dir) = HM.lookup "location" (gSnapshotRepoSettingsObject (gSnapshotRepoSettings r1))
48 let noCompression = FsSnapshotRepo r1n (T.unpack dir) False Nothing Nothing Nothing
49 resp <- updateSnapshotRepo defaultSnapshotRepoUpdateSettings noCompression
50 liftIO (validateStatus resp 200)
51 Right [roundtrippedNoCompression] <- getSnapshotRepos (SnapshotRepoList (ExactRepo r1n :| []))
52 liftIO (roundtrippedNoCompression `shouldBe` toGSnapshotRepo noCompression)
54 -- verify came around in 1.4 it seems
55 it "can verify existing repos" $ when' canSnapshot $ when' (atleast es14) $ withTestEnv $ do
56 let r1n = SnapshotRepoName "bloodhound-repo1"
57 withSnapshotRepo r1n $ \_ -> do
58 res <- verifySnapshotRepo r1n
59 liftIO $ case res of
60 Right (SnapshotVerification vs)
61 | null vs -> expectationFailure "Expected nonempty set of verifying nodes"
62 | otherwise -> return ()
63 Left e -> expectationFailure (show e)
65 describe "Snapshots" $ do
66 it "always parses all snapshots API" $ when' canSnapshot $ withTestEnv $ do
67 let r1n = SnapshotRepoName "bloodhound-repo1"
68 withSnapshotRepo r1n $ \_ -> do
69 res <- getSnapshots r1n AllSnapshots
70 liftIO $ case res of
71 Left e -> expectationFailure ("Expected a right but got Left " <> show e)
72 Right _ -> return ()
74 it "can parse a snapshot that it created" $ when' canSnapshot $ withTestEnv $ do
75 let r1n = SnapshotRepoName "bloodhound-repo1"
76 withSnapshotRepo r1n $ \_ -> do
77 let s1n = SnapshotName "example-snapshot"
78 withSnapshot r1n s1n $ do
79 res <- getSnapshots r1n (SnapshotList (ExactSnap s1n :| []))
80 liftIO $ case res of
81 Right [snap]
82 | snapInfoState snap == SnapshotSuccess &&
83 snapInfoName snap == s1n -> return ()
84 | otherwise -> expectationFailure (show snap)
85 Right [] -> expectationFailure "There were no snapshots"
86 Right snaps -> expectationFailure ("Expected 1 snapshot but got" <> show (length snaps))
87 Left e -> expectationFailure (show e)
89 describe "Snapshot restore" $ do
90 it "can restore a snapshot that we create" $ when' canSnapshot $ withTestEnv $ do
91 let r1n = SnapshotRepoName "bloodhound-repo1"
92 withSnapshotRepo r1n $ \_ -> do
93 let s1n = SnapshotName "example-snapshot"
94 withSnapshot r1n s1n $ do
95 let settings = defaultSnapshotRestoreSettings { snapRestoreWaitForCompletion = True }
96 -- have to close an index to restore it
97 resp1 <- closeIndex testIndex
98 liftIO (validateStatus resp1 200)
99 resp2 <- restoreSnapshot r1n s1n settings
100 liftIO (validateStatus resp2 200)
102 it "can restore and rename" $ when' canSnapshot $ withTestEnv $ do
103 let r1n = SnapshotRepoName "bloodhound-repo1"
104 withSnapshotRepo r1n $ \_ -> do
105 let s1n = SnapshotName "example-snapshot"
106 withSnapshot r1n s1n $ do
107 let pat = RestoreRenamePattern "bloodhound-tests-twitter-(\\d+)"
108 let replace = RRTLit "restored-" :| [RRSubWholeMatch]
109 let expectedIndex = IndexName "restored-bloodhound-tests-twitter-1"
110 oldEnoughForOverrides <- liftIO (atleast es15)
111 let overrides = RestoreIndexSettings { restoreOverrideReplicas = Just (ReplicaCount 0) }
112 let settings = defaultSnapshotRestoreSettings { snapRestoreWaitForCompletion = True
113 , snapRestoreRenamePattern = Just pat
114 , snapRestoreRenameReplacement = Just replace
115 , snapRestoreIndexSettingsOverrides = if oldEnoughForOverrides
116 then Just overrides
117 else Nothing
118 }
119 -- have to close an index to restore it
120 let go = do
121 resp <- restoreSnapshot r1n s1n settings
122 liftIO (validateStatus resp 200)
123 exists <- indexExists expectedIndex
124 liftIO (exists `shouldBe` True)
125 go `finally` deleteIndex expectedIndex
127-- | Get configured repo paths for snapshotting. Note that by default
128-- this is not enabled and if we are over es 1.5, we won't be able to
129-- test snapshotting. Note that this can and should be part of the
130-- client functionality in a much less ad-hoc incarnation.
131getRepoPaths :: IO [FilePath]
132getRepoPaths = withTestEnv $ do
133 bhe <- getBHEnv
134 let Server s = bhServer bhe
135 let tUrl = s <> "/" <> "_nodes"
136 initReq <- parseRequest (URI.escapeURIString URI.isAllowedInURI (T.unpack tUrl))
137 let req = setRequestIgnoreStatus $ initReq { method = NHTM.methodGet }
138 Right (Object o) <- parseEsResponse =<< liftIO (httpLbs req (bhManager bhe))
139 return $ fromMaybe mempty $ do
140 Object nodes <- HM.lookup "nodes" o
141 Object firstNode <- snd <$> headMay (HM.toList nodes)
142 Object settings <- HM.lookup "settings" firstNode
143 Object path <- HM.lookup "path" settings
144 Array repo <- HM.lookup "repo" path
145 return [ T.unpack t | String t <- V.toList repo]
147-- | 1.5 and earlier don't care about repo paths
148canSnapshot :: IO Bool
149canSnapshot = do
150 caresAboutRepos <- atleast es16
151 repoPaths <- getRepoPaths
152 return (not caresAboutRepos || not (null repoPaths))
154withSnapshotRepo
155 :: ( MonadMask m
156 , MonadBH m
157 )
158 => SnapshotRepoName
159 -> (GenericSnapshotRepo -> m a)
160 -> m a
161withSnapshotRepo srn@(SnapshotRepoName n) f = do
162 repoPaths <- liftIO getRepoPaths
163 -- we'll use the first repo path if available, otherwise system temp
164 -- dir. Note that this will fail on ES > 1.6, so be sure you use
165 -- @when' canSnapshot@.
166 case repoPaths of
167 (firstRepoPath:_) -> withTempDirectory firstRepoPath (T.unpack n) $ \dir -> bracket (alloc dir) free f
168 [] -> withSystemTempDirectory (T.unpack n) $ \dir -> bracket (alloc dir) free f
169 where
170 alloc dir = do
171 liftIO (setFileMode dir mode)
172 let repo = FsSnapshotRepo srn "bloodhound-tests-backups" True Nothing Nothing Nothing
173 resp <- updateSnapshotRepo defaultSnapshotRepoUpdateSettings repo
174 liftIO (validateStatus resp 200)
175 return (toGSnapshotRepo repo)
176 mode = ownerModes `unionFileModes` groupModes `unionFileModes` otherModes
177 free GenericSnapshotRepo {..} = do
178 resp <- deleteSnapshotRepo gSnapshotRepoName
179 liftIO (validateStatus resp 200)
182withSnapshot
183 :: ( MonadMask m
184 , MonadBH m
185 )
186 => SnapshotRepoName
187 -> SnapshotName
188 -> m a
189 -> m a
190withSnapshot srn sn = bracket_ alloc free
191 where
192 alloc = do
193 resp <- createSnapshot srn sn createSettings
194 liftIO (validateStatus resp 200)
195 -- We'll make this synchronous for testing purposes
196 createSettings = defaultSnapshotCreateSettings { snapWaitForCompletion = True
197 , snapIndices = Just (IndexList (testIndex :| []))
198 -- We don't actually need to back up any data
199 }
200 free =
201 deleteSnapshot srn sn