Merge pull request #1 from aviaviavi/headers

Headers

curl-runnings.cabal

@@ -2,7 +2,7 @@
 --
 -- see: https://github.com/sol/hpack
 --
--- hash: 5ba21bafee5c2e642cec1c0c7bff81b86f715d883cc524542a61d787f7aca778
+-- hash: eede3d814ea52e96fa0d99ea5f955e191dfea8c6226a50eb1941e2c0567fa527
 
 name:           curl-runnings
 version:        0.2.0
@@ -37,12 +37,15 @@ library
     , aeson-pretty >=0.8.5
     , base >=4.7 && <5
     , bytestring >=0.10.8.2
+    , case-insensitive >=0.2.1
     , directory >=1.3.0.2
     , hspec >=2.4.4
     , hspec-expectations >=0.8.2
     , http-conduit >=2.2.4
+    , http-types >=0.9.1
     , text >=1.2.2.2
     , unordered-containers >=0.2.8.0
+    , vector >=0.12.0
     , yaml >=0.8.28
   exposed-modules:
       Testing.CurlRunnings

examples/example-spec.json

@@ -28,19 +28,33 @@
     "name": "test 3",
     "url": "http://your-url.com/other/path",
     "requestMethod": "GET",
-    "expectData": {
-      "contains": [
-        {
-          "keyValueMatch": {
-            "key": "okay",
-            "value": true
-          }
-        },
-        {
-          "valueMatch": true
-        }
-      ]
-    },
-    "expectStatus": 200
+    "headers": "Content-Type: application/json",
+    "expectStatus": 200,
+    "expectHeaders": "Content-Type: application/json; Hello: world"
+  },
+  {
+    "name": "test 4",
+    "url": "http://your-url.com/other/path",
+    "requestMethod": "GET",
+    "headers": "Content-Type: application/json",
+    "expectStatus": 200,
+    "expectHeaders": [
+      {
+        "key": "Key-With-Val-We-Dont-Care-About"
+      }
+    ]
+  },
+  {
+    "name": "test 5",
+    "url": "http://your-url.com/other/path",
+    "requestMethod": "GET",
+    "headers": "Content-Type: application/json",
+    "expectStatus": 200,
+    "expectHeaders": [
+      "Hello: world",
+      {
+        "value": "Value-With-Key-We-Dont-Care-About"
+      }
+    ]
   }
 ]

examples/example-spec.yaml

@@ -1,5 +1,6 @@
 ---
 # The top level of the file is an array of test cases
+
 - name: test 1 # required
   url: http://your-endpoint.com/status # required
   requestMethod: GET # required
@@ -16,6 +17,7 @@
   # [Required] Assertions about the returned status code. Pass in
   # an acceptable code or list of codes
   expectStatus: 200
+
 - name: test 2
   url: http://your-endpoint.com/path
   requestMethod: POST
@@ -26,21 +28,36 @@
   requestData:
     hello: there
     num: 1
+
 - name: test 3
   url: http://your-url.com/other/path
   requestMethod: GET
-  expectData:
-    # In the `contains` case of data validation, a list of matchers is specified. Currently,
-    # possible types are `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
+  # Specify the headers you want to sent, just like the -H flag in a curl command
+  # IE "key: value; key: value; ..."
+  headers: "Content-Type: application/json"
+  expectStatus: 200
+  # The response must constain at least these headers exactly.
+  # Header strings again match the -H syntax from curl
+  expectHeaders: "Content-Type: application/json; Hello: world"
+
+- name: test 4
+  url: http://your-url.com/other/path
+  requestMethod: GET
+  headers: "Content-Type: application/json"
+  expectStatus: 200
+  # You can also specify a key and/or value to look for in the headers
+  expectHeaders: 
+  -
+    key: "Key-With-Val-We-Dont-Care-About"
+
+- name: test 5
+  url: http://your-url.com/other/path
+  requestMethod: GET
+  headers: "Content-Type: application/json"
   expectStatus: 200
+  # Specify a mix of full or partial header matches in a list like so:
+  expectHeaders: 
+  - "Hello: world"
+  -
+    value: "Value-With-Key-We-Dont-Care-About"
+

package.yaml

@@ -1,5 +1,5 @@
 name:                curl-runnings
-version:             0.2.0
+version:             0.3.0
 github:              aviaviavi/curl-runnings
 license:             MIT
 author:              Avi Press
@@ -34,13 +34,16 @@ library:
   - aeson >=1.2.4.0
   - aeson-pretty >=0.8.5
   - bytestring >=0.10.8.2
+  - case-insensitive >=0.2.1
+  - directory >=1.3.0.2
+  - hspec >= 2.4.4
+  - hspec-expectations >=0.8.2
   - http-conduit >=2.2.4
+  - http-types >=0.9.1
   - text >=1.2.2.2
   - unordered-containers >=0.2.8.0
