diff --git a/curl-runnings.cabal b/curl-runnings.cabal --- a/curl-runnings.cabal +++ b/curl-runnings.cabal @@ -2,10 +2,10 @@ -- -- see: https://github.com/sol/hpack -- --- hash: 5ba21bafee5c2e642cec1c0c7bff81b86f715d883cc524542a61d787f7aca778 +-- hash: 9530ddd7493ff79858e3c01c7064eb8119932f625cdb1fa3f5cb93e3b3786189 name: curl-runnings -version: 0.2.0 +version: 0.3.0 synopsis: A framework for declaratively writing curl based API tests description: Please see the README on Github at category: Testing @@ -37,12 +37,15 @@ , 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 diff --git a/examples/example-spec.json b/examples/example-spec.json --- a/examples/example-spec.json +++ b/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" + } + ] } ] diff --git a/examples/example-spec.yaml b/examples/example-spec.yaml --- a/examples/example-spec.yaml +++ b/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" + diff --git a/src/Testing/CurlRunnings.hs b/src/Testing/CurlRunnings.hs --- a/src/Testing/CurlRunnings.hs +++ b/src/Testing/CurlRunnings.hs @@ -14,12 +14,14 @@ 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 @@ 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 @@ -- | 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 @@ -- | 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 @@ -- | 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 diff --git a/src/Testing/CurlRunnings/Types.hs b/src/Testing/CurlRunnings/Types.hs --- a/src/Testing/CurlRunnings/Types.hs +++ b/src/Testing/CurlRunnings/Types.hs @@ -1,27 +1,37 @@ -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE OverloadedStrings #-} -- | Data types for curl-runnings tests + module Testing.CurlRunnings.Types - ( CurlSuite(..) + ( AssertionFailure(..) + , CaseResult(..) + , CurlSuite(..) , CurlCase(..) + , Header(..) + , HeaderMatcher(..) + , Headers(..) , HttpMethod(..) , JsonMatcher(..) , JsonSubExpr(..) + , PartialHeaderMatcher(..) , StatusCodeMatcher(..) - , AssertionFailure(..) - , CaseResult(..) - , isPassing + , isFailing + , isPassing + ) where import Data.Aeson import Data.Aeson.Encode.Pretty import Data.Aeson.Types import qualified Data.ByteString.Lazy.Char8 as B8 +import Data.Either import qualified Data.HashMap.Strict as H +import Data.List import Data.Maybe import qualified Data.Text as T +import qualified Data.Vector as V import GHC.Generics import Testing.CurlRunnings.Internal import Text.Printf @@ -55,6 +65,80 @@ | isJust $ H.lookup "contains" v = Contains <$> v .: "contains" parseJSON invalid = typeMismatch "JsonMatcher" invalid +-- | 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 = + PartialHeaderMatcher (Maybe T.Text) + (Maybe T.Text) + deriving (Show, Generic) +instance ToJSON PartialHeaderMatcher + +-- | Collection of matchers to run against a single curl response +data HeaderMatcher = + HeaderMatcher [PartialHeaderMatcher] + deriving (Show, Generic) + +instance ToJSON HeaderMatcher + +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 + (\s -> typeMismatch ("HeaderMatcher: " ++ T.unpack s) o) + (\(HeaderSet parsed) -> + return . HeaderMatcher $ + map + (\(Header key val) -> PartialHeaderMatcher (Just key) (Just val)) + parsed) + (parseHeaders v) + parseJSON (Object v) = do + partial <- PartialHeaderMatcher <$> v .:? "key" <*> v .:? "value" + return $ HeaderMatcher [partial] + parseJSON (Array v) = mconcat . V.toList $ V.map parseJSON v + parseJSON invalid = typeMismatch "HeaderMatcher" invalid + -- | A matcher for a subvalue of a json payload data JsonSubExpr -- | Assert some value anywhere in the json has a value equal to a given @@ -94,10 +178,12 @@ data CurlCase = CurlCase { name :: String -- ^ The name of the test case , url :: String -- ^ The target url to test - , requestMethod :: HttpMethod -- ^ Berb to use for the request + , 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 } deriving (Show, Generic) instance FromJSON CurlCase @@ -117,6 +203,10 @@ -- | The status code we got back was wrong | StatusFailure CurlCase Int + -- | The headers we got back were wrong + | HeaderFailure CurlCase + HeaderMatcher + Headers -- | Something else | UnexpectedFailure @@ -149,6 +239,12 @@ (url curlCase) (B8.unpack (encodePretty expectedVals)) (B8.unpack (encodePretty receivedVal)) + show (HeaderFailure curlCase expected receivedHeaders) = + printf + "Headers from %s didn't contain expected headers. Expected headers: %s. Received headers: %s" + (url curlCase) + (show expected) + (show receivedHeaders) show UnexpectedFailure = "Unexpected Error D:" -- | A type representing the result of a single curl, and all associated diff --git a/test/Spec.hs b/test/Spec.hs --- a/test/Spec.hs +++ b/test/Spec.hs @@ -1,12 +1,9 @@ module Main where +import Data.Either import System.Directory import Test.Hspec import Testing.CurlRunnings - -isRight :: Either a b -> Bool -isRight (Right _) = True -isRight _ = False main :: IO () main = hspec $