Skip to content

Commit 52de9e6

Browse files
authored
Fix content type & override (#79)
* fix content type & override * update example spec with content type override example
1 parent 16fd9db commit 52de9e6

File tree

2 files changed

+35
-5
lines changed

2 files changed

+35
-5
lines changed

examples/example-spec.yaml

Lines changed: 11 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -130,3 +130,14 @@ cases:
130130
- "Hello: world"
131131
-
132132
value: "Value-With-Key-We-Dont-Care-About"
133+
134+
- name: We use a json content type by default
135+
url: http://your-url.com/other/path
136+
requestMethod: GET
137+
expectStatus: 200
138+
139+
- name: Override the content type
140+
url: http://your-url.com/other/path
141+
requestMethod: GET
142+
headers: "Content-Type: an overridden content type"
143+
expectStatus: 200

src/Testing/CurlRunnings.hs

Lines changed: 24 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -105,16 +105,35 @@ appendQueryParameters newParams r = setQueryString (existing ++ newQuery) r wher
105105
existing = NT.parseQuery $ queryString r
106106
newQuery = NT.simpleQueryToQuery $ fmap (\(KeyValuePair k v) -> (T.encodeUtf8 . A.toText $ k, T.encodeUtf8 v)) newParams
107107

108+
resetContentTypeIfOverridden :: Request -> Request-> Request
109+
resetContentTypeIfOverridden old new =
110+
if (not $ null (getRequestHeader "Content-Type" old))
111+
then (setRequestHeader
112+
"Content-Type"
113+
(getRequestHeader "Content-Type" old)
114+
new)
115+
else new
116+
117+
118+
-- | Sets the payload based on the provided payload type. If a custom
119+
-- "Content-Type" header is provided, it will be preserved
108120
setPayload :: Maybe Payload -> Request -> Request
109121
-- TODO - for backwards compatability, empty requests will set an empty json
110122
-- payload. Given that we support multiple content types, this funtionality
111123
-- isn't exactly correct anymore. This behavior should be considered
112124
-- deprecated and will be updated with the next major version release of
113125
-- curl-runnings.
114-
setPayload Nothing = setRequestBodyJSON emptyObject
115-
setPayload (Just (JSON v)) = setRequestBodyJSON v
116-
setPayload (Just (URLEncoded (KeyValuePairs xs))) = setRequestBodyURLEncoded $ kvpairs xs where
117-
kvpairs = fmap (\(KeyValuePair k v) -> (T.encodeUtf8 . A.toText $ k, T.encodeUtf8 v))
126+
setPayload Nothing req =
127+
resetContentTypeIfOverridden req . setRequestBodyJSON emptyObject $ req
128+
setPayload (Just (JSON v)) req =
129+
resetContentTypeIfOverridden req . (setRequestBodyJSON v) $ req
130+
setPayload (Just (URLEncoded (KeyValuePairs xs))) req =
131+
resetContentTypeIfOverridden req . (setRequestBodyURLEncoded $ kvpairs xs) $
132+
req
133+
where
134+
kvpairs =
135+
fmap
136+
(\(KeyValuePair k v) -> (T.encodeUtf8 . A.toText $ k, T.encodeUtf8 v))
118137

119138
-- | Run a single test case, and returns the result. IO is needed here since this method is responsible
120139
-- for actually curling the test case endpoint and parsing the result.
@@ -140,8 +159,8 @@ runCase state@(CurlRunningsState _ _ _ tlsCheckType) curlCase = do
140159
manager <- newManager noVerifyTlsManagerSettings
141160

142161
let !request =
143-
setRequestHeaders (toHTTPHeaders interpolatedHeaders) .
144162
setPayload interpolatedData .
163+
setRequestHeaders (toHTTPHeaders interpolatedHeaders) .
145164
appendQueryParameters interpolatedQueryParams .
146165
(if tlsCheckType == DoTLSCheck then id else (setRequestManager manager)) $
147166
initReq { method = B8S.pack . show $ requestMethod curlCase

0 commit comments

Comments
 (0)