git.iko.soy/compaREST
on master help sign in
Some error reporting fixes (#37)
aea5f37mniip
src/OpenAPI/Checker/Validate/ProcessedPathItem.hs+4−3
compare with master
unifiedsplit
@@ -48,9 +48,7 @@ instance Subtree ProcessedPathItems where
48 <$> getH @(ProdCons (Definitions Param)) env
48 <$> getH @(ProdCons (Definitions Param)) env
49 <*> prodCons
49 <*> prodCons
50 sequenceA_
50 sequenceA_
51− [ anyOfAt
51+ [ anyOf'
52− producer
53− NoPathsMatched
54 [ localTrace (step <$> ProdCons pSPath cSPath) $ do
52 [ localTrace (step <$> ProdCons pSPath cSPath) $ do
55 -- make sure every path fragment is compatible
53 -- make sure every path fragment is compatible
56 sequenceA_
54 sequenceA_
@@ -81,6 +79,9 @@ instance Subtree ProcessedPathItems where
81 toList (fmap . (,) <$> processedPathItemGetters <*> pPathItem) >>= maybeToList
79 toList (fmap . (,) <$> processedPathItemGetters <*> pPathItem) >>= maybeToList
82 , let pPathFragmentParams = retrace (step PathFragmentParentStep) <$> pParams
80 , let pPathFragmentParams = retrace (step PathFragmentParentStep) <$> pParams
83 ]
81 ]
82+ where
83+ anyOf' [x] = x -- preserve errors if there's only one choice
84+ anyOf' xs = anyOfAt producer NoPathsMatched xs
84
85
85zipAllWith :: (a -> b -> c) -> [a] -> [b] -> Maybe [c]
86zipAllWith :: (a -> b -> c) -> [a] -> [b] -> Maybe [c]
86zipAllWith _ [] [] = Just []
87zipAllWith _ [] [] = Just []
src/OpenAPI/Checker/Validate/Responses.hs+3−2
@@ -64,7 +64,7 @@ instance Subtree Response where
64 Nothing -> issueAt consumer $ ResponseMediaTypeMissing mediaType
64 Nothing -> issueAt consumer $ ResponseMediaTypeMissing mediaType
65 Just consMediaObject -> localStep (ResponseMediaObject mediaType)
65 Just consMediaObject -> localStep (ResponseMediaObject mediaType)
66 $ swapRoles
66 $ swapRoles
67− $ checkCompatibility @MediaTypeObject (HCons mediaType env)
67+ $ checkCompatibility @MediaTypeObject (mediaType `HCons` swapProdCons schemaRefs `HCons` HNil)
68 $ ProdCons consMediaObject prodMediaObject
68 $ ProdCons consMediaObject prodMediaObject
69 checkHeaders = do
69 checkHeaders = do
70 for_ (IOHM.toList $ _responseHeaders p) $ \ (hname, prodRef) ->
70 for_ (IOHM.toList $ _responseHeaders p) $ \ (hname, prodRef) ->
@@ -74,8 +74,9 @@ instance Subtree Response where
74 let headerRefs = dereference <$> headerDefs <*> ProdCons prodRef consRef
74 let headerRefs = dereference <$> headerDefs <*> ProdCons prodRef consRef
75 localStep (ResponseHeader hname)
75 localStep (ResponseHeader hname)
76 $ swapRoles
76 $ swapRoles
77− $ checkProdCons env $ swapProdCons headerRefs
77+ $ checkProdCons (singletonH $ swapProdCons schemaRefs) $ swapProdCons headerRefs
78 headerDefs = getH @(ProdCons (Definitions Header)) env
78 headerDefs = getH @(ProdCons (Definitions Header)) env
79+ schemaRefs = getH @(ProdCons (Definitions Schema)) env
79
80
80instance Subtree Header where
81instance Subtree Header where
81 type CheckEnv Header = '[ProdCons (Definitions Schema)]
82 type CheckEnv Header = '[ProdCons (Definitions Schema)]
src/OpenAPI/Checker/Validate/Schema.hs+8−4
@@ -529,7 +529,7 @@ processSchema (Traced t Schema{..}) = do
529 TopFormula -> All True
529 TopFormula -> All True
530 _ -> All False
530 _ -> All False
531 -- remove optional fields whose schemata match that of additional props
531 -- 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
533 propertiesClause
533 propertiesClause
534 | any (\p -> propRequired p && allBottom (propFormula p)) propMap
534 | any (\p -> propRequired p && allBottom (propFormula p)) propMap
535 = bottom -- if any required field has unsatisfiable schema
535 = bottom -- if any required field has unsatisfiable schema
@@ -609,15 +609,18 @@ checkFormulas env tr (ProdCons (fp, ep) (fc, ec)) =
609 -- shortcut of \/_j A[j] ⊂ ∅ hardly helps.
609 -- shortcut of \/_j A[j] ⊂ ∅ hardly helps.
610 forType_ $ \ty ->
610 forType_ $ \ty ->
611 case (ty fp, ty fc) of
611 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
613 (DNF pss, SingleConjunct cs) -> F.for_ pss $ \(Conjunct ps) -> do
613 (DNF pss, SingleConjunct cs) -> F.for_ pss $ \(Conjunct ps) -> do
614 F.for_ cs $ checkImplication env ps -- avoid disjuntion if there's only one conjunct
614 F.for_ cs $ checkImplication env ps -- avoid disjuntion if there's only one conjunct
615 (DNF pss, DNF css) -> F.for_ pss $ \(Conjunct ps) -> do
615 (DNF pss, DNF css) -> F.for_ pss $ \(Conjunct ps) -> do
616 anyOfM tr (SubtreeCheckIssue $ NoMatchingCondition $ SomeCondition . getTraced <$> ps)
616 anyOfM tr (SubtreeCheckIssue $ NoMatchingCondition $ SomeCondition . getTraced <$> ps)
617 [F.for_ cs $ checkImplication env ps | Conjunct cs <- S.toList css]
617 [F.for_ cs $ checkImplication env ps | Conjunct cs <- S.toList css]
618
618
619+checkContradiction
620+ :: Trace OpenApi Schema
619−checkContradiction :: [Traced OpenApi (Condition t)] -> CompatFormula s ()
621+ -> [Traced OpenApi (Condition t)]
622+ -> CompatFormula s ()
620−checkContradiction _ = pure () -- TODO
623+checkContradiction tr _ = issueAtTrace tr NoContradiction -- TODO
621
624
622checkImplication
625checkImplication
623 :: (HasAll (CheckEnv Schema) xs, Typeable t)
626 :: (HasAll (CheckEnv Schema) xs, Typeable t)
@@ -759,6 +762,7 @@ instance Subtree Schema where
759 = NotSupported Text
762 = NotSupported Text
760 | InvalidSchema Text
763 | InvalidSchema Text
761 | NoMatchingCondition [SomeCondition]
764 | NoMatchingCondition [SomeCondition]
765+ | NoContradiction
762 deriving stock (Eq, Ord, Show)
766 deriving stock (Eq, Ord, Show)
763 type CheckEnv Schema = '[ProdCons (Definitions Schema)]
767 type CheckEnv Schema = '[ProdCons (Definitions Schema)]
764 checkCompatibility env schs = withTrace $ \traces -> do
768 checkCompatibility env schs = withTrace $ \traces -> do