aea5f37 · compaREST · git.iko.soy

git.iko.soy/compaREST

Some error reporting fixes (#37)

* Preserve errors when matching paths * Complain about contradictions (used in type field checking) * Swap schema definitions when swapping roles * Filter properties correctly

commitaea5f371a681145376d8914bf8402826dc0ba8ea authormniip <mniip@users.noreply.github.com> dateThu 8 Apr 2021, 12:03 (6 years ago) parent5568591

3 files changed+15−9

compare with master

unifiedsplit

src/OpenAPI/Checker/Validate/ProcessedPathItem.hs+4−3 src/OpenAPI/Checker/Validate/Responses.hs+3−2 src/OpenAPI/Checker/Validate/Schema.hs+8−4

src/OpenAPI/Checker/Validate/ProcessedPathItem.hs+4−3

@@ -48,9 +48,7 @@ instance Subtree ProcessedPathItems where

4848 <$> getH @(ProdCons (Definitions Param)) env

4949 <*> prodCons

5050 sequenceA_

51− [ anyOfAt

52− producer

53− NoPathsMatched

51+ [ anyOf'

5452 [ localTrace (step <$> ProdCons pSPath cSPath) $ do

5553 -- make sure every path fragment is compatible

5654 sequenceA_

@@ -81,6 +79,9 @@ instance Subtree ProcessedPathItems where

8179 toList (fmap . (,) <$> processedPathItemGetters <*> pPathItem) >>= maybeToList

8280 , let pPathFragmentParams = retrace (step PathFragmentParentStep) <$> pParams

8381 ]

82+ where

83+ anyOf' [x] = x -- preserve errors if there's only one choice

84+ anyOf' xs = anyOfAt producer NoPathsMatched xs

8485

8586zipAllWith :: (a -> b -> c) -> [a] -> [b] -> Maybe [c]

8687zipAllWith _ [] [] = Just []

src/OpenAPI/Checker/Validate/Responses.hs+3−2

@@ -64,7 +64,7 @@ instance Subtree Response where

6464 Nothing -> issueAt consumer $ ResponseMediaTypeMissing mediaType

6565 Just consMediaObject -> localStep (ResponseMediaObject mediaType)

6666 $ swapRoles

67− $ checkCompatibility @MediaTypeObject (HCons mediaType env)

67+ $ checkCompatibility @MediaTypeObject (mediaType `HCons` swapProdCons schemaRefs `HCons` HNil)

6868 $ ProdCons consMediaObject prodMediaObject

6969 checkHeaders = do

7070 for_ (IOHM.toList $ _responseHeaders p) $ \ (hname, prodRef) ->

@@ -74,8 +74,9 @@ instance Subtree Response where

7474 let headerRefs = dereference <$> headerDefs <*> ProdCons prodRef consRef

7575 localStep (ResponseHeader hname)

7676 $ swapRoles

77− $ checkProdCons env $ swapProdCons headerRefs

77+ $ checkProdCons (singletonH $ swapProdCons schemaRefs) $ swapProdCons headerRefs

7878 headerDefs = getH @(ProdCons (Definitions Header)) env

79+ schemaRefs = getH @(ProdCons (Definitions Schema)) env

7980

8081instance Subtree Header where

8182 type CheckEnv Header = '[ProdCons (Definitions Schema)]

src/OpenAPI/Checker/Validate/Schema.hs+8−4

@@ -529,7 +529,7 @@ processSchema (Traced t Schema{..}) = do

529529 TopFormula -> All True

530530 _ -> All False

531531 -- remove optional fields whose schemata match that of additional props

532− propMap = M.filter (\p -> propRequired p || not (propFormula p /= addProps)) $ M.fromList propList

532+ propMap = M.filter (\p -> propRequired p || propFormula p /= addProps) $ M.fromList propList

533533 propertiesClause

534534 | any (\p -> propRequired p && allBottom (propFormula p)) propMap

535535 = bottom -- if any required field has unsatisfiable schema

@@ -609,15 +609,18 @@ checkFormulas env tr (ProdCons (fp, ep) (fc, ec)) =

609609 -- shortcut of \/_j A[j] ⊂ ∅ hardly helps.

610610 forType_ $ \ty ->

611611 case (ty fp, ty fc) of

612− (DNF pss, BottomFormula) -> F.for_ pss $ \(Conjunct ps) -> checkContradiction ps

612+ (DNF pss, BottomFormula) -> F.for_ pss $ \(Conjunct ps) -> checkContradiction tr ps

613613 (DNF pss, SingleConjunct cs) -> F.for_ pss $ \(Conjunct ps) -> do

614614 F.for_ cs $ checkImplication env ps -- avoid disjuntion if there's only one conjunct

615615 (DNF pss, DNF css) -> F.for_ pss $ \(Conjunct ps) -> do

616616 anyOfM tr (SubtreeCheckIssue $ NoMatchingCondition $ SomeCondition . getTraced <$> ps)

617617 [F.for_ cs $ checkImplication env ps | Conjunct cs <- S.toList css]

618618

619−checkContradiction :: [Traced OpenApi (Condition t)] -> CompatFormula s ()

620−checkContradiction _ = pure () -- TODO

619+checkContradiction

620+ :: Trace OpenApi Schema

621+ -> [Traced OpenApi (Condition t)]

622+ -> CompatFormula s ()

623+checkContradiction tr _ = issueAtTrace tr NoContradiction -- TODO

621624

622625checkImplication

623626 :: (HasAll (CheckEnv Schema) xs, Typeable t)

@@ -759,6 +762,7 @@ instance Subtree Schema where

759762 = NotSupported Text

760763 | InvalidSchema Text

761764 | NoMatchingCondition [SomeCondition]

765+ | NoContradiction

762766 deriving stock (Eq, Ord, Show)

763767 type CheckEnv Schema = '[ProdCons (Definitions Schema)]

764768 checkCompatibility env schs = withTrace $ \traces -> do