content: {-# LANGUAGE OverloadedStrings #-}
  {-# LANGUAGE QuasiQuotes #-}
  {-# LANGUAGE RecordWildCards #-}
  {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
  
  module Test.SnapshotsSpec (spec) where
  
  import qualified Data.Aeson.KeyMap as X
  import qualified Data.List as L
  import qualified Data.Text as T
  import qualified Data.Vector as V
  import qualified Network.HTTP.Types.Method as NHTM
  import TestsUtils.Common
  import TestsUtils.Generators ()
  import TestsUtils.Import
  
  spec :: Spec
  spec = do
    describe "FsSnapshotRepo" $
      prop "SnapshotRepo laws" $ \fsr ->
        fromGSnapshotRepo (toGSnapshotRepo fsr) === Right (fsr :: FsSnapshotRepo)
  
    describe "Snapshot repos" $ do
      it "always parses all snapshot repos API" $
        when' canSnapshot $
          withTestEnv $ do
            res <- tryPerformBHRequest $ getSnapshotRepos AllSnapshotRepos
            liftIO $ case res of
              Left e -> expectationFailure ("Expected a right but got Left " <> show e)
              Right _ -> return ()
  
      it "finds an existing list of repos" $
        when' canSnapshot $
          withTestEnv $ do
            let r1n = SnapshotRepoName "bloodhound-repo1"
            let r2n = SnapshotRepoName "bloodhound-repo2"
            withSnapshotRepo r1n $ \r1 ->
              withSnapshotRepo r2n $ \r2 -> do
                repos <- performBHRequest $ getSnapshotRepos (SnapshotRepoList (ExactRepo r1n :| [ExactRepo r2n]))
                let srt = L.sortOn gSnapshotRepoName
                liftIO $ srt repos `shouldBe` srt [r1, r2]
  
      it "creates and updates with updateSnapshotRepo" $
        when' canSnapshot $
          withTestEnv $ do
            let r1n = SnapshotRepoName "bloodhound-repo1"
            withSnapshotRepo r1n $ \r1 -> do
              let Just (String dir) = X.lookup "location" (gSnapshotRepoSettingsObject (gSnapshotRepoSettings r1))
              let noCompression = FsSnapshotRepo r1n (T.unpack dir) False Nothing Nothing Nothing
              resp <- performBHRequest $ updateSnapshotRepo defaultSnapshotRepoUpdateSettings noCompression
              liftIO $ resp `shouldBe` Acknowledged True
              [roundtrippedNoCompression] <- performBHRequest $ getSnapshotRepos (SnapshotRepoList (ExactRepo r1n :| []))
              liftIO (roundtrippedNoCompression `shouldBe` toGSnapshotRepo noCompression)
  
      -- verify came around in 1.4 it seems
      it "can verify existing repos" $
        when' canSnapshot $
          withTestEnv $ do
            let r1n = SnapshotRepoName "bloodhound-repo1"
            withSnapshotRepo r1n $ \_ -> do
              res <- performBHRequest $ verifySnapshotRepo r1n
              liftIO $ case res of
                SnapshotVerification vs
                  | null vs -> expectationFailure "Expected nonempty set of verifying nodes"
                  | otherwise -> return ()
  
    describe "Snapshots" $ do
      it "always parses all snapshots API" $
        when' canSnapshot $
          withTestEnv $ do
            let r1n = SnapshotRepoName "bloodhound-repo1"
            withSnapshotRepo r1n $ \_ -> do
              res <- tryPerformBHRequest $ getSnapshots r1n AllSnapshots
              liftIO $ case res of
                Left e -> expectationFailure ("Expected a right but got Left " <> show e)
                Right _ -> return ()
  
      it "can parse a snapshot that it created" $
        when' canSnapshot $
          withTestEnv $ do
            let r1n = SnapshotRepoName "bloodhound-repo1"
            withSnapshotRepo r1n $ \_ -> do
              let s1n = SnapshotName "example-snapshot"
              withSnapshot r1n s1n $ do
                res <- performBHRequest $ getSnapshots r1n (SnapshotList (ExactSnap s1n :| []))
                liftIO $ case res of
                  [snap]
                    | snapInfoState snap == SnapshotSuccess
                        && snapInfoName snap == s1n ->
                        return ()
                    | otherwise -> expectationFailure (show snap)
                  [] -> expectationFailure "There were no snapshots"
                  snaps -> expectationFailure ("Expected 1 snapshot but got" <> show (length snaps))
  
    describe "Snapshot restore" $ do
      it "can restore a snapshot that we create" $
        when' canSnapshot $
          withTestEnv $ do
            let r1n = SnapshotRepoName "bloodhound-repo1"
            withSnapshotRepo r1n $ \_ -> do
              let s1n = SnapshotName "example-snapshot"
              withSnapshot r1n s1n $ do
                let settings = defaultSnapshotRestoreSettings {snapRestoreWaitForCompletion = True}
                -- have to close an index to restore it
                resp1 <- performBHRequest $ closeIndex testIndex
                liftIO $ resp1 `shouldBe` Acknowledged True
                resp2 <- performBHRequest $ restoreSnapshot r1n s1n settings
                liftIO $ resp2 `shouldBe` Accepted True
  
      it "can restore and rename" $
        when' canSnapshot $
          withTestEnv $ do
            let r1n = SnapshotRepoName "bloodhound-repo1"
            withSnapshotRepo r1n $ \_ -> do
              let s1n = SnapshotName "example-snapshot"
              withSnapshot r1n s1n $ do
                let pat = RestoreRenamePattern "bloodhound-tests-twitter-(\\d+)"
                let replace = RRTLit "restored-" :| [RRSubWholeMatch]
                let expectedIndex = [qqIndexName|restored-bloodhound-tests-twitter-1|]
                let overrides = RestoreIndexSettings {restoreOverrideReplicas = Just (ReplicaCount 0)}
                let settings =
                      defaultSnapshotRestoreSettings
                        { snapRestoreWaitForCompletion = True,
                          snapRestoreRenamePattern = Just pat,
                          snapRestoreRenameReplacement = Just replace,
                          snapRestoreIndexSettingsOverrides = Just overrides
                        }
                -- have to close an index to restore it
                let go = do
                      resp <- performBHRequest $ restoreSnapshot r1n s1n settings
                      liftIO $ resp `shouldBe` Accepted True
                      exists <- performBHRequest $ indexExists expectedIndex
                      liftIO (exists `shouldBe` True)
                go `finally` performBHRequest (deleteIndex expectedIndex)
  
  -- | Get configured repo paths for snapshotting. Note that by default
  -- this is not enabled and if we are over es 1.5, we won't be able to
  -- test snapshotting. Note that this can and should be part of the
  -- client functionality in a much less ad-hoc incarnation.
  getRepoPaths :: IO [FilePath]
  getRepoPaths = withTestEnv $ do
    Object o <-
      performBHRequest $ mkSimpleRequest @StatusIndependant NHTM.methodGet $ mkEndpoint ["_nodes"]
    return $
      fromMaybe mempty $ do
        Object nodes <- X.lookup "nodes" o
        Object firstNode <- snd <$> headMay (X.toList nodes)
        Object settings <- X.lookup "settings" firstNode
        Object path <- X.lookup "path" settings
        Array repo <- X.lookup "repo" path
        return [T.unpack t | String t <- V.toList repo]
  
  -- | 1.5 and earlier don't care about repo paths
  canSnapshot :: IO Bool
  canSnapshot = do
    repoPaths <- getRepoPaths
    return (not (null repoPaths))
  
  withSnapshotRepo ::
    ( MonadMask m,
      MonadBH m
    ) =>
    SnapshotRepoName ->
    (GenericSnapshotRepo -> m a) ->
    m a
  withSnapshotRepo srn@(SnapshotRepoName n) f = do
    repoPaths <- liftIO getRepoPaths
    -- we'll use the first repo path if available, otherwise system temp
    -- dir. Note that this will fail on ES > 1.6, so be sure you use
    -- @when' canSnapshot@.
    case repoPaths of
      (firstRepoPath : _) -> withTempDirectory firstRepoPath (T.unpack n) $ \dir -> bracket (alloc dir) free f
      [] -> withSystemTempDirectory (T.unpack n) $ \dir -> bracket (alloc dir) free f
    where
      alloc dir = do
        liftIO (setFileMode dir mode)
        let repo = FsSnapshotRepo srn "bloodhound-tests-backups" True Nothing Nothing Nothing
        resp <- performBHRequest $ updateSnapshotRepo defaultSnapshotRepoUpdateSettings repo
        liftIO $ resp `shouldBe` Acknowledged True
        return (toGSnapshotRepo repo)
      mode = ownerModes `unionFileModes` groupModes `unionFileModes` otherModes
      free GenericSnapshotRepo {..} = do
        resp <- performBHRequest $ deleteSnapshotRepo gSnapshotRepoName
        liftIO $ resp `shouldBe` Acknowledged True
  
  withSnapshot ::
    ( MonadMask m,
      MonadBH m
    ) =>
    SnapshotRepoName ->
    SnapshotName ->
    m a ->
    m a
  withSnapshot srn sn = bracket_ alloc free
    where
      alloc = do
        resp <- performBHRequest $ createSnapshot srn sn createSettings
        liftIO $ resp `shouldBe` Acknowledged True
      -- We'll make this synchronous for testing purposes
      createSettings =
        defaultSnapshotCreateSettings
          { snapWaitForCompletion = True,
            snapIndices = Just (IndexList (testIndex :| []))
            -- We don't actually need to back up any data
          }
      free =
        performBHRequest $ deleteSnapshot srn sn
  