├── .gitignore ├── LICENSE ├── README.md ├── Setup.hs ├── package.yaml ├── src └── Toxiproxy.hs ├── stack.yaml └── test └── Spec.hs /.gitignore: -------------------------------------------------------------------------------- 1 | .stack-work/ 2 | toxiproxy-haskell.cabal 3 | *~ -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright Jake Pittis (c) 2018 2 | 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above 12 | copyright notice, this list of conditions and the following 13 | disclaimer in the documentation and/or other materials provided 14 | with the distribution. 15 | 16 | * Neither the name of Author name here nor the names of other 17 | contributors may be used to endorse or promote products derived 18 | from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 31 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | A Haskell client for [Toxiproxy](https://github.com/Shopify/toxiproxy). 2 | 3 | (Requires Toxiproxy version 2.1.3 and above.) 4 | 5 | ## Example 6 | 7 | ````haskell 8 | import Toxiproxy 9 | 10 | main :: IO () 11 | main = do 12 | let proxy = Proxy 13 | { proxyName = "myProxy" 14 | , proxyListen = myProxyHost 15 | , proxyUpstream = myUpstreamHost 16 | , proxyEnabled = True 17 | , proxyToxics = [] 18 | } 19 | let latency = Toxic 20 | { toxicName = "latency" 21 | , toxicType = Latency 22 | , toxicStream = Upstream 23 | , toxicToxicity = 1 24 | , toxicAttributes = Map.fromList [("latency", 1000), ("jitter", 0)] 25 | } 26 | withProxy proxy $ \proxy -> 27 | withToxic proxy latency getRequestToMyProxyHost -- This will take > 1 second 28 | ```` 29 | -------------------------------------------------------------------------------- /Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /package.yaml: -------------------------------------------------------------------------------- 1 | name: toxiproxy-haskell 2 | version: 0.2.1.0 3 | github: "jpittis/toxiproxy-haskell" 4 | license: BSD3 5 | author: "Jake Pittis" 6 | maintainer: "jakepittis@gmail.com" 7 | copyright: "2018 Jake Pittis" 8 | category: web 9 | synopsis: "Client library for Toxiproxy: a TCP failure testing proxy." 10 | 11 | extra-source-files: 12 | - README.md 13 | 14 | description: Please see the README on Github at 15 | 16 | dependencies: 17 | - base >= 4.7 && < 5 18 | 19 | library: 20 | source-dirs: src 21 | dependencies: 22 | - servant 23 | - text 24 | - servant-client 25 | - aeson 26 | - containers 27 | - http-client 28 | 29 | tests: 30 | toxiproxy-haskell-test: 31 | main: Spec.hs 32 | source-dirs: test 33 | ghc-options: 34 | - -threaded 35 | - -rtsopts 36 | - -with-rtsopts=-N 37 | dependencies: 38 | - toxiproxy-haskell 39 | - hspec 40 | - servant-client 41 | - servant 42 | - http-client 43 | - containers 44 | - process 45 | - silently 46 | - time 47 | -------------------------------------------------------------------------------- /src/Toxiproxy.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DataKinds #-} 2 | {-# LANGUAGE TypeOperators #-} 3 | {-# LANGUAGE DeriveGeneric #-} 4 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} 5 | {-# LANGUAGE OverloadedStrings #-} 6 | module Toxiproxy 7 | ( getVersion 8 | , postReset 9 | , getProxies 10 | , createProxy 11 | , getProxy 12 | , postPopulate 13 | , updateProxy 14 | , deleteProxy 15 | , getToxics 16 | , createToxic 17 | , getToxic 18 | , updateToxic 19 | , deleteToxic 20 | , Proxy(..) 21 | , Toxic(..) 22 | , Populate(..) 23 | , Version(..) 24 | , Stream(..) 25 | , ToxicType(..) 26 | , ProxyName(..) 27 | , ToxicName(..) 28 | , Host 29 | , toxiproxyUrl 30 | , withDisabled 31 | , withToxic 32 | , withProxy 33 | , run 34 | ) where 35 | 36 | import Servant.API 37 | import Servant.Client 38 | import qualified Data.Proxy as Proxy 39 | import Data.Text (Text, pack, toLower, unpack) 40 | import Data.List (stripPrefix) 41 | import qualified Data.Char as Char (toLower) 42 | import GHC.Generics 43 | import Data.Aeson (FromJSON, parseJSON, fieldLabelModifier, defaultOptions, genericParseJSON, 44 | ToJSON, genericToJSON, toJSON, FromJSONKey, Value( String )) 45 | import Data.Map.Strict (Map) 46 | import Network.HTTP.Client (newManager, defaultManagerSettings) 47 | import Control.Exception (bracket) 48 | import Control.Monad (void) 49 | import Data.String (IsString) 50 | 51 | type ToxiproxyAPI = 52 | "version" :> Get '[PlainText] Version 53 | :<|> "reset" :> Post '[] NoContent 54 | :<|> "proxies" :> Get '[JSON] (Map ProxyName Proxy) 55 | :<|> "proxies" :> ReqBody '[JSON] Proxy :> Post '[JSON] Proxy 56 | :<|> "proxies" :> Capture "name" ProxyName :> Get '[JSON] Proxy 57 | :<|> "populate" :> ReqBody '[JSON] [Proxy] :> Post '[JSON] Populate 58 | :<|> "proxies" :> Capture "name" ProxyName :> ReqBody '[JSON] Proxy :> Post '[JSON] Proxy 59 | :<|> "proxies" :> Capture "name" ProxyName :> Delete '[] NoContent 60 | :<|> "proxies" :> Capture "name" ProxyName :> 61 | "toxics" :> Get '[JSON] [Toxic] 62 | :<|> "proxies" :> Capture "name" ProxyName :> 63 | "toxics" :> ReqBody '[JSON] Toxic :> Post '[JSON] Toxic 64 | :<|> "proxies" :> Capture "name" ProxyName :> 65 | "toxics" :> Capture "name" ToxicName :> Get '[JSON] Toxic 66 | :<|> "proxies" :> Capture "name" ProxyName :> 67 | "toxics" :> Capture "name" ToxicName :> ReqBody '[JSON] Toxic :> Get '[JSON] Toxic 68 | :<|> "proxies" :> Capture "name" ProxyName :> 69 | "toxics" :> Capture "name" ToxicName :> Delete '[JSON] NoContent 70 | 71 | -- | A unique string for identifying a proxy on the server. 72 | newtype ProxyName = ProxyName Text 73 | deriving (Show, Eq, IsString, Ord, Generic, ToHttpApiData, FromJSONKey) 74 | 75 | instance FromJSON ProxyName 76 | instance ToJSON ProxyName 77 | 78 | -- | A unique string for identifying a toxic on a proxy. 79 | newtype ToxicName = ToxicName Text 80 | deriving (Show, Eq, IsString, Generic, ToHttpApiData) 81 | 82 | instance FromJSON ToxicName 83 | instance ToJSON ToxicName 84 | 85 | -- | The version of the Toxiproxy server. This library is fully supported by any version 86 | -- greater or equal to 2.1.3. 87 | newtype Version = Version Text 88 | deriving (Show, Eq, MimeUnrender PlainText) 89 | 90 | -- | A Toxiproxy proxy. It forwards TCP connections between a listen and upstream host. 91 | -- Toxics can be injected into the proxy to simulate network failure. 92 | data Proxy = Proxy 93 | { proxyName :: ProxyName 94 | -- ^ A unique human readable name to identify a proxy. 95 | , proxyListen :: Host 96 | -- ^ The proxy listens on this host:port. 97 | , proxyUpstream :: Host 98 | -- ^ The proxy forwards to this upstream host:port. 99 | , proxyEnabled :: Bool 100 | -- ^ Whether a proxy is currently listening / accepting connections. 101 | , proxyToxics :: [Toxic] 102 | -- ^ The toxics currently applied to the proxy. These should not be specified when 103 | -- initially creating a proxy. They must be created seperately with 'createToxic' 104 | -- or 'withToxic'. 105 | } deriving (Show, Eq, Generic) 106 | 107 | instance FromJSON Proxy where 108 | parseJSON = genericParseJSON $ 109 | defaultOptions 110 | { fieldLabelModifier = stripPrefixJSON "proxy" } 111 | 112 | instance ToJSON Proxy where 113 | toJSON = genericToJSON $ 114 | defaultOptions 115 | { fieldLabelModifier = stripPrefixJSON "proxy" } 116 | 117 | -- | A host:port pair to represent the entrence of a proxy or the upstream the proxy 118 | -- forwards to. For the best experience, provide 127.0.0.1 instead of localhost. 119 | type Host = Text 120 | 121 | -- | A toxic is applied to a proxy. It allows the user to simulate a specified kind of 122 | -- network failure on the proxy. 123 | data Toxic = Toxic 124 | { toxicName :: ToxicName 125 | -- ^ A unique human readable name to identify a toxic. 126 | , toxicType :: ToxicType 127 | -- ^ The type of toxic. For example "latency". Please refer to 'ToxicType' or the 128 | -- Toxiproxy documentation for more information. 129 | , toxicStream :: Stream 130 | -- ^ The direction on which the toxic is applied. Please refer to 'Stream'. 131 | , toxicToxicity :: Float 132 | -- ^ The strength that the toxic is applied to the proxy. Please refer to the Toxiproxy 133 | -- documation. 134 | , toxicAttributes :: Map Text Int 135 | -- ^ Attributes configure a toxic. They differ based on the 'ToxicType'. Please refer to 136 | -- the Toxiproxy documentation. 137 | } deriving (Show, Eq, Generic) 138 | 139 | instance FromJSON Toxic where 140 | parseJSON = genericParseJSON $ 141 | defaultOptions 142 | { fieldLabelModifier = stripPrefixJSON "toxic" } 143 | 144 | instance ToJSON Toxic where 145 | toJSON = genericToJSON $ 146 | defaultOptions 147 | { fieldLabelModifier = stripPrefixJSON "toxic" } 148 | 149 | -- | The return value of the 'populate' endpoint. 150 | newtype Populate = Populate { populateProxies :: [Proxy] } 151 | deriving (Show, Eq, Generic) 152 | 153 | instance FromJSON Populate where 154 | parseJSON = genericParseJSON $ 155 | defaultOptions 156 | { fieldLabelModifier = stripPrefixJSON "populate" } 157 | 158 | -- | A toxic can be applied to the upstream or the downstream of a connection. Upstream is 159 | -- the stream traveling from the connecting client to the upstream server. Downstream is 160 | -- the stream traveling from the upstream server to the connecting client. 161 | data Stream = Upstream | Downstream 162 | deriving (Show, Eq) 163 | 164 | instance ToJSON Stream where 165 | toJSON Upstream = String "upstream" 166 | toJSON Downstream = String "downstream" 167 | 168 | instance FromJSON Stream where 169 | parseJSON (String stream) = 170 | case stream of 171 | "upstream" -> return Upstream 172 | "downstream" -> return Downstream 173 | 174 | -- | Different toxic types simulate different kinds of failure. Different toxics require 175 | -- different attribute configuration. Please refer to the Toxiproxy documentation. 176 | data ToxicType = 177 | Latency 178 | | Bandwidth 179 | | SlowClose 180 | | Timeout 181 | | Slicer 182 | | LimitData 183 | | Other Text 184 | deriving (Show, Eq) 185 | 186 | instance ToJSON ToxicType where 187 | toJSON Latency = String "latency" 188 | toJSON Bandwidth = String "bandwidth" 189 | toJSON SlowClose = String "slow_close" 190 | toJSON Timeout = String "timeout" 191 | toJSON Slicer = String "slicer" 192 | toJSON LimitData = String "limit_data" 193 | toJSON (Other other) = String other 194 | 195 | instance FromJSON ToxicType where 196 | parseJSON (String toxicType) = 197 | case toxicType of 198 | "latency" -> return Latency 199 | "bandwidth" -> return Bandwidth 200 | "slow_clos" -> return SlowClose 201 | "timeout" -> return Timeout 202 | "slicer" -> return Slicer 203 | "limit_dat" -> return LimitData 204 | other -> return . Other $ other 205 | 206 | stripPrefixJSON :: String -> String -> String 207 | stripPrefixJSON prefix str = 208 | case stripPrefix prefix str of 209 | Nothing -> str 210 | Just (first : rest) -> Char.toLower first : rest 211 | 212 | toxiproxyAPI :: Proxy.Proxy ToxiproxyAPI 213 | toxiproxyAPI = Proxy.Proxy 214 | 215 | -- | Returns the server version number. 216 | getVersion :: ClientM Version 217 | -- | Enable all proxies and remove all active toxics. 218 | postReset :: ClientM NoContent 219 | -- | List existing proxies and their toxics. 220 | getProxies :: ClientM (Map ProxyName Proxy) 221 | -- | Create a new proxy. 222 | createProxy :: Proxy -> ClientM Proxy 223 | -- | Get a proxy with all its active toxics. 224 | getProxy :: ProxyName -> ClientM Proxy 225 | -- | Create or replace a list of proxies. 226 | postPopulate :: [Proxy] -> ClientM Populate 227 | -- | Update a proxy's fields. 228 | updateProxy :: ProxyName -> Proxy -> ClientM Proxy 229 | -- | Delete an existing proxy. 230 | deleteProxy :: ProxyName -> ClientM NoContent 231 | -- | List active toxics. 232 | getToxics :: ProxyName -> ClientM [Toxic] 233 | -- | Create a new toxic. 234 | createToxic :: ProxyName -> Toxic -> ClientM Toxic 235 | -- | Get an active toxic's fields. 236 | getToxic :: ProxyName -> ToxicName -> ClientM Toxic 237 | -- | Update an active toxic. 238 | updateToxic :: ProxyName -> ToxicName -> Toxic -> ClientM Toxic 239 | -- | Remove an active toxic. 240 | deleteToxic :: ProxyName -> ToxicName -> ClientM NoContent 241 | 242 | (getVersion :<|> postReset :<|> getProxies :<|> createProxy :<|> getProxy :<|> postPopulate 243 | :<|> updateProxy :<|> deleteProxy :<|> getToxics :<|> createToxic :<|> getToxic 244 | :<|> updateToxic :<|> deleteToxic) = client toxiproxyAPI 245 | 246 | -- | The default Toxiproxy service URL. 247 | -- (127.0.0.1:8474) 248 | toxiproxyUrl :: BaseUrl 249 | toxiproxyUrl = BaseUrl Http "127.0.0.1" 8474 "" 250 | 251 | -- | A helper for easily querying the Toxiproxy API. Assumes Toxiproxy is running on 252 | -- 'toxiproxyUrl'. 253 | -- 254 | -- @ 255 | -- proxies <- run getProxies 256 | -- @ 257 | run :: ClientM a -> IO (Either ServantError a) 258 | run f = do 259 | manager <- newManager defaultManagerSettings 260 | runClientM f (ClientEnv manager toxiproxyUrl) 261 | 262 | -- | Given an enabled proxy, disable the proxy, run the given action and then re-enable 263 | -- the proxy. 264 | -- 265 | -- This is useful for simulating a crashed server or closed connection. 266 | -- 267 | -- @ 268 | -- connectToMyProxy -- This will connect. 269 | -- withDisabled myProxy $ 270 | -- connectToMyProxy -- This will get rejected. 271 | -- connectToMyProxy -- This will connect again. 272 | -- @ 273 | withDisabled :: Proxy -> IO a -> IO a 274 | withDisabled proxy f = 275 | bracket disable enable $ const f 276 | where 277 | enable = const . run $ updateProxy (proxyName proxy) proxy 278 | disable = void . run $ updateProxy (proxyName proxy) disabledProxy 279 | disabledProxy = proxy { proxyEnabled = False } 280 | 281 | -- | Given a proxy and a toxic, create the toxic on the proxy, run the given action and 282 | -- then delete the toxic. 283 | -- 284 | -- This is useful for running some action with a toxic enabled. 285 | -- 286 | -- @ 287 | -- withToxic myProxy latencyToxic $ 288 | -- sendRequestThroughProxy -- This request will have latency applied to it. 289 | -- @ 290 | withToxic :: Proxy -> Toxic -> IO a -> IO a 291 | withToxic proxy toxic f = 292 | bracket enable disable $ const f 293 | where 294 | enable = void . run $ createToxic (proxyName proxy) toxic 295 | disable = const . run $ deleteToxic (proxyName proxy) (toxicName toxic) 296 | 297 | -- | Given a proxy record, create the proxy on the server, run the given action and then 298 | -- delete the proxy off the server. 299 | -- 300 | -- This is useful for wrapping 'withDisabled' and 'withToxic' calls. It enures that your 301 | -- test cleans up the Toxiproxy server so that proxies don't leak into your other tests. 302 | withProxy :: Proxy -> (Proxy -> IO a) -> IO a 303 | withProxy proxy = 304 | bracket create delete 305 | where 306 | create = run (createProxy proxy) >> return proxy 307 | delete = const . run $ deleteProxy (proxyName proxy) 308 | -------------------------------------------------------------------------------- /stack.yaml: -------------------------------------------------------------------------------- 1 | # This file was automatically generated by 'stack init' 2 | # 3 | # Some commonly used options have been documented as comments in this file. 4 | # For advanced use and comprehensive documentation of the format, please see: 5 | # https://docs.haskellstack.org/en/stable/yaml_configuration/ 6 | 7 | # Resolver to choose a 'specific' stackage snapshot or a compiler version. 8 | # A snapshot resolver dictates the compiler version and the set of packages 9 | # to be used for project dependencies. For example: 10 | # 11 | # resolver: lts-3.5 12 | # resolver: nightly-2015-09-21 13 | # resolver: ghc-7.10.2 14 | # resolver: ghcjs-0.1.0_ghc-7.10.2 15 | # resolver: 16 | # name: custom-snapshot 17 | # location: "./custom-snapshot.yaml" 18 | resolver: lts-10.8 19 | 20 | # User packages to be built. 21 | # Various formats can be used as shown in the example below. 22 | # 23 | # packages: 24 | # - some-directory 25 | # - https://example.com/foo/bar/baz-0.0.2.tar.gz 26 | # - location: 27 | # git: https://github.com/commercialhaskell/stack.git 28 | # commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a 29 | # - location: https://github.com/commercialhaskell/stack/commit/e7b331f14bcffb8367cd58fbfc8b40ec7642100a 30 | # extra-dep: true 31 | # subdirs: 32 | # - auto-update 33 | # - wai 34 | # 35 | # A package marked 'extra-dep: true' will only be built if demanded by a 36 | # non-dependency (i.e. a user package), and its test suites and benchmarks 37 | # will not be run. This is useful for tweaking upstream packages. 38 | packages: 39 | - . 40 | # Dependency packages to be pulled from upstream that are not in the resolver 41 | # (e.g., acme-missiles-0.3) 42 | # extra-deps: [] 43 | 44 | # Override default flag values for local packages and extra-deps 45 | # flags: {} 46 | 47 | # Extra package databases containing global packages 48 | # extra-package-dbs: [] 49 | 50 | # Control whether we use the GHC we find on the path 51 | # system-ghc: true 52 | # 53 | # Require a specific version of stack, using version ranges 54 | # require-stack-version: -any # Default 55 | # require-stack-version: ">=1.6" 56 | # 57 | # Override the architecture used by stack, especially useful on Windows 58 | # arch: i386 59 | # arch: x86_64 60 | # 61 | # Extra directories used by stack for building 62 | # extra-include-dirs: [/path/to/dir] 63 | # extra-lib-dirs: [/path/to/dir] 64 | # 65 | # Allow a newer minor version of GHC than the snapshot specifies 66 | # compiler-check: newer-minor 67 | -------------------------------------------------------------------------------- /test/Spec.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | module Main where 3 | 4 | import Test.Hspec 5 | 6 | import Servant.Client 7 | import Servant.API 8 | import qualified Data.Map.Strict as Map 9 | import Control.Concurrent (threadDelay) 10 | import System.Process (withCreateProcess, proc, CreateProcess) 11 | import System.IO.Silently (silence) 12 | import Network.HTTP.Client (newManager, defaultManagerSettings) 13 | import Data.Either (isLeft) 14 | import Data.Time.Clock.POSIX (getPOSIXTime) 15 | 16 | import Toxiproxy 17 | 18 | main :: IO () 19 | main = hspec $ do 20 | describe "Toxiproxy API" $ do 21 | it "get version" $ 22 | withToxiproxyServer $ 23 | run getVersion `shouldReturn` Right version 24 | it "post reset" $ 25 | withToxiproxyServer $ 26 | run postReset `shouldReturn` Right NoContent 27 | it "create, update, get and delete a proxy" $ 28 | withToxiproxyServer $ do 29 | let name = "myProxy" 30 | let proxy = Proxy 31 | { proxyName = name 32 | , proxyListen = "127.0.0.1:4444" 33 | , proxyUpstream = "127.0.0.1:4445" 34 | , proxyEnabled = False 35 | , proxyToxics = [] 36 | } 37 | run (createProxy proxy) `shouldReturn` Right proxy 38 | run getProxies `shouldReturn` Right (Map.fromList [(name, proxy)]) 39 | run (getProxy name) `shouldReturn` Right proxy 40 | let enabled = proxy { proxyEnabled = True } 41 | run (updateProxy name enabled) `shouldReturn` Right enabled 42 | run (deleteProxy name) `shouldReturn` Right NoContent 43 | run getProxies `shouldReturn` Right Map.empty 44 | it "populate proxies" $ 45 | withToxiproxyServer $ do 46 | let proxy1 = Proxy 47 | { proxyName = "myProxy" 48 | , proxyListen = "127.0.0.1:4444" 49 | , proxyUpstream = "127.0.0.1:4445" 50 | , proxyEnabled = False 51 | , proxyToxics = [] 52 | } 53 | let proxy2 = Proxy 54 | { proxyName = "myOtherProxy" 55 | , proxyListen = "127.0.0.1:4446" 56 | , proxyUpstream = "127.0.0.1:4447" 57 | , proxyEnabled = False 58 | , proxyToxics = [] 59 | } 60 | run (postPopulate [proxy1, proxy2]) `shouldReturn` Right (Populate [proxy1, proxy2]) 61 | it "create get, update and delete toxic" $ 62 | withToxiproxyServer $ do 63 | let name = "myProxy" 64 | let toxicName = "latency" 65 | let toxic = Toxic 66 | { toxicName = toxicName 67 | , toxicType = Latency 68 | , toxicStream = Upstream 69 | , toxicToxicity = 1 70 | , toxicAttributes = Map.fromList [("latency", 1000), ("jitter", 0)] 71 | } 72 | let proxy = Proxy 73 | { proxyName = name 74 | , proxyListen = "127.0.0.1:4444" 75 | , proxyUpstream = "127.0.0.1:4445" 76 | , proxyEnabled = False 77 | , proxyToxics = [] 78 | } 79 | let proxyWithToxic = proxy { proxyToxics = [toxic] } 80 | let updatedToxic = 81 | toxic { toxicAttributes = Map.fromList [("latency", 1000), ("jitter", 0)] } 82 | run (createProxy proxy) `shouldReturn` Right proxy 83 | run (createToxic name toxic) `shouldReturn` Right toxic 84 | run (getToxics name) `shouldReturn` Right [toxic] 85 | run (getProxy name) `shouldReturn` Right proxyWithToxic 86 | run (updateToxic name toxicName updatedToxic) `shouldReturn` Right updatedToxic 87 | run (deleteToxic name toxicName) `shouldReturn` Right NoContent 88 | run (getToxics name) `shouldReturn` Right [] 89 | describe "Toxiproxy Helpers" $ do 90 | it "disabled temporarily using withDisabled" $ 91 | withToxiproxyServer $ do 92 | let proxy = Proxy 93 | { proxyName = "myProxy" 94 | , proxyListen = "127.0.0.1:4444" 95 | , proxyUpstream = "127.0.0.1:8474" 96 | , proxyEnabled = True 97 | , proxyToxics = [] 98 | } 99 | withProxy proxy $ \proxy -> do 100 | runThroughProxy getVersion `shouldReturn` Right version 101 | withDisabled proxy $ do 102 | resp <- runThroughProxy getVersion 103 | isLeft resp `shouldBe` True 104 | runThroughProxy getVersion `shouldReturn` Right version 105 | it "has temporary toxic using withToxic" $ 106 | withToxiproxyServer $ do 107 | let proxy = Proxy 108 | { proxyName = "myProxy" 109 | , proxyListen = "127.0.0.1:4444" 110 | , proxyUpstream = "127.0.0.1:8474" 111 | , proxyEnabled = True 112 | , proxyToxics = [] 113 | } 114 | let toxic = Toxic 115 | { toxicName = "latency" 116 | , toxicType = Latency 117 | , toxicStream = Upstream 118 | , toxicToxicity = 1 119 | , toxicAttributes = Map.fromList [("latency", 1000), ("jitter", 0)] 120 | } 121 | withProxy proxy $ \proxy -> do 122 | runThroughProxy getVersion `shouldReturn` Right version 123 | withToxic proxy toxic $ do 124 | before <- getPOSIXTime 125 | runThroughProxy getVersion `shouldReturn` Right version 126 | after <- getPOSIXTime 127 | after - before > 1 `shouldBe` True 128 | runThroughProxy getVersion `shouldReturn` Right version 129 | 130 | withToxiproxyServer :: IO a -> IO a 131 | withToxiproxyServer f = 132 | silence $ 133 | withCreateProcess server $ \_ _ _ _ -> threadDelay 100000 >> f 134 | where 135 | server :: CreateProcess 136 | server = proc "toxiproxy-server" [] 137 | 138 | version :: Version 139 | version = Version "git-fe6bf4f" 140 | 141 | proxyUrl :: BaseUrl 142 | proxyUrl = BaseUrl Http "127.0.0.1" 4444 "" 143 | 144 | runThroughProxy :: ClientM a -> IO (Either ServantError a) 145 | runThroughProxy f = do 146 | manager <- newManager defaultManagerSettings 147 | runClientM f (ClientEnv manager proxyUrl) 148 | --------------------------------------------------------------------------------