curl-runnings 0.3.0 → 0.6.0

raw patch · 12 files changed

+769/−212 lines, 12 filesdep +megaparsecPVP ok

version bump matches the API change (PVP)

Dependencies added: megaparsec

API changes (from Hackage documentation)

Files

• README.md +29/−25
• app/Main.hs +26/−20
• curl-runnings.cabal +5/−3
• examples/example-spec.json +21/−2
• examples/example-spec.yaml +21/−2
• examples/interpolation-spec.yaml +46/−0
• examples/test.json +0/−75
• src/Testing/CurlRunnings.hs +288/−75
• src/Testing/CurlRunnings/Internal.hs +48/−0
• src/Testing/CurlRunnings/Internal/Parser.hs +141/−0
• src/Testing/CurlRunnings/Types.hs +119/−10
• test/Spec.hs +25/−0

@@ -4,11 +4,13 @@  _Feel the rhythm! Feel the rhyme! Get on up, it's testing time! curl-runnings!_ -curl-runnings is a framework for writing declarative, curl based tests for your APIs. +curl-runnings is a framework for writing declarative, curl based tests for your+APIs. Write your tests quickly and correctly with a straight-forward+specification in yaml or json that can encode simple but powerful matchers+against responses. -Write your tests quickly and correctly with a straight-forward specification in-yaml or json. A DSL for writing your tests is on the way! Alternatively, you can-use the curl-runnings library to write your tests directly in Haskell.+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).  ### Why? @@ -17,28 +19,29 @@ 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 simple to write tests that curl some endpoints and verify the+make it very easy to write tests that just hit some endpoints and verify the output looks sane. -With curl-runnings, you can write your tests just as data in a yaml or json file,-curl runnings will take care of the rest!+Now you can write your tests just as data in a yaml or json file,+and curl-runnings will take care of the rest!  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+language, which is a future goal for the project. curl-runnings specs in Dhall+is also being developed and may fufill the same needs.  ### Installing  There are few options to install: -- download the releases from the github [releases page](https://github.com/aviaviavi/curl-runnings/releases)-- `stack install curl-runnings`-- `cabal install curl-runnings`+- download the 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 -For now, you write your tests specs in a yaml or json file. See /examples to get+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. @@ -46,30 +49,31 @@  Once you've written a spec, simply run it with: -```bash-$ curl-runnings -f path/to/your/spec.yaml-```+```bash $ curl-runnings -f path/to/your/spec.yaml ```  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.  For more info: -```bash-$ curl-runnings --help-```+```bash $ curl-runnings --help ``` -### Roadmap+### 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-- [ ] Embedded dsl for specifications for tests. As the specification gets more complex.-  - [ ] Spec out dsl that can compile down into a yaml/json spec-  - [ ] Implement dsl+- [ ] Dhall specifications for tests - [ ] More specification features-  - [ ] timeouts-  - [ ] retry logic-  - [ ] ability to configure alerts+  - [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   

@@ -3,16 +3,15 @@  module Main where -import qualified Data.Text                       as T-import           Data.Version                    (showVersion)-import           Paths_curl_runnings             (version)+import qualified Data.Text                     as T+import           Data.Version                  (showVersion)+import           Paths_curl_runnings           (version) import           System.Console.CmdArgs import           System.Environment import           System.Exit import           Testing.CurlRunnings import           Testing.CurlRunnings.Internal import           Testing.CurlRunnings.Types-import           Text.Printf  -- | Command line flags data CurlRunnings = CurlRunnings@@ -25,23 +24,30 @@   CurlRunnings {file = def &= typFile &= help "File to run"} &=   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 "" _ =+  putStrLn+    "Please specify an input file with the --file (-f) flag or use --help for more information"+runFile path verbosityLevel = 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+      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++toLogLevel :: Verbosity -> LogLevel+toLogLevel v = toEnum $ fromEnum v+ main :: IO () main = do-  mainArgs <- cmdArgs argParser-  case file mainArgs of-    "" ->-      putStrLn-        "Please specify an input file with the --file (-f) flag or use --help for more information"-    path -> 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-          if any isFailing results-            then putStrLn (makeRed "Some tests failed") >>-                 exitWith (ExitFailure 1)-            else putStrLn $ makeGreen "All tests passed!"-        Left messgage -> putStrLn $ "Couldn't read input json or yaml file: " ++ messgage+  userArgs <- cmdArgs argParser+  verbosityLevel <- getVerbosity+  runFile (file userArgs) verbosityLevel

