Adds support for URLEncoded request bodies on the requestData field (#52)

* Adds support for URLEncoded request bodies on the requestData field

To set a URLEncoded body set bodyType to urlencoded:

  requestData:
     bodyType: urlencoded
     content:
       a: b
       c: d
       e: f

To set a JSON body set bodyType to json:

  requestData:
     bodyType: json
     content:
       a: b
       c: d
       e: f

In either case the body is formed from the value of the content key.

The change is backwards compatible so that the following:

  requestData:
    a: b
    c: d
    e: A

will send a JSON body formed from the value of the requestData key.

* Adds queryParameters to example JSON specification.

* Adds `requestData` enhancements to JSON and YAML example specs.

* Moves KeyValuePairs type into its own module

* Adds tests for decoding KeyValuePairs

* Moves Payload to its own module and adds documentation.

* Adds tests for Payload

Author: paulcadman

curl-runnings.cabal

@@ -4,7 +4,7 @@ cabal-version: 1.12
 --
 -- see: https://github.com/sol/hpack
 --
--- hash: d7e8fd8b9ac832b7f655ad0afb08922e6d81f002810f33a8785f57504b9e38f3
+-- hash: 47e14a53d64cd8b70caa137bf6d6d5d667b4b75064f6cebc3ed82c11072d6258
 
 name:           curl-runnings
 version:        0.11.1
@@ -37,6 +37,8 @@ library
       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:
@@ -93,10 +95,13 @@ test-suite curl-runnings-test
       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

examples/example-spec.json

@@ -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,15 +103,15 @@
     "expectStatus": 200
   },
   {
-    "name": "test 6",
+    "name": "test 7",
     "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 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",

examples/example-spec.yaml

@@ -34,6 +34,22 @@ cases:
       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:
@@ -54,7 +70,7 @@ cases:
       - keyMatch: okay
     expectStatus: 200
 
-  - name: test 4
+  - name: test 5
     url: http://your-url.com/other/path
     requestMethod: GET
     expectData:
@@ -70,7 +86,7 @@ cases:
       - keyMatch: error
     expectStatus: 200
 
-  - name: test 5
+  - name: test 6
     url: http://your-url.com/other/path
     requestMethod: GET
     expectData:
@@ -83,7 +99,7 @@ cases:
       - 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
@@ -94,7 +110,7 @@ cases:
     # 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"
@@ -104,7 +120,7 @@ cases:
     -
       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"
@@ -114,4 +130,3 @@ cases:
     - "Hello: world"
     -
       value: "Value-With-Key-We-Dont-Care-About"
-

package.yaml

@@ -25,6 +25,8 @@ library:
   - Testing.CurlRunnings.Internal
   - Testing.CurlRunnings.Internal.Parser
   - Testing.CurlRunnings.Internal.Headers
+  - Testing.CurlRunnings.Internal.KeyValuePairs
+  - Testing.CurlRunnings.Internal.Payload
   dependencies:
   - aeson >=1.2.4.0
   - bytestring >=0.10.8.2
@@ -75,8 +77,11 @@ tests:
     - -rtsopts
     - -with-rtsopts=-N
     dependencies:
+    - bytestring >=0.10.8.2
     - curl-runnings
     - directory >=1.3.0.2
+    - aeson >=1.2.4.0
     - hspec >= 2.4.4
     - hspec-expectations >=0.8.2
+    - raw-strings-qq >= 1.1
     - text >=1.2.2.2

src/Testing/CurlRunnings.hs

@@ -71,10 +71,16 @@ noVerifyTlsSettings =
   }
 
 -- | Fetch existing query parameters from the request and append those specfied in the queryParameters field.
-appendQueryParameters :: [QueryParameter] -> Request -> Request
+appendQueryParameters :: [KeyValuePair] -> Request -> Request
 appendQueryParameters newParams r = setQueryString (existing ++ newQuery) r where
   existing = NT.parseQuery $ queryString r
-  newQuery = NT.simpleQueryToQuery $ fmap (\(QueryParameter k v) -> (T.encodeUtf8 k, T.encodeUtf8 v)) newParams
+  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.
@@ -83,34 +89,33 @@ runCase state@(CurlRunningsState _ _ _ tlsCheckType) curlCase = do
   let eInterpolatedUrl = interpolateQueryString state $ url curlCase
       eInterpolatedHeaders =
         interpolateHeaders state $ fromMaybe (HeaderSet []) (headers curlCase)
-      eInterpolatedQueryParams = interpolateViaJSON state $ fromMaybe (QueryParameters []) (queryParameters curlCase)
+      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 (QueryParameters interpolatedQueryParams)) ->
-      case sequence $ runReplacements state <$> requestData curlCase of
+    (Right interpolatedUrl, Right interpolatedHeaders, Right (KeyValuePairs interpolatedQueryParams)) ->
+      case sequence $ interpolateViaJSON state <$> requestData curlCase of
         Left l ->
           return $ CaseFail curlCase Nothing Nothing [QueryFailure curlCase l] 0
-        Right replacedJSON -> do
+        Right interpolatedData -> do
           initReq <- parseRequest $ T.unpack interpolatedUrl
           manager <- newManager noVerifyTlsManagerSettings
 
           let !request =
-                  setRequestBodyJSON (fromMaybe emptyObject replacedJSON) .
-                  setRequestHeaders (toHTTPHeaders interpolatedHeaders) .
-                  appendQueryParameters interpolatedQueryParams  .
-                  (if tlsCheckType == DoTLSCheck then id else (setRequestManager manager)) $
-                  initReq {method = B8S.pack . show $ requestMethod curlCase}
-
+                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

src/Testing/CurlRunnings/Internal/KeyValuePairs.hs

@@ -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