curl-runnings 0.11.1 → 0.12.0

raw patch · 12 files changed

+529/−126 lines, 12 filesdep +clockdep +http-typesdep +raw-strings-qqPVP ok

version bump matches the API change (PVP)

Dependencies added: clock, http-types, raw-strings-qq, time

API changes (from Hackage documentation)

Files

• README.md +12/−13
• curl-runnings.cabal +13/−3
• examples/example-spec.json +24/−5
• examples/example-spec.yaml +23/−6
• src/Testing/CurlRunnings.hs +65/−28
• src/Testing/CurlRunnings/Internal.hs +13/−0
• src/Testing/CurlRunnings/Internal/Headers.hs +97/−0
• src/Testing/CurlRunnings/Internal/KeyValuePairs.hs +46/−0
• src/Testing/CurlRunnings/Internal/Parser.hs +2/−1
• src/Testing/CurlRunnings/Internal/Payload.hs +84/−0
• src/Testing/CurlRunnings/Types.hs +43/−69
• test/Spec.hs +107/−1

@@ -16,18 +16,18 @@  ### Why? -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.+This library came out of a pain-point my coworkers 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!@@ -125,7 +125,6 @@       context: .       dockerfile: ./Dockerfile ```-  ### Contributing 

@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: c5eff7acb49843acbacdcf64e3e57fd05242eee41e466f2468cc9bf696b5f666+-- hash: 184f34d36c0d081262571516a7ddbef911407a4dc5c3c08f6b67982a7d30d485  name:           curl-runnings-version:        0.11.1+version:        0.12.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@@ -36,6 +36,9 @@       Testing.CurlRunnings.Types       Testing.CurlRunnings.Internal       Testing.CurlRunnings.Internal.Parser+      Testing.CurlRunnings.Internal.Headers+      Testing.CurlRunnings.Internal.KeyValuePairs+      Testing.CurlRunnings.Internal.Payload   other-modules:       Paths_curl_runnings   hs-source-dirs:@@ -45,16 +48,19 @@     , base >=4.0 && <5     , bytestring >=0.10.8.2     , case-insensitive >=0.2.1+    , clock >=0.7.2     , connection >=0.2.8     , directory >=1.3.0.2     , hspec >=2.4.4     , hspec-expectations >=0.8.2     , http-client-tls >=0.3.5.3     , http-conduit >=2.3.6+    , http-types >=0.12.3     , megaparsec >=7.0.4     , pretty-simple >=2.0.2.1     , regex-posix >=0.95.2     , text >=1.2.2.2+    , time >=1.8.0.2     , unordered-containers >=0.2.8.0     , vector >=0.12.0     , yaml >=0.8.28@@ -89,9 +95,13 @@       test   ghc-options: -threaded -rtsopts -with-rtsopts=-N   build-depends:-      base >=4.0 && <5+      aeson >=1.2.4.0+    , base >=4.0 && <5+    , bytestring >=0.10.8.2     , curl-runnings     , directory >=1.3.0.2     , hspec >=2.4.4     , hspec-expectations >=0.8.2+    , raw-strings-qq >=1.1+    , text >=1.2.2.2   default-language: Haskell2010