@@ -2,10 +2,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 9530ddd7493ff79858e3c01c7064eb8119932f625cdb1fa3f5cb93e3b3786189+-- hash: e22614c4e739f355b79fac77eb1cf5c8111237f2adc4aebcccbbb3b118e8d817  name:           curl-runnings-version:        0.3.0+version:        0.6.0 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@@ -22,7 +22,7 @@ extra-source-files:     examples/example-spec.json     examples/example-spec.yaml-    examples/test.json+    examples/interpolation-spec.yaml     README.md  source-repository head@@ -43,6 +43,7 @@     , hspec-expectations >=0.8.2     , http-conduit >=2.2.4     , http-types >=0.9.1+    , megaparsec >=6.3.0     , text >=1.2.2.2     , unordered-containers >=0.2.8.0     , vector >=0.12.0@@ -51,6 +52,7 @@       Testing.CurlRunnings       Testing.CurlRunnings.Types       Testing.CurlRunnings.Internal+      Testing.CurlRunnings.Internal.Parser   other-modules:       Paths_curl_runnings   default-language: Haskell2010

@@ -28,12 +28,31 @@     "name": "test 3",     "url": "http://your-url.com/other/path",     "requestMethod": "GET",+    "expectData": {+      "contains": [+        {+          "keyValueMatch": {+            "key": "okay",+            "value": true+          }+        },+        {+          "valueMatch": true+        }+      ]+    },+    "expectStatus": 200+  },+  {+    "name": "test 4",+    "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 4",+    "name": "test 5",     "url": "http://your-url.com/other/path",     "requestMethod": "GET",     "headers": "Content-Type: application/json",@@ -45,7 +64,7 @@     ]   },   {-    "name": "test 5",+    "name": "test 6",     "url": "http://your-url.com/other/path",     "requestMethod": "GET",     "headers": "Content-Type: application/json",

@@ -32,6 +32,25 @@ - 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   # 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"@@ -40,7 +59,7 @@   # Header strings again match the -H syntax from curl   expectHeaders: "Content-Type: application/json; Hello: world" -- name: test 4+- name: test 5   url: http://your-url.com/other/path   requestMethod: GET   headers: "Content-Type: application/json"@@ -50,7 +69,7 @@   -     key: "Key-With-Val-We-Dont-Care-About" -- name: test 5+- name: test 6   url: http://your-url.com/other/path   requestMethod: GET   headers: "Content-Type: application/json"

@@ -0,0 +1,46 @@+---+- 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 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+  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

@@ -1,75 +0,0 @@-[-  {-    "name": "test 1",-    "url": "http://sd.ddpay.io/status",-    "requestMethod": "GET",-    "expectData": {-        "tag": "Exactly",-        "contents": {-            "okay": true,-            "msg": ""-        }-    },-    "expectStatus": {-        "tag": "ExactCode",-        "contents": 200-    },-    "requestData": null-  },--  {-    "name": "test 2",-    "url": "http://sd.ddpay.io/status",-    "requestMethod": "GET",-    "expectData": {-        "tag": "Contains",-        "contents": [-          {-            "tag": "ValueMatch",-            "contents": true-          },-          {-            "tag": "ValueMatch",-            "contents": ""-          },-          {-            "tag": "KeyValueMatch",-            "matchKey": "msg",-            "matchValue": ""-          },-          {-            "tag": "KeyValueMatch",-            "matchKey": "okay",-            "matchValue": true-          }-                      ]-    },-    "expectStatus": {-      "tag": "AnyCodeIn",-      "contents": [200, 300]-    },-    "requestData": null-  },--  {-    "name": "test 4",-    "url": "http://sd.ddpay.io/v1/DevOnlyGetAllCustomerIds",-    "requestMethod": "POST",-    "expectStatus": {-      "tag": "ExactCode",-      "contents": 400-    },-    "requestData": {}-  },-  {-    "name": "test 5",-    "url": "http://sd.ddpay.io/v1/DevOnlyGetAllCustomerIds",-    "requestMethod": "POST",-    "expectData": null,-    "expectStatus": {-      "tag": "AnyCodeIn",-      "contents": [401]-    },-    "requestData": {"api_token": "asdf"}-  }-]

@@ -1,10 +1,10 @@-{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE OverloadedStrings   #-}+{-# LANGUAGE ScopedTypeVariables #-}  -- | 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@@ -12,74 +12,136 @@  import           Control.Monad import           Data.Aeson-import qualified Data.ByteString.Char8      as B8S-import qualified Data.ByteString.Lazy       as B-import qualified Data.CaseInsensitive       as CI-import qualified Data.HashMap.Strict        as H+import           Data.Aeson.Types+import qualified Data.ByteString.Char8                as B8S+import qualified Data.ByteString.Lazy                 as B+import qualified Data.CaseInsensitive                 as CI+import           Data.Either+import qualified Data.HashMap.Strict                  as H+import           Data.List import           Data.Maybe-import qualified Data.Text                  as T-import qualified Data.Yaml                  as Y+import           Data.Monoid+import qualified Data.Text                            as T+import qualified Data.Vector                          as V+import qualified Data.Yaml                            as Y import           Network.HTTP.Conduit import           Network.HTTP.Simple-import qualified Network.HTTP.Types.Header  as HTTP+import qualified Network.HTTP.Types.Header            as HTTP+import           System.Directory+import           System.Environment+import           Testing.CurlRunnings.Internal+import           Testing.CurlRunnings.Internal.Parser import           Testing.CurlRunnings.Types import           Text.Printf  -- | decode a json or yaml file into a suite object decodeFile :: FilePath -> IO (Either String CurlSuite)-decodeFile specPath =-  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" (T.pack 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" ->+        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  -- | 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 :: CurlCase -> IO CaseResult-runCase curlCase = do-  initReq <- parseRequest $ url curlCase-  response <--    httpBS .-    (setRequestHeaders-       (toHTTPHeaders $ fromMaybe (HeaderSet []) (headers curlCase))) .-    setRequestBodyJSON (requestData curlCase) $-    initReq {method = B8S.pack . show $ requestMethod curlCase}-  returnVal <--    (return . decode . B.fromStrict $ getResponseBody response) :: IO (Maybe Value)-  let returnCode = getResponseStatusCode response-      receivedHeaders = responseHeaders response-      assertionErrors =-        map fromJust $-        filter-          isJust-          [ checkBody curlCase returnVal-          , checkCode curlCase returnCode-          , checkHeaders curlCase receivedHeaders-          ]-  return $-    case assertionErrors of-      []       -> CasePass curlCase-      failures -> CaseFail curlCase failures+runCase :: CurlRunningsState -> CurlCase -> IO CaseResult+runCase state curlCase = do+  let eInterpolatedUrl = interpolateQueryString state $ T.pack $ url curlCase+      eInterpolatedHeaders =+        interpolateHeaders state $ fromMaybe (HeaderSet []) (headers curlCase)+  case (eInterpolatedUrl, eInterpolatedHeaders) of+    (Left err, _) ->+      return $ CaseFail curlCase Nothing Nothing [QueryFailure curlCase err]+    (_, Left err) ->+      return $ CaseFail curlCase Nothing Nothing [QueryFailure curlCase err]+    (Right interpolatedUrl, Right interpolatedHeaders) ->+      case sequence $ runReplacements state <$> requestData curlCase of+        Left l ->+          return $ CaseFail curlCase Nothing Nothing [QueryFailure curlCase l]+        Right replacedJSON -> do+          initReq <- parseRequest $ T.unpack interpolatedUrl+          let request =+                setRequestBodyJSON (fromMaybe emptyObject replacedJSON) .+                setRequestHeaders (toHTTPHeaders interpolatedHeaders) $+                initReq {method = B8S.pack . show $ requestMethod curlCase}+          logger state DEBUG (show request)+          response <- httpBS request+          logger state DEBUG (show response)+          returnVal <-+            (return . decode . B.fromStrict $ getResponseBody response) :: IO (Maybe Value)+          let returnCode = getResponseStatusCode response+              receivedHeaders = fromHTTPHeaders $ responseHeaders response+              assertionErrors =+                map fromJust $+                filter+                  isJust+                  [ checkBody state curlCase returnVal+                  , checkCode curlCase returnCode+                  , checkHeaders state curlCase receivedHeaders+                  ]+          return $+            case assertionErrors of+              [] -> CasePass curlCase (Just receivedHeaders) returnVal+              failures ->+                CaseFail curlCase (Just receivedHeaders) returnVal failures -checkHeaders :: CurlCase -> [HTTP.Header] -> Maybe AssertionFailure-checkHeaders (CurlCase _ _ _ _ _ _ _ Nothing) _ = Nothing-checkHeaders curlCase@(CurlCase _ _ _ _ _ _ _ (Just matcher@(HeaderMatcher m))) l =-  let receivedHeaders = fromHTTPHeaders l-      notFound = filter (not . headerIn receivedHeaders) m-  in-    if null $ notFound then-      Nothing-    else-      Just $ HeaderFailure curlCase matcher receivedHeaders+checkHeaders :: CurlRunningsState -> CurlCase -> Headers -> Maybe AssertionFailure+checkHeaders _ (CurlCase _ _ _ _ _ _ _ Nothing) _ = Nothing+checkHeaders state curlCase@(CurlCase _ _ _ _ _ _ _ (Just (HeaderMatcher m))) receivedHeaders =+  let interpolatedHeaders = mapM (interpolatePartialHeader state) m+  in case interpolatedHeaders of+       Left f -> Just $ QueryFailure curlCase f+       Right headerList ->+         let notFound =+               filter+                 (not . headerIn receivedHeaders)+                 (unsafeLogger state DEBUG "header matchers" headerList)+         in if null notFound+              then Nothing+              else Just $+                   HeaderFailure+                     curlCase+                     (HeaderMatcher headerList)+                     receivedHeaders +interpolatePartialHeader :: CurlRunningsState -> PartialHeaderMatcher -> Either QueryError PartialHeaderMatcher+interpolatePartialHeader state (PartialHeaderMatcher k v) =+  let k' = interpolateQueryString state <$> k+      v' = interpolateQueryString state <$> v+  in case (k', v') of+       (Just (Left err), _) -> Left err+       (_, Just (Left err)) -> Left err+       (Just (Right p), Just (Right q)) ->+         Right $ PartialHeaderMatcher (Just p) (Just q)+       (Just (Right p), Nothing) ->+         Right $ PartialHeaderMatcher (Just p) Nothing+       (Nothing, Just (Right p)) ->+         Right $ PartialHeaderMatcher Nothing (Just p)+       _ ->+         unsafeLogger state ERROR "WARNING: empty header matcher found" . Right $+         PartialHeaderMatcher Nothing Nothing++interpolateHeaders :: CurlRunningsState -> Headers -> Either QueryError Headers+interpolateHeaders state (HeaderSet headerList) =+  mapM+    (\(Header k v) ->+       case sequence+              [interpolateQueryString state k, interpolateQueryString state v] of+         Left err       -> Left err+         Right [k', v'] -> Right $ Header k' v')+    headerList >>=+  (Right . HeaderSet)+ -- | Does this header contain our matcher? headerMatches :: PartialHeaderMatcher -> Header -> Bool headerMatches (PartialHeaderMatcher mk mv) (Header k v) =-  (maybe True (== k) mk) && (maybe True (== v) mv)+  maybe True (== k) mk && maybe True (== v) mv  -- | Does any of these headers contain our matcher? headerIn :: Headers -> PartialHeaderMatcher -> Bool@@ -94,44 +156,195 @@ printR x = print x >> return x  -- | Runs the test cases in order and stop when an error is hit. Returns all the results-runSuite :: CurlSuite -> IO [CaseResult]-runSuite (CurlSuite cases) =+runSuite :: CurlSuite -> LogLevel -> IO [CaseResult]+runSuite (CurlSuite cases) logLevel = do+  fullEnv <- getEnvironment+  let envMap = H.fromList $ map (\(x, y) -> (T.pack x, T.pack y)) fullEnv   foldM     (\prevResults curlCase ->        case safeLast prevResults of-         Just (CaseFail _ _) -> return prevResults-         Just (CasePass _) -> do-           result <- runCase curlCase >>= printR+         Just CaseFail {} -> return prevResults+         Just CasePass {} -> do+           result <- runCase (CurlRunningsState envMap prevResults logLevel) curlCase >>= printR            return $ prevResults ++ [result]          Nothing -> do-           result <- runCase curlCase >>= printR+           result <- runCase (CurlRunningsState envMap [] logLevel) curlCase >>= printR            return [result])     []     cases  -- | Check if the retrieved value fail's the case's assertion-checkBody :: 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 curlCase@(CurlCase _ _ _ _ _ (Just matcher@(Exactly expectedValue)) _ _) (Just receivedBody)-  | expectedValue /= receivedBody =-    Just $ DataFailure curlCase matcher (Just receivedBody)-  | otherwise = Nothing+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+        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 curlCase@(CurlCase _ _ _ _ _ (Just matcher@(Contains expectedSubvalues)) _ _) (Just receivedBody)-  | jsonContainsAll receivedBody expectedSubvalues = Nothing-  | otherwise = Just $ DataFailure curlCase matcher (Just receivedBody)+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)+        then Nothing+        else Just $+             DataFailure curlCase (Contains updatedMatcher) (Just receivedBody)+ -- | We expected a body but didn't get one-checkBody curlCase@(CurlCase _ _ _ _ _ (Just anything) _ _) Nothing = Just $ DataFailure curlCase anything Nothing+checkBody _ curlCase@(CurlCase _ _ _ _ _ (Just anything) _ _) Nothing =+  Just $ DataFailure curlCase anything Nothing+ -- | No assertions on the body-checkBody (CurlCase _ _ _ _ _ Nothing _ _) _ = Nothing+checkBody _ (CurlCase _ _ _ _ _ Nothing _ _) _ = Nothing +runReplacementsOnSubvalues :: CurlRunningsState -> [JsonSubExpr] -> Either QueryError [JsonSubExpr]+runReplacementsOnSubvalues state =+  mapM+    (\expr ->+       case expr of+         ValueMatch v ->+           case runReplacements state v of+             Left l       -> Left l+             Right newVal -> Right $ ValueMatch newVal+         KeyValueMatch k v ->+           case (interpolateQueryString state k, runReplacements state v) of+             (Left l, _) -> Left l+             (_, Left l) -> Left l+             (Right k', Right v') ->+               Right KeyValueMatch {matchKey = k', matchValue = v'})++-- | runReplacements+runReplacements :: CurlRunningsState -> Value -> Either QueryError Value+runReplacements state (Object o) =+  let keys = H.keys o+      keysWithUpdatedKeyVal =+        map+          (\key ->+             let value = fromJust $ H.lookup key o+              -- (old key, new key, new value)+             in ( key+                , interpolateQueryString state key+                , runReplacements state value))+          keys+  in mapRight Object $+     foldr+       (\((key, eKeyResult, eValueResult) :: ( T.Text+                                             , Either QueryError T.Text+                                             , Either QueryError Value)) (eObjectToUpdate :: Either QueryError Object) ->+          case (eKeyResult, eValueResult, eObjectToUpdate)+            -- TODO there should be a more elegant way to write this error+            -- handling below+                of+            (Left queryErr, _, _) -> Left queryErr+            (_, Left queryErr, _) -> Left queryErr+            (_, _, Left queryErr) -> Left queryErr+            (Right newKey, Right newValue, Right objectToUpdate) ->+              if key /= newKey+                then let inserted = H.insert newKey newValue objectToUpdate+                         deleted = H.delete key inserted+                     in Right deleted+                else Right $ H.insert key newValue objectToUpdate)+       (Right o)+       keysWithUpdatedKeyVal+runReplacements p (Array a) =+  let results = V.mapM (runReplacements p) a+  in case results of+       Left l  -> Left l+       Right r -> Right $ Array r+-- special case, i can't figure out how to get the parser to parse empty strings :'(+runReplacements _ s@(String "") = Right s+runReplacements state (String s) =+  case parseQuery s of+    Right [LiteralText t] -> Right $ String t+    Right [q@(InterpolatedQuery _ _)] -> getStringValueForQuery state q >>= (Right . String)+    Right [q@(NonInterpolatedQuery _)] -> getValueForQuery state q+    Right _ -> mapRight String $ interpolateQueryString state s+    Left parseErr -> Left parseErr+runReplacements _ valToUpdate = Right valToUpdate++-- | 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 state query =+  let parsedQuery = parseQuery query+  in case parsedQuery of+       (Left err) -> Left err+       (Right interpolatedQ) ->+         let lookups :: [Either QueryError T.Text] =+               map (getStringValueForQuery state) interpolatedQ+             failure = find isLeft lookups+             goodLookups :: [T.Text] =+               Prelude.map (fromRight (T.pack "error")) lookups+         in fromMaybe (Right $ foldr (<>) (T.pack "") goodLookups) failure++-- | Lookup the text at the specified query+getStringValueForQuery :: CurlRunningsState -> InterpolatedQuery -> Either QueryError T.Text+getStringValueForQuery _ (LiteralText rawText) = Right rawText+getStringValueForQuery state (NonInterpolatedQuery q) =+  getStringValueForQuery state $ InterpolatedQuery "" q+getStringValueForQuery state i@(InterpolatedQuery rawText (Query _)) =+  case getValueForQuery state i of+    Left l           -> Left l+    Right (String s) -> Right $ rawText <> s+    (Right o)        -> Left $ QueryTypeMismatch "Expected a string" o+getStringValueForQuery (CurlRunningsState env _ _) (InterpolatedQuery rawText (EnvironmentVariable v)) =+  Right $ rawText <> H.lookupDefault "" v env++-- | Lookup the value for the specified query+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)+    _ ->+      Left . QueryValidationError $+      T.pack $ "$<> queries must start with a SUITE[index] query: " ++ show full+getValueForQuery (CurlRunningsState env _ _) (NonInterpolatedQuery (EnvironmentVariable var)) =+  Right . String $ H.lookupDefault "" var env+getValueForQuery state (InterpolatedQuery _ q) =+  case getValueForQuery state (NonInterpolatedQuery q) of+    Right (String s) -> Right . String $ s+    Right Null -> Right Null+    Right v -> Left $ QueryTypeMismatch (T.pack "Expected a string") v+    Left l -> Left l+ -- | 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 ->-            containsKeyVal jsonValue key subval+  all $ \match ->+    case match of+      ValueMatch subval -> subval `elem` traverseValue jsonValue+      KeyValueMatch key subval ->+        any (\o -> containsKeyVal o key subval) (traverseValue jsonValue)  -- | Does the json value contain the given key value pair? containsKeyVal :: Value -> T.Text -> Value -> Bool

@@ -3,10 +3,58 @@ module Testing.CurlRunnings.Internal   ( makeRed   , makeGreen+  , tracer+  , mapRight+  , arrayGet+  , makeLogger+  , makeUnsafeLogger++  , LogLevel(..)+  , CurlRunningsLogger+  , CurlRunningsUnsafeLogger   ) where +import           Control.Monad+import           Debug.Trace+ makeGreen :: String -> String makeGreen s = "\x1B[32m" ++ s ++ "\x1B[0m"  makeRed :: String -> String makeRed s = "\x1B[31m" ++ s ++ "\x1B[0m"++tracer :: Show a => String -> a -> a+tracer a b = trace (a ++ ": " ++ show b) b++mapRight :: (b -> c) -> Either a b -> Either a c+mapRight f (Right v) = Right $ f v+mapRight _ (Left v)  = Left v++-- | Array indexing with negative values allowed+arrayGet :: [a] -> Int -> a+arrayGet a i+  | i >= 0 = a !! i+  | otherwise = reverse a !! (-i)++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 ())++-- | 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)++makeLogger :: LogLevel -> CurlRunningsLogger+makeLogger threshold level text =+  when (level <= threshold) $ putStrLn text++makeUnsafeLogger :: Show a => LogLevel -> CurlRunningsUnsafeLogger a+makeUnsafeLogger threshold level text object =+  if level <= threshold then+    tracer text object+  else+    object++