+  - vector >=0.12.0
   - yaml >=0.8.28
-  - hspec >= 2.4.4
-  - hspec-expectations >=0.8.2
-  - directory >=1.3.0.2
 
 executables:
   curl-runnings:
@@ -66,6 +69,6 @@ tests:
     - -with-rtsopts=-N
     dependencies:
     - curl-runnings
+    - directory >=1.3.0.2
     - hspec >= 2.4.4
     - hspec-expectations >=0.8.2
-    - directory >=1.3.0.2

src/Testing/CurlRunnings.hs

@@ -14,12 +14,14 @@ 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.Maybe
-import qualified Data.Text as T
+import qualified Data.Text                  as T
 import qualified Data.Yaml                  as Y
 import           Network.HTTP.Conduit
 import           Network.HTTP.Simple
+import qualified Network.HTTP.Types.Header  as HTTP
 import           Testing.CurlRunnings.Types
 import           Text.Printf
 
@@ -40,20 +42,50 @@ decodeFile specPath =
 runCase :: CurlCase -> IO CaseResult
 runCase curlCase = do
   initReq <- parseRequest $ url curlCase
-  response <- httpBS . setRequestBodyJSON (requestData curlCase) $ initReq {method = B8S.pack . show $ requestMethod 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]
+          [ checkBody curlCase returnVal
+          , checkCode curlCase returnCode
+          , checkHeaders curlCase receivedHeaders
+          ]
   return $
     case assertionErrors of
       []       -> CasePass curlCase
       failures -> CaseFail curlCase 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
+
+-- | 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)
+
+-- | Does any of these headers contain our matcher?
+headerIn :: Headers -> PartialHeaderMatcher -> Bool
+headerIn (HeaderSet received) headerMatcher =
+  any (headerMatches headerMatcher) received
+
 safeLast :: [a] -> Maybe a
 safeLast [] = Nothing
 safeLast x  = Just $ last x
@@ -80,18 +112,18 @@ runSuite (CurlSuite cases) =
 -- | Check if the retrieved value fail's the case's assertion
 checkBody :: 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)
+checkBody curlCase@(CurlCase _ _ _ _ _ (Just matcher@(Exactly expectedValue)) _ _) (Just receivedBody)
   | expectedValue /= receivedBody =
     Just $ DataFailure curlCase matcher (Just receivedBody)
   | otherwise = 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)
+checkBody curlCase@(CurlCase _ _ _ _ _ (Just matcher@(Contains expectedSubvalues)) _ _) (Just receivedBody)
   | jsonContainsAll receivedBody expectedSubvalues = Nothing
   | otherwise = Just $ DataFailure curlCase matcher (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
 
 -- | Does the json value contain all of these sub-values?
 jsonContainsAll :: Value -> [JsonSubExpr] -> Bool
@@ -104,7 +136,7 @@ jsonContainsAll jsonValue =
 -- | Does the json value contain the given key value pair?
 containsKeyVal :: Value -> T.Text -> Value -> Bool
 containsKeyVal jsonValue key val = case jsonValue of
-  Object o -> isJust $ H.lookup key o
+  Object o -> H.lookup key o == Just val
   _        -> False
 
 -- | Fully traverse the json and return a list of all the values
@@ -121,9 +153,26 @@ traverseValue val =
 -- | 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 _ _ _ _ _ _ (ExactCode expectedCode) _) receivedCode
   | expectedCode /= receivedCode = Just $ StatusFailure curlCase receivedCode
   | otherwise = Nothing
-checkCode curlCase@(CurlCase _ _ _ _ _ (AnyCodeIn l)) receivedCode
+checkCode curlCase@(CurlCase _ _ _ _ _ _ (AnyCodeIn l) _) receivedCode
   | receivedCode `notElem` l = Just $ StatusFailure curlCase receivedCode
   | otherwise = Nothing
+
+-- | Utility conversion from HTTP headers to CurlRunnings headers.
+fromHTTPHeaders :: HTTP.ResponseHeaders -> Headers
+fromHTTPHeaders rh = HeaderSet $ map fromHTTPHeader rh
+
+-- | Utility conversion from an HTTP header to a CurlRunnings header.
+fromHTTPHeader :: HTTP.Header -> Header
+fromHTTPHeader (a, b) =
+  Header (T.pack . B8S.unpack $ CI.original a) (T.pack $ B8S.unpack b)
+
+-- | Utility conversion from an HTTP header to a CurlRunnings header.
+toHTTPHeader :: Header -> HTTP.Header
+toHTTPHeader (Header a b) = (CI.mk . B8S.pack $ T.unpack a, B8S.pack $ T.unpack b)
+
+-- | Utility conversion from CurlRunnings headers to HTTP headers.
+toHTTPHeaders :: Headers -> HTTP.RequestHeaders
+toHTTPHeaders (HeaderSet h) = map toHTTPHeader h