git.iko.soy/typeable/compaREST
on master help sign in
Fixups (#38)

Fix some logic in request/response stuff

commit241c2eb3772f236a57daf15041e8e4249672d4b1 authorAlexey Uimanov <s9gf4ult@gmail.com> dateThu 8 Apr 2021, 14:16 (6 years ago) parentaea5f37
3 files changed+28−22
compare with master
unifiedsplit
src/OpenAPI/Checker/Validate/MediaTypeObject.hs+9−5 src/OpenAPI/Checker/Validate/RequestBody.hs+7−7 src/OpenAPI/Checker/Validate/Responses.hs+12−10
src/OpenAPI/Checker/Validate/MediaTypeObject.hs+9−5
@@ -10,7 +10,7 @@ import Data.Text (Text)
1010import Network.HTTP.Media (MediaType, mainType, subType)
1111import OpenAPI.Checker.Subtree
1212import OpenAPI.Checker.Trace
13−import OpenAPI.Checker.Validate.Schema
13+import OpenAPI.Checker.Validate.Schema ()
1414
1515instance Subtree MediaTypeObject where
1616 type CheckEnv MediaTypeObject =
@@ -34,12 +34,16 @@ instance Subtree MediaTypeObject where
3434 "x-www-form-urlencoded" == subType mediaType -> checkEncoding
3535 | otherwise -> pure ()
3636 where
37− checkEncoding = for_ (IOHM.toList $ _mediaTypeObjectEncoding c) $ \(paramName, consEncoding) ->
38− case IOHM.lookup paramName $ _mediaTypeObjectEncoding p of
39− Nothing -> issueAt producer MediaEncodingMissing
40− Just prodEncoding -> localStep (MediaTypeParamEncoding paramName)
37+ -- Each parameter encoded by the producer must be parsed by the
38+ -- consumer
39+ checkEncoding = for_ (IOHM.toList $ _mediaTypeObjectEncoding p) $ \(paramName, prodEncoding) ->
40+ case IOHM.lookup paramName $ _mediaTypeObjectEncoding c of
41+ Nothing -> issueAt consumer MediaEncodingMissing
42+ Just consEncoding -> localStep (MediaTypeParamEncoding paramName)
4143 $ checkCompatibility HNil
4244 $ ProdCons prodEncoding consEncoding
45+ -- If consumer requires schema then producer must produce compatible
46+ -- request
4347 checkSchema = for_ (_mediaTypeObjectSchema c) $ \consRef ->
4448 case _mediaTypeObjectSchema p of
4549 Nothing -> issueAt producer MediaTypeSchemaRequired
src/OpenAPI/Checker/Validate/RequestBody.hs+7−7
@@ -20,19 +20,19 @@ instance Subtree RequestBody where
2020 '[ ProdCons (Definitions Schema) ]
2121 data CheckIssue RequestBody
2222 = RequestBodyRequired
23− | RequestMediaTypeNotFound
23+ | RequestMediaTypeNotFound MediaType
2424 deriving (Eq, Ord, Show)
2525 checkCompatibility env (ProdCons p c) =
2626 if not (fromMaybe False $ _requestBodyRequired p)
2727 && (fromMaybe False $ _requestBodyRequired c)
2828 then issueAt producer RequestBodyRequired
2929 else
30− -- For each consumer we must find at least one compatible producer media
31− -- type
32− for_ (IOHM.toList $ _requestBodyContent c) $ \(mediaType, consMedia) ->
33− case IOHM.lookup mediaType $ _requestBodyContent p of
34− Nothing -> issueAt producer RequestMediaTypeNotFound
35− Just prodMedia -> localStep (MediaTypeStep mediaType) $
30+ -- Each media type generated by the producer must be parsed by the
31+ -- consumer
32+ for_ (IOHM.toList $ _requestBodyContent p) $ \(mediaType, prodMedia) ->
33+ case IOHM.lookup mediaType $ _requestBodyContent c of
34+ Nothing -> issueAt consumer (RequestMediaTypeNotFound mediaType)
35+ Just consMedia -> localStep (MediaTypeStep mediaType) $
3636 checkCompatibility (HCons mediaType env) (ProdCons prodMedia consMedia)
3737
3838instance Steppable RequestBody MediaTypeObject where
src/OpenAPI/Checker/Validate/Responses.hs+12−10
@@ -30,10 +30,10 @@ instance Subtree Responses where
3030 -- it. So, the logic is swapped.
3131 checkCompatibility env (ProdCons p c) = do
3232 let defs = getH @(ProdCons (Definitions Response)) env
33− for_ (IOHM.toList $ _responsesResponses p) $ \ (prodStatus, prodRef) ->
34− case IOHM.lookup prodStatus $ _responsesResponses c of
35− Nothing -> issueAt consumer $ ResponseCodeNotFound prodStatus
36− Just consRef -> do
33+ for_ (IOHM.toList $ _responsesResponses c) $ \(prodStatus, consRef) ->
34+ case IOHM.lookup prodStatus $ _responsesResponses p of
35+ Nothing -> issueAt producer $ ResponseCodeNotFound prodStatus
36+ Just prodRef -> do
3737 let tracedRefs = dereference <$> defs <*> ProdCons prodRef consRef
3838 localStep (ResponseCodeStep prodStatus)
3939 $ checkProdCons env tracedRefs
@@ -56,16 +56,18 @@ instance Subtree Response where
5656 checkHeaders
5757 pure ()
5858 where
59− -- Each response type expected by producer must be in the consumer (logic
60− -- is swapped)
59+ -- Each response type, generated by the consumer must be parseable by the
60+ -- producer
6161 checkMediaTypes = do
62− for_ (IOHM.toList $ _responseContent p) $ \ (mediaType, prodMediaObject) ->
63− case IOHM.lookup mediaType $ _responseContent c of
64− Nothing -> issueAt consumer $ ResponseMediaTypeMissing mediaType
65− Just consMediaObject -> localStep (ResponseMediaObject mediaType)
62+ for_ (IOHM.toList $ _responseContent c) $ \ (mediaType, consMediaObject) ->
63+ case IOHM.lookup mediaType $ _responseContent p of
64+ Nothing -> issueAt producer $ ResponseMediaTypeMissing mediaType
65+ Just prodMediaObject -> localStep (ResponseMediaObject mediaType)
6666 $ swapRoles
6767 $ checkCompatibility @MediaTypeObject (mediaType `HCons` swapProdCons schemaRefs `HCons` HNil)
6868 $ ProdCons consMediaObject prodMediaObject
69+ -- Each header expected by the producer must be provided by the
70+ -- consumer. Assume, that extra consumer headers are ignored.
6971 checkHeaders = do
7072 for_ (IOHM.toList $ _responseHeaders p) $ \ (hname, prodRef) ->
7173 case IOHM.lookup hname $ _responseHeaders c of