curl-runnings 0.6.0 → 0.9.2
raw patch · 12 files changed
+807/−316 lines, 12 filesdep +pretty-simpledep +regex-posixdep +tardep −aeson-pretty
Dependencies added: pretty-simple, regex-posix, tar, zlib
Dependencies removed: aeson-pretty
Files
- README.md +60/−31
- app/Main.hs +151/−11
- curl-runnings.cabal +13/−6
- examples/example-spec.json +42/−2
- examples/example-spec.yaml +108/−75
- examples/importable.yaml +4/−0
- examples/interpolation-spec.yaml +66/−42
- src/Testing/CurlRunnings.hs +181/−70
- src/Testing/CurlRunnings/Internal.hs +36/−21
- src/Testing/CurlRunnings/Internal/Parser.hs +20/−7
- src/Testing/CurlRunnings/Types.hs +95/−39
- test/Spec.hs +31/−12
README.md view
@@ -1,6 +1,6 @@ # curl-runnings -[](https://travis-ci.org/aviaviavi/curl-runnings)+[](https://travis-ci.org/aviaviavi/curl-runnings) [](https://hackage.haskell.org/package/curl-runnings) _Feel the rhythm! Feel the rhyme! Get on up, it's testing time! curl-runnings!_ @@ -10,17 +10,22 @@ against responses. Alternatively, you can use the curl-runnings library to write your tests in-Haskell (though a haskell setup is absolutely not required to use this tool).+Haskell (though a Haskell setup is absolutely not required to use this tool). ### Why? -When writing curl based smoke/integration tests for APIs using bash and `curl`-is very convenient, but quickly becomes hard to maintain. Writing matchers for-json output quickly becomes unweildy and error prone. Writing these sorts of-tests in a more traditional programming language is fine, but certainly more-time consuming to write than some simple curl requests. curl-runnings aims to-make it very easy to write tests that just hit some endpoints and verify the-output looks sane.+This library came out of a pain-point my coworkers at+[DotDashPay](https://dotdashpay.com) and I were running into during development:+Writing integration tests for our APIs was generally annoying. They were time+consuming to write especially considering how basic they were, and we are a+small startup where developer time is in short supply. Over time, we found+ourselves sometimes just writing bash scripts that would `curl` our various+endpoints and check the output with very basic matchers. These tests were fast+to write, but quickly became difficult to maintain as complexity was added. Not+only did maintenance become challenging, but the whole system was very error prone+and confidence in the tests overall was decreasing. At the end of the day, we+needed to just curl some endpoints and verify the output looks sane, and do this+quickly and correctly. This is precisely the goal of curl-runnings. Now you can write your tests just as data in a yaml or json file, and curl-runnings will take care of the rest!@@ -28,52 +33,76 @@ While yaml/json is the current way to write curl-runnings tests, this project is being built in a way that should lend itself well to an embedded domain specific language, which is a future goal for the project. curl-runnings specs in Dhall-is also being developed and may fufill the same needs.+is also being developed and may fulfill the same needs. ### Installing There are few options to install: -- download the releases from the+- download the Linux or Mac built releases from the github [releases page](https://github.com/aviaviavi/curl-runnings/releases) - install the binary with `stack` or `cabal` - build from source with `stack` ### Writing a test specification -Write your tests specs in a yaml or json file. See /examples to get-started. A test spec is a top level array of test cases, each item represents a-single curl and set of assertions about the response.+Curl runnings tests are just data! A test spec is an object containing an array+of `cases`, where each item represents a single curl and set of assertions about+the response. Write your tests specs in a yaml or json file. Note: the legacy+format of a top level array of test cases is still supported, but may not be in+future releases. ++```yaml+---+# example-test.yaml+#+# specify all your test cases as an array keys on `cases`+cases:+ - name: A curl runnings test case+ url: http://your-endpoint.com/status+ requestMethod: GET+ # Specify the json payload we expect here+ expectData:+ # The 1 key in this object specifies the matcher we want+ # to use to test the returned payload. In this case, we+ # require the payload is exactly what we specify.+ exactly:+ okay: true+ msg: 'a message'+ # Assertions about the returned status code. Pass in+ # an acceptable code or list of codes+ expectStatus: 200++```++See /examples for more example curl runnings specifications, which walk+through some of the other features that can be encoded in your tests such as:+- reference data from previous responses of previous test cases+- reference environment variables+- various easy-to-use json matchers+- support for importing data from other yaml files in your spec+ ### Running Once you've written a spec, simply run it with: -```bash $ curl-runnings -f path/to/your/spec.yaml ```+```curl-runnings -f path/to/your/spec.yaml ``` +(hint: try using the --verbose flag for more output)+ If all your tests pass, curl-runnings will cleanly exit with a 0 code. A code of 1 will be returned if any tests failed. +You can also select specific test cases by filtering via regex by using the+`--grep` flag. Just make sure your case isn't referencing data from previous+examples that won't get run!+ For more info: -```bash $ curl-runnings --help ```+```curl-runnings --help ``` ### Contributing -Curl-runnings is totally usable now but is also being actively developed. Contributions in any form are welcome and encouraged. Don't be shy! :D -### Roadmap--- [x] Json specifications for tests-- [x] Yaml specifications for tests-- [ ] Dhall specifications for tests-- [ ] More specification features- - [x] Reference values from previous json responses in matchers- - [x] Environment variable interpolation- - [ ] Call out to arbitrary shell commands in and between test cases- - [ ] Timeouts- - [ ] Support for non-json content type- - [ ] Retry logic-- [ ] A DSL for writing test specs-
app/Main.hs view
@@ -1,48 +1,186 @@ {-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE OverloadedStrings #-} module Main where +import qualified Codec.Archive.Tar as Tar+import qualified Codec.Compression.GZip as GZ+import Control.Monad+import Data.Aeson+import qualified Data.ByteString.Lazy as B+import Data.List+import qualified Data.List.NonEmpty as NE+import Data.Maybe+import Data.Monoid import qualified Data.Text as T import Data.Version (showVersion)+import GHC.Generics+import Network.HTTP.Conduit+import Network.HTTP.Simple import Paths_curl_runnings (version) import System.Console.CmdArgs+import System.Directory import System.Environment import System.Exit+import System.Info import Testing.CurlRunnings import Testing.CurlRunnings.Internal import Testing.CurlRunnings.Types -- | Command line flags data CurlRunnings = CurlRunnings- { file :: FilePath+ { file :: FilePath+ , grep :: Maybe T.Text+ , upgrade :: Bool } deriving (Show, Data, Typeable, Eq) -- | cmdargs object argParser :: CurlRunnings argParser =- CurlRunnings {file = def &= typFile &= help "File to run"} &=+ CurlRunnings+ { file = def &= typFile &= help "File to run"+ , grep = def &= help "Regex to filter test cases by name"+ , upgrade = def &= help "Pull the latest version of curl runnings"+ } &= summary ("curl-runnings " ++ showVersion version) &= program "curl-runnings" &= verbosity &= help "Use the --file or -f flag to specify an intput file spec to run" -runFile :: FilePath -> Verbosity -> IO ()-runFile "" _ =+-- | A single release asset in a github release. Eg curl-runnings-${version}.tar.gz+data GithubReleaseAsset = GithubReleaseAsset+ { name :: T.Text+ , browser_download_url :: T.Text -- snake case because that's what we get back from github+ } deriving (Show, Generic)++instance FromJSON GithubReleaseAsset++-- | The json response we expect from github when we check for the latest release+data GithubRelease = GithubRelease+ { assets :: [GithubReleaseAsset]+ , tag_name :: T.Text -- snake case because that's what we get back from github+ } deriving (Show, Generic)+instance FromJSON GithubRelease++newtype GithubReleasesResponse =+ GithubReleasesResponse (NE.NonEmpty GithubRelease)+ deriving (Show, Generic)+instance FromJSON GithubReleasesResponse++-- | Github requires a user agent, preferably with a username+setGithubReqHeaders :: Request -> Request+setGithubReqHeaders = setRequestHeaders [("User-Agent", "aviaviavi")]++runFile :: FilePath -> Verbosity -> Maybe T.Text -> IO ()+runFile "" _ _ = putStrLn "Please specify an input file with the --file (-f) flag or use --help for more information"-runFile path verbosityLevel = do+runFile path verbosityLevel regexp = do home <- getEnv "HOME" suite <- decodeFile . T.unpack $ T.replace "~" (T.pack home) (T.pack path) case suite of Right s -> do- results <- runSuite s $ toLogLevel verbosityLevel+ results <-+ runSuite (s {suiteCaseFilter = regexp}) $ toLogLevel verbosityLevel if any isFailing results- then putStrLn (makeRed "Some tests failed") >> exitWith (ExitFailure 1)- else putStrLn $ makeGreen "All tests passed!"- Left messgage ->- putStrLn . makeRed $ "Couldn't read input json or yaml file: " ++ messgage+ then putStrLn (T.unpack $ makeRed "Some tests failed") >>+ exitWith (ExitFailure 1)+ else putStrLn . T.unpack $ makeGreen "All tests passed!"+ Left message ->+ (putStrLn . T.unpack . makeRed . T.pack $+ "Couldn't read input json or yaml file: " <> message) >>+ exitWith (ExitFailure 1) +-- | If we're on mac, we want a *-mac tarball from the releases page. If we're on linux we+-- do not+filterAsset :: [GithubReleaseAsset] -> Maybe GithubReleaseAsset+filterAsset assetList = find filterFn assetList+ where+ filterFn' a = "mac" `T.isInfixOf` Main.name a+ filterFn =+ if os == "darwin"+ then filterFn'+ else not . filterFn'++-- | From the list of releases on github, find the newest release that has a binary+-- tarball for the platform we're on.+findAssetFromReleases :: GithubReleasesResponse -> Maybe GithubReleaseAsset+findAssetFromReleases (GithubReleasesResponse releases) =+ let assetList = map (filterAsset . assets) $ NE.toList releases+ in join $ find isJust assetList++-- | We'll upgrade any time the latest version is different from what we have+shouldUpgrade :: GithubReleaseAsset -> Bool+shouldUpgrade asset =+ let assetNameTokens = T.splitOn "-" (Main.name asset)+ in if length assetNameTokens `notElem` [3, 4]+ then False+ else (T.replace ".tar.gz" "" (assetNameTokens !! 2)) /= T.pack (showVersion version)++-- | If conditions are met, download the appropriate tarball from the latest+-- github release, extract and copy to /usr/local/bin+upgradeCurlRunnings :: IO ()+upgradeCurlRunnings =+ let tmpArchive = "/tmp/curl-runnings-latest.tar.gz"+ tmpArchiveExtracedFolder = "/tmp/curl-runnings-latest"+ tmpExtractedBin = tmpArchiveExtracedFolder ++ "/curl-runnings"+ installPath = "/usr/local/bin/curl-runnings"+ in do req <-+ parseRequest+ "https://api.github.com/repos/aviaviavi/curl-runnings/releases"+ req' <- return $ setGithubReqHeaders req+ resp <- httpBS req'+ decoded <- return $ eitherDecode' . B.fromStrict $ getResponseBody resp+ case decoded of+ Right r ->+ let asset = findAssetFromReleases r+ in if maybe False shouldUpgrade asset+ then case asset of+ (Just a) -> do+ let downloadUrl = browser_download_url a+ putStrLn+ "Getting the latest version of curl-runnings..."+ downloadResp <-+ httpBS . setGithubReqHeaders =<<+ (parseRequest $ T.unpack downloadUrl)+ _ <-+ B.writeFile+ tmpArchive+ (B.fromStrict $ getResponseBody downloadResp)+ putStrLn "Extracting..."+ Tar.unpack tmpArchiveExtracedFolder .+ Tar.read . GZ.decompress =<<+ B.readFile tmpArchive+ putStrLn "Copying..."+ permissions <- getPermissions tmpExtractedBin+ setPermissions+ tmpExtractedBin+ (setOwnerExecutable True permissions)+ copyFile tmpExtractedBin installPath+ putStrLn $+ "The latest version curl-runnings has been installed to /usr/local/bin. " +++ "If you are using curl-runnings from a different location," +++ " please update your environment accordingly."+ -- We got a good response from github, but no asset for our platform was there+ Nothing -> do+ putStrLn . T.unpack $+ makeRed "Error upgrading curl-runnings"+ putStrLn $+ "No asset found from github. It's possible the binary for your " +++ "platform hasn't yet been uploaded to the latest release. Please wait and try again. " +++ "If the issue persists, please open an issue at https://github.com/aviaviavi/curl-runnings/issues."+ exitWith (ExitFailure 1)+ -- No upgrade required+ else putStrLn $+ "curl-runnings is already at the newest version: " +++ showVersion version ++ ". Nothing to upgrade."+ -- Coudn't decode github response+ Left err -> do+ putStrLn . T.unpack $ makeRed "Error upgrading curl-runnings"+ putStrLn err+ exitWith (ExitFailure 1)+ toLogLevel :: Verbosity -> LogLevel toLogLevel v = toEnum $ fromEnum v @@ -50,4 +188,6 @@ main = do userArgs <- cmdArgs argParser verbosityLevel <- getVerbosity- runFile (file userArgs) verbosityLevel+ if upgrade userArgs+ then upgradeCurlRunnings+ else runFile (file userArgs) verbosityLevel (grep userArgs)
curl-runnings.cabal view
@@ -1,11 +1,11 @@--- This file has been generated from package.yaml by hpack version 0.20.0.+-- This file has been generated from package.yaml by hpack version 0.28.2. -- -- see: https://github.com/sol/hpack ----- hash: e22614c4e739f355b79fac77eb1cf5c8111237f2adc4aebcccbbb3b118e8d817+-- hash: 0e66b58842dd3cfc4bba11992201740113a8539e45270702205df083d4feb579 name: curl-runnings-version: 0.6.0+version: 0.9.2 synopsis: A framework for declaratively writing curl based API tests description: Please see the README on Github at <https://github.com/aviaviavi/curl-runnings#readme> category: Testing@@ -18,10 +18,10 @@ license-file: LICENSE build-type: Simple cabal-version: >= 1.10- extra-source-files: examples/example-spec.json examples/example-spec.yaml+ examples/importable.yaml examples/interpolation-spec.yaml README.md @@ -34,7 +34,6 @@ src build-depends: aeson >=1.2.4.0- , aeson-pretty >=0.8.5 , base >=4.7 && <5 , bytestring >=0.10.8.2 , case-insensitive >=0.2.1@@ -44,6 +43,8 @@ , http-conduit >=2.2.4 , http-types >=0.9.1 , megaparsec >=6.3.0+ , pretty-simple >=2.0.2.1+ , regex-posix >=0.95.2 , text >=1.2.2.2 , unordered-containers >=0.2.8.0 , vector >=0.12.0@@ -63,10 +64,16 @@ app ghc-options: -threaded -rtsopts -with-rtsopts=-N build-depends:- base >=4.7+ aeson >=1.2.4.0+ , base >=4.7+ , bytestring >=0.10.8.2 , cmdargs >=0.10.20 , curl-runnings+ , directory >=1.3.0.2+ , http-conduit >=2.2.4+ , tar >=0.5.0.3 , text >=1.2.2.2+ , zlib >=0.6.1.2 other-modules: Paths_curl_runnings default-language: Haskell2010
examples/example-spec.json view
@@ -47,12 +47,52 @@ "name": "test 4", "url": "http://your-url.com/other/path", "requestMethod": "GET",+ "expectData": {+ "notContains": [+ {+ "keyValueMatch": {+ "key": "okay",+ "value": true+ }+ },+ {+ "valueMatch": true+ }+ ]+ },+ "expectStatus": 200+ },+ {+ "name": "test 5",+ "url": "http://your-url.com/other/path",+ "requestMethod": "GET",+ "expectData": {+ "contains": [+ {+ "keyValueMatch": {+ "key": "okay",+ "value": true+ }+ }+ ],+ "notContains": [+ {+ "valueMatch": false+ }+ ]+ },+ "expectStatus": 200+ },+ {+ "name": "test 6",+ "url": "http://your-url.com/other/path",+ "requestMethod": "GET", "headers": "Content-Type: application/json", "expectStatus": 200, "expectHeaders": "Content-Type: application/json; Hello: world" }, {- "name": "test 5",+ "name": "test 7", "url": "http://your-url.com/other/path", "requestMethod": "GET", "headers": "Content-Type: application/json",@@ -64,7 +104,7 @@ ] }, {- "name": "test 6",+ "name": "test 8", "url": "http://your-url.com/other/path", "requestMethod": "GET", "headers": "Content-Type: application/json",
examples/example-spec.yaml view
@@ -1,82 +1,115 @@ ----# The top level of the file is an array of test cases+# A curl runnings spec is an object with an array of `cases`.+# Note: the legacy format of a top level array of cases is still supported at this time, but it's recommended+# to migrate to the new format, as it may not be supported in later versions.+cases:+ - name: test 1 # required+ url: http://your-endpoint.com/status # required+ requestMethod: GET # required+ # [Optional] Specify the json payload we expect here+ # The 1 key in this block should be either:+ # exactly | contains+ expectData:+ # The 1 key in this object specifies the matcher we want+ # to use to test the returned payload. In this case, we+ # require the payload is exactly what we specify.+ exactly:+ okay: true+ msg: 'a message'+ # [Required] Assertions about the returned status code. Pass in+ # an acceptable code or list of codes+ expectStatus: 200 -- name: test 1 # required- url: http://your-endpoint.com/status # required- requestMethod: GET # required- # [Optional] Specify the json payload we expect here- # The 1 key in this block should be either:- # exactly | contains- expectData:- # The 1 key in this object specifies the matcher we want- # to use to test the returned payload. In this case, we- # require the payload is exactly what we specify.- exactly:- okay: true- msg: 'a message'- # [Required] Assertions about the returned status code. Pass in- # an acceptable code or list of codes- expectStatus: 200+ - name: test 2+ url: http://your-endpoint.com/path+ requestMethod: POST+ expectStatus:+ - 200+ - 201+ # [Optional] json data to send with the request+ requestData:+ hello: there+ num: 1 -- name: test 2- url: http://your-endpoint.com/path- requestMethod: POST- expectStatus:- - 200- - 201- # [Optional] json data to send with the request- requestData:- hello: there- num: 1+ - name: test 3+ url: http://your-url.com/other/path+ requestMethod: GET+ expectData:+ # In the `contains` case of data validation, a list of matchers is specified. Currently,+ # possible types are `keyMatch` | `valueMatch` | `keyValueMatch`.+ contains:+ # `keyValueMatch` looks for the key/value pair anywhere in the payload+ # here, {'okay': true} must be somewhere in the return payload+ - keyValueMatch:+ key: okay+ value: true+ # `valueMatch` searches for a value anywhere in the payload (note: _not_ a key).+ # Here, we look for the value `true` anywhere in the payload.+ # This can be useful for matching against values where you don't know the key ahead of time,+ # or for values in a top level array.+ - valueMatch: true+ # `keyMatch` searches for a key anywhere in the payload+ - keyMatch: okay+ expectStatus: 200 -- name: test 3- url: http://your-url.com/other/path- requestMethod: GET- expectData:- # In the `contains` case of data validation, a list of matchers is specified. Currently,- # possible types are `valueMatch` | `keyValueMatch`.- contains:- # `keyValueMatch` looks for the key/value pair anywhere in the payload- # here, {'okay': true} must be somewhere in the return payload- - keyValueMatch:- key: okay- value: true- # `valueMatch` searches for a value anywhere in the payload (note: _not_ a key).- # Here, we look for the value `true` anywhere in the payload.- # This can be useful for matching against values where you don't know the key ahead of time,- # or for values in a top level array.- - valueMatch: true- expectStatus: 200+ - name: test 4+ url: http://your-url.com/other/path+ requestMethod: GET+ expectData:+ # In the `notContains` case of data validation, a list of matchers is specified. If any+ # matcher is found in the response payload, the test will fail. Currently,+ # possible matchers are `valueMatch` | `keyValueMatch`.+ notContains:+ - keyValueMatch:+ key: okay+ value: true+ - valueMatch: true+ # notContains + keyMatch works great for asserting no errors came back+ - keyMatch: error+ expectStatus: 200 -- name: test 4- url: http://your-url.com/other/path- requestMethod: GET- # Specify the headers you want to sent, just like the -H flag in a curl command- # IE "key: value; key: value; ..."- headers: "Content-Type: application/json"- expectStatus: 200- # The response must constain at least these headers exactly.- # Header strings again match the -H syntax from curl- expectHeaders: "Content-Type: application/json; Hello: world"+ - name: test 5+ url: http://your-url.com/other/path+ requestMethod: GET+ expectData:+ # you can have both a contains and a notContains block in your expectData+ contains:+ - keyValueMatch:+ key: okay+ value: true+ notContains:+ - valueMatch: false+ expectStatus: 200 -- name: test 5- url: http://your-url.com/other/path- requestMethod: GET- headers: "Content-Type: application/json"- expectStatus: 200- # You can also specify a key and/or value to look for in the headers- expectHeaders: - -- key: "Key-With-Val-We-Dont-Care-About"+ - name: test 6+ url: http://your-url.com/other/path+ requestMethod: GET+ # Specify the headers you want to sent, just like the -H flag in a curl command+ # IE "key: value; key: value; ..."+ headers: "Content-Type: application/json"+ expectStatus: 200+ # The response must contain at least these headers exactly.+ # Header strings again match the -H syntax from curl+ expectHeaders: "Content-Type: application/json; Hello: world" -- name: test 6- url: http://your-url.com/other/path- requestMethod: GET- headers: "Content-Type: application/json"- expectStatus: 200- # Specify a mix of full or partial header matches in a list like so:- expectHeaders: - - "Hello: world"- -- value: "Value-With-Key-We-Dont-Care-About"- + - name: test 7+ url: http://your-url.com/other/path+ requestMethod: GET+ headers: "Content-Type: application/json"+ expectStatus: 200+ # You can also specify a key and/or value to look for in the headers+ expectHeaders: + -+ key: "Key-With-Val-We-Dont-Care-About"++ - name: test 8+ url: http://your-url.com/other/path+ requestMethod: GET+ headers: "Content-Type: application/json"+ expectStatus: 200+ # Specify a mix of full or partial header matches in a list like so:+ expectHeaders: + - "Hello: world"+ -+ value: "Value-With-Key-We-Dont-Care-About"+
+ examples/importable.yaml view
@@ -0,0 +1,4 @@+---+# you can define any variables in a yaml file, which can be imported in your specs via the+# !import <filename> directive. This is especially useful for defining aliases for data you use frequently+some_key: &ping ping
examples/interpolation-spec.yaml view
@@ -1,46 +1,70 @@ ----- name: test 1 - # interpolate environment variables with ${...} just like you would in bash- url: 'https://tabdextension.com/${ping_path}'- headers: 'ping: ${ping_path}'- requestMethod: GET- expectData:- exactly:- ping: pong- expectStatus: 200+# use the !include <file> yaml directive for import data from other yaml files!+include: !include ./importable.yaml+cases:+ - name: test 1 + # interpolate environment variables with ${...} just like you would in bash+ url: 'https://tabdextension.com/${ping_path}'+ headers: 'ping: ${ping_path}'+ requestMethod: GET+ expectData:+ exactly:+ ping: pong+ expectStatus: 200 -- name: test should pass- url: https://tabdextension.com/ping- requestMethod: GET- expectData:- exactly:- # a string can be interpolated with variables inside of a $<...>- # a query should start by indexing the array `SUITE` which contains- # the json results of all previous test results. otherwise, use normal json / jq syntax.- # you can put just a bare query and subsitute any json value, or use several queries- # combined with raw text and substitue string values- ping: $<SUITE[0].ping>- expectStatus: 200+ - name: test should pass+ url: https://tabdextension.com/ping+ requestMethod: GET+ expectData:+ exactly:+ # a string can be interpolated with variables inside of a $<...>+ # a query should start by indexing the array `RESPONSES` which contains+ # the json results of all previous test results. otherwise, use normal json / jq syntax.+ # you can put just a bare query and subsitute any json value, or use several queries+ # combined with raw text and substitue string values+ # NOTE - The legacy reserved variable SUITE is still supported at this time, but may not+ # be in a future version of curl-runnings.+ ping: $<RESPONSES[0].ping>+ expectStatus: 200 -- name: test will fail- url: https://tabdextension.com/ping- requestMethod: GET- expectHeaders: "ping: $<SUITE[-1].ping>; ${ping_path}: pong"- expectStatus: 200+ - name: test will fail+ url: https://tabdextension.com/ping+ requestMethod: GET+ expectHeaders: "ping: $<RESPONSES[-1].ping>; ${ping_path}: pong"+ expectStatus: 200 -- name: test will fail- url: https://tabdextension.com/ping- requestMethod: GET- expectData:- contains:- - keyValueMatch:- # environment interpolation just like bash- key: 'interpolated ${env_variable} ${another_variable}-key'- value: ${ping_value}- - keyValueMatch:- key: msg- value: $<SUITE[0].msg>- # here, we are interpolating several string values into a string- - valueMatch: 'hello $<SUITE[0].ping> : $<SUITE[0].ping> trailing text'- - valueMatch: $<SUITE[0].okay>- expectStatus: 200+ - name: test will fail+ url: https://tabdextension.com/ping+ requestMethod: GET+ expectData:+ contains:+ - keyValueMatch:+ # environment interpolation just like bash+ key: 'interpolated ${env_variable} ${another_variable}-key'+ value: ${ping_value}+ - keyValueMatch:+ key: msg+ value: $<RESPONSES[0].msg>+ # here, we are interpolating several string values into a string+ - valueMatch: 'hello $<RESPONSES[0].ping> : $<RESPONSES[0].ping> trailing text'+ - valueMatch: $<RESPONSES[0].okay>+ expectStatus: 200++ - name: test should pass+ url: https://tabdextension.com/ping+ requestMethod: GET+ expectData:+ notContains:+ - keyValueMatch:+ # environment interpolation just like bash+ key: 'interpolated ${env_variable} ${another_variable}-key'+ value: ${ping_value}+ - keyValueMatch:+ key: msg+ value: $<RESPONSES[0].msg>+ # here, we are interpolating several string values into a string+ - valueMatch: 'hello $<RESPONSES[0].ping> : $<RESPONSES[0].ping> trailing text'+ - valueMatch: $<RESPONSES[0].okay>+ # use anchors from this file or an imported one. here, `ping` is an anchor defined in importable.yaml+ - valueMatch: *ping+ expectStatus: 200
src/Testing/CurlRunnings.hs view
@@ -4,12 +4,12 @@ -- | curl-runnings is a framework for writing declaratively writing curl based tests for your API's. -- Write your test specifications with yaml or json, and you're done! module Testing.CurlRunnings- (- runCase- , runSuite- , decodeFile- ) where+ ( runCase+ , runSuite+ , decodeFile+ ) where +import Control.Exception import Control.Monad import Data.Aeson import Data.Aeson.Types@@ -23,7 +23,7 @@ import Data.Monoid import qualified Data.Text as T import qualified Data.Vector as V-import qualified Data.Yaml as Y+import qualified Data.Yaml.Include as YI import Network.HTTP.Conduit import Network.HTTP.Simple import qualified Network.HTTP.Types.Header as HTTP@@ -33,26 +33,26 @@ import Testing.CurlRunnings.Internal.Parser import Testing.CurlRunnings.Types import Text.Printf+import Text.Regex.Posix -- | decode a json or yaml file into a suite object decodeFile :: FilePath -> IO (Either String CurlSuite)-decodeFile specPath = doesFileExist specPath >>= \exists ->- if exists then- case last $ T.splitOn "." (T.pack specPath) of- "json" ->- eitherDecode' <$> B.readFile specPath :: IO (Either String CurlSuite)- "yaml" ->- Y.decodeEither <$> B8S.readFile specPath :: IO (Either String CurlSuite)- "yml" ->- Y.decodeEither <$> B8S.readFile specPath :: IO (Either String CurlSuite)- _ -> return . Left $ printf "Invalid spec path %s" specPath- else return . Left $ printf "%s not found" specPath+decodeFile specPath =+ doesFileExist specPath >>= \exists ->+ if exists+ then case last $ T.splitOn "." (T.pack specPath) of+ "json" ->+ eitherDecode' <$> B.readFile specPath :: IO (Either String CurlSuite)+ "yaml" -> mapLeft show <$> YI.decodeFileEither specPath+ "yml" -> mapLeft show <$> YI.decodeFileEither specPath+ _ -> return . Left $ printf "Invalid spec path %s" specPath+ else return . Left $ printf "%s not found" specPath -- | Run a single test case, and returns the result. IO is needed here since this method is responsible -- for actually curling the test case endpoint and parsing the result. runCase :: CurlRunningsState -> CurlCase -> IO CaseResult runCase state curlCase = do- let eInterpolatedUrl = interpolateQueryString state $ T.pack $ url curlCase+ let eInterpolatedUrl = interpolateQueryString state $ url curlCase eInterpolatedHeaders = interpolateHeaders state $ fromMaybe (HeaderSet []) (headers curlCase) case (eInterpolatedUrl, eInterpolatedHeaders) of@@ -70,11 +70,34 @@ setRequestBodyJSON (fromMaybe emptyObject replacedJSON) . setRequestHeaders (toHTTPHeaders interpolatedHeaders) $ initReq {method = B8S.pack . show $ requestMethod curlCase}- logger state DEBUG (show request)+ logger state DEBUG (pShow request)+ logger+ state+ DEBUG+ ("Request body: " <> (pShow $ fromMaybe emptyObject replacedJSON)) response <- httpBS request- logger state DEBUG (show response)+ -- If the response is just returning bytes, we won't print them+ let responseHeaderValues = map snd (getResponseHeaders response)+ if "application/octet-stream" `notElem` responseHeaderValues &&+ "application/vnd.apple.pkpass" `notElem` responseHeaderValues+ then catch+ (logger state DEBUG (pShow response))+ (\(e :: IOException) ->+ logger state ERROR ("Error logging response: " <> pShow e))+ -- TODO: we should log as much info as possible without printing the raw body+ else logger+ state+ DEBUG+ "Response output supressed (returned content-type was bytes)" returnVal <-- (return . decode . B.fromStrict $ getResponseBody response) :: IO (Maybe Value)+ catch+ ((return . decode . B.fromStrict $ getResponseBody response) :: IO (Maybe Value))+ (\(e :: IOException) ->+ logger+ state+ ERROR+ ("Error decoding response into json: " <> pShow e) >>+ return (Just Null)) let returnCode = getResponseStatusCode response receivedHeaders = fromHTTPHeaders $ responseHeaders response assertionErrors =@@ -91,7 +114,8 @@ failures -> CaseFail curlCase (Just receivedHeaders) returnVal failures -checkHeaders :: CurlRunningsState -> CurlCase -> Headers -> Maybe AssertionFailure+checkHeaders ::+ CurlRunningsState -> CurlCase -> Headers -> Maybe AssertionFailure checkHeaders _ (CurlCase _ _ _ _ _ _ _ Nothing) _ = Nothing checkHeaders state curlCase@(CurlCase _ _ _ _ _ _ _ (Just (HeaderMatcher m))) receivedHeaders = let interpolatedHeaders = mapM (interpolatePartialHeader state) m@@ -110,7 +134,10 @@ (HeaderMatcher headerList) receivedHeaders -interpolatePartialHeader :: CurlRunningsState -> PartialHeaderMatcher -> Either QueryError PartialHeaderMatcher+interpolatePartialHeader ::+ CurlRunningsState+ -> PartialHeaderMatcher+ -> Either QueryError PartialHeaderMatcher interpolatePartialHeader state (PartialHeaderMatcher k v) = let k' = interpolateQueryString state <$> k v' = interpolateQueryString state <$> v@@ -157,55 +184,93 @@ -- | Runs the test cases in order and stop when an error is hit. Returns all the results runSuite :: CurlSuite -> LogLevel -> IO [CaseResult]-runSuite (CurlSuite cases) logLevel = do+runSuite (CurlSuite cases filterRegex) logLevel = do fullEnv <- getEnvironment let envMap = H.fromList $ map (\(x, y) -> (T.pack x, T.pack y)) fullEnv+ filterNameByRegexp curlCase =+ maybe+ True+ (\regexp -> T.unpack (name curlCase) =~ T.unpack regexp :: Bool)+ filterRegex foldM (\prevResults curlCase -> case safeLast prevResults of Just CaseFail {} -> return prevResults Just CasePass {} -> do- result <- runCase (CurlRunningsState envMap prevResults logLevel) curlCase >>= printR+ result <-+ runCase (CurlRunningsState envMap prevResults logLevel) curlCase >>=+ printR return $ prevResults ++ [result] Nothing -> do- result <- runCase (CurlRunningsState envMap [] logLevel) curlCase >>= printR+ result <-+ runCase (CurlRunningsState envMap [] logLevel) curlCase >>= printR return [result]) []- cases+ (filter filterNameByRegexp cases) -- | Check if the retrieved value fail's the case's assertion-checkBody :: CurlRunningsState -> CurlCase -> Maybe Value -> Maybe AssertionFailure+checkBody ::+ CurlRunningsState -> CurlCase -> Maybe Value -> Maybe AssertionFailure -- | We are looking for an exact payload match, and we have a payload to check checkBody state curlCase@(CurlCase _ _ _ _ _ (Just (Exactly expectedValue)) _ _) (Just receivedBody) = case runReplacements state expectedValue of (Left err) -> Just $ QueryFailure curlCase err (Right interpolated) ->- if (unsafeLogger state DEBUG "exact body matcher" interpolated) /= receivedBody+ if (unsafeLogger state DEBUG "exact body matcher" interpolated) /=+ receivedBody then Just $ DataFailure (curlCase {expectData = Just $ Exactly interpolated}) (Exactly interpolated) (Just receivedBody) else Nothing- -- | We are checking a list of expected subvalues, and we have a payload to check checkBody state curlCase@(CurlCase _ _ _ _ _ (Just (Contains subexprs)) _ _) (Just receivedBody) = case runReplacementsOnSubvalues state subexprs of Left f -> Just $ QueryFailure curlCase f Right updatedMatcher ->- if jsonContainsAll receivedBody (unsafeLogger state DEBUG "partial json body matcher" updatedMatcher)+ if jsonContainsAll+ receivedBody+ (unsafeLogger state DEBUG "partial json body matcher" updatedMatcher) then Nothing else Just $ DataFailure curlCase (Contains updatedMatcher) (Just receivedBody)-+-- | We are checking a list of expected absent subvalues, and we have a payload to check+checkBody state curlCase@(CurlCase _ _ _ _ _ (Just (NotContains subexprs)) _ _) (Just receivedBody) =+ case runReplacementsOnSubvalues state subexprs of+ Left f -> Just $ QueryFailure curlCase f+ Right updatedMatcher ->+ if jsonContainsAny+ receivedBody+ (unsafeLogger state DEBUG "partial json body matcher" updatedMatcher)+ then Just $+ DataFailure+ curlCase+ (NotContains updatedMatcher)+ (Just receivedBody)+ else Nothing+-- | We are checking for both contains and notContains vals, and we have a payload to check+checkBody state curlCase@(CurlCase _ _ _ _ _ (Just m@(MixedContains subexprs)) _ _) receivedBody =+ let failure =+ join $+ find+ isJust+ (map+ (\subexpr ->+ checkBody+ state+ curlCase {expectData = Just subexpr}+ receivedBody)+ subexprs)+ in fmap (\_ -> DataFailure curlCase m receivedBody) failure -- | We expected a body but didn't get one checkBody _ curlCase@(CurlCase _ _ _ _ _ (Just anything) _ _) Nothing = Just $ DataFailure curlCase anything Nothing- -- | No assertions on the body checkBody _ (CurlCase _ _ _ _ _ Nothing _ _) _ = Nothing -runReplacementsOnSubvalues :: CurlRunningsState -> [JsonSubExpr] -> Either QueryError [JsonSubExpr]+runReplacementsOnSubvalues ::+ CurlRunningsState -> [JsonSubExpr] -> Either QueryError [JsonSubExpr] runReplacementsOnSubvalues state = mapM (\expr ->@@ -214,6 +279,10 @@ case runReplacements state v of Left l -> Left l Right newVal -> Right $ ValueMatch newVal+ KeyMatch k ->+ case interpolateQueryString state k of+ Left l -> Left l+ Right newKey -> Right $ KeyMatch newKey KeyValueMatch k v -> case (interpolateQueryString state k, runReplacements state v) of (Left l, _) -> Left l@@ -264,7 +333,8 @@ runReplacements state (String s) = case parseQuery s of Right [LiteralText t] -> Right $ String t- Right [q@(InterpolatedQuery _ _)] -> getStringValueForQuery state q >>= (Right . String)+ Right [q@(InterpolatedQuery _ _)] ->+ getStringValueForQuery state q >>= (Right . String) Right [q@(NonInterpolatedQuery _)] -> getValueForQuery state q Right _ -> mapRight String $ interpolateQueryString state s Left parseErr -> Left parseErr@@ -272,7 +342,8 @@ -- | Given a query string, return some text with interpolated values. Type -- errors will be returned if queries don't resolve to strings-interpolateQueryString :: CurlRunningsState -> FullQueryText -> Either QueryError T.Text+interpolateQueryString ::+ CurlRunningsState -> FullQueryText -> Either QueryError T.Text interpolateQueryString state query = let parsedQuery = parseQuery query in case parsedQuery of@@ -286,7 +357,8 @@ in fromMaybe (Right $ foldr (<>) (T.pack "") goodLookups) failure -- | Lookup the text at the specified query-getStringValueForQuery :: CurlRunningsState -> InterpolatedQuery -> Either QueryError T.Text+getStringValueForQuery ::+ CurlRunningsState -> InterpolatedQuery -> Either QueryError T.Text getStringValueForQuery _ (LiteralText rawText) = Right rawText getStringValueForQuery state (NonInterpolatedQuery q) = getStringValueForQuery state $ InterpolatedQuery "" q@@ -299,35 +371,52 @@ Right $ rawText <> H.lookupDefault "" v env -- | Lookup the value for the specified query-getValueForQuery :: CurlRunningsState -> InterpolatedQuery -> Either QueryError Value+getValueForQuery ::+ CurlRunningsState -> InterpolatedQuery -> Either QueryError Value getValueForQuery _ (LiteralText rawText) = Right $ String rawText getValueForQuery (CurlRunningsState _ previousResults _) full@(NonInterpolatedQuery (Query indexes)) = case head indexes of (CaseResultIndex i) ->- let (CasePass _ _ returnedJSON) = arrayGet previousResults $ fromInteger i- jsonToIndex =- case returnedJSON of- Just v -> Right v- Nothing ->- Left $- NullPointer- (T.pack $ show full)- "No data was returned from this case"- in foldr- (\index eitherVal ->- case (eitherVal, index) of- (Left l, _) -> Left l- (Right (Object o), KeyIndex k) ->- Right $ H.lookupDefault Null k o- (Right (Array a), ArrayIndex i') -> Right $ arrayGet (V.toList a) $ fromInteger i'- (Right Null, q) ->- Left $ NullPointer (T.pack $ show full) (T.pack $ show q)- (Right o, _) -> Left $ QueryTypeMismatch (T.pack $ show index) o)- jsonToIndex- (tail indexes)+ let maybeCase = arrayGet previousResults $ fromInteger i+ in if isJust maybeCase+ then let (CasePass _ _ returnedJSON) = fromJust maybeCase+ jsonToIndex =+ case returnedJSON of+ Just v -> Right v+ Nothing ->+ Left $+ NullPointer+ (T.pack $ show full)+ "No data was returned from this case"+ in foldl+ (\eitherVal index ->+ case (eitherVal, index) of+ (Left l, _) -> Left l+ (Right (Object o), KeyIndex k) ->+ Right $ H.lookupDefault Null k o+ (Right (Array a), ArrayIndex i') ->+ maybe+ (Left $+ NullPointer (T.pack $ show full) $+ "Array index not found: " <> T.pack (show i'))+ Right+ (arrayGet (V.toList a) $ fromInteger i')+ (Right Null, q) ->+ Left $+ NullPointer (T.pack $ show full) (T.pack $ show q)+ (Right o, _) ->+ Left $ QueryTypeMismatch (T.pack $ show index) o)+ jsonToIndex+ (tail indexes)+ else Left $+ NullPointer (T.pack $ show full) $+ "Attempted to index into previous a test case that didn't exist: " <>+ T.pack (show i) _ -> Left . QueryValidationError $- T.pack $ "$<> queries must start with a SUITE[index] query: " ++ show full+ T.pack $+ "'$< ... >' queries must start with a RESPONSES[index] query: " +++ show full getValueForQuery (CurlRunningsState env _ _) (NonInterpolatedQuery (EnvironmentVariable var)) = Right . String $ H.lookupDefault "" var env getValueForQuery state (InterpolatedQuery _ q) =@@ -337,21 +426,42 @@ Right v -> Left $ QueryTypeMismatch (T.pack "Expected a string") v Left l -> Left l +jsonContains ::+ ((JsonSubExpr -> Bool) -> [JsonSubExpr] -> Bool)+ -> Value+ -> [JsonSubExpr]+ -> Bool+jsonContains f jsonValue =+ let traversedValue = traverseValue jsonValue+ in f $ \match ->+ case match of+ ValueMatch subval -> subval `elem` traversedValue+ KeyMatch key -> any (`containsKey` key) traversedValue+ KeyValueMatch key subval ->+ any (\o -> containsKeyVal o key subval) traversedValue+ -- | Does the json value contain all of these sub-values? jsonContainsAll :: Value -> [JsonSubExpr] -> Bool-jsonContainsAll jsonValue =- all $ \match ->- case match of- ValueMatch subval -> subval `elem` traverseValue jsonValue- KeyValueMatch key subval ->- any (\o -> containsKeyVal o key subval) (traverseValue jsonValue)+jsonContainsAll = jsonContains all +-- | Does the json value contain any of these sub-values?+jsonContainsAny :: Value -> [JsonSubExpr] -> Bool+jsonContainsAny = jsonContains any+ -- | Does the json value contain the given key value pair? containsKeyVal :: Value -> T.Text -> Value -> Bool-containsKeyVal jsonValue key val = case jsonValue of- Object o -> H.lookup key o == Just val- _ -> False+containsKeyVal jsonValue key val =+ case jsonValue of+ Object o -> H.lookup key o == Just val+ _ -> False +-- | Does the json value contain the given key value pair?+containsKey :: Value -> T.Text -> Bool+containsKey jsonValue key =+ case jsonValue of+ Object o -> isJust $ H.lookup key o+ _ -> False+ -- | Fully traverse the json and return a list of all the values traverseValue :: Value -> [Value] traverseValue val =@@ -384,7 +494,8 @@ -- | Utility conversion from an HTTP header to a CurlRunnings header. toHTTPHeader :: Header -> HTTP.Header-toHTTPHeader (Header a b) = (CI.mk . B8S.pack $ T.unpack a, B8S.pack $ T.unpack b)+toHTTPHeader (Header a b) =+ (CI.mk . B8S.pack $ T.unpack a, B8S.pack $ T.unpack b) -- | Utility conversion from CurlRunnings headers to HTTP headers. toHTTPHeaders :: Headers -> HTTP.RequestHeaders
src/Testing/CurlRunnings/Internal.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE OverloadedStrings #-}+ -- | This module specifies any utilities used by this package. At this time, -- consider everything in this module to be private to the curl-runnings package module Testing.CurlRunnings.Internal@@ -5,56 +7,69 @@ , makeGreen , tracer , mapRight+ , mapLeft , arrayGet , makeLogger , makeUnsafeLogger-+ , pShow , LogLevel(..) , CurlRunningsLogger , CurlRunningsUnsafeLogger ) where import Control.Monad+import Data.Monoid+import qualified Data.Text as T+import qualified Data.Text.Lazy as TL import Debug.Trace+import qualified Text.Pretty.Simple as P -makeGreen :: String -> String-makeGreen s = "\x1B[32m" ++ s ++ "\x1B[0m"+makeGreen :: T.Text -> T.Text+makeGreen s = "\x1B[32m" <> s <> "\x1B[0m" -makeRed :: String -> String-makeRed s = "\x1B[31m" ++ s ++ "\x1B[0m"+makeRed :: T.Text -> T.Text+makeRed s = "\x1B[31m" <> s <> "\x1B[0m" -tracer :: Show a => String -> a -> a-tracer a b = trace (a ++ ": " ++ show b) b+pShow :: Show a => a -> T.Text+pShow = TL.toStrict . P.pShow +tracer :: Show a => T.Text -> a -> a+tracer a b = trace (T.unpack $ a <> T.pack ": " <> pShow b) b+ mapRight :: (b -> c) -> Either a b -> Either a c mapRight f (Right v) = Right $ f v mapRight _ (Left v) = Left v +mapLeft :: (a -> c) -> Either a b -> Either c b+mapLeft f (Left v) = Left $ f v+mapLeft _ (Right v) = Right v+ -- | Array indexing with negative values allowed-arrayGet :: [a] -> Int -> a+arrayGet :: [a] -> Int -> Maybe a arrayGet a i- | i >= 0 = a !! i- | otherwise = reverse a !! (-i)+ | (i >= 0 && length a <= abs i) || null a || (i < 0 && length a <= (abs i - 1)) = Nothing+ | i >= 0 = Just $ a !! i+ | otherwise = Just $ a !! (length a + i) -data LogLevel = ERROR | INFO | DEBUG deriving (Show, Eq, Ord, Enum)+data LogLevel+ = ERROR+ | INFO+ | DEBUG+ deriving (Show, Eq, Ord, Enum) -- | A logger that respects the verbosity level given by input args-type CurlRunningsLogger = (LogLevel -> String -> IO ())+type CurlRunningsLogger = (LogLevel -> T.Text -> IO ()) -- | A tracer that respects the verbosity level given by input args. Logging -- with this calls out to Debug.trace and can be used in pure code, but be aware -- of the unsafe IO.-type CurlRunningsUnsafeLogger a = (LogLevel -> String -> a -> a)+type CurlRunningsUnsafeLogger a = (LogLevel -> T.Text -> a -> a) makeLogger :: LogLevel -> CurlRunningsLogger-makeLogger threshold level text =- when (level <= threshold) $ putStrLn text+makeLogger threshold level text = when (level <= threshold) $ P.pPrint text makeUnsafeLogger :: Show a => LogLevel -> CurlRunningsUnsafeLogger a makeUnsafeLogger threshold level text object =- if level <= threshold then- tracer text object- else- object--+ if level <= threshold+ then tracer text object+ else object
src/Testing/CurlRunnings/Internal/Parser.hs view
@@ -5,22 +5,22 @@ -- interpolation can be performed, where interpolated values are json quries -- into responses from past test cases. ----- > "$<SUITE[0].key[0].another_key>"+-- > "$<RESPONSES[0].key[0].another_key>" ----- here the `SUITE` keyword references the results of previous test cases. Here, the+-- here the `RESPONSES` keyword references the results of previous test cases. Here, the -- whole string is a query, so if the value referenced by this query is itself a -- json value, the entire value will replace this string in a json matcher. -- Additionally, interpolation of the form: -- -- >--- > "some text to interpolate with $<SUITE[0].key.key>"+-- > "some text to interpolate with $<RESPONSES[0].key.key>" -- > -- -- will substitute a string found at the specified query -- and subsitute the string. -- -- Rules for the language are similar to JQ or regular JSON indexing rules. All--- queries must start with a SUITE[integer] index, and be written between a+-- queries must start with a RESPONSES[integer] index, and be written between a -- -- > -- > $< ... >@@ -47,15 +47,28 @@ parseQuery q = let trimmed = T.strip q in case Text.Megaparsec.parse parseFullTextWithQuery "" trimmed of- Right a -> Right a- Left a -> Left $ QueryParseError (T.pack $ parseErrorPretty a) q+ Right a -> Right a >>= validateQuery+ Left a -> Left $ QueryParseError (T.pack $ parseErrorPretty a) q +-- | Once we have parsed a query successfully, ensure that it is a legal query+validateQuery :: [InterpolatedQuery] -> Either QueryError [InterpolatedQuery]+-- If we have a json indexing query, it needs to start by indexing the special+-- RESPONSES array+validateQuery q@(InterpolatedQuery _ (Query (CaseResultIndex _:_)):_) = Right q+validateQuery q@(NonInterpolatedQuery (Query (CaseResultIndex _:_)):_) = Right q+-- If the RESPONSES array is not indexed, it's not valid, as we don't know which+-- response to look at+validateQuery (InterpolatedQuery _ (Query _):_) = Left $ QueryValidationError "JSON interpolation must begin by indexing into RESPONSES"+validateQuery (NonInterpolatedQuery (Query _):_) = Left $ QueryValidationError "JSON interpolation must begin by indexing into RESPONSES"+-- Otherwise, we're good!+validateQuery q = Right q+ type Parser = Parsec Void T.Text parseSuiteIndex' :: Parser Index parseSuiteIndex' = do notFollowedBy gtlt- _ <- string "SUITE"+ _ <- string "RESPONSES" <|> string "SUITE" (ArrayIndex i) <- arrayIndexParser return $ CaseResultIndex i
src/Testing/CurlRunnings/Types.hs view
@@ -32,13 +32,12 @@ ) where import Data.Aeson-import Data.Aeson.Encode.Pretty import Data.Aeson.Types-import qualified Data.ByteString.Lazy.Char8 as B8 import Data.Either import qualified Data.HashMap.Strict as H import Data.List import Data.Maybe+import Data.Monoid import qualified Data.Text as T import qualified Data.Vector as V import GHC.Generics@@ -62,8 +61,12 @@ data JsonMatcher -- | Performs `==` = Exactly Value- -- | A list of matchers to make assertions about some subset of the response.+ -- | A list of matchers to make assertions that contains values exist in the response | Contains [JsonSubExpr]+ -- | A list of matchers to make assertions that contains values do not exist in the response+ | NotContains [JsonSubExpr]+ -- | We're specifiying both Contains and NotContains matchers+ | MixedContains [JsonMatcher] deriving (Show, Generic) instance ToJSON JsonMatcher@@ -71,9 +74,24 @@ instance FromJSON JsonMatcher where parseJSON (Object v) | isJust $ H.lookup "exactly" v = Exactly <$> v .: "exactly"+ | isJust (H.lookup "contains" v) && isJust (H.lookup "notContains" v) = do+ c <- Contains <$> v .: "contains"+ n <- NotContains <$> v .: "notContains"+ return $ MixedContains [c, n] | isJust $ H.lookup "contains" v = Contains <$> v .: "contains"+ | isJust $ H.lookup "notContains" v = NotContains <$> v .: "notContains" parseJSON invalid = typeMismatch "JsonMatcher" invalid +-- | Simple predicate to check value constructor type+isContains :: JsonMatcher -> Bool+isContains (Contains _) = True+isContains _ = False++-- | Simple predicate to check value constructor type+isNotContains :: JsonMatcher -> Bool+isNotContains (NotContains _) = True+isNotContains _ = False+ -- | A representation of a single header data Header = Header T.Text@@ -108,28 +126,29 @@ -- | Different errors relating to querying json from previous test cases data QueryError -- | The query was malformed and couldn't be parsed- = QueryParseError T.Text T.Text+ = QueryParseError T.Text+ T.Text -- | The retrieved a value of the wrong type or was otherwise operating on the -- wrong type of thing | QueryTypeMismatch T.Text Value -- | The query was parse-able | QueryValidationError T.Text- -- | Tried to access a value in a null object- | NullPointer T.Text- T.Text+ -- | Tried to access a value in a null object.+ | NullPointer T.Text -- full query+ T.Text -- message instance Show QueryError where show (QueryParseError t q) = printf "error parsing query %s: %s" q $ T.unpack t show (NullPointer full part) = printf "null pointer in %s at %s" (T.unpack full) $ T.unpack part- show (QueryTypeMismatch message val) = printf "type error: %s %s" (message) $ show val+ show (QueryTypeMismatch message val) = printf "type error: %s %s" message $ show val show (QueryValidationError message) = printf "invalid query: %s" message parseHeader :: T.Text -> Either T.Text Header parseHeader str = case map T.strip $ T.splitOn ":" str of- [key, val] -> Right $ Header key val- anythingElse -> Left . T.pack $ "bad header found: " ++ (show anythingElse)+ [key, val] -> Right $ Header key val+ anythingElse -> Left . T.pack $ "bad header found: " ++ show anythingElse parseHeaders :: T.Text -> Either T.Text Headers parseHeaders str =@@ -174,6 +193,8 @@ -- value. The motivation for this field is largely for checking contents of a -- top level array. It's also useful if you don't know the key ahead of time. = ValueMatch Value+ -- | Assert a key exists anywhere in the json+ | KeyMatch T.Text -- | Assert the key value pair can be found somewhere the json. | KeyValueMatch { matchKey :: T.Text , matchValue :: Value }@@ -186,6 +207,11 @@ in case toParse of Object o -> KeyValueMatch <$> o .: "key" <*> o .: "value" _ -> typeMismatch "JsonSubExpr" toParse+ | isJust $ H.lookup "keyMatch" v =+ let toParse = fromJust $ H.lookup "keyMatch" v+ in case toParse of+ String s -> return $ KeyMatch s+ _ -> typeMismatch "JsonSubExpr" toParse | isJust $ H.lookup "valueMatch" v = ValueMatch <$> v .: "valueMatch" parseJSON invalid = typeMismatch "JsonSubExpr" invalid instance ToJSON JsonSubExpr@@ -205,8 +231,8 @@ -- | A single curl test case, the basic foundation of a curl-runnings test. data CurlCase = CurlCase- { name :: String -- ^ The name of the test case- , url :: String -- ^ The target url to test+ { name :: T.Text -- ^ The name of the test case+ , url :: T.Text -- ^ The target url to test , requestMethod :: HttpMethod -- ^ Verb to use for the request , requestData :: Maybe Value -- ^ Payload to send with the request, if any , headers :: Maybe Headers -- ^ Headers to send with the request, if any@@ -245,10 +271,10 @@ colorizeExpects :: String -> String colorizeExpects t =- let expectedColor = makeRed "Excpected:"+ let expectedColor = makeRed "Expected:" actualColor = makeRed "Actual:"- replacedExpected = T.replace "Expected:" (T.pack expectedColor) (T.pack t)- in T.unpack $ T.replace "Actual:" (T.pack actualColor) replacedExpected+ replacedExpected = T.replace "Expected:" expectedColor (T.pack t)+ in T.unpack $ T.replace "Actual:" actualColor replacedExpected instance Show AssertionFailure where show (StatusFailure c receivedCode) =@@ -256,14 +282,16 @@ ExactCode code -> colorizeExpects $ printf- "Incorrect status code from %s. Expected: %s. Actual: %s"+ "[%s] Incorrect status code from %s. Expected: %s. Actual: %s"+ (name c) (url c) (show code) (show receivedCode) AnyCodeIn codes -> colorizeExpects $ printf- "Incorrect status code from %s. Expected: %s. Actual: %s"+ "[%s] Incorrect status code from %s. Expected: %s. Actual: %s"+ (name c) (url c) (show codes) (show receivedCode)@@ -272,21 +300,41 @@ Exactly expectedVal -> colorizeExpects $ printf- "JSON response from %s didn't match spec. Expected: %s. Actual: %s"+ "[%s] JSON response from %s didn't match spec. Expected: %s. Actual: %s"+ (name curlCase) (url curlCase)- (B8.unpack (encodePretty expectedVal))- (B8.unpack (encodePretty receivedVal))+ (T.unpack (pShow expectedVal))+ (T.unpack (pShow receivedVal)) (Contains expectedVals) -> colorizeExpects $ printf- "JSON response from %s didn't contain the matcher. Expected: %s to be each be subvalues in: %s"+ "[%s] JSON response from %s didn't contain the matcher. Expected: %s to each be subvalues in: %s"+ (name curlCase) (url curlCase)- (B8.unpack (encodePretty expectedVals))- (B8.unpack (encodePretty receivedVal))+ (T.unpack (pShow expectedVals))+ (T.unpack (pShow receivedVal))+ (NotContains expectedVals) ->+ colorizeExpects $+ printf+ "[%s] JSON response from %s did contain the matcher. Expected: %s not to be subvalues in: %s"+ (name curlCase)+ (url curlCase)+ (T.unpack (pShow expectedVals))+ (T.unpack (pShow receivedVal))+ (MixedContains expectedVals) ->+ colorizeExpects $+ printf+ "[%s] JSON response from %s didn't satisfy the matcher. Expected: %s to each be subvalues and %s not to be subvalues in: %s"+ (name curlCase)+ (url curlCase)+ (T.unpack (pShow (filter isContains expectedVals)))+ (T.unpack (pShow (filter isNotContains expectedVals)))+ (T.unpack (pShow receivedVal)) show (HeaderFailure curlCase expected receivedHeaders) = colorizeExpects $ printf- "Headers from %s didn't contain expected headers. Expected: %s. Actual: %s"+ "[%s] Headers from %s didn't contain expected headers. Expected: %s. Actual: %s"+ (name curlCase) (url curlCase) (show expected) (show receivedHeaders)@@ -307,23 +355,30 @@ [AssertionFailure] instance Show CaseResult where- show (CasePass c _ _) = makeGreen "[PASS] " ++ name c+ show (CasePass c _ _) = T.unpack . makeGreen $ "[PASS] " <> name c show (CaseFail c _ _ failures) =- makeRed "[FAIL] " ++- name c ++- "\n" ++- concatMap ((\s -> "\nAssertion failed: " ++ s) . (++ "\n") . show) failures+ T.unpack $ makeRed "[FAIL] " <>+ name c <>+ "\n" <>+ mconcat (map ((\s -> "\nAssertion failed: " <> s) . (<> "\n") . pShow) failures) -- | A wrapper type around a set of test cases. This is the top level spec type -- that we parse a test spec file into-newtype CurlSuite =- CurlSuite [CurlCase]- deriving (Show, Generic)+data CurlSuite = CurlSuite+ { suiteCases :: [CurlCase]+ , suiteCaseFilter :: Maybe T.Text+ } deriving (Show, Generic) -instance FromJSON CurlSuite+noFilterSuite :: [CurlCase] -> CurlSuite+noFilterSuite = flip CurlSuite Nothing instance ToJSON CurlSuite +instance FromJSON CurlSuite where+ parseJSON (Object v) = noFilterSuite <$> v .: "cases"+ parseJSON a@(Array _) = noFilterSuite <$> parseJSON a+ parseJSON invalid = typeMismatch "JsonMatcher" invalid+ -- | Simple predicate that checks if the result is passing isPassing :: CaseResult -> Bool isPassing CasePass {} = True@@ -347,7 +402,7 @@ -- | A single lookup operation in a json query data Index- -- | Drill into the json of a specific test case. The SUITE object is+ -- | Drill into the json of a specific test case. The RESPONSES object is -- accessible as an array of values that have come back from previous test -- cases = CaseResultIndex Integer@@ -357,7 +412,8 @@ | ArrayIndex Integer deriving (Show) -printOriginalQuery (CaseResultIndex t) = "SUITE[" ++ show t ++ "]"+printOriginalQuery :: Index -> String+printOriginalQuery (CaseResultIndex t) = "RESPONSES[" ++ show t ++ "]" printOriginalQuery (KeyIndex key) = "." ++ T.unpack key printOriginalQuery (ArrayIndex i) = printf "[%d]" i @@ -383,10 +439,10 @@ printQueryString :: InterpolatedQuery -> String printQueryString (LiteralText t) = show t printQueryString (InterpolatedQuery raw (Query indexes)) =- printf "%s$<%s>" raw (concat $ map show indexes)-printQueryString (NonInterpolatedQuery (Query indexes)) = printf "$<%s>" (concat $ map show indexes)+ printf "%s$<%s>" raw $ concatMap show indexes+printQueryString (NonInterpolatedQuery (Query indexes)) = printf "$<%s>" (concatMap show indexes) --- | The full string in which a query appears, eg "prefix-${{SUITE[0].key.another_key[0].last_key}}"+-- | The full string in which a query appears, eg "prefix-${{RESPONSES[0].key.another_key[0].last_key}}" type FullQueryText = T.Text--- | The string for one query given the FullQueryText above, the single query text would be SUITE[0].key.another_key[0].last_key+-- | The string for one query given the FullQueryText above, the single query text would be RESPONSES[0].key.another_key[0].last_key type SingleQueryText = T.Text
test/Spec.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE OverloadedStrings #-} module Main where @@ -6,6 +6,7 @@ import System.Directory import Test.Hspec import Testing.CurlRunnings+import Testing.CurlRunnings.Internal import Testing.CurlRunnings.Internal.Parser main :: IO ()@@ -24,20 +25,38 @@ it "should parse valid queries" $ do parseQuery "just some text" `shouldSatisfy` isRight- parseQuery "$<SUITE[0].key.key>" `shouldSatisfy` isRight- parseQuery "$<SUITE[0].key.key[0].key_with_underscores>" `shouldSatisfy` isRight- parseQuery "$<SUITE[100].key.key[0].key_with_underscores>" `shouldSatisfy` isRight- parseQuery "some text before $<SUITE[100].key.key[0].key_with_underscores> and after" `shouldSatisfy` isRight- parseQuery "some $<SUITE[100]> querires $<SUITE[100]>" `shouldSatisfy` isRight- parseQuery "some $<SUITE[100]> querires $<SUITE[100]> ${SOME_ENV_VARIABLE} asdf" `shouldSatisfy` isRight+ parseQuery "$<RESPONSES[0].key.key>" `shouldSatisfy` isRight+ parseQuery "$<RESPONSES[0].key.key[0].key_with_underscores>" `shouldSatisfy` isRight+ parseQuery "$<RESPONSES[100].key.key[0].key_with_underscores>" `shouldSatisfy` isRight+ parseQuery "some text before $<RESPONSES[100].key.key[0].key_with_underscores> and after" `shouldSatisfy` isRight+ parseQuery "some $<RESPONSES[100]> querires $<RESPONSES[100]>" `shouldSatisfy` isRight+ parseQuery "some $<RESPONSES[100]> querires $<RESPONSES[100]> ${SOME_ENV_VARIABLE} asdf" `shouldSatisfy` isRight+ parseQuery "$<SUITE[0].key.key>" `shouldSatisfy` isRight -- legacy SUITE should still be supported it "should reject invalid queries" $ do parseQuery "$<" `shouldSatisfy` isLeft- parseQuery "$<SUITE[f].key>" `shouldSatisfy` isLeft- parseQuery "$<SUITE[1].key[r]>" `shouldSatisfy` isLeft- parseQuery "$<SUITE[1].key[1][1] $<>>" `shouldSatisfy` isLeft- parseQuery "$<SUITE[1].key[1][1]" `shouldSatisfy` isLeft- parseQuery "$<SUITE[1]>.key[1][1] ${" `shouldSatisfy` isLeft+ parseQuery "$<RESPONSES[f].key>" `shouldSatisfy` isLeft+ parseQuery "$<RESPONSES[1].key[r]>" `shouldSatisfy` isLeft+ parseQuery "$<RESPONSES[1].key[1][1] $<>>" `shouldSatisfy` isLeft+ parseQuery "$<RESPONSES[1].key[1][1]" `shouldSatisfy` isLeft+ parseQuery "$<RESPONSES[1]>.key[1][1] ${" `shouldSatisfy` isLeft+ parseQuery "$<POOP[0].key.key>" `shouldSatisfy` isLeft+ parseQuery "some text $<BAD_RESPONSES_REF[0].key.key>" `shouldSatisfy` isLeft++ it "arrayGet should handle positive and negative indexes correctly" $ do+ let a = [1, 2, 3]+ b = [] :: [Int]+ (arrayGet a 0) `shouldBe` Just 1+ (arrayGet a 1) `shouldBe` Just 2+ (arrayGet a 2) `shouldBe` Just 3+ (arrayGet a (-1)) `shouldBe` Just 3+ (arrayGet a (-2)) `shouldBe` Just 2+ (arrayGet a (-3)) `shouldBe` Just 1+ (arrayGet a (-4)) `shouldBe` Nothing+ (arrayGet a 3) `shouldBe` Nothing+ (arrayGet b 0) `shouldBe` Nothing+ (arrayGet b 1) `shouldBe` Nothing+ (arrayGet b (-1)) `shouldBe` Nothing testValidSpec :: String -> IO () testValidSpec file = do