@@ -3,6 +3,9 @@     "name": "test 1",     "url": "http://your-endpoint.com/status",     "requestMethod": "GET",+    "queryParameters": {+       "key": "value"+    },     "expectData": {       "exactly": {         "okay": true,@@ -26,6 +29,22 @@   },   {     "name": "test 3",+    "url": "http://your-endpoint.com/path",+    "requestMethod": "POST",+    "expectStatus": [+      200,+      201+    ],+    "requestData": {+      "bodyType": "urlencoded",+      "content": {+        "hello": "there",+        "num": 1+      }+    }+  },+  {+    "name": "test 4",     "url": "http://your-url.com/other/path",     "requestMethod": "GET",     "expectData": {@@ -44,7 +63,7 @@     "expectStatus": 200   },   {-    "name": "test 4",+    "name": "test 5",     "url": "http://your-url.com/other/path",     "requestMethod": "GET",     "expectData": {@@ -63,7 +82,7 @@     "expectStatus": 200   },   {-    "name": "test 5",+    "name": "test 6",     "url": "http://your-url.com/other/path",     "requestMethod": "GET",     "expectData": {@@ -84,7 +103,7 @@     "expectStatus": 200   },   {-    "name": "test 6",+    "name": "test 7",     "url": "http://your-url.com/other/path",     "requestMethod": "GET",     "headers": "Content-Type: application/json",@@ -92,7 +111,7 @@     "expectHeaders": "Content-Type: application/json; Hello: world"   },   {-    "name": "test 7",+    "name": "test 8",     "url": "http://your-url.com/other/path",     "requestMethod": "GET",     "headers": "Content-Type: application/json",@@ -104,7 +123,7 @@     ]   },   {-    "name": "test 8",+    "name": "test 9",     "url": "http://your-url.com/other/path",     "requestMethod": "GET",     "headers": "Content-Type: application/json",

@@ -6,6 +6,8 @@   - name: test 1 # required     url: http://your-endpoint.com/status # required     requestMethod: GET # required+    queryParameters: # optional (in addition to those set on the url).+        key: value     # [Optional] Specify the json payload we expect here     # The 1 key in this block should be either:     # exactly | contains@@ -32,6 +34,22 @@       num: 1    - name: test 3+    url: http://your-endpoint.com/path+    requestMethod: POST+    expectStatus:+    - 200+    - 201+    # [Optional] Data to send with the request.+    requestData:+      # `bodyType` specifies the type of request payload. Possible values+      # are `urlencoded` | `json`.+      bodyType: urlencoded+      content:+        # This object specifies the data to send with the request.+        hello: there+        num: 1++  - name: test 4     url: http://your-url.com/other/path     requestMethod: GET     expectData:@@ -52,7 +70,7 @@       - keyMatch: okay     expectStatus: 200 -  - name: test 4+  - name: test 5     url: http://your-url.com/other/path     requestMethod: GET     expectData:@@ -68,7 +86,7 @@       - keyMatch: error     expectStatus: 200 -  - name: test 5+  - name: test 6     url: http://your-url.com/other/path     requestMethod: GET     expectData:@@ -81,7 +99,7 @@       - valueMatch: false     expectStatus: 200 -  - name: test 6+  - name: test 7     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@@ -92,7 +110,7 @@     # Header strings again match the -H syntax from curl     expectHeaders: "Content-Type: application/json; Hello: world" -  - name: test 7+  - name: test 8     url: http://your-url.com/other/path     requestMethod: GET     headers: "Content-Type: application/json"@@ -102,7 +120,7 @@     -       key: "Key-With-Val-We-Dont-Care-About" -  - name: test 8+  - name: test 9     url: http://your-url.com/other/path     requestMethod: GET     headers: "Content-Type: application/json"@@ -112,4 +130,3 @@     - "Hello: world"     -       value: "Value-With-Key-We-Dont-Care-About"-

@@ -1,6 +1,10 @@-{-# LANGUAGE OverloadedStrings   #-}-{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE BangPatterns             #-}+{-# LANGUAGE DisambiguateRecordFields #-}+{-# LANGUAGE NamedFieldPuns           #-}+{-# 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@@ -22,6 +26,8 @@ import           Data.Maybe import           Data.Monoid import qualified Data.Text                            as T+import qualified Data.Text.Encoding                   as T+import           Data.Time.Clock import qualified Data.Vector                          as V import qualified Data.Yaml.Include                    as YI import           Network.Connection                   (TLSSettings (..))@@ -29,6 +35,7 @@ import           Network.HTTP.Conduit import           Network.HTTP.Simple                  hiding (Header) import qualified Network.HTTP.Simple                  as HTTP+import qualified Network.HTTP.Types                   as NT import           System.Directory import           System.Environment import           Testing.CurlRunnings.Internal@@ -63,6 +70,18 @@   , settingUseServerName = False   } +-- | Fetch existing query parameters from the request and append those specfied in the queryParameters field.+appendQueryParameters :: [KeyValuePair] -> Request -> Request+appendQueryParameters newParams r = setQueryString (existing ++ newQuery) r where+  existing = NT.parseQuery $ queryString r+  newQuery = NT.simpleQueryToQuery $ fmap (\(KeyValuePair k v) -> (T.encodeUtf8 k, T.encodeUtf8 v)) newParams++setPayload :: Maybe Payload -> Request -> Request+setPayload Nothing = id+setPayload (Just (JSON v)) = setRequestBodyJSON v+setPayload (Just (URLEncoded (KeyValuePairs xs))) = setRequestBodyURLEncoded $ kvpairs xs where+  kvpairs = fmap (\(KeyValuePair k v) -> (T.encodeUtf8 k, T.encodeUtf8 v))+ -- | 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@@ -70,29 +89,37 @@   let eInterpolatedUrl = interpolateQueryString state $ 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+      eInterpolatedQueryParams = interpolateViaJSON state $ fromMaybe (KeyValuePairs []) (queryParameters curlCase)+  case (eInterpolatedUrl, eInterpolatedHeaders, eInterpolatedQueryParams) of+    (Left err, _, _) ->+      return $ CaseFail curlCase Nothing Nothing [QueryFailure curlCase err] 0+    (_, Left err, _) ->+      return $ CaseFail curlCase Nothing Nothing [QueryFailure curlCase err] 0+    (_, _, Left err) ->+      return $ CaseFail curlCase Nothing Nothing [QueryFailure curlCase err] 0+    (Right interpolatedUrl, Right interpolatedHeaders, Right (KeyValuePairs interpolatedQueryParams)) ->+      case sequence $ interpolateViaJSON state <$> requestData curlCase of         Left l ->-          return $ CaseFail curlCase Nothing Nothing [QueryFailure curlCase l]-        Right replacedJSON -> do+          return $ CaseFail curlCase Nothing Nothing [QueryFailure curlCase l] 0+        Right interpolatedData -> do           initReq <- parseRequest $ T.unpack interpolatedUrl           manager <- newManager noVerifyTlsManagerSettings-          let request =-                setRequestBodyJSON (fromMaybe emptyObject replacedJSON) .++          let !request =+                setPayload interpolatedData .                 setRequestHeaders (toHTTPHeaders interpolatedHeaders) .+                appendQueryParameters interpolatedQueryParams  .                 (if tlsCheckType == DoTLSCheck then id else (setRequestManager manager)) $                 initReq {method = B8S.pack . show $ requestMethod curlCase}           logger state DEBUG (pShow request)           logger             state             DEBUG-            ("Request body: " <> (pShow $ fromMaybe emptyObject replacedJSON))+            ("Request body: " <> (pShow $ fromMaybe (JSON emptyObject) interpolatedData))+          start <- nowMillis           response <- httpBS request+          stop <- nowMillis+          let elapsed = stop - start           -- If the response is just returning bytes, we won't print them           let responseHeaderValues = map snd (getResponseHeaders response)           if "application/octet-stream" `notElem` responseHeaderValues &&@@ -127,14 +154,14 @@                   ]           return $             case assertionErrors of-              [] -> CasePass curlCase (Just receivedHeaders) returnVal+              [] -> CasePass curlCase (Just receivedHeaders) returnVal elapsed               failures ->-                CaseFail curlCase (Just receivedHeaders) returnVal failures+                CaseFail curlCase (Just receivedHeaders) returnVal failures elapsed  checkHeaders ::      CurlRunningsState -> CurlCase -> Headers -> Maybe AssertionFailure-checkHeaders _ (CurlCase _ _ _ _ _ _ _ Nothing) _ = Nothing-checkHeaders state curlCase@(CurlCase _ _ _ _ _ _ _ (Just (HeaderMatcher m))) receivedHeaders =+checkHeaders _ CurlCase { expectHeaders = Nothing } _ = Nothing+checkHeaders state curlCase@CurlCase { expectHeaders = Just (HeaderMatcher m) } receivedHeaders =   let interpolatedHeaders = mapM (interpolatePartialHeader state) m   in case interpolatedHeaders of        Left f -> Just $ QueryFailure curlCase f@@ -229,7 +256,7 @@ 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) =+checkBody state curlCase@CurlCase { expectData = (Just (Exactly expectedValue)) } (Just receivedBody) =   case runReplacements state expectedValue of     (Left err) -> Just $ QueryFailure curlCase err     (Right interpolated) ->@@ -242,7 +269,7 @@                (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) =+checkBody state curlCase@CurlCase { expectData = (Just (Contains subexprs)) } (Just receivedBody) =   case runReplacementsOnSubvalues state subexprs of     Left f -> Just $ QueryFailure curlCase f     Right updatedMatcher ->@@ -253,7 +280,7 @@         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) =+checkBody state curlCase@CurlCase { expectData = (Just (NotContains subexprs)) } (Just receivedBody) =   case runReplacementsOnSubvalues state subexprs of     Left f -> Just $ QueryFailure curlCase f     Right updatedMatcher ->@@ -267,7 +294,7 @@                (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 =+checkBody state curlCase@CurlCase { expectData = (Just m@(MixedContains subexprs)) } receivedBody =   let failure =         join $         find@@ -281,10 +308,10 @@              subexprs)   in fmap (\_ -> DataFailure curlCase m receivedBody) failure -- | We expected a body but didn't get one-checkBody _ curlCase@(CurlCase _ _ _ _ _ (Just anything) _ _) Nothing =+checkBody _ curlCase@CurlCase { expectData = (Just anything) } Nothing =   Just $ DataFailure curlCase anything Nothing -- | No assertions on the body-checkBody _ (CurlCase _ _ _ _ _ Nothing _ _) _ = Nothing+checkBody _ CurlCase { expectData = Nothing } _ = Nothing  runReplacementsOnSubvalues ::      CurlRunningsState -> [JsonSubExpr] -> Either QueryError [JsonSubExpr]@@ -357,6 +384,16 @@     Left parseErr -> Left parseErr runReplacements _ valToUpdate = Right valToUpdate +-- | Given an instance of both ToJSON and FromJSON return a new instance with+-- interpolated values.+-- NB: interpolateViaJSON assumes that fromJSON . toJSON is identity+interpolateViaJSON :: (ToJSON a, FromJSON a) => CurlRunningsState -> a -> Either QueryError a+interpolateViaJSON state i = do+  replaced <- runReplacements state $ toJSON i+  resultToEither $ fromJSON replaced where+    resultToEither (Error e)   = Left $ QueryValidationError $ T.pack e+    resultToEither (Success a) = Right a+ -- | Given a query string, return some text with interpolated values. Type -- errors will be returned if queries don't resolve to strings interpolateQueryString ::@@ -396,9 +433,9 @@     (CaseResultIndex i) ->       let maybeCase = arrayGet previousResults $ fromInteger i       in if isJust maybeCase-           then let (CasePass _ _ returnedJSON) = fromJust maybeCase+           then let CasePass{caseResponseValue} = fromJust maybeCase                     jsonToIndex =-                      case returnedJSON of+                      case caseResponseValue of                         Just v -> Right v                         Nothing ->                           Left $@@ -493,10 +530,10 @@ -- | Verify the returned http status code is ok, construct the right failure -- type if needed checkCode :: CurlCase -> Int -> Maybe AssertionFailure-checkCode curlCase@(CurlCase _ _ _ _ _ _ (ExactCode expectedCode) _) receivedCode+checkCode curlCase@CurlCase { expectStatus = (ExactCode expectedCode) } receivedCode   | expectedCode /= receivedCode = Just $ StatusFailure curlCase receivedCode   | otherwise = Nothing-checkCode curlCase@(CurlCase _ _ _ _ _ _ (AnyCodeIn l) _) receivedCode+checkCode curlCase@CurlCase { expectStatus = (AnyCodeIn l) } receivedCode   | receivedCode `notElem` l = Just $ StatusFailure curlCase receivedCode   | otherwise = Nothing 

@@ -12,6 +12,8 @@   , makeLogger   , makeUnsafeLogger   , pShow+  , nowMillis+  , roundToStr   , LogLevel(..)   , CurlRunningsLogger   , CurlRunningsUnsafeLogger@@ -22,8 +24,11 @@ import qualified Data.Text          as T import qualified Data.Text.Lazy     as TL import           Debug.Trace+import           System.Clock import qualified Text.Pretty.Simple as P+import           Text.Printf + makeGreen :: T.Text -> T.Text makeGreen s = "\x1B[32m" <> s <> "\x1B[0m" @@ -73,3 +78,11 @@   if level <= threshold     then tracer text object     else object++nowMillis :: IO Integer+nowMillis = do+  t <- getTime Realtime+  return $ (toNanoSecs t) `div` 1000000++roundToStr :: (PrintfArg a, Floating a) => a -> String+roundToStr = printf "%0.2f"

@@ -0,0 +1,97 @@+{-# LANGUAGE DeriveGeneric     #-}+{-# LANGUAGE OverloadedStrings #-}++-- | Module defining the Header and Headers types and a parser with a FromJSON+-- instance for the Headers type.+--+-- Headers are parsed from a semi-colon separated sequence of key:value pairs.+-- Some examples:+--+-- > "key: value"+-- > "key1: value1; key2: value2"+--+-- Keys can be any sequence of ASCII characters excluding ':' and must not be+-- all whitespace. For example:+--+-- > " : value"+--+-- is invalid.+--+-- Values can be any sequence of ASCII characters excluding ';' and may be all+-- whitespace. For example:+--+-- > "key : "+--+-- is valid.+module Testing.CurlRunnings.Internal.Headers+    ( Header (..)+    , Headers (..)+    , parseHeaders+    ) where++import           Data.Aeson+import           Data.Aeson.Types           hiding (Parser)+import           Data.Bifunctor             (Bifunctor (..))+import           Data.Char                  (isAscii, isSpace)+import           Data.Functor               (void)+import qualified Data.Text                  as T+import           Data.Void+import           GHC.Generics+import           Text.Megaparsec+import           Text.Megaparsec.Char+import qualified Text.Megaparsec.Char.Lexer as L++-- | A representation of a single header+data Header =+  Header T.Text+         T.Text+  deriving (Show, Generic, Eq)++instance ToJSON Header++instance ToJSON Headers++-- | Simple container for a list of headers, useful for a vehicle for defining a+-- fromJSON+newtype Headers =+  HeaderSet [Header]+  deriving (Show, Generic, Eq)++instance FromJSON Headers where+  parseJSON a@(String v) =+    case parseHeaders v of+      Right h -> return h+      Left e  -> typeMismatch ("Header failure: " ++ T.unpack e) a+  parseJSON invalid = typeMismatch "Header" invalid++-- | Given a header text, attempt to parse it into Headers.+parseHeaders :: T.Text -> Either T.Text Headers+parseHeaders hs = let trimmed = T.strip hs in+  first (T.pack . errorBundlePretty) (Text.Megaparsec.parse headersParser "" trimmed)++type Parser = Parsec Void T.Text++headerColon :: Parser T.Text+headerColon = L.symbol space ":"++headerSemiColon :: Parser T.Text+headerSemiColon = L.symbol space ";"++endOfHeader :: Parser ()+endOfHeader = try (void headerSemiColon) <|> eof++headerParser :: Parser Header+headerParser = do+  key <- do+    firstChar <- satisfy asciiExcludingColonAndSpace+    rest <- takeWhileP (Just "header key") asciiExcludingColon <* headerColon+    return $ T.singleton firstChar <> rest+  value <- takeWhileP (Just "header value") asciiExcludingSemiColon <* endOfHeader+  return $ Header (T.strip key) (T.strip value) where+    asciiExcludingColon = asciiExcludingChar ':'+    asciiExcludingSemiColon = asciiExcludingChar ';'+    asciiExcludingColonAndSpace t = asciiExcludingColon t && not (isSpace t)+    asciiExcludingChar c t =  isAscii t && t /= c++headersParser :: Parser Headers+headersParser = HeaderSet <$> some headerParser

@@ -0,0 +1,46 @@+{-# LANGUAGE OverloadedStrings #-}++-- | A module defining the KeyValuePairs type. This type may be used to+-- represent a structure in a specification that is a collection of+-- key-vaue pairs. For example query parameters and URLEncoded request+-- bodies.+--+-- The module provides FromJSON and ToJSON instances for KeyValuePairs.+-- Valid KeyValuePairs JSON is a single JSON object where all values+-- are either String, Scienfific or Bool.++module Testing.CurlRunnings.Internal.KeyValuePairs+  ( KeyValuePairs (..)+  , KeyValuePair (..)+  ) where++import           Data.Aeson+import           Data.Aeson.Types+import qualified Data.ByteString.Lazy as LBS+import           Data.HashMap.Strict  as H+import qualified Data.Text            as T+import           Data.Text.Encoding   as T++-- | A container for a list of key-value pairs+newtype KeyValuePairs = KeyValuePairs [KeyValuePair] deriving Show++-- | A representation of a single key-value pair+data KeyValuePair = KeyValuePair T.Text T.Text deriving Show++instance ToJSON KeyValuePairs where+  toJSON (KeyValuePairs qs) =+    object (fmap (\(KeyValuePair k v) -> k .= toJSON v) qs)++instance FromJSON KeyValuePairs where+  parseJSON = withObject "keyValuePairs" parseKeyValuePairs where+    parseKeyValuePairs o = KeyValuePairs <$> traverse parseKeyValuePair (H.toList o)+    parseKeyValuePair (t, v) = KeyValuePair t <$> parseSingleValueType v++parseSingleValueType :: Value -> Parser T.Text+parseSingleValueType (Bool b)   = parseToText b+parseSingleValueType (String t) = return t+parseSingleValueType (Number n) = parseToText n+parseSingleValueType invalid    = typeMismatch "KeyValuePairs" invalid++parseToText :: (ToJSON a) => a -> Parser T.Text+parseToText = return . T.decodeUtf8 . LBS.toStrict . encode

@@ -34,6 +34,8 @@       parseQuery     ) where +import           Data.Bifunctor             (Bifunctor (..))+import           Data.Char                  (isAscii) import           Data.List import qualified Data.Text                  as T import           Data.Void@@ -151,4 +153,3 @@  parseFullTextWithQuery :: Parser [InterpolatedQuery] parseFullTextWithQuery = many ((try interpolatedQueryParser) <|> noQueryText)-

@@ -0,0 +1,84 @@+{-# LANGUAGE DeriveGeneric     #-}+{-# LANGUAGE OverloadedStrings #-}++-- | A module defining the Payload type. This is used in specifications to+-- represent request body data. Currently JSON and URLEncoded bodies are+-- supported.+--+-- The module provides a FromJSON instance to parse a Payload from a+-- specification.+--+-- Payload is parsed from an object containing two keys: `bodyType` and+-- `content`.+--+-- The value of the `bodyType` field must be either `json` or+-- `urlencoded` and this indicates how the request data should be encoded.+--+-- When `bodyType` is `urlencoded ` the value of the `content` field must be an+-- object with string, numeric or boolean values.+--+-- When `bodyType` is `json` the value of the `content` field will be used as+-- the JSON payload.+--+-- If `bodyType` is not present then the whole object is used as the JSON+-- payload.+--+-- Examples:+-- 1. A URLEncoded request payload:+--+-- >  requestData:+-- >     bodyType: urlencoded+-- >     content:+-- >       key1: value+-- >       key2: true+-- >       key3: 10.22+--+-- 2: A JSON request payload using `bodyType`:+--+-- >  requestData:+-- >     bodyType: json+-- >     content:+-- >       key1: value+-- >       key2: [1,2,3]+--+-- 3: A JSON request payload without using `bodyType`:+--+-- >  requestData:+-- >     key1: value+-- >     key2: [1,2,3]+--+module Testing.CurlRunnings.Internal.Payload+  ( Payload (..)+  ) where++import           Data.Aeson+import qualified Data.Char                                   as C+import qualified Data.HashMap.Strict                         as H+import qualified Data.Text                                   as T+import           GHC.Generics+import           Testing.CurlRunnings.Internal.KeyValuePairs++data Payload = JSON Value | URLEncoded KeyValuePairs deriving Generic++instance Show Payload where+  show (JSON v) = show v+  show (URLEncoded (KeyValuePairs xs)) = T.unpack $ T.intercalate "&" $ fmap (\(KeyValuePair k v) -> k <> "=" <> v) xs++payloadTagFieldName :: T.Text+payloadTagFieldName = "bodyType"++payloadContentsFieldName :: T.Text+payloadContentsFieldName = "content"++instance FromJSON Payload where+  parseJSON v = withObject "payload" parsePayload v where+    parsePayload o = if not (H.member payloadTagFieldName o) then return (JSON v) else genericParseJSON payloadOptions v+    payloadOptions = defaultOptions { sumEncoding = TaggedObject { tagFieldName = T.unpack payloadTagFieldName+                                                                 , contentsFieldName = T.unpack payloadContentsFieldName+                                                                 }+                                    , constructorTagModifier = fmap C.toLower+                                    }++instance ToJSON Payload where+  toJSON (JSON v) = object [(payloadTagFieldName, "json"), (payloadContentsFieldName, toJSON v)]+  toJSON (URLEncoded xs) = object [(payloadTagFieldName, "urlencoded"), (payloadContentsFieldName, toJSON xs)]

@@ -1,5 +1,7 @@-{-# LANGUAGE DeriveGeneric     #-}-{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE DeriveGeneric            #-}+{-# LANGUAGE DisambiguateRecordFields #-}+{-# LANGUAGE NamedFieldPuns           #-}+{-# LANGUAGE OverloadedStrings        #-}  -- | Data types for curl-runnings tests @@ -11,6 +13,9 @@   , Header(..)   , HeaderMatcher(..)   , Headers(..)+  , KeyValuePair(..)+  , KeyValuePairs(..)+  , Payload(..)   , HttpMethod(..)   , JsonMatcher(..)   , JsonSubExpr(..)@@ -34,15 +39,17 @@  import           Data.Aeson import           Data.Aeson.Types-import           Data.Either-import qualified Data.HashMap.Strict           as H-import           Data.List+import qualified Data.Char                                   as C+import qualified Data.HashMap.Strict                         as H import           Data.Maybe import           Data.Monoid-import qualified Data.Text                     as T-import qualified Data.Vector                   as V+import qualified Data.Text                                   as T+import qualified Data.Vector                                 as V import           GHC.Generics import           Testing.CurlRunnings.Internal+import           Testing.CurlRunnings.Internal.Headers+import           Testing.CurlRunnings.Internal.KeyValuePairs+import           Testing.CurlRunnings.Internal.Payload import           Text.Printf  -- | A basic enum for supported HTTP verbs@@ -93,22 +100,6 @@ isNotContains (NotContains _) = True isNotContains _               = False --- | A representation of a single header-data Header =-  Header T.Text-         T.Text-  deriving (Show, Generic)--instance ToJSON Header---- | Simple container for a list of headers, useful for a vehicle for defining a--- fromJSON-data Headers =-  HeaderSet [Header]-  deriving (Show, Generic)--instance ToJSON Headers- -- | Specify a key, value, or both to match against in the returned headers of a -- response. data PartialHeaderMatcher =@@ -145,33 +136,6 @@   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--parseHeaders :: T.Text -> Either T.Text Headers-parseHeaders str =-  let _headers = filter (/= "") $ T.splitOn ";" str-      parses = map parseHeader _headers-  in case find isLeft parses of-       Just (Left failure) -> Left failure-       _ ->-         Right . HeaderSet $-         map-           (fromRight $-            error-              "Internal error parsing headers, this is a bug in curl runnings :(")-           parses--instance FromJSON Headers where-  parseJSON a@(String v) =-    case parseHeaders v of-      Right h      -> return h-      Left failure -> typeMismatch ("Header failure: " ++ T.unpack failure) a-  parseJSON invalid = typeMismatch "Header" invalid- instance FromJSON HeaderMatcher where   parseJSON o@(String v) =     either@@ -232,14 +196,15 @@  -- | A single curl test case, the basic foundation of a curl-runnings test. data CurlCase = CurlCase-  { 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-  , expectData    :: Maybe JsonMatcher -- ^ The assertions to make on the response payload, if any-  , expectStatus  :: StatusCodeMatcher -- ^ Assertion about the status code returned by the target-  , expectHeaders :: Maybe HeaderMatcher -- ^ Assertions to make about the response headers, if any+  { 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 Payload -- ^ Payload to send with the request, if any+  , queryParameters :: Maybe KeyValuePairs -- ^ Query parameters to set in the request, if any+  , headers         :: Maybe Headers -- ^ Headers to send with the request, if any+  , expectData      :: Maybe JsonMatcher -- ^ The assertions to make on the response payload, if any+  , expectStatus    :: StatusCodeMatcher -- ^ Assertion about the status code returned by the target+  , expectHeaders   :: Maybe HeaderMatcher -- ^ Assertions to make about the response headers, if any   } deriving (Show, Generic)  instance FromJSON CurlCase@@ -344,22 +309,31 @@     printf "JSON query error in spec %s: %s" (name curlCase) (show queryErr)   show UnexpectedFailure = "Unexpected Error D:" +formatSecToMS :: Integer -> String+formatSecToMS t = roundToStr ((fromIntegral t :: Double) / 1000.0)+ -- | 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]-+  = CasePass+      { curlCase            :: CurlCase+      , caseResponseHeaders :: Maybe Headers+      , caseResponseValue   :: Maybe Value+      , elapsedTime         :: Integer -- ^ Elapsed time+      }+  | CaseFail+      { curlCase            :: CurlCase+      , caseResponseHeaders :: Maybe Headers+      , caseResponseValue   :: Maybe Value+      , failures            :: [AssertionFailure]+      , elapsedTime         :: Integer -- ^ Elapsed time+      } instance Show CaseResult where-  show (CasePass c _ _) = T.unpack . makeGreen $ "[PASS] " <> name c-  show (CaseFail c _ _ failures) =+  show CasePass{curlCase, elapsedTime} = T.unpack . makeGreen $ "[PASS] " <> (T.pack $ printf "%s (%s seconds)" (name curlCase) (formatSecToMS elapsedTime))+  show CaseFail{curlCase, failures, elapsedTime} =     T.unpack $ makeRed "[FAIL] " <>-    name c <>+    name curlCase <>+    (T.pack $ printf " (%s seconds) " (formatSecToMS elapsedTime)) <>     "\n" <>     mconcat (map ((\s -> "\nAssertion failed: " <> s) . (<> "\n") . (T.pack . show)) failures) 

@@ -1,13 +1,23 @@-{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE OverloadedStrings  #-}+{-# LANGUAGE QuasiQuotes        #-}+{-# LANGUAGE StandaloneDeriving #-}  module Main where +import           Data.Aeson+import           Data.ByteString                             (ByteString) import           Data.Either+import           Data.List+import qualified Data.Text                                   as T import           System.Directory import           Test.Hspec import           Testing.CurlRunnings import           Testing.CurlRunnings.Internal+import           Testing.CurlRunnings.Internal.Headers+import           Testing.CurlRunnings.Internal.KeyValuePairs import           Testing.CurlRunnings.Internal.Parser+import           Testing.CurlRunnings.Internal.Payload+import           Text.RawString.QQ  main :: IO () main = hspec $@@ -44,6 +54,38 @@     parseQuery "$<POOP[0].key.key>" `shouldSatisfy` isLeft     parseQuery "some text $<BAD_RESPONSES_REF[0].key.key>" `shouldSatisfy` isLeft +  it "should parse valid headers" $ do+    parseHeaders "key:" `shouldBeHeaders` [("key", "")]+    parseHeaders "key: ;" `shouldBeHeaders` [("key", "")]+    parseHeaders "key:" `shouldBeHeaders` [("key", "")]+    parseHeaders "key: value" `shouldBeHeaders` [("key", "value")]+    parseHeaders "key: value;" `shouldBeHeaders` [("key", "value")]+    parseHeaders "key : value" `shouldBeHeaders` [("key", "value")]+    parseHeaders "key :value" `shouldBeHeaders` [("key", "value")]+    parseHeaders "key : value " `shouldBeHeaders` [("key", "value")]+    parseHeaders "  key : value " `shouldBeHeaders` [("key", "value")]+    parseHeaders "key name : value" `shouldBeHeaders` [("key name", "value")]+    parseHeaders "key : value name " `shouldBeHeaders` [("key", "value name")]+    parseHeaders "key1 : value1:value2;" `shouldBeHeaders` [("key1", "value1:value2")]+    parseHeaders "key1 : value1:value2" `shouldBeHeaders` [("key1", "value1:value2")]+    parseHeaders "key1 : value1 ; key2: value2" `shouldBeHeaders` [("key1", "value1"), ("key2", "value2")]+    parseHeaders "key1 : value1 ;\n key2: value2" `shouldBeHeaders` [("key1", "value1"), ("key2", "value2")]+    parseHeaders "key1 : value1 ;\n key2: value2\n" `shouldBeHeaders` [("key1", "value1"), ("key2", "value2")]+    parseHeaders "key1 : value1 ;\n key2: value2;" `shouldBeHeaders` [("key1", "value1"), ("key2", "value2")]+    parseHeaders "Content-Type : application/json" `shouldBeHeaders` [("Content-Type", "application/json")]+    parseHeaders "$<RESPONSES[1].key[r]>: $<RESPONSES[100]> ;" `shouldBeHeaders` [("$<RESPONSES[1].key[r]>", "$<RESPONSES[100]>")]++  it "should reject invalid headers" $ do+    parseHeaders "" `shouldSatisfy` isLeft+    parseHeaders "\n" `shouldSatisfy` isLeft+    parseHeaders "£key: value" `shouldSatisfy` isLeft+    parseHeaders "key: £value" `shouldSatisfy` isLeft+    parseHeaders "key" `shouldSatisfy` isLeft+    parseHeaders "key ;" `shouldSatisfy` isLeft+    parseHeaders " : value" `shouldSatisfy` isLeft+    parseHeaders " : value ;" `shouldSatisfy` isLeft+    parseHeaders " : value ; key : value2" `shouldSatisfy` isLeft+   it "arrayGet should handle positive and negative indexes correctly" $ do     let a = [1, 2, 3]         b = [] :: [Int]@@ -59,10 +101,74 @@     (arrayGet b 1) `shouldBe` Nothing     (arrayGet b (-1)) `shouldBe` Nothing +  it "should decode valid key-value pairs" $ do+    [r|{"key": "value"}|] `shouldBeKeyValuePairs` [("key", "value")]+    [r|{"key": 1}|] `shouldBeKeyValuePairs` [("key", "1")]+    [r|{"key": 9.999}|] `shouldBeKeyValuePairs` [("key", "9.999")]+    [r|{"key": true}|] `shouldBeKeyValuePairs` [("key", "true")]+    [r|{"key1": 10, "key2": "a", "key3": 1.1, "key4": false}|]+      `shouldBeKeyValuePairs`+      [ ("key1", "10")+      , ("key2", "a")+      , ("key3", "1.1")+      , ("key4", "false")+      ]++  it "should not decode invalid key-value pairs" $ do+    decodeKeyValuePair [r|{"key": null}|] `shouldSatisfy` isLeft+    decodeKeyValuePair [r|{"key": [1, "1"]}|] `shouldSatisfy` isLeft+    decodeKeyValuePair [r|{"key": {"nestedKey": true}}|] `shouldSatisfy` isLeft+    decodeKeyValuePair [r|{"key1": "a", "key2": {"nestedKey": true}}|] `shouldSatisfy` isLeft++  it "should decode request body" $ do+    decodePayload [r|{"bodyType": "urlencoded", "content": {"key1": "value1"}}|] `shouldSatisfy` isURLEncoded+    decodePayload [r|{"bodyType": "json", "content": {"key1": "value1"}}|] `shouldSatisfy` isJSON+    decodePayload [r|{"bodyType": "json", "content": ["key1", "value1"]}|] `shouldSatisfy` isJSON+    decodePayload [r|{"content": {"key1": "value1"}}|] `shouldSatisfy` isJSON+    decodePayload [r|{"other": {"key1": "value1"}}|] `shouldSatisfy` isJSON+    decodePayload [r|{"other": ["key1", "value1"]}|] `shouldSatisfy` isJSON+    -- "other" is ignored+    decodePayload [r|{"bodyType": "json", "content": {"a": "b"}, "other": 1}|] `shouldSatisfy` isJSON+    decodePayload [r|{"bodytype": "urlencoded", "content": ["key1", "value1"]}|] `shouldSatisfy` isJSON++  it "should not decode invalid request body" $ do+    decodePayload [r|{"bodyType": "plain", "content": {"key1": "value1"}}|] `shouldSatisfy` isLeft+    decodePayload [r|{"bodyType": "urlencoded"}|] `shouldSatisfy` isLeft+    decodePayload [r|{"bodyType": "json"}|] `shouldSatisfy` isLeft+    decodePayload [r|{"bodyType": "urlencoded", "content": ["key1", "value1"]}|] `shouldSatisfy` isLeft+ testValidSpec :: String -> IO () testValidSpec file = do   currentDirectory <- getCurrentDirectory   spec <- decodeFile (currentDirectory ++ file)   spec `shouldSatisfy` isRight +decodeKeyValuePair :: ByteString -> Either String KeyValuePairs+decodeKeyValuePair = eitherDecodeStrict +decodePayload :: ByteString -> Either String Payload+decodePayload = eitherDecodeStrict++shouldBeHeaders :: (Eq a, Show a) => Either a Headers -> [(T.Text, T.Text)] -> Expectation+shouldBeHeaders actual expected =+  let expectedHeaders = Right . HeaderSet $ uncurry Header <$> expected in+    actual `shouldBe` expectedHeaders++shouldBeKeyValuePairs :: ByteString -> [(T.Text, T.Text)] -> Expectation+shouldBeKeyValuePairs json expected = actual `shouldBe` expectedKeyValuePairs where+  actual = eitherDecodeStrict json+  expectedKeyValuePairs = Right . KeyValuePairs $ uncurry KeyValuePair <$> expected++deriving instance Eq KeyValuePair++-- KeyValuePairs should be considered equal if they contain the same elements.+instance Eq KeyValuePairs where+  (==) (KeyValuePairs x) (KeyValuePairs y) = null (x \\ y) && null (y \\ x)++isURLEncoded :: Either String Payload -> Bool+isURLEncoded (Right (URLEncoded _)) = True+isURLEncoded _                      = False++isJSON :: Either String Payload -> Bool+isJSON (Right (JSON _)) = True+isJSON _                = False