diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +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. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,29 @@ +A complete Haskell client for [Toxiproxy](https://github.com/Shopify/toxiproxy). + +(Requires Toxiproxy version 2.1.3 and above.) + +## Example + +````haskell +import Toxiproxy + +main :: IO () +main = do + let proxy = Proxy + { proxyName = "myProxy" + , proxyListen = myProxyHost + , proxyUpstream = myUpstreamHost + , proxyEnabled = True + , proxyToxics = [] + } + let latency = Toxic + { toxicName = "latency" + , toxicType = "latency" + , toxicStream = "upstream" + , toxicToxicity = 1 + , toxicAttributes = Map.fromList [("latency", 1000), ("jitter", 0)] + } + withProxy proxy $ \proxy -> do + withToxic proxy latency $ do + getRequestToMyProxyHost -- This will take > 1 second +```` diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/src/Toxiproxy.hs b/src/Toxiproxy.hs new file mode 100644 --- /dev/null +++ b/src/Toxiproxy.hs @@ -0,0 +1,164 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE DeriveGeneric #-} +module Toxiproxy + ( getVersion + , postReset + , getProxies + , createProxy + , getProxy + , postPopulate + , updateProxy + , deleteProxy + , getToxics + , createToxic + , getToxic + , updateToxic + , deleteToxic + , Proxy(..) + , Toxic(..) + , Populate(..) + , toxiproxyUrl + , withDisabled + , withToxic + , withProxy + , run + , Version + ) where + +import Servant.API +import Servant.Client +import qualified Data.Proxy as Proxy +import Data.Text (Text) +import Data.List (stripPrefix) +import Data.Char (toLower) +import GHC.Generics +import Data.Aeson (FromJSON, parseJSON, fieldLabelModifier, defaultOptions, genericParseJSON, + ToJSON, genericToJSON, toJSON) +import Data.Map.Strict (Map) +import Network.HTTP.Client (newManager, defaultManagerSettings) +import Control.Exception (bracket) +import Control.Monad (void) + +type ToxiproxyAPI = + "version" :> Get '[PlainText] Version + :<|> "reset" :> Post '[] NoContent + :<|> "proxies" :> Get '[JSON] (Map Text Proxy) + :<|> "proxies" :> ReqBody '[JSON] Proxy :> Post '[JSON] Proxy + :<|> "proxies" :> Capture "name" Text :> Get '[JSON] Proxy + :<|> "populate" :> ReqBody '[JSON] [Proxy] :> Post '[JSON] Populate + :<|> "proxies" :> Capture "name" Text :> ReqBody '[JSON] Proxy :> Post '[JSON] Proxy + :<|> "proxies" :> Capture "name" Text :> Delete '[] NoContent + :<|> "proxies" :> Capture "name" Text :> + "toxics" :> Get '[JSON] [Toxic] + :<|> "proxies" :> Capture "name" Text :> + "toxics" :> ReqBody '[JSON] Toxic :> Post '[JSON] Toxic + :<|> "proxies" :> Capture "name" Text :> + "toxics" :> Capture "name" Text :> Get '[JSON] Toxic + :<|> "proxies" :> Capture "name" Text :> + "toxics" :> Capture "name" Text :> ReqBody '[JSON] Toxic :> Get '[JSON] Toxic + :<|> "proxies" :> Capture "name" Text :> + "toxics" :> Capture "name" Text :> Delete '[JSON] NoContent + +type Version = Text + +data Proxy = Proxy + { proxyName :: Text + , proxyListen :: Text + , proxyUpstream :: Text + , proxyEnabled :: Bool + , proxyToxics :: [Toxic] + } deriving (Show, Eq, Generic) + +instance FromJSON Proxy where + parseJSON = genericParseJSON $ + defaultOptions + { fieldLabelModifier = stripPrefixJSON "proxy" } + +instance ToJSON Proxy where + toJSON = genericToJSON $ + defaultOptions + { fieldLabelModifier = stripPrefixJSON "proxy" } + +data Toxic = Toxic + { toxicName :: Text + , toxicType :: Text + , toxicStream :: Text + , toxicToxicity :: Float + , toxicAttributes :: Map Text Int + } deriving (Show, Eq, Generic) + +instance FromJSON Toxic where + parseJSON = genericParseJSON $ + defaultOptions + { fieldLabelModifier = stripPrefixJSON "toxic" } + +instance ToJSON Toxic where + toJSON = genericToJSON $ + defaultOptions + { fieldLabelModifier = stripPrefixJSON "toxic" } + +newtype Populate = Populate { populateProxies :: [Proxy] } + deriving (Show, Eq, Generic) + +instance FromJSON Populate where + parseJSON = genericParseJSON $ + defaultOptions + { fieldLabelModifier = stripPrefixJSON "populate" } + +stripPrefixJSON :: String -> String -> String +stripPrefixJSON prefix str = + case stripPrefix prefix str of + Nothing -> str + Just (first : rest) -> toLower first : rest + +toxiproxyAPI :: Proxy.Proxy ToxiproxyAPI +toxiproxyAPI = Proxy.Proxy + +getVersion :: ClientM Version +postReset :: ClientM NoContent +getProxies :: ClientM (Map Text Proxy) +createProxy :: Proxy -> ClientM Proxy +getProxy :: Text -> ClientM Proxy +postPopulate :: [Proxy] -> ClientM Populate +updateProxy :: Text -> Proxy -> ClientM Proxy +deleteProxy :: Text -> ClientM NoContent +getToxics :: Text -> ClientM [Toxic] +createToxic :: Text -> Toxic -> ClientM Toxic +getToxic :: Text -> Text -> ClientM Toxic +updateToxic :: Text -> Text -> Toxic -> ClientM Toxic +deleteToxic :: Text -> Text -> ClientM NoContent + +(getVersion :<|> postReset :<|> getProxies :<|> createProxy :<|> getProxy :<|> postPopulate + :<|> updateProxy :<|> deleteProxy :<|> getToxics :<|> createToxic :<|> getToxic + :<|> updateToxic :<|> deleteToxic) = client toxiproxyAPI + +toxiproxyUrl :: BaseUrl +toxiproxyUrl = BaseUrl Http "127.0.0.1" 8474 "" + +run :: ClientM a -> IO (Either ServantError a) +run f = do + manager <- newManager defaultManagerSettings + runClientM f (ClientEnv manager toxiproxyUrl) + +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 } + +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) + +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) diff --git a/test/Spec.hs b/test/Spec.hs new file mode 100644 --- /dev/null +++ b/test/Spec.hs @@ -0,0 +1,147 @@ +{-# LANGUAGE OverloadedStrings #-} +module Main where + +import Test.Hspec + +import Servant.Client +import Servant.API +import qualified Data.Map.Strict as Map +import Control.Concurrent (threadDelay) +import System.Process (withCreateProcess, proc, CreateProcess) +import System.IO.Silently (silence) +import Network.HTTP.Client (newManager, defaultManagerSettings) +import Data.Either (isLeft) +import Data.Time.Clock.POSIX (getPOSIXTime) + +import Toxiproxy + +main :: IO () +main = hspec $ do + describe "Toxiproxy API" $ do + it "get version" $ + withToxiproxyServer $ + run getVersion `shouldReturn` Right version + it "post reset" $ + withToxiproxyServer $ + run postReset `shouldReturn` Right NoContent + it "create, update, get and delete a proxy" $ + withToxiproxyServer $ do + let name = "myProxy" + let proxy = Proxy + { proxyName = name + , proxyListen = "127.0.0.1:4444" + , proxyUpstream = "127.0.0.1:4445" + , proxyEnabled = False + , proxyToxics = [] + } + run (createProxy proxy) `shouldReturn` Right proxy + run getProxies `shouldReturn` Right (Map.fromList [(name, proxy)]) + run (getProxy name) `shouldReturn` Right proxy + let enabled = proxy { proxyEnabled = True } + run (updateProxy name enabled) `shouldReturn` Right enabled + run (deleteProxy name) `shouldReturn` Right NoContent + run getProxies `shouldReturn` Right Map.empty + it "populate proxies" $ + withToxiproxyServer $ do + let proxy1 = Proxy + { proxyName = "myProxy" + , proxyListen = "127.0.0.1:4444" + , proxyUpstream = "127.0.0.1:4445" + , proxyEnabled = False + , proxyToxics = [] + } + let proxy2 = Proxy + { proxyName = "myOtherProxy" + , proxyListen = "127.0.0.1:4446" + , proxyUpstream = "127.0.0.1:4447" + , proxyEnabled = False + , proxyToxics = [] + } + run (postPopulate [proxy1, proxy2]) `shouldReturn` Right (Populate [proxy1, proxy2]) + it "create get, update and delete toxic" $ + withToxiproxyServer $ do + let name = "myProxy" + let toxicName = "latency" + let toxic = Toxic + { toxicName = toxicName + , toxicType = toxicName + , toxicStream = "upstream" + , toxicToxicity = 1 + , toxicAttributes = Map.fromList [("latency", 1000), ("jitter", 0)] + } + let proxy = Proxy + { proxyName = name + , proxyListen = "127.0.0.1:4444" + , proxyUpstream = "127.0.0.1:4445" + , proxyEnabled = False + , proxyToxics = [] + } + let proxyWithToxic = proxy { proxyToxics = [toxic] } + let updatedToxic = + toxic { toxicAttributes = Map.fromList [("latency", 1000), ("jitter", 0)] } + run (createProxy proxy) `shouldReturn` Right proxy + run (createToxic name toxic) `shouldReturn` Right toxic + run (getToxics name) `shouldReturn` Right [toxic] + run (getProxy name) `shouldReturn` Right proxyWithToxic + run (updateToxic name toxicName updatedToxic) `shouldReturn` Right updatedToxic + run (deleteToxic name toxicName) `shouldReturn` Right NoContent + run (getToxics name) `shouldReturn` Right [] + describe "Toxiproxy Helpers" $ do + it "disabled temporarily using withDisabled" $ + withToxiproxyServer $ do + let proxy = Proxy + { proxyName = "myProxy" + , proxyListen = "127.0.0.1:4444" + , proxyUpstream = "127.0.0.1:8474" + , proxyEnabled = True + , proxyToxics = [] + } + withProxy proxy $ \proxy -> do + runThroughProxy getVersion `shouldReturn` Right version + withDisabled proxy $ do + resp <- runThroughProxy getVersion + isLeft resp `shouldBe` True + runThroughProxy getVersion `shouldReturn` Right version + it "has temporary toxic using withToxic" $ + withToxiproxyServer $ do + let proxy = Proxy + { proxyName = "myProxy" + , proxyListen = "127.0.0.1:4444" + , proxyUpstream = "127.0.0.1:8474" + , proxyEnabled = True + , proxyToxics = [] + } + let toxic = Toxic + { toxicName = "latency" + , toxicType = "latency" + , toxicStream = "upstream" + , toxicToxicity = 1 + , toxicAttributes = Map.fromList [("latency", 1000), ("jitter", 0)] + } + withProxy proxy $ \proxy -> do + runThroughProxy getVersion `shouldReturn` Right version + withToxic proxy toxic $ do + before <- getPOSIXTime + runThroughProxy getVersion `shouldReturn` Right version + after <- getPOSIXTime + after - before > 1 `shouldBe` True + runThroughProxy getVersion `shouldReturn` Right version + +withToxiproxyServer :: IO a -> IO a +withToxiproxyServer f = + silence $ + withCreateProcess server $ \_ _ _ _ -> threadDelay 100000 >> f + where + server :: CreateProcess + server = proc "toxiproxy-server" [] + +version :: Version +version = "git-fe6bf4f" + +proxyUrl :: BaseUrl +proxyUrl = BaseUrl Http "127.0.0.1" 4444 "" + +runThroughProxy :: ClientM a -> IO (Either ServantError a) +runThroughProxy f = do + manager <- newManager defaultManagerSettings + runClientM f (ClientEnv manager proxyUrl) diff --git a/toxiproxy-haskell.cabal b/toxiproxy-haskell.cabal new file mode 100644 --- /dev/null +++ b/toxiproxy-haskell.cabal @@ -0,0 +1,65 @@ +-- This file has been generated from package.yaml by hpack version 0.20.0. +-- +-- see: https://github.com/sol/hpack +-- +-- hash: 5cb73d2ae60bbc8465572da4b0035b5ad27b03f3c50e79f4af4eae94ab5783f3 + +name: toxiproxy-haskell +version: 0.1.0.0 +synopsis: Client library for Toxiproxy: a TCP failure testing proxy. +description: Please see the README on Github at +category: web +homepage: https://github.com/jpittis/toxiproxy-haskell#readme +bug-reports: https://github.com/jpittis/toxiproxy-haskell/issues +author: Jake Pittis +maintainer: jakepittis@gmail.com +copyright: 2018 Jake Pittis +license: BSD3 +license-file: LICENSE +build-type: Simple +cabal-version: >= 1.10 + +extra-source-files: + README.md + +source-repository head + type: git + location: https://github.com/jpittis/toxiproxy-haskell + +library + hs-source-dirs: + src + build-depends: + aeson + , base >=4.7 && <5 + , containers + , http-client + , servant + , servant-client + , text + exposed-modules: + Toxiproxy + other-modules: + Paths_toxiproxy_haskell + default-language: Haskell2010 + +test-suite toxiproxy-haskell-test + type: exitcode-stdio-1.0 + main-is: Spec.hs + hs-source-dirs: + test + ghc-options: -threaded -rtsopts -with-rtsopts=-N + build-depends: + base >=4.7 && <5 + , containers + , hspec + , http-client + , process + , servant + , servant-client + , silently + , time + , toxiproxy-haskell + other-modules: + Paths_toxiproxy_haskell + default-language: Haskell2010