bloodhound-1.0.0.0: tests/Test/CCRSpec.hs
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-}
module Test.CCRSpec (spec) where
import Control.Concurrent (threadDelay)
import Control.Monad.Catch (bracket_)
import Data.ByteString.Char8 qualified as BS
import Data.ByteString.Lazy.Char8 qualified as LBS
import Data.List qualified as L
import Data.Map.Strict qualified as Map
import Data.Text qualified as T
import Data.Time.Clock.POSIX (getPOSIXTime)
import Database.Bloodhound.OpenSearch1.Requests qualified as OS1Requests
import Database.Bloodhound.OpenSearch1.Types qualified as OS1Types
import Database.Bloodhound.OpenSearch2.Requests qualified as OS2Requests
import Database.Bloodhound.OpenSearch2.Types qualified as OS2Types
import Database.Bloodhound.OpenSearch3.Client qualified as OS3Client
import Database.Bloodhound.OpenSearch3.Requests qualified as OS3Requests
import Database.Bloodhound.OpenSearch3.Types
import Database.Bloodhound.OpenSearch3.Types qualified as OS3Types
import System.Environment (lookupEnv)
import TestsUtils.Common
import TestsUtils.Import
import Prelude
-- ---------------------------------------------------------------------------
-- Sample bodies, drawn verbatim from the OpenSearch CCR plugin docs
-- (<https://docs.opensearch.org/latest/tuning-your-cluster/replication-plugin/api/>).
-- ---------------------------------------------------------------------------
-- | The canonical start-replication body with Security roles.
sampleStartRequestJson :: LBS.ByteString
sampleStartRequestJson =
"{\
\ \"leader_alias\": \"my-connection\",\
\ \"leader_index\": \"leader-01\",\
\ \"use_roles\": {\
\ \"leader_cluster_role\": \"leader_role\",\
\ \"follower_cluster_role\": \"follower_role\"\
\ }\
\}"
-- | A start-replication body without @use_roles@ (Security plugin disabled).
sampleStartRequestNoRolesJson :: LBS.ByteString
sampleStartRequestNoRolesJson =
"{\
\ \"leader_alias\": \"my-connection\",\
\ \"leader_index\": \"leader-01\"\
\}"
-- | The update-settings body carrying two index settings.
sampleUpdateSettingsJson :: LBS.ByteString
sampleUpdateSettingsJson =
"{\
\ \"settings\": {\
\ \"index.number_of_shards\": 4,\
\ \"index.number_of_replicas\": 2\
\ }\
\}"
-- | A create auto-follow pattern body.
sampleCreateAutoFollowJson :: LBS.ByteString
sampleCreateAutoFollowJson =
"{\
\ \"leader_alias\": \"my-connection\",\
\ \"name\": \"my-rule\",\
\ \"pattern\": \"leader-*\",\
\ \"use_roles\": {\
\ \"leader_cluster_role\": \"leader_role\",\
\ \"follower_cluster_role\": \"follower_role\"\
\ }\
\}"
-- | A delete auto-follow pattern body.
sampleDeleteAutoFollowJson :: LBS.ByteString
sampleDeleteAutoFollowJson =
"{\
\ \"leader_alias\": \"my-connection\",\
\ \"name\": \"my-rule\"\
\}"
-- | The status response body while syncing (includes syncing_details).
sampleStatusSyncingJson :: LBS.ByteString
sampleStatusSyncingJson =
"{\
\ \"status\": \"SYNCING\",\
\ \"reason\": \"User initiated\",\
\ \"leader_alias\": \"my-connection\",\
\ \"leader_index\": \"leader-01\",\
\ \"follower_index\": \"follower-01\",\
\ \"syncing_details\": {\
\ \"leader_checkpoint\": 19,\
\ \"follower_checkpoint\": 19,\
\ \"seq_no\": 0\
\ }\
\}"
-- | The status response body when replication is not in progress.
sampleStatusNotInProgressJson :: LBS.ByteString
sampleStatusNotInProgressJson =
"{\
\ \"status\": \"REPLICATION NOT IN PROGRESS\",\
\ \"reason\": \"User initiated\",\
\ \"leader_alias\": \"my-connection\",\
\ \"leader_index\": \"leader-01\",\
\ \"follower_index\": \"follower-01\"\
\}"
spec :: Spec
spec = describe "Cross-Cluster Replication (CCR) plugin" $ do
-- =======================================================================
-- ReplicationStatus enum
-- =======================================================================
describe "ReplicationStatus JSON" $ do
let cases =
[ (ReplicationStatusSyncing, "SYNCING"),
(ReplicationStatusBootstrapping, "BOOTSTRAPPING"),
(ReplicationStatusPaused, "PAUSED"),
(ReplicationStatusNotInProgress, "REPLICATION NOT IN PROGRESS")
]
forM_ cases $ \(t, wire) -> do
it ("encodes " <> show wire <> " to the documented wire string") $ do
encode t `shouldBe` "\"" <> LBS.fromStrict wire <> "\""
it ("decodes the documented wire string " <> show wire) $ do
decode ("\"" <> LBS.fromStrict wire <> "\"" :: LBS.ByteString)
`shouldBe` Just t
it "round-trips an unknown status through ReplicationStatusOther" $ do
let t = ReplicationStatusOther "NEW_FUTURE_STATE"
(decode . encode) t `shouldBe` Just t
it "replicationStatusText round-trips with ToJSON/FromJSON" $
property $ \(t :: ReplicationStatus) ->
(decode . encode) t === Just t
-- =======================================================================
-- ReplicationUseRoles
-- =======================================================================
describe "ReplicationUseRoles JSON" $ do
it "round-trips both roles" $ do
let t = ReplicationUseRoles "leader_role" "follower_role"
(decode . encode) t `shouldBe` Just t
it "encodes to the documented wire shape" $
(decode (encode (ReplicationUseRoles "lr" "fr")) :: Maybe Value)
`shouldBe` decode "{\"leader_cluster_role\":\"lr\",\"follower_cluster_role\":\"fr\"}"
it "decodes the documented fixture" $
(decode sampleStartRequestJson :: Maybe StartReplicationRequest)
`shouldSatisfy` isJust
-- =======================================================================
-- StartReplicationRequest
-- =======================================================================
describe "StartReplicationRequest JSON" $ do
it "decodes a body with use_roles" $ do
let Just req = decode sampleStartRequestJson
startReplicationRequestLeaderAlias req `shouldBe` "my-connection"
startReplicationRequestLeaderIndex req `shouldBe` "leader-01"
startReplicationRequestUseRoles req `shouldSatisfy` isJust
it "decodes a body without use_roles" $ do
let Just req = decode sampleStartRequestNoRolesJson
startReplicationRequestUseRoles req `shouldBe` Nothing
it "round-trips through ToJSON/FromJSON" $
property $ \(req :: StartReplicationRequest) ->
(decode . encode) req === Just req
it "omits use_roles when absent" $ do
let req =
StartReplicationRequest "a" "i" Nothing
LBS.toStrict (encode req) `shouldSatisfy` not . BS.isInfixOf "use_roles"
-- =======================================================================
-- UpdateReplicationSettingsRequest
-- =======================================================================
describe "UpdateReplicationSettingsRequest JSON" $ do
it "decodes the documented fixture" $ do
let Just req = decode sampleUpdateSettingsJson
Map.size (updateReplicationSettingsRequestSettings req) `shouldBe` 2
it "round-trips a concrete settings map" $ do
let m =
Map.fromList
[ ("index.number_of_replicas", toJSON (2 :: Int)),
("index.number_of_shards", toJSON (4 :: Int))
]
req = UpdateReplicationSettingsRequest m
(decode . encode) req `shouldBe` Just req
-- =======================================================================
-- CreateAutoFollowPatternRequest / DeleteAutoFollowPatternRequest
-- =======================================================================
describe "CreateAutoFollowPatternRequest JSON" $ do
it "decodes the documented fixture" $ do
let Just req = decode sampleCreateAutoFollowJson
createAutoFollowPatternRequestName req `shouldBe` "my-rule"
createAutoFollowPatternRequestPattern req `shouldBe` "leader-*"
it "round-trips through ToJSON/FromJSON" $
property $ \(req :: CreateAutoFollowPatternRequest) ->
(decode . encode) req === Just req
describe "DeleteAutoFollowPatternRequest JSON" $ do
it "decodes the documented fixture" $ do
let Just req = decode sampleDeleteAutoFollowJson
deleteAutoFollowPatternRequestName req `shouldBe` "my-rule"
it "round-trips through ToJSON/FromJSON" $
property $ \(req :: DeleteAutoFollowPatternRequest) ->
(decode . encode) req === Just req
-- =======================================================================
-- SyncingDetails / ReplicationStatusResponse
-- =======================================================================
describe "SyncingDetails JSON" $ do
it "round-trips through ToJSON/FromJSON" $
property $ \(d :: SyncingDetails) ->
(decode . encode) d === Just d
describe "ReplicationStatusResponse JSON" $ do
it "decodes a SYNCING body with syncing_details" $ do
let Just resp = decode sampleStatusSyncingJson
replicationStatusResponseStatus resp `shouldBe` ReplicationStatusSyncing
replicationStatusResponseSyncingDetails resp `shouldSatisfy` isJust
it "decodes a not-in-progress body without syncing_details" $ do
let Just resp = decode sampleStatusNotInProgressJson
replicationStatusResponseStatus resp `shouldBe` ReplicationStatusNotInProgress
replicationStatusResponseSyncingDetails resp `shouldBe` Nothing
it "round-trips through ToJSON/FromJSON" $
property $ \(resp :: ReplicationStatusResponse) ->
(decode . encode) resp === Just resp
-- =======================================================================
-- Stats responses
-- =======================================================================
describe "LeaderIndexStats JSON" $ do
it "round-trips through ToJSON/FromJSON" $
property $ \(s :: LeaderIndexStats) ->
(decode . encode) s === Just s
describe "LeaderStatsResponse JSON" $ do
it "decodes with an empty index_stats default when omitted" $ do
let fixture =
"{\
\ \"num_replicated_indices\": 0,\
\ \"operations_read\": 0,\
\ \"translog_size_bytes\": 0,\
\ \"operations_read_lucene\": 0,\
\ \"operations_read_translog\": 0,\
\ \"total_read_time_lucene_millis\": 0,\
\ \"total_read_time_translog_millis\": 0,\
\ \"bytes_read\": 0\
\}"
Just resp = decode fixture
leaderStatsResponseIndexStats resp `shouldBe` mempty
it "round-trips through ToJSON/FromJSON" $
property $ \(resp :: LeaderStatsResponse) ->
(decode . encode) resp === Just resp
describe "FollowerIndexStats JSON" $ do
it "round-trips through ToJSON/FromJSON" $
property $ \(s :: FollowerIndexStats) ->
(decode . encode) s === Just s
describe "FollowerStatsResponse JSON" $ do
it "round-trips through ToJSON/FromJSON" $
property $ \(resp :: FollowerStatsResponse) ->
(decode . encode) resp === Just resp
describe "AutoFollowRuleStats JSON" $ do
it "round-trips through ToJSON/FromJSON" $
property $ \(s :: AutoFollowRuleStats) ->
(decode . encode) s === Just s
describe "AutoFollowStatsResponse JSON" $ do
it "decodes with empty defaults for failed_indices and autofollow_stats" $ do
let fixture =
"{\
\ \"num_success_start_replication\": 0,\
\ \"num_failed_start_replication\": 0,\
\ \"num_failed_leader_calls\": 0\
\}"
Just resp = decode fixture
autoFollowStatsResponseFailedIndices resp `shouldBe` []
autoFollowStatsResponseAutoFollowStats resp `shouldBe` []
it "round-trips through ToJSON/FromJSON" $
property $ \(resp :: AutoFollowStatsResponse) ->
(decode . encode) resp === Just resp
-- =======================================================================
-- Endpoint shape tests (OpenSearch 3)
-- =======================================================================
describe "startReplication endpoint shape (OpenSearch 3)" $ do
let req =
StartReplicationRequest
{ startReplicationRequestLeaderAlias = "conn",
startReplicationRequestLeaderIndex = "leader-01",
startReplicationRequestUseRoles =
Just (ReplicationUseRoles "lr" "fr")
}
it "PUTs to /_plugins/_replication/{follower}/_start" $ do
let r = OS3Requests.startReplication "follower-01" req
getRawEndpoint (bhRequestEndpoint r)
`shouldBe` ["_plugins", "_replication", "follower-01", "_start"]
getRawEndpointQueries (bhRequestEndpoint r) `shouldBe` []
it "uses PUT and attaches the encoded body" $ do
let r = OS3Requests.startReplication "follower-01" req
bhRequestMethod r `shouldBe` "PUT"
bhRequestBody r `shouldSatisfy` isJust
describe "stopReplication endpoint shape (OpenSearch 3)" $ do
it "POSTs to /_plugins/_replication/{follower}/_stop with an empty body" $ do
let r = OS3Requests.stopReplication "follower-01"
bhRequestMethod r `shouldBe` "POST"
getRawEndpoint (bhRequestEndpoint r)
`shouldBe` ["_plugins", "_replication", "follower-01", "_stop"]
bhRequestBody r `shouldBe` Just "{}"
describe "pauseReplication endpoint shape (OpenSearch 3)" $ do
it "POSTs to /_plugins/_replication/{follower}/_pause with an empty body" $ do
let r = OS3Requests.pauseReplication "follower-01"
bhRequestMethod r `shouldBe` "POST"
getRawEndpoint (bhRequestEndpoint r)
`shouldBe` ["_plugins", "_replication", "follower-01", "_pause"]
bhRequestBody r `shouldBe` Just "{}"
describe "resumeReplication endpoint shape (OpenSearch 3)" $ do
it "POSTs to /_plugins/_replication/{follower}/_resume with an empty body" $ do
let r = OS3Requests.resumeReplication "follower-01"
bhRequestMethod r `shouldBe` "POST"
getRawEndpoint (bhRequestEndpoint r)
`shouldBe` ["_plugins", "_replication", "follower-01", "_resume"]
bhRequestBody r `shouldBe` Just "{}"
describe "updateReplicationSettings endpoint shape (OpenSearch 3)" $ do
let req =
UpdateReplicationSettingsRequest $
Map.fromList [("index.number_of_replicas", toJSON (2 :: Int))]
it "PUTs to /_plugins/_replication/{follower}/_update" $ do
let r = OS3Requests.updateReplicationSettings "follower-01" req
bhRequestMethod r `shouldBe` "PUT"
getRawEndpoint (bhRequestEndpoint r)
`shouldBe` ["_plugins", "_replication", "follower-01", "_update"]
bhRequestBody r `shouldSatisfy` isJust
describe "getReplicationStatus endpoint shape (OpenSearch 3)" $ do
it "GETs /_plugins/_replication/{follower}/_status with no query" $ do
let r = OS3Requests.getReplicationStatus "follower-01"
bhRequestMethod r `shouldBe` "GET"
getRawEndpoint (bhRequestEndpoint r)
`shouldBe` ["_plugins", "_replication", "follower-01", "_status"]
getRawEndpointQueries (bhRequestEndpoint r) `shouldBe` []
bhRequestBody r `shouldBe` Nothing
describe "getReplicationStatusWith endpoint shape (OpenSearch 3)" $ do
it "forwards verbose=true as a query parameter" $ do
let opts = defaultReplicationStatusOptions {replicationStatusOptionsVerbose = Just True}
r = OS3Requests.getReplicationStatusWith opts "follower-01"
getRawEndpointQueries (bhRequestEndpoint r)
`shouldBe` [("verbose", Just "true")]
it "default options produce no query string" $ do
let r = OS3Requests.getReplicationStatusWith defaultReplicationStatusOptions "follower-01"
getRawEndpointQueries (bhRequestEndpoint r) `shouldBe` []
describe "getLeaderStats endpoint shape (OpenSearch 3)" $ do
it "GETs /_plugins/_replication/leader_stats with no body" $ do
let r = OS3Requests.getLeaderStats
bhRequestMethod r `shouldBe` "GET"
getRawEndpoint (bhRequestEndpoint r)
`shouldBe` ["_plugins", "_replication", "leader_stats"]
bhRequestBody r `shouldBe` Nothing
describe "getFollowerStats endpoint shape (OpenSearch 3)" $ do
it "GETs /_plugins/_replication/follower_stats with no body" $ do
let r = OS3Requests.getFollowerStats
bhRequestMethod r `shouldBe` "GET"
getRawEndpoint (bhRequestEndpoint r)
`shouldBe` ["_plugins", "_replication", "follower_stats"]
bhRequestBody r `shouldBe` Nothing
describe "getAutoFollowStats endpoint shape (OpenSearch 3)" $ do
it "GETs /_plugins/_replication/autofollow_stats with no body" $ do
let r = OS3Requests.getAutoFollowStats
bhRequestMethod r `shouldBe` "GET"
getRawEndpoint (bhRequestEndpoint r)
`shouldBe` ["_plugins", "_replication", "autofollow_stats"]
bhRequestBody r `shouldBe` Nothing
describe "createAutoFollowPattern endpoint shape (OpenSearch 3)" $ do
let req =
CreateAutoFollowPatternRequest
{ createAutoFollowPatternRequestLeaderAlias = "conn",
createAutoFollowPatternRequestName = "rule",
createAutoFollowPatternRequestPattern = "leader-*",
createAutoFollowPatternRequestUseRoles = Nothing
}
it "POSTs to /_plugins/_replication/_autofollow with a body" $ do
let r = OS3Requests.createAutoFollowPattern req
bhRequestMethod r `shouldBe` "POST"
getRawEndpoint (bhRequestEndpoint r)
`shouldBe` ["_plugins", "_replication", "_autofollow"]
bhRequestBody r `shouldSatisfy` isJust
describe "deleteAutoFollowPattern endpoint shape (OpenSearch 3)" $ do
let req =
DeleteAutoFollowPatternRequest
{ deleteAutoFollowPatternRequestLeaderAlias = "conn",
deleteAutoFollowPatternRequestName = "rule"
}
it "DELETEs /_plugins/_replication/_autofollow with a body" $ do
let r = OS3Requests.deleteAutoFollowPattern req
bhRequestMethod r `shouldBe` "DELETE"
getRawEndpoint (bhRequestEndpoint r)
`shouldBe` ["_plugins", "_replication", "_autofollow"]
bhRequestBody r `shouldSatisfy` isJust
-- =======================================================================
-- Cross-version parity (OS1 vs OS2 vs OS3)
-- =======================================================================
describe "cross-version parity (OS1/OS2/OS3)" $ do
let mkOS1Start :: OS1Types.StartReplicationRequest
mkOS1Start =
OS1Types.StartReplicationRequest
{ OS1Types.startReplicationRequestLeaderAlias = "conn",
OS1Types.startReplicationRequestLeaderIndex = "leader-01",
OS1Types.startReplicationRequestUseRoles = Nothing
}
mkOS2Start :: OS2Types.StartReplicationRequest
mkOS2Start =
OS2Types.StartReplicationRequest
{ OS2Types.startReplicationRequestLeaderAlias = "conn",
OS2Types.startReplicationRequestLeaderIndex = "leader-01",
OS2Types.startReplicationRequestUseRoles = Nothing
}
mkOS3Start :: StartReplicationRequest
mkOS3Start =
StartReplicationRequest
{ startReplicationRequestLeaderAlias = "conn",
startReplicationRequestLeaderIndex = "leader-01",
startReplicationRequestUseRoles = Nothing
}
it "startReplication emits identical paths/methods across OS1/OS2/OS3" $ do
let r1 = OS1Requests.startReplication "f" mkOS1Start
r2 = OS2Requests.startReplication "f" mkOS2Start
r3 = OS3Requests.startReplication "f" mkOS3Start
getRawEndpoint (bhRequestEndpoint r1) `shouldBe` getRawEndpoint (bhRequestEndpoint r2)
getRawEndpoint (bhRequestEndpoint r2) `shouldBe` getRawEndpoint (bhRequestEndpoint r3)
bhRequestMethod r1 `shouldBe` bhRequestMethod r3
it "stopReplication emits identical empty-body POSTs across OS1/OS2/OS3" $ do
let r1 = OS1Requests.stopReplication "f"
r2 = OS2Requests.stopReplication "f"
r3 = OS3Requests.stopReplication "f"
map bhRequestMethod [r1, r2, r3] `shouldBe` ["POST", "POST", "POST"]
map bhRequestBody [r1, r2, r3] `shouldBe` [Just "{}", Just "{}", Just "{}"]
length (L.nub (map (getRawEndpoint . bhRequestEndpoint) [r1, r2, r3])) `shouldBe` 1
it "pause/resume emit identical requests across OS1/OS2/OS3" $ do
let pause1 = OS1Requests.pauseReplication "f"
pause3 = OS3Requests.pauseReplication "f"
resume1 = OS1Requests.resumeReplication "f"
resume3 = OS3Requests.resumeReplication "f"
bhRequestMethod pause1 `shouldBe` bhRequestMethod pause3
bhRequestBody pause1 `shouldBe` bhRequestBody pause3
bhRequestMethod resume1 `shouldBe` bhRequestMethod resume3
bhRequestBody resume1 `shouldBe` bhRequestBody resume3
it "getLeaderStats/getFollowerStats/getAutoFollowStats emit identical GETs across OS1/OS2/OS3" $ do
let leader1 = OS1Requests.getLeaderStats
leader3 = OS3Requests.getLeaderStats
follower1 = OS1Requests.getFollowerStats
follower3 = OS3Requests.getFollowerStats
auto1 = OS1Requests.getAutoFollowStats
auto3 = OS3Requests.getAutoFollowStats
getRawEndpoint (bhRequestEndpoint leader1) `shouldBe` getRawEndpoint (bhRequestEndpoint leader3)
getRawEndpoint (bhRequestEndpoint follower1) `shouldBe` getRawEndpoint (bhRequestEndpoint follower3)
getRawEndpoint (bhRequestEndpoint auto1) `shouldBe` getRawEndpoint (bhRequestEndpoint auto3)
it "createAutoFollowPattern emits identical POSTs across OS1/OS2/OS3" $ do
let mkOS1Pattern =
OS1Types.CreateAutoFollowPatternRequest
{ OS1Types.createAutoFollowPatternRequestLeaderAlias = "conn",
OS1Types.createAutoFollowPatternRequestName = "rule",
OS1Types.createAutoFollowPatternRequestPattern = "leader-*",
OS1Types.createAutoFollowPatternRequestUseRoles = Nothing
}
mkOS3Pattern =
CreateAutoFollowPatternRequest
{ createAutoFollowPatternRequestLeaderAlias = "conn",
createAutoFollowPatternRequestName = "rule",
createAutoFollowPatternRequestPattern = "leader-*",
createAutoFollowPatternRequestUseRoles = Nothing
}
r1 = OS1Requests.createAutoFollowPattern mkOS1Pattern
r3 = OS3Requests.createAutoFollowPattern mkOS3Pattern
getRawEndpoint (bhRequestEndpoint r1) `shouldBe` getRawEndpoint (bhRequestEndpoint r3)
bhRequestMethod r1 `shouldBe` bhRequestMethod r3
-- =======================================================================
-- Live integration tests (gated: requires a CCR-configured follower cluster)
-- =======================================================================
describe "CCR live round-trip" $ do
ccrIt <- runIO ccrOnlyIT
ccrIt "auto-follow pattern create -> stats -> delete (OpenSearch)" $
withTestEnv $ do
suffix <- liftIO $ show @Int . floor <$> getPOSIXTime
let ruleName = T.pack ("bloodhound_test_ccr_" <> suffix)
createReq =
CreateAutoFollowPatternRequest
{ createAutoFollowPatternRequestLeaderAlias = "bloodhound-test-conn",
createAutoFollowPatternRequestName = ruleName,
createAutoFollowPatternRequestPattern = "bloodhound-ccr-*",
createAutoFollowPatternRequestUseRoles = Nothing
}
bracket_
( do
resp <- OS3Client.createAutoFollowPattern createReq
liftIO $
case resp of
Left e -> expectationFailure ("createAutoFollowPattern failed: " <> show e)
Right _ -> pure ()
)
( do
void $
OS3Client.deleteAutoFollowPattern $
DeleteAutoFollowPatternRequest "bloodhound-test-conn" ruleName
)
$ do
statsResult <-
waitFor $ do
resp <- OS3Client.getAutoFollowStats
pure $ case resp of
Right stats ->
Right
( ruleName
`elem` map autoFollowRuleStatsName (autoFollowStatsResponseAutoFollowStats stats)
)
Left e -> Left e
liftIO $
case statsResult of
Right True -> pure ()
Right False ->
expectationFailure
("auto-follow rule " <> T.unpack ruleName <> " not found in getAutoFollowStats after polling")
Left e ->
expectationFailure ("getAutoFollowStats failed during polling: " <> show e)
-- | Gate live CCR tests on an explicit opt-in env var. The CCR plugin
-- needs a follower cluster with the plugin installed and a configured
-- leader connection; set @BLOODHOUND_CCR_LIVE=1@ (and point
-- @ES_TEST_SERVER@ at the follower cluster) to enable. Skips otherwise.
ccrOnlyIT :: (HasCallStack, Example a) => IO (String -> a -> SpecWith (Arg a))
ccrOnlyIT = do
enabled <- lookupEnv "BLOODHOUND_CCR_LIVE"
return $ case enabled of
Just _ -> it
Nothing -> xit
-- | Poll a predicate up to ~5s (10 x 500ms) to absorb the CCR plugin's
-- async refresh delay after a create\/delete.
waitFor :: (MonadIO m) => m (Either EsError Bool) -> m (Either EsError Bool)
waitFor check = go (0 :: Int)
where
go n = do
result <- check
case result of
Right True -> pure result
_
| n >= 9 -> pure result
| otherwise -> do
liftIO $ threadDelay 500000
go (n + 1)
-- ---------------------------------------------------------------------------
-- QuickCheck instances
-- ---------------------------------------------------------------------------
instance Arbitrary ReplicationStatus where
arbitrary =
oneof
[ pure ReplicationStatusSyncing,
pure ReplicationStatusBootstrapping,
pure ReplicationStatusPaused,
pure ReplicationStatusNotInProgress,
ReplicationStatusOther . T.pack <$> listOf1 (elements ['A' .. 'Z'])
]
instance Arbitrary ReplicationUseRoles where
arbitrary =
ReplicationUseRoles
<$> (T.pack <$> listOf1 (elements ['a' .. 'z']))
<*> (T.pack <$> listOf1 (elements ['a' .. 'z']))
instance Arbitrary SyncingDetails where
arbitrary =
SyncingDetails
<$> arbitrary
<*> arbitrary
<*> arbitrary
instance Arbitrary StartReplicationRequest where
arbitrary =
StartReplicationRequest
<$> (T.pack <$> listOf1 (elements ('a' : ['0' .. '9'])))
<*> (T.pack <$> listOf1 (elements ('a' : ['0' .. '9'])))
<*> arbitrary
instance Arbitrary CreateAutoFollowPatternRequest where
arbitrary =
CreateAutoFollowPatternRequest
<$> (T.pack <$> listOf1 (elements ('a' : ['0' .. '9'])))
<*> (T.pack <$> listOf1 (elements ['a' .. 'z']))
<*> (T.pack <$> listOf1 (elements (['a' .. 'z'] ++ "*")))
<*> arbitrary
instance Arbitrary DeleteAutoFollowPatternRequest where
arbitrary =
DeleteAutoFollowPatternRequest
<$> (T.pack <$> listOf1 (elements ('a' : ['0' .. '9'])))
<*> (T.pack <$> listOf1 (elements ['a' .. 'z']))
instance Arbitrary LeaderIndexStats where
arbitrary =
LeaderIndexStats
<$> arbitrary
<*> arbitrary
<*> arbitrary
<*> arbitrary
<*> arbitrary
<*> arbitrary
<*> arbitrary
instance Arbitrary FollowerIndexStats where
arbitrary =
FollowerIndexStats
<$> arbitrary
<*> arbitrary
<*> arbitrary
<*> arbitrary
<*> arbitrary
<*> arbitrary
<*> arbitrary
<*> arbitrary
<*> arbitrary
instance Arbitrary AutoFollowRuleStats where
arbitrary =
AutoFollowRuleStats
<$> (T.pack <$> listOf1 (elements ['a' .. 'z']))
<*> (T.pack <$> listOf1 (elements ('*' : ['a' .. 'z'])))
<*> arbitrary
<*> arbitrary
<*> arbitrary
<*> listOf (T.pack <$> listOf1 (elements ['a' .. 'z']))
instance Arbitrary LeaderStatsResponse where
arbitrary = do
keys <- listOf (T.pack <$> listOf1 (elements ['a' .. 'z']))
vals <- listOf arbitrary
LeaderStatsResponse
<$> arbitrary
<*> arbitrary
<*> arbitrary
<*> arbitrary
<*> arbitrary
<*> arbitrary
<*> arbitrary
<*> arbitrary
<*> pure (Map.fromList (zip keys vals))
shrink (LeaderStatsResponse a b c d e f g h m) =
[ LeaderStatsResponse a b c d e f g h (Map.fromList smaller)
| smaller <- shrinkList (const []) (Map.toList m)
]
instance Arbitrary FollowerStatsResponse where
arbitrary = do
keys <- listOf (T.pack <$> listOf1 (elements ['a' .. 'z']))
vals <- listOf arbitrary
FollowerStatsResponse
<$> arbitrary
<*> arbitrary
<*> arbitrary
<*> arbitrary
<*> arbitrary
<*> arbitrary
<*> arbitrary
<*> arbitrary
<*> arbitrary
<*> arbitrary
<*> arbitrary
<*> arbitrary
<*> arbitrary
<*> arbitrary
<*> arbitrary
<*> pure (Map.fromList (zip keys vals))
shrink (FollowerStatsResponse a b c d e f g h i j k l m n o m') =
[ FollowerStatsResponse a b c d e f g h i j k l m n o (Map.fromList smaller)
| smaller <- shrinkList (const []) (Map.toList m')
]
instance Arbitrary ReplicationStatusResponse where
arbitrary =
ReplicationStatusResponse
<$> arbitrary
<*> (T.pack <$> listOf1 (elements ('a' : ['A' .. 'Z'] ++ " ")))
<*> (T.pack <$> listOf1 (elements ('a' : ['0' .. '9'])))
<*> (T.pack <$> listOf1 (elements ('a' : ['0' .. '9'])))
<*> (T.pack <$> listOf1 (elements ('a' : ['0' .. '9'])))
<*> arbitrary
instance Arbitrary AutoFollowStatsResponse where
arbitrary = do
failed <- listOf (T.pack <$> listOf1 (elements ['a' .. 'z']))
rules <- listOf arbitrary
AutoFollowStatsResponse
<$> arbitrary
<*> arbitrary
<*> arbitrary
<*> pure failed
<*> pure rules
shrink (AutoFollowStatsResponse a b c f r) =
[ AutoFollowStatsResponse a b c f' r
| f' <- shrinkList (const []) f
]
++ [ AutoFollowStatsResponse a b c f r'
| r' <- shrinkList (const []) r
]