@@ -0,0 +1,141 @@+{-# LANGUAGE OverloadedStrings   #-}++-- | Internal module for parsing string based directives inside of curl runnings+-- suites. Use this module at your own risk, it may change. Currently, string+-- interpolation can be performed, where interpolated values are json quries+-- into responses from past test cases.+--+-- > "$<SUITE[0].key[0].another_key>"+--+-- here the `SUITE` 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>"+-- >+--+-- 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+--+-- >+-- >  $< ... >+-- >+--+-- to signify an interpolation. You can have mutliple queries inside a+-- single string, but if interpolation is occuring, then the query specified+-- must resolve to a string value. Otheriwse, a type error will be thrown.+module Testing.CurlRunnings.Internal.Parser+    (+      parseQuery+    ) where++import           Data.List+import qualified Data.Text                  as T+import           Data.Void+import           Testing.CurlRunnings.Types+import           Text.Megaparsec+import           Text.Megaparsec.Char+import qualified Text.Megaparsec.Char.Lexer as L++-- | Given some query text, attempt to parse it to a list of interplated query objects. This data representation may change.+parseQuery :: FullQueryText -> Either QueryError [InterpolatedQuery]+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++type Parser = Parsec Void T.Text++parseSuiteIndex' :: Parser Index+parseSuiteIndex' = do+  notFollowedBy gtlt+  _ <- string "SUITE"+  (ArrayIndex i) <- arrayIndexParser+  return $ CaseResultIndex i++spaceOrDot :: Parser ()+spaceOrDot = (try $ char '.' >> space) <|> space++lexeme :: Parser a -> Parser a+lexeme = L.lexeme spaceOrDot++symbol :: T.Text -> Parser T.Text+symbol = L.symbol spaceOrDot++inGTLT :: Parser a -> Parser a+inGTLT = between (symbol "$<") (string ">")++gtlt :: Parser T.Text+gtlt = symbol "<" <|> symbol ">"++brackets :: Parser a -> Parser a+brackets = between (symbol "[") (symbol "]")++bracket :: Parser T.Text+bracket = symbol "[" <|> symbol "]"++braces ::  Parser a -> Parser a+braces = between (symbol "${") (string "}")++brace :: Parser T.Text+brace = symbol "{" <|> symbol "}"++integer :: Parser Integer+integer = lexeme $ L.signed spaceOrDot L.decimal++dot :: Parser T.Text+dot = symbol "."++arrayIndexParser :: Parser Index+arrayIndexParser = notFollowedBy gtlt >> ArrayIndex <$> brackets integer++environmentVariableParser :: Parser Query+environmentVariableParser = do+  notFollowedBy endingChars+  (EnvironmentVariable . T.pack) <$> braces (lexeme $ many (noneOf ['[', ']', '<', '>', ' ', '{', '}']))++endingChars :: Parser T.Text+endingChars = dot <|> eol <|> bracket <|> gtlt <|> brace++keyIndexParser :: Parser Index+keyIndexParser = do+  notFollowedBy endingChars+  (lexeme . try) ((KeyIndex . T.pack) <$> p)+  where+    p = (:) <$> letterChar <*> many (noneOf ['.', '[', ']', '<', '>', ' ', '{', '}'])++jsonIndexParser :: Parser Query+jsonIndexParser =+  leadingText >>+  (inGTLT $ some (parseSuiteIndex' <|> keyIndexParser <|> arrayIndexParser)) >>=+  return . Query++interpolatedQueryParser :: Parser InterpolatedQuery+interpolatedQueryParser = do+  text <- leadingText+  q <- environmentVariableParser <|> jsonIndexParser+  if null text then return $ NonInterpolatedQuery q+  else return $ InterpolatedQuery (T.pack text) q++leadingText :: Parser String+leadingText = manyTill anyChar $ lookAhead (symbol "$<" <|> "${")++noQueryText :: Parser InterpolatedQuery+noQueryText = do+  str <- some anyChar+  eof+  if "$<" `isInfixOf` str+    then fail "invalid `$<` found"+    else if "${" `isInfixOf` str+      then fail "invalid `${` found"+      else return $ LiteralText $ T.pack str++parseFullTextWithQuery :: Parser [InterpolatedQuery]+parseFullTextWithQuery = many ((try interpolatedQueryParser) <|> noQueryText)+

@@ -1,5 +1,5 @@-{-# LANGUAGE DeriveGeneric        #-}-{-# LANGUAGE OverloadedStrings    #-}+{-# LANGUAGE DeriveGeneric     #-}+{-# LANGUAGE OverloadedStrings #-}  -- | Data types for curl-runnings tests @@ -16,9 +16,18 @@   , JsonSubExpr(..)   , PartialHeaderMatcher(..)   , StatusCodeMatcher(..)+  , QueryError(..)+  , Index(..)+  , Query(..)+  , InterpolatedQuery(..)+  , FullQueryText+  , SingleQueryText+  , CurlRunningsState(..)    , isFailing   , isPassing+  , logger+  , unsafeLogger    ) where @@ -96,6 +105,26 @@  instance ToJSON HeaderMatcher +-- | 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+  -- | 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++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 (QueryValidationError message) = printf "invalid query: %s" message+ parseHeader :: T.Text -> Either T.Text Header parseHeader str =   case map T.strip $ T.splitOn ":" str of@@ -207,56 +236,79 @@   | HeaderFailure CurlCase                   HeaderMatcher                   Headers+  -- | Something went wrong with a test case json query+  | QueryFailure CurlCase+                 QueryError   -- | Something else   | UnexpectedFailure ++colorizeExpects :: String -> String+colorizeExpects t =+  let expectedColor = makeRed "Excpected:"+      actualColor = makeRed "Actual:"+      replacedExpected = T.replace "Expected:" (T.pack expectedColor) (T.pack t)+  in T.unpack $ T.replace "Actual:" (T.pack actualColor) replacedExpected+ instance Show AssertionFailure where   show (StatusFailure c receivedCode) =     case expectStatus c of       ExactCode code ->+        colorizeExpects $         printf           "Incorrect status code from %s. Expected: %s. Actual: %s"           (url c)           (show code)           (show receivedCode)       AnyCodeIn codes ->+        colorizeExpects $         printf-          "Incorrect status code from %s. Expected one of: %s. Actual: %s"+          "Incorrect status code from %s. Expected: %s. Actual: %s"           (url c)           (show codes)           (show receivedCode)   show (DataFailure curlCase expected receivedVal) =     case expected of       Exactly expectedVal ->+        colorizeExpects $         printf           "JSON response from %s didn't match spec. Expected: %s. Actual: %s"           (url curlCase)           (B8.unpack (encodePretty expectedVal))           (B8.unpack (encodePretty receivedVal))       (Contains expectedVals) ->+        colorizeExpects $         printf           "JSON response from %s didn't contain the matcher. Expected: %s to be each be subvalues in: %s"           (url curlCase)           (B8.unpack (encodePretty expectedVals))           (B8.unpack (encodePretty receivedVal))   show (HeaderFailure curlCase expected receivedHeaders) =+    colorizeExpects $     printf-      "Headers from %s didn't contain expected headers. Expected headers: %s. Received headers: %s"+      "Headers from %s didn't contain expected headers. Expected: %s. Actual: %s"       (url curlCase)       (show expected)       (show receivedHeaders)+  show (QueryFailure curlCase queryErr) =+    colorizeExpects $+    printf "JSON query error in spec %s: %s" (name curlCase) (show queryErr)   show UnexpectedFailure = "Unexpected Error D:"  -- | A type representing the result of a single curl, and all associated -- assertions data CaseResult   = CasePass CurlCase+             (Maybe Headers)+             (Maybe Value)   | CaseFail CurlCase+             (Maybe Headers)+             (Maybe Value)              [AssertionFailure]  instance Show CaseResult where-  show (CasePass c) = makeGreen "[PASS] " ++ name c-  show (CaseFail c failures) =+  show (CasePass c _ _) = makeGreen "[PASS] " ++ name c+  show (CaseFail c _ _ failures) =     makeRed "[FAIL] " ++     name c ++     "\n" ++@@ -274,10 +326,67 @@  -- | Simple predicate that checks if the result is passing isPassing :: CaseResult -> Bool-isPassing (CasePass _)   = True-isPassing (CaseFail _ _) = False+isPassing CasePass {} = True+isPassing CaseFail {} = False  -- | Simple predicate that checks if the result is failing isFailing :: CaseResult -> Bool-isFailing (CasePass _)   = False-isFailing (CaseFail _ _) = True+isFailing = not . isPassing++-- | A map of the system environment+type Environment = H.HashMap T.Text T.Text++-- | The state of a suite. Tracks environment variables, and all the test results so far+data CurlRunningsState = CurlRunningsState Environment [CaseResult] LogLevel++logger :: CurlRunningsState -> CurlRunningsLogger+logger (CurlRunningsState _ _ l) = makeLogger l++unsafeLogger :: Show a => CurlRunningsState -> CurlRunningsUnsafeLogger a+unsafeLogger (CurlRunningsState _ _ l) = makeUnsafeLogger l++-- | A single lookup operation in a json query+data Index+  -- | Drill into the json of a specific test case. The SUITE object is+  -- accessible as an array of values that have come back from previous test+  -- cases+  = CaseResultIndex Integer+  -- | A standard json key lookup.+  | KeyIndex T.Text+  -- | A standard json array index lookup.+  | ArrayIndex Integer+  deriving (Show)++printOriginalQuery (CaseResultIndex t) = "SUITE[" ++ show t ++ "]"+printOriginalQuery (KeyIndex key)      = "." ++ T.unpack key+printOriginalQuery (ArrayIndex i)      = printf "[%d]" i++-- | A single entity to be queries from a json value+data Query =+  -- | A single query contains a list of discrete index operations+  Query [Index] |+  -- | Lookup a string in the environment+  EnvironmentVariable T.Text+  deriving (Show)++-- | A distinct parsed unit in a query+data InterpolatedQuery+  -- | Regular text, no query+  = LiteralText T.Text+  -- | Some leading text, then a query+  | InterpolatedQuery T.Text+                      Query+  -- | Just a query, no leading text+  | NonInterpolatedQuery Query+  deriving (Show)++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)++-- | The full string in which a query appears, eg "prefix-${{SUITE[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+type SingleQueryText = T.Text

@@ -1,9 +1,12 @@+{-# LANGUAGE OverloadedStrings   #-}+ module Main where  import           Data.Either import           System.Directory import           Test.Hspec import           Testing.CurlRunnings+import           Testing.CurlRunnings.Internal.Parser  main :: IO () main = hspec $@@ -13,6 +16,28 @@    it "should provide valid example json specs" $     testValidSpec "/examples/example-spec.json"++  -- note that this doesn't actually try to parse the interpolations themselves,+  -- but that would be useful thing to add here+  it "should provid a valid interpolation spec" $+    testValidSpec "/examples/interpolation-spec.yaml"++  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++  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  testValidSpec :: String -> IO () testValidSpec file = do