diff --git a/nix/tools/tests.nix b/nix/tools/tests.nix index 27b9ad366a..13b207706f 100644 --- a/nix/tools/tests.nix +++ b/nix/tools/tests.nix @@ -42,7 +42,8 @@ let } '' ${withTools.withPg} -f test/observability/fixtures/load.sql \ - ${cabal-install}/bin/cabal v2-run ${devCabalOptions} test:observability -- "''${_arg_leftovers[@]}" + ${withTools.withToxiproxyPgProxy} \ + ${cabal-install}/bin/cabal v2-run ${devCabalOptions} test:observability -- "''${_arg_leftovers[@]}" ''; testDoctests = diff --git a/nix/tools/withTools.nix b/nix/tools/withTools.nix index 094f13b359..692a10bf75 100644 --- a/nix/tools/withTools.nix +++ b/nix/tools/withTools.nix @@ -8,6 +8,7 @@ , python3Packages , writeText , writers +, toxiproxy }: let withTmpDb = @@ -54,6 +55,8 @@ let export PGDATA="$tmpdir/db" export PGHOST="$tmpdir/socket" + PGPORT=$(${randomPort}) + export PGPORT export PGUSER export PGDATABASE export PGRST_DB_SCHEMAS @@ -61,9 +64,16 @@ let export PGOPTIONS HBA_FILE="$tmpdir/pg_hba.conf" - echo "local $PGDATABASE some_protected_user password" > "$HBA_FILE" - echo "local $PGDATABASE all trust" >> "$HBA_FILE" - echo "local replication all trust" >> "$HBA_FILE" + { + echo "local $PGDATABASE some_protected_user password" + echo "local $PGDATABASE all trust" + echo "local replication all trust" + echo "host $PGDATABASE some_protected_user localhost password" + echo "host $PGDATABASE all localhost trust" + } >> "$HBA_FILE" + + UNIX_PGHOST="$PGHOST" + export TCP_PGHOST="localhost" log "Initializing database cluster..." # We try to make the database cluster as independent as possible from the host @@ -80,7 +90,7 @@ let # On MacOS, it's 104 chars # See: https://serverfault.com/questions/641347/check-if-a-path-exceeds-maximum-for-unix-domain-socket - pg_ctl -l "$tmpdir/db.log" -w start -o "-F -c listen_addresses=\"\" -c hba_file=$HBA_FILE -k $PGHOST -c log_statement=\"all\" " \ + pg_ctl -l "$tmpdir/db.log" -w start -o "-F -c listen_addresses=\"$TCP_PGHOST\" -c hba_file=$HBA_FILE -k $UNIX_PGHOST -c log_statement=\"all\" " \ >> "$setuplog" log "Creating a minimally privileged $PGUSER connection role..." @@ -93,6 +103,7 @@ let replica_slot="replica_$RANDOM" replica_dir="$tmpdir/$replica_slot" replica_host="$tmpdir/socket_$replica_slot" + replica_port=$(${randomPort}) mkdir -p "$replica_host" @@ -106,15 +117,16 @@ let log "Starting replica on $replica_host" # We set a low max_standby_streaming_delay to make the replication conflict fail faster in tests (otherwise it waits for the default 30s) - pg_ctl -D "$replica_dir" -l "$replica_dblog" -w start -o "-F -c listen_addresses=\"\" -c hba_file=$HBA_FILE -k $replica_host -c log_statement=\"all\" -c max_standby_streaming_delay=\"3s\" " \ + pg_ctl -D "$replica_dir" -l "$replica_dblog" -w start -o "-F -c listen_addresses=\"$TCP_PGHOST\" -c port=$replica_port -c hba_file=$HBA_FILE -k $replica_host -c log_statement=\"all\" -c max_standby_streaming_delay=\"3s\" " \ >> "$setuplog" >&2 echo "${commandName}: Replica enabled. You can connect to it with: psql 'postgres:///$PGDATABASE?host=$replica_host' -U postgres" >&2 echo "${commandName}: You can tail the replica logs with: tail -f $replica_dblog" export PGREPLICAHOST="$replica_host" + export PGREPLICAPORT="$replica_port" export PGREPLICASLOT="$replica_slot" - export PGRST_DB_URI="postgres:///$PGDATABASE?host=$PGREPLICAHOST,$PGHOST" + export PGRST_DB_URI="postgres:///$PGDATABASE?host=$PGREPLICAHOST,$PGHOST&port=$replica_port,$PGPORT" fi # shellcheck disable=SC2329 @@ -372,6 +384,97 @@ let libraries = [ python3Packages.pandas python3Packages.tabulate python3Packages.psutil ]; } (builtins.readFile ./monitor_pid.py); + + randomPort = + writers.writePython3 "postgrest-random-port" + { + # Quick one-liner: ignore linting errors + flakeIgnore = [ "E702" "W292" "E501" ]; + } + ''import socket; s = socket.socket(); s.bind(("127.0.0.1", 0)); print(s.getsockname()[1]); s.close()''; + + withToxiproxyProxy = + checkedShellScript + { + name = "postgrest-with-toxiproxy-proxy"; + docs = "Run with Toxiproxy proxy created. Proxy name passed as TOXI_PROXY_NAME env variable."; + args = + [ + "ARG_POSITIONAL_SINGLE([command], [Command to run])" + "ARG_LEFTOVERS([command arguments])" + "ARG_OPTIONAL_SINGLE([listen], [l], [Proxy will listen on this address])" + "ARG_OPTIONAL_SINGLE([upstream], [u], [Proxy will forward to this address])" + ]; + positionalCompletion = "_command"; + workingDir = "/"; + withPath = [ toxiproxy ]; + } + '' + proxyname="tp$RANDOM" + toxiproxy-cli create -l "$_arg_listen" -u "$_arg_upstream" "$proxyname" + + # shellcheck disable=SC2329 + stop () { + toxiproxy-cli delete "$proxyname" || true + } + trap stop EXIT + + (TOXI_PROXY_NAME="$proxyname" "$_arg_command" "''${_arg_leftovers[@]}") + ''; + + withToxiproxyPgProxy = + checkedShellScript + { + name = "postgrest-with-toxiproxy-pg-proxy"; + docs = "Run with a Toxiproxy proxy to PosgreSQL."; + args = + [ + "ARG_POSITIONAL_SINGLE([command], [Command to run])" + "ARG_LEFTOVERS([command arguments])" + "ARG_USE_ENV([TCP_PGHOST], [], [PG host name])" + "ARG_USE_ENV([PGPORT], [], [PG port])" + ]; + positionalCompletion = "_command"; + workingDir = "/"; + } + '' + proxy_port=''$(${randomPort}) + + ${withToxiproxyServer} ${withToxiproxyProxy} -l "$TCP_PGHOST:$proxy_port" -u "$TCP_PGHOST:$PGPORT" \ + env "TOXI_PGPORT=$proxy_port" "$_arg_command" "''${_arg_leftovers[@]}" + ''; + + withToxiproxyServer = + checkedShellScript + { + name = "postgrest-with-toxiproxy-server"; + docs = "Run with toxiproxy-server"; + args = + [ + "ARG_POSITIONAL_SINGLE([command], [Command to run])" + "ARG_LEFTOVERS([command arguments])" + ]; + positionalCompletion = "_command"; + workingDir = "/"; + withPath = [ toxiproxy ]; + } + '' + if ! test -v TOXI_PROXY; then + export TOXI_PROXY="" + LOG_LEVEL=error toxiproxy-server& + TOXIPROXY_PID=$! + sleep 1 # give the server a moment to start + + # shellcheck disable=SC2329 + stop () { + kill "$TOXIPROXY_PID" || true + wait "$TOXIPROXY_PID" || true + } + trap stop EXIT + fi + ("$_arg_command" "''${_arg_leftovers[@]}") + ''; + in buildToolbox { @@ -386,5 +489,5 @@ buildToolbox builtins.map (pg: { inherit (pg) name; value = withTmpDb pg; }) postgresqlVersions ); # make latest withPg available for other nix files - extra = { inherit withPg; }; + extra = { inherit withPg withToxiproxyPgProxy; }; } diff --git a/postgrest.cabal b/postgrest.cabal index 2a819d80bf..0df1fdde1a 100644 --- a/postgrest.cabal +++ b/postgrest.cabal @@ -311,22 +311,32 @@ test-suite observability Observation.JwtCache Observation.MetricsSpec Observation.SchemaCacheSpec + Observation.ToxiSpec + Toxiproxy build-depends: base >= 4.9 && < 4.22 + , aeson >= 2.0.3 && < 2.3 , base64-bytestring >= 1 && < 1.3 , bytestring >= 0.10.8 && < 0.13 + , containers >= 0.5.7 && < 0.8 , hasql-pool >= 1.0.1 && <= 1.3.0.4 , hasql-transaction >= 1.0.1 && <= 1.2.1 , hspec >= 2.3 && < 2.12 , hspec-expectations >= 0.8.4 && < 0.9 , hspec-wai >= 0.10 && < 0.12 , hspec-wai-json >= 0.10 && < 0.12 + , http-client >= 0.7.19 && < 0.8 , http-types >= 0.12.3 && < 0.13 , jose-jwt >= 0.9.6 && < 0.11 + , monad-control >= 1.0.1 && < 1.1 , postgrest , prometheus-client >= 1.1.1 && < 1.2.0 , protolude >= 0.3.1 && < 0.4 + , servant-client >= 0.20.3.0 && < 0.21 + , servant >= 0.20.3.0 && < 0.21 , text >= 1.2.2 && < 2.2 + , transformers-base >= 0.4.4 && < 0.5 , wai >= 3.2.1 && < 3.3 + , wai-extra >= 3.1.8 && < 3.2 ghc-options: -threaded -O0 -Werror -Wall -fwarn-identities -fno-spec-constr -optP-Wno-nonportable-include-path -fwrite-ide-info diff --git a/src/PostgREST/App.hs b/src/PostgREST/App.hs index 81f1b66722..3e772f9b43 100644 --- a/src/PostgREST/App.hs +++ b/src/PostgREST/App.hs @@ -85,7 +85,7 @@ run appState = do NS.close mainSocket Unix.installSignalHandlers observer closeSockets (AppState.schemaCacheLoader appState) (AppState.readInDbConfig False appState) - Listener.runListener appState + void $ Listener.runListener appState Admin.runAdmin appState adminSocket mainSocket (serverSettings conf) diff --git a/src/PostgREST/AppState.hs b/src/PostgREST/AppState.hs index fdaac1a908..e78d0091d2 100644 --- a/src/PostgREST/AppState.hs +++ b/src/PostgREST/AppState.hs @@ -6,6 +6,7 @@ module PostgREST.AppState ( AppState , destroy + , flushPool , getConfig , getSchemaCache , getMainThreadId diff --git a/src/PostgREST/Config.hs b/src/PostgREST/Config.hs index 0590414d8e..472f357a4b 100644 --- a/src/PostgREST/Config.hs +++ b/src/PostgREST/Config.hs @@ -26,6 +26,7 @@ module PostgREST.Config , readPGRSTEnvironment , toURI , parseSecret + , addConnStringOption , addFallbackAppName , addTargetSessionAttrs , toConnectionSettings @@ -627,7 +628,7 @@ pgConnString conn | uriDesignator `T.isPrefixOf` conn || shortUriDesignator `T.i -- >>> addFallbackAppName ver "postgresql:///postgres?host=/run/user/1000/postgrest/postgrest-with-postgresql-16-BuR/socket&user=some_protected_user&password=invalid_pass" -- "postgresql:///postgres?host=/run/user/1000/postgrest/postgrest-with-postgresql-16-BuR/socket&user=some_protected_user&password=invalid_pass&fallback_application_name=PostgREST%2011.1.0%20%285a04ec7%29" addFallbackAppName :: ByteString -> Text -> Text -addFallbackAppName version dbUri = addConnStringOption dbUri "fallback_application_name" pgrstVer +addFallbackAppName version = addConnStringOption "fallback_application_name" pgrstVer where pgrstVer = "PostgREST " <> T.decodeUtf8 version @@ -649,7 +650,7 @@ addFallbackAppName version dbUri = addConnStringOption dbUri "fallback_applicati -- >>> addTargetSessionAttrs "host=localhost port=5432 dbname=postgres" -- "host=localhost port=5432 dbname=postgres target_session_attrs='read-write'" addTargetSessionAttrs :: Text -> Text -addTargetSessionAttrs dbUri = addConnStringOption dbUri "target_session_attrs" "read-write" +addTargetSessionAttrs = addConnStringOption "target_session_attrs" "read-write" toConnectionSettings :: (Text -> Text) -> AppConfig -> [SQL.Setting] toConnectionSettings transformUri AppConfig{configDbUri, configDbPreparedStatements} = @@ -658,7 +659,7 @@ toConnectionSettings transformUri AppConfig{configDbUri, configDbPreparedStateme ] addConnStringOption :: Text -> Text -> Text -> Text -addConnStringOption dbUri key val = dbUri <> +addConnStringOption key val dbUri= dbUri <> case pgConnString dbUri of Nothing -> mempty Just PGKeyVal -> " " <> keyValFmt diff --git a/src/PostgREST/Listener.hs b/src/PostgREST/Listener.hs index 80c65c2189..70324108b0 100644 --- a/src/PostgREST/Listener.hs +++ b/src/PostgREST/Listener.hs @@ -1,8 +1,11 @@ -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE MultiWayIf #-} -{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE MultiWayIf #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} -module PostgREST.Listener (runListener) where +module PostgREST.Listener (runListener, runListener') where import qualified Data.ByteString.Char8 as BS @@ -18,28 +21,55 @@ import qualified PostgREST.Config as Config import Control.Arrow ((&&&)) import Data.Bitraversable (bisequence) import Data.Either.Combinators (whenRight) +import Data.IORef (IORef, newIORef, + readIORef, writeIORef) import qualified Data.Text as T +import Data.Time (UTCTime, diffUTCTime, + nominalDiffTimeToSeconds) import qualified Database.PostgreSQL.LibPQ as LibPQ import qualified Hasql.Session as SQL import PostgREST.Config.Database (queryPgVersion) import PostgREST.Config.PgVersion (pgvFullName) import Protolude +import System.IO.Error (isResourceVanishedError) -- | Starts the Listener in a thread -runListener :: AppState -> IO () -runListener appState = do +-- | Returns IO action to stop the listener thread. +runListener :: AppState -> IO (IO ()) +runListener appState = runListener' appState (15 * minute) (30 * minute) + where + minute = 60 + +data ListenerStopped = ListenerStopped deriving (Show, Exception) + +runListener' :: AppState -> Int -> Int -> IO (IO ()) +runListener' appState initialTcpKeepAlivesIdleSec maxTcpKeepAlivesIdleSec = do AppConfig{..} <- getConfig appState - when configDbChannelEnabled $ - void . forkIO . void $ retryingListen appState + if configDbChannelEnabled then do + started <- newIORef Nothing + listenerThreadId <- forkIO . void $ retryingListen started initialTcpKeepAlivesIdleSec maxTcpKeepAlivesIdleSec False appState + pure $ throwTo listenerThreadId ListenerStopped + else + mempty -- | Starts a LISTEN connection and handles notifications. It recovers with exponential backoff with a cap of 32 seconds, if the LISTEN connection is lost. -- | This function never returns (but can throw) and return type enforces that. -retryingListen :: AppState -> IO Void -retryingListen appState = do +retryingListen :: IORef (Maybe UTCTime) -> Int -> Int -> Bool -> AppState -> IO () +retryingListen lastActivity currentKeepalivesIdle maxKeepalivesIdle retryingOnIdleTimeout appState = do cfg@AppConfig{..} <- AppState.getConfig appState let dbChannel = toS configDbChannel onError err = do + -- ResourceVanished should be reported when reading from socket fails + -- as long as hasql-notifications does not wrap IOException in something else... + let resourceVanished = maybe False isResourceVanishedError (fromException @IOException err) + (newTcpIdle, newMaxKeepalivesIdle) <- + if resourceVanished then do + readIORef lastActivity >>= + maybe (pure (currentKeepalivesIdle, maxKeepalivesIdle)) adjustTcpIdle + else + pure (currentKeepalivesIdle, maxKeepalivesIdle) + writeIORef lastActivity Nothing AppState.putIsListenerOn appState False observer $ DBListenFail dbChannel (Right err) when (isDbListenerBug err) $ @@ -54,15 +84,15 @@ retryingListen appState = do unless (delay == maxDelay) $ AppState.putNextListenerDelay appState (delay * 2) -- loop running the listener - retryingListen appState + retryingListen lastActivity newTcpIdle newMaxKeepalivesIdle resourceVanished appState -- Execute the listener with with error handling - handle onError $ do + handle onError $ handle (\ListenerStopped -> pure ()) $ do -- Make sure we don't leak connections on errors bracket -- acquire connection (SQL.acquire $ - Config.toConnectionSettings Config.addTargetSessionAttrs cfg) + Config.toConnectionSettings (addKeepalivesOptions . Config.addTargetSessionAttrs) cfg) -- release connection (`whenRight` releaseConnection) $ -- use connection @@ -82,6 +112,7 @@ retryingListen appState = do AppState.putNextListenerDelay appState 1 observer $ DBListenStart pqHost pqPort pgFullName dbChannel + saveLastActivityTime -- wait for notifications -- this will never return, in case of an error it will throw and be caught by onError @@ -96,11 +127,14 @@ retryingListen appState = do oneSecondInMicro = 1000000 maxDelay = 32 - handleNotification channel msg = + handleNotification channel msg = do if | BS.null msg -> observer (DBListenerGotSCacheMsg channel) >> cacheReloader | msg == "reload schema" -> observer (DBListenerGotSCacheMsg channel) >> cacheReloader | msg == "reload config" -> observer (DBListenerGotConfigMsg channel) >> AppState.readInDbConfig False appState | otherwise -> pure () -- Do nothing if anything else than an empty message is sent + saveLastActivityTime + + saveLastActivityTime = AppState.getTime appState >>= writeIORef lastActivity . Just cacheReloader = AppState.schemaCacheLoader appState @@ -108,3 +142,44 @@ retryingListen appState = do releaseConnection = void . forkIO . handle (observer . DBListenerConnectionCleanupFail) . SQL.release isDbListenerBug e = "could not access status of transaction" `T.isInfixOf` show e + + -- adjust the next keepalive timeout + -- This is a simple discovery mechanism that + -- should converge to optimum keepalive timeout + -- we calculate the time T between connection failure and last activity + -- if T is <= than current timeout + -- it means timeout is too long + -- so we set next timeout to T/2 and max timeout to T + -- (max cannot be longer because we lost connection earlier) + -- if T is longer than current timeout + -- we set timeout in between current timeout and current max + adjustTcpIdle lastActiveTime = do + currentIdleSeconds <- AppState.getTime appState <&> round . nominalDiffTimeToSeconds . (`diffUTCTime` lastActiveTime) + let currentIdleTimeout = currentKeepalivesIdle + keepalivesInterval * keepalivesCount + -- if our idle time == current idle timeout setting it means + -- we have to make it shorter + if currentIdleSeconds `div` currentIdleTimeout <= 1 then + -- only adjust if this is the second idle timeout failure + -- this is to eliminate spurious adjustments (TODO rethink if it is really needed) + if retryingOnIdleTimeout then + -- try with 1/2 of current keepalive idle + -- remember that it is the new maximum we can try later + pure (max 1 $ currentKeepalivesIdle `div` 2, currentKeepalivesIdle) + else + pure (currentKeepalivesIdle, maxKeepalivesIdle) + else + -- we can try to make it longer + -- but not longer than previously calculated maximum + pure (currentKeepalivesIdle + (maxKeepalivesIdle - currentKeepalivesIdle) `div` 2, maxKeepalivesIdle) + + keepalivesInterval = max 1 $ currentKeepalivesIdle `div` (5 * keepalivesCount) + keepalivesCount = 5 + + -- (Config.addConnStringOption opt val) is an endomorphism + -- so it is a Monoid under function composition + -- Haskell is awesome + addKeepalivesOptions = appEndo $ foldMap (Endo . uncurry Config.addConnStringOption . fmap show) [ + ("keepalives_count", keepalivesCount) + , ("keepalives_interval", keepalivesInterval) + , ("keepalives_idle", currentKeepalivesIdle) + ] diff --git a/test/io/conftest.py b/test/io/conftest.py index b6a068222f..dc42a9e0da 100644 --- a/test/io/conftest.py +++ b/test/io/conftest.py @@ -9,8 +9,9 @@ def dburi(): "Postgres database connection URI." dbname = os.environ["PGDATABASE"] host = os.environ["PGHOST"] + port = os.environ["PGPORT"] user = os.environ["PGUSER"] - return f"postgresql://?dbname={dbname}&host={host}&user={user}".encode() + return f"postgresql://?dbname={dbname}&host={host}&port={port}&user={user}".encode() @pytest.fixture @@ -19,6 +20,7 @@ def baseenv(): return { "PGDATABASE": os.environ["PGDATABASE"], "PGHOST": os.environ["PGHOST"], + "PGPORT": os.environ["PGPORT"], "PGUSER": os.environ["PGUSER"], } @@ -51,6 +53,7 @@ def replicaenv(defaultenv): **defaultenv, **conf, "PGHOST": os.environ["PGREPLICAHOST"] + "," + os.environ["PGHOST"], + "PGPORT": os.environ["PGREPLICAPORT"] + "," + os.environ["PGPORT"], "PGREPLICASLOT": os.environ["PGREPLICASLOT"], }, } @@ -76,6 +79,7 @@ def metapostgrest(): env = { "PGDATABASE": os.environ["PGDATABASE"], "PGHOST": os.environ["PGHOST"], + "PGPORT": os.environ["PGPORT"], "PGUSER": role, "PGRST_DB_ANON_ROLE": role, "PGRST_DB_CONFIG": "true", diff --git a/test/io/test_auth.py b/test/io/test_auth.py index 82ed07706e..0b4ac7d006 100644 --- a/test/io/test_auth.py +++ b/test/io/test_auth.py @@ -165,7 +165,7 @@ def relativeSeconds(sec): def test_fail_with_invalid_password(defaultenv): "Connecting with an invalid password should fail without retries." - uri = f'postgresql://?dbname={defaultenv["PGDATABASE"]}&host={defaultenv["PGHOST"]}&user=some_protected_user&password=invalid_pass' + uri = f'postgresql://?dbname={defaultenv["PGDATABASE"]}&host={defaultenv["PGHOST"]}&port={defaultenv["PGPORT"]}&user=some_protected_user&password=invalid_pass' env = {**defaultenv, "PGRST_DB_URI": uri} with run(env=env, wait_for_readiness=False) as postgrest: exitCode = wait_until_exit(postgrest) diff --git a/test/io/test_io.py b/test/io/test_io.py index 03cc458932..3eaac4e43f 100644 --- a/test/io/test_io.py +++ b/test/io/test_io.py @@ -1849,7 +1849,7 @@ def test_log_listener_connection_start(defaultenv): # Check for the listener start message containing host and port # Do not check if pg version is displayed properly as it is tricky to test it assert any( - f'"{defaultenv["PGHOST"]}:5432" and listening for database notifications on the "pgrst" channel' + f'"{defaultenv["PGHOST"]}:{defaultenv["PGPORT"]}" and listening for database notifications on the "pgrst" channel' in line for line in output ) diff --git a/test/observability/Main.hs b/test/observability/Main.hs index 2173161220..bc6ef35267 100644 --- a/test/observability/Main.hs +++ b/test/observability/Main.hs @@ -18,10 +18,13 @@ import PostgREST.SchemaCache (querySchemaCache) import qualified Observation.JwtCache import qualified Observation.MetricsSpec +import qualified Data.Text as T import qualified Observation.SchemaCacheSpec +import qualified Observation.ToxiSpec import ObsHelper import PostgREST.Observation (Observation (HasqlPoolObs)) import Protolude hiding (toList, toS) +import qualified System.Environment as System import Test.Hspec main :: IO () @@ -34,12 +37,16 @@ main = do -- this means we have another thread running for the entire duration of the spec but this shouldn't be a problem since Haskell green threads are lightweight void $ forkIO $ forever $ readChan poolChan metricsState <- Metrics.init (configDbPoolSize testCfg) + toxiProxyName <- T.pack <$> System.getEnv "TOXI_PROXY_NAME" + toxiPgPort <- T.pack <$> System.getEnv "TOXI_PGPORT" + pgPort <- T.pack <$> System.getEnv "PGPORT" + let toxiCfg = testCfg { configDbUri = "postgresql://localhost:" <> toxiPgPort } pool <- P.acquire $ P.settings [ P.size 3 , P.acquisitionTimeout 10 , P.agingTimeout 60 , P.idlenessTimeout 60 - , P.staticConnectionSettings $ toConnectionSettings identity testCfg + , P.staticConnectionSettings $ toConnectionSettings identity toxiCfg -- make sure metrics are updated and pool observations published to poolChan , P.observationHandler $ (writeChan poolChan <> Metrics.observationMetrics metricsState) . HasqlPoolObs ] @@ -47,27 +54,30 @@ main = do actualPgVersion <- either (panic . show) id <$> P.use pool queryPgVersion -- cached schema cache so most tests run fast - baseSchemaCache <- loadSCache pool testCfg + baseSchemaCache <- loadSCache pool toxiCfg loggerState <- Logger.init let - initApp sCache config = do + initApp sCache configure = + let config = configure toxiCfg in do -- duplicate poolChan as a starting point obsChan <- dupChan poolChan stateObsChan <- newObsChan obsChan appState <- AppState.initWithPool pool config loggerState metricsState (Metrics.observationMetrics metricsState <> writeChan obsChan) AppState.putPgVersion appState actualPgVersion AppState.putSchemaCache appState (Just sCache) - return (SpecState appState metricsState stateObsChan, postgrest (configLogLevel config) appState (pure ())) + return (SpecState appState metricsState stateObsChan $ testToxiProxy toxiProxyName toxiPgPort pgPort, postgrest (configLogLevel config) appState (pure ())) -- Run all test modules hspec $ do before (initApp baseSchemaCache testCfgJwtCache) $ describe "Observation.JwtCacheObs" Observation.JwtCache.spec - before (initApp baseSchemaCache testCfg) $ - describe "Feature.MetricsSpec" Observation.MetricsSpec.spec - before (initApp baseSchemaCache testCfg) $ - describe "Feature.SchemaCacheSpec" Observation.SchemaCacheSpec.spec + + traverse_ (before (initApp baseSchemaCache identity) . uncurry describe) [ + ("Observation.MetricsSpec", Observation.MetricsSpec.spec) + , ("Observation.SchemaCacheSpec", Observation.SchemaCacheSpec.spec) + , ("Observation.ToxiSpec", Observation.ToxiSpec.spec) + ] where loadSCache pool conf = diff --git a/test/observability/ObsHelper.hs b/test/observability/ObsHelper.hs index fb897390e8..e5acec6b01 100644 --- a/test/observability/ObsHelper.hs +++ b/test/observability/ObsHelper.hs @@ -4,13 +4,19 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE LambdaCase #-} +{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} +{-# LANGUAGE UndecidableInstances #-} +{-# OPTIONS_GHC -Wno-orphans #-} module ObsHelper where +import Control.Monad.Base (MonadBase (liftBase)) +import Control.Monad.Trans.Control import qualified Data.ByteString as BS import qualified Data.ByteString.Base64 as B64 import qualified Data.ByteString.Lazy as BL @@ -22,6 +28,7 @@ import qualified Jose.Jwa as JWT import qualified Jose.Jws as JWT import qualified Jose.Jwt as JWT import Network.HTTP.Types +import Network.Wai.Test import qualified PostgREST.AppState as AppState import PostgREST.Config (AppConfig (..), JSPathExp (..), @@ -36,6 +43,13 @@ import Protolude hiding (get, toS) import System.Timeout (timeout) import Test.Hspec import Test.Hspec.Expectations.Contrib (annotate) +import Test.Hspec.Wai.Internal +import qualified Toxiproxy +import Toxiproxy (proxyEnabled, + proxyListen, + proxyName, + proxyToxics, + proxyUpstream) -- helpers used to produce observation diagnostics in waitForObs -- Implementing the Show instance for Observation is hard due to having many different parameters so instead we use generic programming (`conName`) to obtain the constructor name as `Text` @@ -52,10 +66,23 @@ instance (HasConstructor x, HasConstructor y) => HasConstructor (x :+: y) where instance Constructor c => HasConstructor (C1 c f) where genericConstrName = T.pack . conName +instance MonadBaseControl IO (WaiSession st) where + type StM (WaiSession st) a = StM Session a + liftBaseWith f = WaiSession $ + liftBaseWith $ \runInBase -> + f $ \k -> runInBase (unWaiSession k) + restoreM = WaiSession . restoreM + {-# INLINE liftBaseWith #-} + {-# INLINE restoreM #-} + +instance MonadBase IO (WaiSession st) where + liftBase = liftIO + data SpecState = SpecState { - specAppState :: AppState.AppState, - specMetrics :: Metrics.MetricsState, - specObsChan :: ObsChan + specAppState :: AppState.AppState, + specMetrics :: Metrics.MetricsState, + specObsChan :: ObsChan, + specToxiProxy :: Toxiproxy.Proxy } data StateCheck st m = forall a. StateCheck (st -> (String, m a)) (a -> a -> Expectation) @@ -74,7 +101,7 @@ baseCfg = let secret = encodeUtf8 "reallyreallyreallyreallyverysafe" in , configClientErrorVerbosity = Verbose , configDbAggregates = False , configDbAnonRole = Just "postgrest_test_anonymous" - , configDbChannel = mempty + , configDbChannel = "pgrst" , configDbChannelEnabled = True , configDbExtraSearchPath = [] , configDbHoistedTxSettings = ["default_transaction_isolation","plan_filter.statement_cost_limit","statement_timeout"] @@ -126,14 +153,27 @@ baseCfg = let secret = encodeUtf8 "reallyreallyreallyreallyverysafe" in testCfg :: AppConfig testCfg = baseCfg -testCfgJwtCache :: AppConfig -testCfgJwtCache = - baseCfg { +testCfgJwtCache :: AppConfig -> AppConfig +testCfgJwtCache base = + base { configJwtSecret = Just generateSecret , configJWKS = rightToMaybe $ parseSecret generateSecret , configJwtCacheMaxEntries = 2 } +testToxiProxy :: Text -> Text -> Text -> Toxiproxy.Proxy +testToxiProxy name proxyPort pgPort = Toxiproxy.Proxy { + proxyName = Toxiproxy.ProxyName name, + proxyEnabled = True, + proxyToxics = mempty, + -- we don't create proxies + -- as they are already created + -- but we have to be careful not to override + -- the values + proxyListen = "localhost:" <> proxyPort, + proxyUpstream = "localhost:" <> pgPort +} + authHeader :: BS.ByteString -> BS.ByteString -> Header authHeader typ creds = (hAuthorization, typ <> " " <> creds) diff --git a/test/observability/Observation/ToxiSpec.hs b/test/observability/Observation/ToxiSpec.hs new file mode 100644 index 0000000000..faa129057d --- /dev/null +++ b/test/observability/Observation/ToxiSpec.hs @@ -0,0 +1,111 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE MonadComprehensions #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE NumericUnderscores #-} +module Observation.ToxiSpec where + +import Control.Monad.Trans.Control (liftBaseDiscard) +import qualified Data.Map as M +import Network.Wai (Application) +import ObsHelper +import qualified PostgREST.AppState as AppState +import PostgREST.Listener (runListener, + runListener') +import PostgREST.Observation (Observation (..)) +import Protolude hiding (get) +import Test.Hspec (SpecWith, describe, it) +import Test.Hspec.Wai +import Toxiproxy (Stream (..), Toxic (..), + ToxicType (..), + withDisabled, withToxic) + +spec :: SpecWith (SpecState, Application) +spec = describe "Tests using Toxiproxy" $ do + it "Should return 503 on temporary database server unavailability" $ do + pendingWith "TODO fix" + SpecState{specAppState, specToxiProxy} <- getState + + -- make sure there are no open connections + liftIO $ AppState.flushPool specAppState + + liftBaseDiscard (withDisabled specToxiProxy) $ do + void $ get "/items?id=eq.5" + `shouldRespondWith` 503 + + void $ get "/items?id=eq.5" + `shouldRespondWith` 200 + + liftBaseDiscard (withDisabled specToxiProxy) $ do + void $ get "/items?id=eq.5" + `shouldRespondWith` 503 + + describe "Toxiproxy tests of notification listener" $ do + it "should start listener" $ do + SpecState {specAppState, specObsChan} <- getState + let waitFor = waitForObs specObsChan + + liftIO $ withListener specAppState $ + waitFor (1*sec) "DBListenStart" $ \x -> [ o | o@DBListenStart{} <- pure x] + + it "should retry listener" $ do + SpecState {specAppState, specObsChan, specToxiProxy} <- getState + let waitFor = waitForObs specObsChan + + liftIO $ bracket ( + withDisabled specToxiProxy $ do + stopListener <- runListener specAppState + (do + waitFor (1*sec) "DBListenFail" $ \x -> [ o | o@DBListenFail{} <- pure x ] + waitFor (1*sec) "DBListenRetry" $ \x -> [ o | o@DBListenRetry{} <- pure x ]) + `onException` stopListener + pure stopListener) + identity + (const $ waitFor (2*sec) "DBListenStart" $ \x -> [ o | o@DBListenStart{} <- pure x]) + + it "should retry listener with exponential backoff when connection broken" $ do + SpecState {specAppState, specObsChan, specToxiProxy} <- getState + let waitFor = waitForObs specObsChan + + liftIO $ withListener specAppState $ do + waitFor (1*sec) "DBListenStart" $ \x -> [ o | o@DBListenStart{} <- pure x] + withDisabled specToxiProxy $ do + waitFor (1*sec) "DBListenFail" $ \x -> [ o | o@DBListenFail{} <- pure x ] + waitFor (1*sec) "DBListenRetry 1" $ \x -> [ o | o@(DBListenRetry 1) <- pure x ] + waitFor (2*sec) "DBListenRetry 2" $ \x -> [ o | o@(DBListenRetry 2) <- pure x ] + waitFor (3*sec) "DBListenRetry 4" $ \x -> [ o | o@(DBListenRetry 4) <- pure x ] + waitFor (5*sec) "DBListenStart after retries" $ \x -> [ o | o@DBListenStart{} <- pure x] + waitFor (1*sec) "SchemaCacheLoadedObs" $ \x -> [ o | o@SchemaCacheLoadedObs{} <- pure x ] + + -- this scenario cannot be tested with Toxiproxy + -- because keepalives are handled by the kernel TCP/IP stack + -- left here as an example and template for a test + -- using some future more advanced tool + it "should detect broken connection using keepalives" $ do + pendingWith "Cannot be tested with Toxiproxy" + SpecState {specAppState, specObsChan, specToxiProxy} <- getState + let waitFor = waitForObs specObsChan + + liftIO $ withKeepAliveListener specAppState $ do + waitFor (1*sec) "DBListenStart" $ \x -> [ o | o@DBListenStart{} <- pure x] + withTimedOutConnection specToxiProxy $ do + waitFor (10*sec) "DBListenFail" $ \x -> [ o | o@DBListenFail{} <- pure x ] + waitFor (1*sec) "DBListenRetry 1" $ \x -> [ o | o@(DBListenRetry 1) <- pure x ] + waitFor (2*sec) "DBListenStart after timeout toxic" $ \x -> [ o | o@DBListenStart{} <- pure x] + + where + withListener appState = bracket (runListener appState) identity . const + withKeepAliveListener appState = bracket (runListener' appState 1 1) identity . const + withTimedOutConnection proxy = + withToxic proxy (timeoutToxic Upstream) . + withToxic proxy (timeoutToxic Downstream) + timeoutToxic stream = Toxic + { toxicName = case stream of + Upstream -> "listener-timeout-upstream" + Downstream -> "listener-timeout-downstream" + , toxicType = Timeout + , toxicStream = stream + , toxicToxicity = 1 + , toxicAttributes = M.fromList [("timeout", 0)] + } + sec = 1_000_000 diff --git a/test/observability/Toxiproxy.hs b/test/observability/Toxiproxy.hs new file mode 100644 index 0000000000..cd4ff9acda --- /dev/null +++ b/test/observability/Toxiproxy.hs @@ -0,0 +1,347 @@ +{- +Copyright Jake Pittis (c) 2018 + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Author name here nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeOperators #-} +module Toxiproxy + ( getVersion + , postReset + , getProxies + , createProxy + , getProxy + , postPopulate + , updateProxy + , deleteProxy + , getToxics + , createToxic + , getToxic + , updateToxic + , deleteToxic + , Proxy(..) + , Toxic(..) + , Populate(..) + , Version(..) + , Stream(..) + , ToxicType(..) + , ProxyName(..) + , ToxicName(..) + , Host + , toxiproxyUrl + , withDisabled + , withToxic + , withProxy + , run + ) where + +import Control.Exception (bracket) +import Control.Monad (void) +import Data.Aeson (FromJSON, FromJSONKey, ToJSON, + Value (String), defaultOptions, + fieldLabelModifier, + genericParseJSON, genericToJSON, + parseJSON, toJSON) +import qualified Data.Char as Char (toLower) +import Data.List (stripPrefix) +import Data.Map.Strict (Map) +import qualified Data.Proxy as Proxy +import Data.String (IsString) +import Data.Text (Text) +import GHC.Generics +import Network.HTTP.Client (defaultManagerSettings, + newManager) +import Prelude +import Servant.API hiding (Host, Stream) +import Servant.Client + +type ToxiproxyAPI = + "version" :> Get '[PlainText] Version + :<|> "reset" :> Post '[] NoContent + :<|> "proxies" :> Get '[JSON] (Map ProxyName Proxy) + :<|> "proxies" :> ReqBody '[JSON] Proxy :> Post '[JSON] Proxy + :<|> "proxies" :> Capture "name" ProxyName :> Get '[JSON] Proxy + :<|> "populate" :> ReqBody '[JSON] [Proxy] :> Post '[JSON] Populate + :<|> "proxies" :> Capture "name" ProxyName :> ReqBody '[JSON] Proxy :> Post '[JSON] Proxy + :<|> "proxies" :> Capture "name" ProxyName :> Delete '[] NoContent + :<|> "proxies" :> Capture "name" ProxyName :> + "toxics" :> Get '[JSON] [Toxic] + :<|> "proxies" :> Capture "name" ProxyName :> + "toxics" :> ReqBody '[JSON] Toxic :> Post '[JSON] Toxic + :<|> "proxies" :> Capture "name" ProxyName :> + "toxics" :> Capture "name" ToxicName :> Get '[JSON] Toxic + :<|> "proxies" :> Capture "name" ProxyName :> + "toxics" :> Capture "name" ToxicName :> ReqBody '[JSON] Toxic :> Get '[JSON] Toxic + :<|> "proxies" :> Capture "name" ProxyName :> + "toxics" :> Capture "name" ToxicName :> Delete '[JSON] NoContent + +-- | A unique string for identifying a proxy on the server. +newtype ProxyName = ProxyName Text + deriving (Show, Eq, IsString, Ord, Generic, ToHttpApiData, FromJSONKey) + +instance FromJSON ProxyName +instance ToJSON ProxyName + +-- | A unique string for identifying a toxic on a proxy. +newtype ToxicName = ToxicName Text + deriving (Show, Eq, IsString, Generic, ToHttpApiData) + +instance FromJSON ToxicName +instance ToJSON ToxicName + +-- | The version of the Toxiproxy server. This library is fully supported by any version +-- greater or equal to 2.1.3. +newtype Version = Version Text + deriving (Show, Eq, MimeUnrender PlainText) + +-- | A Toxiproxy proxy. It forwards TCP connections between a listen and upstream host. +-- Toxics can be injected into the proxy to simulate network failure. +data Proxy = Proxy + { proxyName :: ProxyName + -- ^ A unique human readable name to identify a proxy. + , proxyListen :: Host + -- ^ The proxy listens on this host:port. + , proxyUpstream :: Host + -- ^ The proxy forwards to this upstream host:port. + , proxyEnabled :: Bool + -- ^ Whether a proxy is currently listening / accepting connections. + , proxyToxics :: [Toxic] + -- ^ The toxics currently applied to the proxy. These should not be specified when + -- initially creating a proxy. They must be created seperately with 'createToxic' + -- or 'withToxic'. + } deriving (Show, Eq, Generic) + +instance FromJSON Proxy where + parseJSON = genericParseJSON $ + defaultOptions + { fieldLabelModifier = stripPrefixJSON "proxy" } + +instance ToJSON Proxy where + toJSON = genericToJSON $ + defaultOptions + { fieldLabelModifier = stripPrefixJSON "proxy" } + +-- | A host:port pair to represent the entrence of a proxy or the upstream the proxy +-- forwards to. For the best experience, provide 127.0.0.1 instead of localhost. +type Host = Text + +-- | A toxic is applied to a proxy. It allows the user to simulate a specified kind of +-- network failure on the proxy. +data Toxic = Toxic + { toxicName :: ToxicName + -- ^ A unique human readable name to identify a toxic. + , toxicType :: ToxicType + -- ^ The type of toxic. For example "latency". Please refer to 'ToxicType' or the + -- Toxiproxy documentation for more information. + , toxicStream :: Stream + -- ^ The direction on which the toxic is applied. Please refer to 'Stream'. + , toxicToxicity :: Float + -- ^ The strength that the toxic is applied to the proxy. Please refer to the Toxiproxy + -- documation. + , toxicAttributes :: Map Text Int + -- ^ Attributes configure a toxic. They differ based on the 'ToxicType'. Please refer to + -- the Toxiproxy documentation. + } deriving (Show, Eq, Generic) + +instance FromJSON Toxic where + parseJSON = genericParseJSON $ + defaultOptions + { fieldLabelModifier = stripPrefixJSON "toxic" } + +instance ToJSON Toxic where + toJSON = genericToJSON $ + defaultOptions + { fieldLabelModifier = stripPrefixJSON "toxic" } + +-- | The return value of the 'populate' endpoint. +newtype Populate = Populate { populateProxies :: [Proxy] } + deriving (Show, Eq, Generic) + +instance FromJSON Populate where + parseJSON = genericParseJSON $ + defaultOptions + { fieldLabelModifier = stripPrefixJSON "populate" } + +-- | A toxic can be applied to the upstream or the downstream of a connection. Upstream is +-- the stream traveling from the connecting client to the upstream server. Downstream is +-- the stream traveling from the upstream server to the connecting client. +data Stream = Upstream | Downstream + deriving (Show, Eq) + +instance ToJSON Stream where + toJSON Upstream = String "upstream" + toJSON Downstream = String "downstream" + +instance FromJSON Stream where + parseJSON (String stream) = + case stream of + "upstream" -> return Upstream + "downstream" -> return Downstream + _ -> fail "must be either upstream or downstream" + parseJSON _ = fail "must be string" + +-- | Different toxic types simulate different kinds of failure. Different toxics require +-- different attribute configuration. Please refer to the Toxiproxy documentation. +data ToxicType = + Latency + | Bandwidth + | SlowClose + | Timeout + | Slicer + | LimitData + | Other Text + deriving (Show, Eq) + +instance ToJSON ToxicType where + toJSON Latency = String "latency" + toJSON Bandwidth = String "bandwidth" + toJSON SlowClose = String "slow_close" + toJSON Timeout = String "timeout" + toJSON Slicer = String "slicer" + toJSON LimitData = String "limit_data" + toJSON (Other other) = String other + +instance FromJSON ToxicType where + parseJSON (String tt) = + case tt of + "latency" -> return Latency + "bandwidth" -> return Bandwidth + "slow_clos" -> return SlowClose + "timeout" -> return Timeout + "slicer" -> return Slicer + "limit_dat" -> return LimitData + other -> return . Other $ other + parseJSON _ = fail "toxicType must be string" + +stripPrefixJSON :: String -> String -> String +stripPrefixJSON prefix str = + case stripPrefix prefix str of + Just (first : rest) -> Char.toLower first : rest + _ -> str + +toxiproxyAPI :: Proxy.Proxy ToxiproxyAPI +toxiproxyAPI = Proxy.Proxy + +-- | Returns the server version number. +getVersion :: ClientM Version +-- | Enable all proxies and remove all active toxics. +postReset :: ClientM NoContent +-- | List existing proxies and their toxics. +getProxies :: ClientM (Map ProxyName Proxy) +-- | Create a new proxy. +createProxy :: Proxy -> ClientM Proxy +-- | Get a proxy with all its active toxics. +getProxy :: ProxyName -> ClientM Proxy +-- | Create or replace a list of proxies. +postPopulate :: [Proxy] -> ClientM Populate +-- | Update a proxy's fields. +updateProxy :: ProxyName -> Proxy -> ClientM Proxy +-- | Delete an existing proxy. +deleteProxy :: ProxyName -> ClientM NoContent +-- | List active toxics. +getToxics :: ProxyName -> ClientM [Toxic] +-- | Create a new toxic. +createToxic :: ProxyName -> Toxic -> ClientM Toxic +-- | Get an active toxic's fields. +getToxic :: ProxyName -> ToxicName -> ClientM Toxic +-- | Update an active toxic. +updateToxic :: ProxyName -> ToxicName -> Toxic -> ClientM Toxic +-- | Remove an active toxic. +deleteToxic :: ProxyName -> ToxicName -> ClientM NoContent + +(getVersion :<|> postReset :<|> getProxies :<|> createProxy :<|> getProxy :<|> postPopulate + :<|> updateProxy :<|> deleteProxy :<|> getToxics :<|> createToxic :<|> getToxic + :<|> updateToxic :<|> deleteToxic) = client toxiproxyAPI + +-- | The default Toxiproxy service URL. +-- (127.0.0.1:8474) +toxiproxyUrl :: BaseUrl +toxiproxyUrl = BaseUrl Http "127.0.0.1" 8474 "" + +-- | A helper for easily querying the Toxiproxy API. Assumes Toxiproxy is running on +-- 'toxiproxyUrl'. +-- +-- @ +-- proxies <- run getProxies +-- @ +run :: ClientM a -> IO (Either ClientError a) +run f = do + mgr <- newManager defaultManagerSettings + runClientM f (mkClientEnv mgr toxiproxyUrl) + +-- | Given an enabled proxy, disable the proxy, run the given action and then re-enable +-- the proxy. +-- +-- This is useful for simulating a crashed server or closed connection. +-- +-- @ +-- connectToMyProxy -- This will connect. +-- withDisabled myProxy $ +-- connectToMyProxy -- This will get rejected. +-- connectToMyProxy -- This will connect again. +-- @ +withDisabled :: Proxy -> IO a -> IO a +withDisabled proxy f = + bracket disable enable $ const f + where + enable = const . run $ updateProxy (proxyName proxy) proxy + disable = void . run $ updateProxy (proxyName proxy) disabledProxy + disabledProxy = proxy { proxyEnabled = False } + +-- | Given a proxy and a toxic, create the toxic on the proxy, run the given action and +-- then delete the toxic. +-- +-- This is useful for running some action with a toxic enabled. +-- +-- @ +-- withToxic myProxy latencyToxic $ +-- sendRequestThroughProxy -- This request will have latency applied to it. +-- @ +withToxic :: Proxy -> Toxic -> IO a -> IO a +withToxic proxy toxic f = + bracket enable disable $ const f + where + enable = void . run $ createToxic (proxyName proxy) toxic + disable = const . run $ deleteToxic (proxyName proxy) (toxicName toxic) + +-- | Given a proxy record, create the proxy on the server, run the given action and then +-- delete the proxy off the server. +-- +-- This is useful for wrapping 'withDisabled' and 'withToxic' calls. It enures that your +-- test cleans up the Toxiproxy server so that proxies don't leak into your other tests. +withProxy :: Proxy -> (Proxy -> IO a) -> IO a +withProxy proxy = + bracket create delete + where + create = run (createProxy proxy) >> return proxy + delete = const . run $ deleteProxy (proxyName proxy)