on master help sign in
Fixups (#38)
241c2ebAlexey Uimanov
src/OpenAPI/Checker/Validate/MediaTypeObject.hs+9−5
@@ -10,7 +10,7 @@ import Data.Text (Text)
10import Network.HTTP.Media (MediaType, mainType, subType)
10import Network.HTTP.Media (MediaType, mainType, subType)
11import OpenAPI.Checker.Subtree
11import OpenAPI.Checker.Subtree
12import OpenAPI.Checker.Trace
12import OpenAPI.Checker.Trace
13−import OpenAPI.Checker.Validate.Schema
13+import OpenAPI.Checker.Validate.Schema ()
14
14
15instance Subtree MediaTypeObject where
15instance Subtree MediaTypeObject where
16 type CheckEnv MediaTypeObject =
16 type CheckEnv MediaTypeObject =
@@ -34,12 +34,16 @@ instance Subtree MediaTypeObject where
34 "x-www-form-urlencoded" == subType mediaType -> checkEncoding
34 "x-www-form-urlencoded" == subType mediaType -> checkEncoding
35 | otherwise -> pure ()
35 | otherwise -> pure ()
36 where
36 where
37+ -- Each parameter encoded by the producer must be parsed by the
38+ -- consumer
37− checkEncoding = for_ (IOHM.toList $ _mediaTypeObjectEncoding c) $ \(paramName, consEncoding) ->
39+ checkEncoding = for_ (IOHM.toList $ _mediaTypeObjectEncoding p) $ \(paramName, prodEncoding) ->
38− case IOHM.lookup paramName $ _mediaTypeObjectEncoding p of
40+ case IOHM.lookup paramName $ _mediaTypeObjectEncoding c of
39− Nothing -> issueAt producer MediaEncodingMissing
41+ Nothing -> issueAt consumer MediaEncodingMissing
40− Just prodEncoding -> localStep (MediaTypeParamEncoding paramName)
42+ Just consEncoding -> localStep (MediaTypeParamEncoding paramName)
41 $ checkCompatibility HNil
43 $ checkCompatibility HNil
42 $ ProdCons prodEncoding consEncoding
44 $ ProdCons prodEncoding consEncoding
45+ -- If consumer requires schema then producer must produce compatible
46+ -- request
43 checkSchema = for_ (_mediaTypeObjectSchema c) $ \consRef ->
47 checkSchema = for_ (_mediaTypeObjectSchema c) $ \consRef ->
44 case _mediaTypeObjectSchema p of
48 case _mediaTypeObjectSchema p of
45 Nothing -> issueAt producer MediaTypeSchemaRequired
49 Nothing -> issueAt producer MediaTypeSchemaRequired
src/OpenAPI/Checker/Validate/RequestBody.hs+7−7
@@ -20,19 +20,19 @@ instance Subtree RequestBody where
20 '[ ProdCons (Definitions Schema) ]
20 '[ ProdCons (Definitions Schema) ]
21 data CheckIssue RequestBody
21 data CheckIssue RequestBody
22 = RequestBodyRequired
22 = RequestBodyRequired
23− | RequestMediaTypeNotFound
23+ | RequestMediaTypeNotFound MediaType
24 deriving (Eq, Ord, Show)
24 deriving (Eq, Ord, Show)
25 checkCompatibility env (ProdCons p c) =
25 checkCompatibility env (ProdCons p c) =
26 if not (fromMaybe False $ _requestBodyRequired p)
26 if not (fromMaybe False $ _requestBodyRequired p)
27 && (fromMaybe False $ _requestBodyRequired c)
27 && (fromMaybe False $ _requestBodyRequired c)
28 then issueAt producer RequestBodyRequired
28 then issueAt producer RequestBodyRequired
29 else
29 else
30− -- For each consumer we must find at least one compatible producer media
30+ -- Each media type generated by the producer must be parsed by the
31− -- type
31+ -- consumer
32− for_ (IOHM.toList $ _requestBodyContent c) $ \(mediaType, consMedia) ->
32+ for_ (IOHM.toList $ _requestBodyContent p) $ \(mediaType, prodMedia) ->
33− case IOHM.lookup mediaType $ _requestBodyContent p of
33+ case IOHM.lookup mediaType $ _requestBodyContent c of
34− Nothing -> issueAt producer RequestMediaTypeNotFound
34+ Nothing -> issueAt consumer (RequestMediaTypeNotFound mediaType)
35− Just prodMedia -> localStep (MediaTypeStep mediaType) $
35+ Just consMedia -> localStep (MediaTypeStep mediaType) $
36 checkCompatibility (HCons mediaType env) (ProdCons prodMedia consMedia)
36 checkCompatibility (HCons mediaType env) (ProdCons prodMedia consMedia)
37
37
38instance Steppable RequestBody MediaTypeObject where
38instance Steppable RequestBody MediaTypeObject where
src/OpenAPI/Checker/Validate/Responses.hs+12−10
@@ -30,10 +30,10 @@ instance Subtree Responses where
30 -- it. So, the logic is swapped.
30 -- it. So, the logic is swapped.
31 checkCompatibility env (ProdCons p c) = do
31 checkCompatibility env (ProdCons p c) = do
32 let defs = getH @(ProdCons (Definitions Response)) env
32 let defs = getH @(ProdCons (Definitions Response)) env
33− for_ (IOHM.toList $ _responsesResponses p) $ \ (prodStatus, prodRef) ->
33+ for_ (IOHM.toList $ _responsesResponses c) $ \(prodStatus, consRef) ->
34− case IOHM.lookup prodStatus $ _responsesResponses c of
34+ case IOHM.lookup prodStatus $ _responsesResponses p of
35− Nothing -> issueAt consumer $ ResponseCodeNotFound prodStatus
35+ Nothing -> issueAt producer $ ResponseCodeNotFound prodStatus
36− Just consRef -> do
36+ Just prodRef -> do
37 let tracedRefs = dereference <$> defs <*> ProdCons prodRef consRef
37 let tracedRefs = dereference <$> defs <*> ProdCons prodRef consRef
38 localStep (ResponseCodeStep prodStatus)
38 localStep (ResponseCodeStep prodStatus)
39 $ checkProdCons env tracedRefs
39 $ checkProdCons env tracedRefs
@@ -56,16 +56,18 @@ instance Subtree Response where
56 checkHeaders
56 checkHeaders
57 pure ()
57 pure ()
58 where
58 where
59− -- Each response type expected by producer must be in the consumer (logic
59+ -- Each response type, generated by the consumer must be parseable by the
60− -- is swapped)
60+ -- producer
61 checkMediaTypes = do
61 checkMediaTypes = do
62− for_ (IOHM.toList $ _responseContent p) $ \ (mediaType, prodMediaObject) ->
62+ for_ (IOHM.toList $ _responseContent c) $ \ (mediaType, consMediaObject) ->
63− case IOHM.lookup mediaType $ _responseContent c of
63+ case IOHM.lookup mediaType $ _responseContent p of
64− Nothing -> issueAt consumer $ ResponseMediaTypeMissing mediaType
64+ Nothing -> issueAt producer $ ResponseMediaTypeMissing mediaType
65− Just consMediaObject -> localStep (ResponseMediaObject mediaType)
65+ Just prodMediaObject -> localStep (ResponseMediaObject mediaType)
66 $ swapRoles
66 $ swapRoles
67 $ checkCompatibility @MediaTypeObject (mediaType `HCons` swapProdCons schemaRefs `HCons` HNil)
67 $ checkCompatibility @MediaTypeObject (mediaType `HCons` swapProdCons schemaRefs `HCons` HNil)
68 $ ProdCons consMediaObject prodMediaObject
68 $ ProdCons consMediaObject prodMediaObject
69+ -- Each header expected by the producer must be provided by the
70+ -- consumer. Assume, that extra consumer headers are ignored.
69 checkHeaders = do
71 checkHeaders = do
70 for_ (IOHM.toList $ _responseHeaders p) $ \ (hname, prodRef) ->
72 for_ (IOHM.toList $ _responseHeaders p) $ \ (hname, prodRef) ->
71 case IOHM.lookup hname $ _responseHeaders c of
73 case IOHM.lookup hname $ _responseHeaders c of