on master help sign in
Improved reports (#78)

* Extracted jets * Split document structure * Splite removed paths * bumped resolver * Better enum errors * Better removed paths rendering * Slightly better wording * Strip empty jetted headers * Don't check field further if it will fail based on being optional or required * changed wording slightly * Slightly changed wording * Changed wording some more * Changed wording a lot

commit695c8fb31da6244805ef85274d5fed234bc874e0 authoriko <ilyakooo0@gmail.com> dateTue 15 Jun 2021, 18:57 (5 years ago) parentf883264
37 files changed+516−261
app/Main.hs+4−3 openapi-diff.cabal+1 src/OpenAPI/Checker/Behavior.hs+2 src/OpenAPI/Checker/PathsPrefixTree.hs+43−13 src/OpenAPI/Checker/Report.hs+100−91 src/OpenAPI/Checker/Report/Jet.hs+64 src/OpenAPI/Checker/Subtree.hs+1−1 src/OpenAPI/Checker/Validate/Header.hs+2−2 src/OpenAPI/Checker/Validate/MediaTypeObject.hs+4−4 src/OpenAPI/Checker/Validate/OAuth2Flows.hs+16−16 src/OpenAPI/Checker/Validate/OpenApi.hs+1 src/OpenAPI/Checker/Validate/Operation.hs+4−3 src/OpenAPI/Checker/Validate/Param.hs+2−2 src/OpenAPI/Checker/Validate/RequestBody.hs+2−2 src/OpenAPI/Checker/Validate/Responses.hs+2−2 src/OpenAPI/Checker/Validate/Schema.hs+57−46 src/OpenAPI/Checker/Validate/Server.hs+3−3 stack.yaml+1−1 stack.yaml.lock+4−4 test/Spec/Golden/TraceTree.hs+2−1 test/golden/common/maximum-lowered/report.md+12−4 test/golden/common/pathItem/operation/parameters/allowEmptyValue/reset/report.md+10−2 test/golden/common/pathItem/operation/parameters/change/report.md+13−5 test/golden/common/pathItem/operation/parameters/required/set/report.md+11−3 test/golden/common/pathItem/operation/parameters/required/true/add/report.md+10−2 test/golden/common/pathItem/operation/requestBody/mediaTypeObject/change/report.md+12−4 test/golden/common/pathItem/operation/requestBody/mediaTypeObject/del/report.md+11−4 test/golden/common/pathItem/operation/requestBody/required/set/report.md+11−3 test/golden/common/pathItem/operation/responses/add/report.md+10−2 test/golden/common/pathItem/operation/responses/change/headers/mandatory/del/report.md+11−3 test/golden/common/pathItem/operation/responses/change/mediaTypeObject/add/report.md+11−4 test/golden/common/pathItem/operation/responses/change/mediaTypeObject/change/report.md+12−4 test/golden/common/property-removed/report.md+15−7 test/golden/common/property-required/report.md+12−4 test/golden/common/security-scheme/report.md+16−8 test/golden/common/servers/report.md+14−6 test/golden/common/unguarded-recursive/report.md+10−2
app/Main.hs+4−3
@@ -38,13 +38,14 @@ main = do
3838 let result = runCompatFormula $ checkCompatibility HNil Root (ProdCons a b)
3939 runPandocIO :: PandocIO a -> ExceptT Errors IO a
4040 runPandocIO x = lift (runIO x) >>= either (throwError . DocumentError) pure
41+ options = def {writerExtensions = githubMarkdownExtensions}
4142 output :: Either (PathsPrefixTree Behave AnIssue 'APILevel) () -> ExceptT Errors IO ()
4243 output = case outputMode opts of
43− StdoutMode -> lift . T.putStrLn <=< runPandocIO . writeMarkdown def . generateReport
44+ StdoutMode -> lift . T.putStrLn <=< runPandocIO . writeMarkdown options . generateReport
4445 FileMode f -> case formatFromFilePath f of
4546 Nothing -> \_ -> throwError UnknownOutputFormat
46− Just (TextWriter writer) -> lift . T.writeFile f <=< runPandocIO . writer def . generateReport
47− Just (ByteStringWriter writer) -> lift . BSL.writeFile f <=< runPandocIO . writer def . generateReport
47+ Just (TextWriter writer) -> lift . T.writeFile f <=< runPandocIO . writer options . generateReport
48+ Just (ByteStringWriter writer) -> lift . BSL.writeFile f <=< runPandocIO . writer options . generateReport
4849 either handler pure <=< runExceptT $ output result
4950 case result of
5051 Right () -> exitSuccess
openapi-diff.cabal+1
@@ -133,6 +133,7 @@ library
133133 , OpenAPI.Checker.Validate.OAuth2Flows
134134 , OpenAPI.Checker.Report
135135 , Data.OpenUnion.Extra
136+ , OpenAPI.Checker.Report.Jet
136137
137138executable openapi-diff
138139 import: common-options
src/OpenAPI/Checker/Behavior.hs+2
@@ -55,6 +55,8 @@ instance Issuable l => ToJSON (Issue l) where
5555data AnIssue (l :: BehaviorLevel) where
5656 AnIssue :: Issuable l => Issue l -> AnIssue l
5757
58+deriving stock instance Show (AnIssue l)
59+
5860deriving stock instance Eq (AnIssue l)
5961
6062deriving stock instance Ord (AnIssue l)
src/OpenAPI/Checker/PathsPrefixTree.hs+43−13
@@ -10,10 +10,14 @@ module OpenAPI.Checker.PathsPrefixTree
1010 , foldWith
1111 , toList
1212 , filter
13+ , takeSubtree
1314 , embed
15+ , size
16+ , partition
1417 )
1518where
1619
20+import Control.Monad
1721import Data.Aeson
1822import Data.Foldable hiding (null, toList)
1923import qualified Data.HashMap.Strict as HM
@@ -26,7 +30,6 @@ import Data.Type.Equality
2630import qualified Data.TypeRepMap as TRM
2731import qualified Data.Vector as V
2832import qualified GHC.Exts as Exts
29−import qualified GHC.Exts as TRM
3033import OpenAPI.Checker.Paths
3134import Type.Reflection
3235import Prelude hiding (filter, null)
@@ -36,13 +39,33 @@ data PathsPrefixTree (q :: k -> k -> Type) (f :: k -> Type) (r :: k) = PathsPref
3639 { rootItems :: !(ASet (f r))
3740 , snocItems :: !(TRM.TypeRepMap (AStep q f r))
3841 }
42+ deriving stock (Show)
43+
44+-- TODO: optimize
45+partition :: (forall a. f a -> Bool) -> PathsPrefixTree q f r -> (PathsPrefixTree q f r, PathsPrefixTree q f r)
46+partition f x = (filter f x, filter (not . f) x)
47+
48+filter :: (forall a. f a -> Bool) -> PathsPrefixTree q f r -> PathsPrefixTree q f r
49+filter f (PathsPrefixTree roots branches) = PathsPrefixTree roots' branches'
50+ where
51+ roots' = filterASet f roots
52+ branches' =
53+ Exts.fromList
54+ . fmap (\(TRM.WrapTypeable (AStep x)) -> TRM.WrapTypeable . AStep . M.filter (not . null) . fmap (filter f) $ x)
55+ . Exts.toList
56+ $ branches
57+
58+-- | The number of leaves.
59+size :: PathsPrefixTree q f r -> Int
60+size (PathsPrefixTree root branches) =
61+ (S.size . toSet $ root)
62+ + (sum . fmap (\(TRM.WrapTypeable (AStep x)) -> sum . fmap size . M.elems $ x) . Exts.toList $ branches)
3963
4064pattern PathsPrefixNode :: Ord (f r) => S.Set (f r) -> [TRM.WrapTypeable (AStep q f r)] -> PathsPrefixTree q f r
4165pattern PathsPrefixNode s steps <-
4266 (\(PathsPrefixTree aset m) -> (toSet aset, Exts.toList m) -> (s, steps))
4367 where
44− PathsPrefixNode s steps | S.null s = PathsPrefixTree AnEmptySet (Exts.fromList steps)
45− PathsPrefixNode s steps = PathsPrefixTree (ASet s) (Exts.fromList steps)
68+ PathsPrefixNode s steps = PathsPrefixTree (fromSet s) (Exts.fromList steps)
4669
4770{-# COMPLETE PathsPrefixNode #-}
4871
@@ -79,25 +102,32 @@ compareTRM s1 s2 =
79102 | otherwise = EQ -- unreachable
80103 toMap s =
81104 M.fromList
82− [(someTypeRep x, w) | w@(TRM.WrapTypeable x) <- TRM.toList s]
105+ [(someTypeRep x, w) | w@(TRM.WrapTypeable x) <- Exts.toList s]
83106
84107instance Ord (PathsPrefixTree q f a) where
85108 compare (PathsPrefixTree r1 s1) (PathsPrefixTree r2 s2) =
86109 compare r1 r2 <> compareTRM s1 s2
87110
111+filterASet :: (a -> Bool) -> ASet a -> ASet a
112+filterASet _ AnEmptySet = AnEmptySet
113+filterASet f (ASet s) = fromSet $ S.filter f s
114+
88115data ASet (a :: Type) where
89116 AnEmptySet :: ASet a
90117 ASet :: Ord a => S.Set a -> ASet a
91118
119+deriving stock instance Show a => Show (ASet a)
120+
92121toSet :: ASet a -> S.Set a
93122toSet AnEmptySet = S.empty
94123toSet (ASet s) = s
95124
125+fromSet :: Ord a => S.Set a -> ASet a
126+fromSet s | S.null s = AnEmptySet
127+fromSet s = ASet s
128+
96129instance ToJSON a => ToJSON (ASet a) where
97− toJSON =
98− toJSON . \case
99− AnEmptySet -> S.empty
100− ASet s -> s
130+ toJSON = toJSON . toSet
101131
102132instance Semigroup (ASet a) where
103133 AnEmptySet <> s = s
@@ -168,7 +198,7 @@ foldWith k = goTPT Root
168198 goASet _ AnEmptySet = mempty
169199 goASet xs (ASet rs) = foldMap (k xs) rs
170200 goTRM :: forall a. Paths q r a -> TRM.TypeRepMap (AStep q f a) -> m
171− goTRM xs s = foldMap (\(TRM.WrapTypeable f) -> goAStep xs f) $ TRM.toList s
201+ goTRM xs s = foldMap (\(TRM.WrapTypeable f) -> goAStep xs f) $ Exts.toList s
172202 goAStep :: forall a b. Paths q r a -> AStep q f a b -> m
173203 goAStep xs (AStep m) =
174204 M.foldrWithKey (\x t -> (goTPT (Snoc xs x) t <>)) mempty m
@@ -177,11 +207,11 @@ toList :: PathsPrefixTree q f r -> [AnItem q f r]
177207toList t = appEndo (foldWith (\xs f -> Endo (AnItem xs f :)) t) []
178208
179209-- | Select a subtree by prefix
180−filter :: forall q f r a. Paths q r a -> PathsPrefixTree q f r -> PathsPrefixTree q f a
181−filter Root t = t
182−filter (Snoc xs x) t =
210+takeSubtree :: forall q f r a. Paths q r a -> PathsPrefixTree q f r -> PathsPrefixTree q f a
211+takeSubtree Root t = t
212+takeSubtree (Snoc xs x) t =
183213 foldMap (\(AStep m) -> fold $ M.lookup x m) $
184− TRM.lookup @a $ snocItems $ filter xs t
214+ TRM.lookup @a $ snocItems $ takeSubtree xs t
185215
186216-- | Embed a subtree in a larger tree with given prefix
187217embed :: Paths q r a -> PathsPrefixTree q f a -> PathsPrefixTree q f r
src/OpenAPI/Checker/Report.hs+100−91
@@ -3,7 +3,6 @@ module OpenAPI.Checker.Report
33 )
44where
55
6−import Control.Applicative
76import Control.Monad.Free hiding (unfoldM)
87import Control.Monad.Reader
98import Control.Monad.Writer
@@ -17,6 +16,8 @@ import qualified Data.Map as M
1716import Data.Maybe
1817import Data.OpenUnion
1918import Data.OpenUnion.Extra
19+import Data.Set
20+import qualified Data.Set as S
2021import Data.Text (Text)
2122import qualified Data.Text as T
2223import Data.TypeRepMap hiding (empty)
@@ -25,13 +26,45 @@ import OpenAPI.Checker.Behavior
2526import OpenAPI.Checker.Paths
2627import OpenAPI.Checker.PathsPrefixTree hiding (empty)
2728import qualified OpenAPI.Checker.PathsPrefixTree as P hiding (empty)
29+import OpenAPI.Checker.Report.Jet
2830import OpenAPI.Checker.Validate.OpenApi
2931import OpenAPI.Checker.Validate.Schema
3032import Text.Pandoc.Builder
3133
3234generateReport :: Either (P.PathsPrefixTree Behave AnIssue 'APILevel) () -> Pandoc
3335generateReport (Right ()) = doc $ header 1 "No breaking changes found ✨"
34−generateReport (Left errs) = doc $ runReportMonad jets $ showErrs errs
36+generateReport (Left errs) = doc $
37+ runReportMonad jets $ do
38+ let (unsupported, breaking) = P.partition (\(AnIssue i) -> issueIsUnsupported i) errs
39+ breakingChangesPresent = not $ P.null breaking
40+ unsupportedChangesPresent = not $ P.null unsupported
41+ smartHeader "Summary"
42+ tell $
43+ simpleTable
44+ (para
45+ <$> [ refOpt breakingChangesPresent breakingChangesId "⚠️ Breaking changes"
46+ , refOpt unsupportedChangesPresent unsupportedChangesId "🤷 Unsupported feature changes"
47+ ])
48+ [para . show' <$> [P.size breaking, P.size unsupported]]
49+ when breakingChangesPresent $ do
50+ smartHeader $ anchor breakingChangesId <> "⚠️ Breaking changes"
51+ incrementHeaders $ showErrs breaking
52+ when unsupportedChangesPresent $ do
53+ smartHeader $ anchor unsupportedChangesId <> "🤷 Unsupported feature changes"
54+ incrementHeaders $ showErrs unsupported
55+ where
56+ anchor :: Text -> Inlines
57+ anchor a = spanWith (a, [], []) mempty
58+
59+ refOpt :: Bool -> Text -> Inlines -> Inlines
60+ refOpt False _ i = i
61+ refOpt True a i = link ("#" <> a) "" i
62+
63+ breakingChangesId :: Text
64+ breakingChangesId = "breaking-changes"
65+
66+ unsupportedChangesId :: Text
67+ unsupportedChangesId = "unsupported-changes"
3568
3669data ReportState = ReportState
3770 { sourceJets :: [ReportJet' Behave Inlines]
@@ -55,10 +88,29 @@ smartHeader i = do
5588 h <- asks headerLevel
5689 tell $ header h i
5790
58−showErrs :: P.PathsPrefixTree Behave AnIssue a -> ReportMonad ()
91+showErrs :: forall a. Typeable a => P.PathsPrefixTree Behave AnIssue a -> ReportMonad ()
5992showErrs x@(P.PathsPrefixNode currentIssues _) = do
93+ let -- Extract this pattern if more cases like this arise
94+ (removedPaths :: [Issue 'APILevel], otherIssues :: Set (AnIssue a)) = case eqT @a @'APILevel of
95+ Just Refl ->
96+ let (p, o) =
97+ S.partition
98+ (\(AnIssue u) -> case u of
99+ NoPathsMatched {} -> True
100+ AllPathsFailed {} -> True)
101+ currentIssues
102+ p' = S.toList p <&> (\(AnIssue i) -> i)
103+ in (p', o)
104+ Nothing -> (mempty, currentIssues)
60105 jts <- asks sourceJets
61− for_ currentIssues $ \(AnIssue i) -> tell . describeIssue $ i
106+ for_ otherIssues $ \(AnIssue i) -> tell . describeIssue $ i
107+ unless ([] == removedPaths) $ do
108+ smartHeader "Removed paths"
109+ tell $
110+ bulletList $
111+ removedPaths <&> \case
112+ (NoPathsMatched p) -> para . code $ T.pack p
113+ (AllPathsFailed p) -> para . code $ T.pack p
62114 unfoldM x (observeJetShowErrs <$> jts) $ \(P.PathsPrefixNode _ subIssues) -> do
63115 for_ subIssues $ \(WrapTypeable (AStep m)) ->
64116 for_ (M.toList m) $ \(bhv, subErrors) -> do
@@ -72,93 +124,6 @@ unfoldM a (f : ff) g = do
72124 a' <- f a
73125 unfoldM a' ff g
74126
75−observeJetShowErrs
76− :: ReportJet' Behave Inlines
77− -> P.PathsPrefixTree Behave AnIssue a
78− -> ReportMonad (P.PathsPrefixTree Behave AnIssue a)
79−observeJetShowErrs jet p = case observeJetShowErrs' jet p of
80− Just m -> m
81− Nothing -> pure p
82−
83−observeJetShowErrs'
84− :: forall a.
85− ReportJet' Behave Inlines
86− -> P.PathsPrefixTree Behave AnIssue a
87− -> Maybe (ReportMonad (P.PathsPrefixTree Behave AnIssue a))
88−observeJetShowErrs' (ReportJet jet) (P.PathsPrefixNode currentIssues subIssues) =
89− let results =
90− subIssues >>= \(WrapTypeable (AStep m)) ->
91− M.toList m <&> \(bhv, subErrs) ->
92− maybe (Left $ embed (step bhv) subErrs) Right . listToMaybe $
93− jet @_ @_ @[] bhv
94− & mapMaybe
95− (\case
96− Free jet' -> fmap (embed $ step bhv) <$> observeJetShowErrs' jet' subErrs
97− Pure h -> Just $ do
98− smartHeader h
99− incrementHeaders $ showErrs subErrs
100− return mempty)
101− in (fmap . fmap) (PathsPrefixNode currentIssues mempty <>) $
102− if any isRight results
103− then
104− Just $
105− catMapM
106− (\case
107− Left e -> pure e
108− Right m -> m)
109− results
110− else Nothing
111−
112−catMapM :: (Monad m, Monoid b) => (a -> m b) -> [a] -> m b
113−catMapM f xs = mconcat <$> mapM f xs
114−
115−-- | A "jet" is a way of simplifying expressions from "outside". The "jetted"
116−-- expressions should still be completely valid and correct without the jets.
117−-- Jets just make the expression more "optimized" by identifying patterns and
118−-- replacing the expressions with "better" ones that have the same sematics.
119−--
120−-- The term "jet" in this context was introduced in the Urbit project:
121−-- https://urbit.org/docs/vere/jetting/
122−--
123−-- The pattern fits well for simplifying 'Behaviour' tree paths.
124−class ConstructReportJet x f where
125− constructReportJet :: x -> ReportJetResult f Inlines
126−
127−instance (ConstructReportJet b f, JetArg a) => ConstructReportJet (a -> b) f where
128− constructReportJet f = Free (fmap f <$> consumeJetArg @a) >>= constructReportJet
129−
130−instance ConstructReportJet Inlines f where
131− constructReportJet x = Pure x
132−
133−class JetArg a where
134− consumeJetArg :: ReportJet' f a
135−
136−instance Typeable (f a b) => JetArg (f a b) where
137− consumeJetArg =
138− ReportJet $ \(x :: x) ->
139− case eqT @(f a b) @x of
140− Nothing -> empty
141− Just Refl -> pure $ Pure x
142−
143−instance TryLiftUnion xs => JetArg (Union xs) where
144− consumeJetArg = ReportJet $ fmap Pure . tryLiftUnion
145−
146−instance JetArg x => JetArg (NonEmpty x) where
147− consumeJetArg =
148− let (ReportJet f) = (consumeJetArg @x)
149− in ReportJet $ \a -> do
150− u <- f a
151− pure (u >>= \y -> Free $ fmap (NE.cons y) <$> consumeJetArg)
152− <|> pure (pure <$> u)
153−
154−type ReportJetResult f = Free (ReportJet f)
155−
156−-- Not a true 'Applicative'
157−newtype ReportJet f x = ReportJet (forall a b m. (Typeable (f a b), Alternative m, Monad m) => f a b -> m x)
158− deriving stock (Functor)
159−
160−type ReportJet' f a = ReportJet f (Free (ReportJet f) a)
161−
162127incrementHeaders :: ReportMonad x -> ReportMonad x
163128incrementHeaders m = do
164129 l <- asks headerLevel
@@ -209,3 +174,47 @@ jets =
209174 @@> typesExhausted)
210175 y
211176 <> showParts ys
177+
178+observeJetShowErrs
179+ :: ReportJet' Behave Inlines
180+ -> P.PathsPrefixTree Behave AnIssue a
181+ -> ReportMonad (P.PathsPrefixTree Behave AnIssue a)
182+observeJetShowErrs jet p = case observeJetShowErrs' jet p of
183+ Just m -> m
184+ Nothing -> pure p
185+
186+observeJetShowErrs'
187+ :: forall a.
188+ ReportJet' Behave Inlines
189+ -> P.PathsPrefixTree Behave AnIssue a
190+ -> Maybe (ReportMonad (P.PathsPrefixTree Behave AnIssue a))
191+observeJetShowErrs' (ReportJet jet) (P.PathsPrefixNode currentIssues subIssues) =
192+ let results =
193+ subIssues >>= \(WrapTypeable (AStep m)) ->
194+ M.toList m <&> \(bhv, subErrs) ->
195+ maybe (Left $ embed (step bhv) subErrs) Right . listToMaybe $
196+ jet @_ @_ @[] bhv
197+ & mapMaybe
198+ (\case
199+ Free jet' -> fmap (embed $ step bhv) <$> observeJetShowErrs' jet' subErrs
200+ Pure h -> Just $ do
201+ unless (P.null subErrs) $ do
202+ smartHeader h
203+ incrementHeaders $ showErrs subErrs
204+ return mempty)
205+ in (fmap . fmap) (PathsPrefixNode currentIssues mempty <>) $
206+ if any isRight results
207+ then
208+ Just $
209+ catMapM
210+ (\case
211+ Left e -> pure e
212+ Right m -> m)
213+ results
214+ else Nothing
215+
216+catMapM :: (Monad m, Monoid b) => (a -> m b) -> [a] -> m b
217+catMapM f xs = mconcat <$> mapM f xs
218+
219+show' :: Show x => x -> Inlines
220+show' = str . T.pack . show
src/OpenAPI/Checker/Report/Jet.hsnew file+64
@@ -0,0 +1,64 @@
1+module OpenAPI.Checker.Report.Jet
2+ ( ReportJet (..)
3+ , ReportJet'
4+ , ConstructReportJet (..)
5+ , ReportJetResult
6+ )
7+where
8+
9+import Control.Applicative
10+import Control.Monad.Free
11+import Data.List.NonEmpty
12+import qualified Data.List.NonEmpty as NE
13+import Data.OpenUnion
14+import Data.OpenUnion.Extra
15+import Data.Typeable
16+import Text.Pandoc.Builder
17+
18+-- | A "jet" is a way of simplifying expressions from "outside". The "jetted"
19+-- expressions should still be completely valid and correct without the jets.
20+-- Jets just make the expression more "optimized" by identifying patterns and
21+-- replacing the expressions with "better" ones that have the same sematics.
22+--
23+-- The term "jet" in this context was introduced in the Urbit project:
24+-- https://urbit.org/docs/vere/jetting/
25+--
26+-- The pattern fits well for simplifying 'Behaviour' tree paths.
27+class ConstructReportJet x f where
28+ constructReportJet :: x -> ReportJetResult f Inlines
29+
30+instance (ConstructReportJet b f, JetArg a) => ConstructReportJet (a -> b) f where
31+ constructReportJet f = Free (fmap f <$> consumeJetArg @a) >>= constructReportJet
32+
33+instance ConstructReportJet Inlines f where
34+ constructReportJet x = Pure x
35+
36+class JetArg a where
37+ consumeJetArg :: ReportJet' f a
38+
39+instance Typeable (f a b) => JetArg (f a b) where
40+ consumeJetArg =
41+ ReportJet $ \(x :: x) ->
42+ case eqT @(f a b) @x of
43+ Nothing -> empty
44+ Just Refl -> pure $ Pure x
45+
46+instance TryLiftUnion xs => JetArg (Union xs) where
47+ consumeJetArg = ReportJet $ fmap Pure . tryLiftUnion
48+
49+instance JetArg x => JetArg (NonEmpty x) where
50+ consumeJetArg =
51+ let (ReportJet f) = (consumeJetArg @x)
52+ in ReportJet $ \a -> do
53+ u <- f a
54+ pure (u >>= \y -> Free $ fmap (NE.cons y) <$> consumeJetArg)
55+ <|> pure (pure <$> u)
56+
57+type ReportJetResult f = Free (ReportJet f)
58+
59+-- Not a true 'Applicative'
60+newtype ReportJet f x
61+ = ReportJet (forall a b m. (Typeable (f a b), Alternative m, Monad m) => f a b -> m x)
62+ deriving stock (Functor)
63+
64+type ReportJet' f a = ReportJet f (Free (ReportJet f) a)
src/OpenAPI/Checker/Subtree.hs+1−1
@@ -306,7 +306,7 @@ memo bhv k f pc = Compose $ do
306306 fixpointKnot
307307 (do
308308 formula <- getCompose $ f pc
309− pure $ mapErrors (P.filter bhv) formula)
309+ pure $ mapErrors (P.takeSubtree bhv) formula)
310310 (k, ask <$> pc)
311311 pure $ mapErrors (P.embed bhv) formula'
312312
src/OpenAPI/Checker/Validate/Header.hs+2−2
@@ -51,8 +51,8 @@ instance Issuable 'HeaderLevel where
5151 | HeaderSchemaRequired
5252 deriving stock (Eq, Ord, Show)
5353 issueIsUnsupported _ = False
54− describeIssue RequiredHeaderMissing = para "Header expected, but missing."
55− describeIssue NonEmptyHeaderRequired = para "Empty header not allowed."
54+ describeIssue RequiredHeaderMissing = para "Header has become required."
55+ describeIssue NonEmptyHeaderRequired = para "The header does not allow empty values anymore."
5656 describeIssue HeaderSchemaRequired = para "Expected header schema, but it is not present."
5757
5858instance Behavable 'HeaderLevel 'SchemaLevel where
src/OpenAPI/Checker/Validate/MediaTypeObject.hs+4−4
@@ -43,7 +43,7 @@ instance Issuable 'PayloadLevel where
4343 _ -> False
4444
4545 describeIssue MediaTypeSchemaRequired = para "Media type expected, but was not specified."
46− describeIssue (MediaEncodingMissing enc) = para $ "Media encoding " <> str enc <> " expected, but was not specified."
46+ describeIssue (MediaEncodingMissing enc) = para $ "Media encoding " <> str enc <> " added."
4747 describeIssue EncodingNotSupported = para "OpenApi Diff does not currently support media encodings other than JSON."
4848
4949instance Behavable 'PayloadLevel 'SchemaLevel where
@@ -154,10 +154,10 @@ instance Issuable 'OperationLevel where
154154 issueIsUnsupported = \case
155155 _ -> False
156156 describeIssue (ResponseCodeNotFound c) =
157− para $ "Reponse code " <> (str . T.pack . show $ c) <> " is not supported."
157+ para $ "Reponse code " <> (str . T.pack . show $ c) <> " has been added."
158158 describeIssue (ParamNotMatched param) =
159− para $ "Parameter " <> str param <> " is not supported."
159+ para $ "Parameter " <> code param <> " has become required."
160160 describeIssue (PathFragmentNotMatched i) =
161161 -- TODO: Indices are meaningless in this context. Replace with a better error.
162162 para $ "Path fragment " <> (str . T.pack . show $ i) <> " not matched."
163− describeIssue NoRequestBody = para "Request body not specified."
163+ describeIssue NoRequestBody = para "Request body has been added."
src/OpenAPI/Checker/Validate/OAuth2Flows.hs+16−16
@@ -104,7 +104,7 @@ instance Issuable 'SecurityRequirementLevel where
104104 | UndefinedSecurityScheme Text
105105 deriving stock (Eq, Ord, Show)
106106 issueIsUnsupported _ = False
107− describeIssue SecurityRequirementNotMet = para "Security scheme was not met."
107+ describeIssue SecurityRequirementNotMet = para "Security scheme has been removed."
108108 describeIssue (UndefinedSecurityScheme k) = para $ "Security scheme " <> code k <> " is not defined."
109109
110110instance Issuable 'SecuritySchemeLevel where
@@ -129,23 +129,23 @@ instance Issuable 'SecuritySchemeLevel where
129129 | ScopeNotDefined Text
130130 deriving stock (Eq, Ord, Show)
131131 issueIsUnsupported _ = False
132− describeIssue RefreshUrlsDontMatch = para "Refresh URLs differ."
133− describeIssue (HttpSchemeTypesDontMatch _ _) = para "HTTP scheme types don't match."
134− describeIssue (ApiKeyParamsDontMatch _ _) = para "API Key parameters don't match."
135− describeIssue (OpenIdConnectUrlsDontMatch _ _) = para "OpenaId Connect URLs don't match."
132+ describeIssue RefreshUrlsDontMatch = para "Refresh URL changed."
133+ describeIssue (HttpSchemeTypesDontMatch _ _) = para "HTTP scheme type changed."
134+ describeIssue (ApiKeyParamsDontMatch _ _) = para "API Key parameters changed."
135+ describeIssue (OpenIdConnectUrlsDontMatch _ _) = para "OpenaId Connect URL changed."
136136 describeIssue (CustomHttpSchemesDontMatch e a) =
137− para $ "Expected HTTP scheme " <> code e <> " but got " <> code a <> "."
138− describeIssue ConsumerDoesNotSupportImplicitFlow = para "Implicit flow not supported."
139− describeIssue ConsumerDoesNotSupportPasswordFlow = para "Password flow not supported."
140− describeIssue ConsumerDoesNotSupportClientCridentialsFlow = para "Client Cridentials flow not supported."
141− describeIssue ConsumerDoesNotSupportAuthorizationCodeFlow = para "Authorization Code flow not supported."
142− describeIssue SecuritySchemeNotMatched = para "Security scheme not met."
143− describeIssue OAuth2ImplicitFlowNotEqual = para "Implicit Flows don't match."
144− describeIssue OAuth2PasswordFlowNotEqual = para "Password Flows don't match."
145− describeIssue OAuth2ClientCredentialsFlowNotEqual = para "Client Cridentials Flows don't match."
146− describeIssue OAuth2AuthorizationCodeFlowNotEqual = para "Authorization Code Flows don't match."
137+ para $ "Changed HTTP scheme from " <> code e <> " to " <> code a <> "."
138+ describeIssue ConsumerDoesNotSupportImplicitFlow = para "Implicit flow support has been removed."
139+ describeIssue ConsumerDoesNotSupportPasswordFlow = para "Password flow support has been removed."
140+ describeIssue ConsumerDoesNotSupportClientCridentialsFlow = para "Client Cridentials flow support has been removed."
141+ describeIssue ConsumerDoesNotSupportAuthorizationCodeFlow = para "Authorization Code flow support has been removed."
142+ describeIssue SecuritySchemeNotMatched = para "Security scheme has been removed."
143+ describeIssue OAuth2ImplicitFlowNotEqual = para "Implicit Flow changed."
144+ describeIssue OAuth2PasswordFlowNotEqual = para "Password Flow changed."
145+ describeIssue OAuth2ClientCredentialsFlowNotEqual = para "Client Cridentials Flow changed."
146+ describeIssue OAuth2AuthorizationCodeFlowNotEqual = para "Authorization Code Flow changed."
147147 describeIssue (ScopesMissing ss) =
148− para "Scopes missing:" <> bulletList (S.toList ss <&> codeBlock)
148+ para "New scopes required:" <> bulletList (S.toList ss <&> codeBlock)
149149 describeIssue DifferentSecuritySchemes = para "Completely different security scheme types."
150150 describeIssue CanNotHaveScopes = para "The specified security scheme can not have scopes."
151151 describeIssue (ScopeNotDefined k) = para $ "Scope with key " <> code k <> " is not defined."
src/OpenAPI/Checker/Validate/OpenApi.hs+1
@@ -4,6 +4,7 @@
44
55module OpenAPI.Checker.Validate.OpenApi
66 ( Behave (..)
7+ , Issue (..)
78 )
89where
910
src/OpenAPI/Checker/Validate/Operation.hs+4−3
@@ -14,6 +14,7 @@ module OpenAPI.Checker.Validate.Operation
1414 , processPathItems
1515 , Step (..)
1616 , Behave (..)
17+ , Issue (..)
1718 )
1819where
1920
@@ -358,8 +359,8 @@ instance Issuable 'APILevel where
358359 -- When several paths match given but all checks failed
359360 deriving stock (Eq, Ord, Show)
360361 issueIsUnsupported _ = False
361− describeIssue (NoPathsMatched p) = para $ "The path " <> (code . T.pack) p <> " did not match anything."
362− describeIssue (AllPathsFailed p) = para $ "The path " <> (code . T.pack) p <> " did not match anything."
362+ describeIssue (NoPathsMatched p) = para $ "The path " <> (code . T.pack) p <> " has been removed."
363+ describeIssue (AllPathsFailed p) = para $ "The path " <> (code . T.pack) p <> " has been removed."
363364
364365instance Behavable 'APILevel 'PathLevel where
365366 data Behave 'APILevel 'PathLevel
@@ -461,7 +462,7 @@ instance Issuable 'PathLevel where
461462 = OperationMissing OperationMethod
462463 deriving stock (Eq, Ord, Show)
463464 issueIsUnsupported _ = False
464− describeIssue (OperationMissing op) = para $ "Method " <> strong (showMethod op) <> " is not defined."
465+ describeIssue (OperationMissing op) = para $ "Method " <> strong (showMethod op) <> " has been removed."
465466
466467instance Behavable 'PathLevel 'OperationLevel where
467468 data Behave 'PathLevel 'OperationLevel
src/OpenAPI/Checker/Validate/Param.hs+2−2
@@ -71,11 +71,11 @@ instance Issuable 'PathFragmentLevel where
7171 issueIsUnsupported _ = False
7272 describeIssue ParamNameMismatch = para "The path fragments don't match."
7373 describeIssue ParamEmptinessIncompatible = para "Expected that an empty parameter is allowed, but it isn't."
74− describeIssue ParamRequired = para "Expected the parameter to be optional, but it is required."
74+ describeIssue ParamRequired = para "Parameter has become required."
7575 describeIssue ParamPlaceIncompatible = para "Parameters in incompatible locations."
7676 describeIssue ParamStyleMismatch = para "Different parameter styles (encodings)."
7777 describeIssue ParamSchemaMismatch = para "Expected a schema, but didn't find one."
78− describeIssue (PathFragmentsDontMatch e a) = para $ "Expected " <> code e <> " but got " <> code a <> "."
78+ describeIssue (PathFragmentsDontMatch e a) = para $ "Parameter changed from " <> code e <> " to " <> code a <> "."
7979
8080instance Behavable 'PathFragmentLevel 'SchemaLevel where
8181 data Behave 'PathFragmentLevel 'SchemaLevel
src/OpenAPI/Checker/Validate/RequestBody.hs+2−2
@@ -32,9 +32,9 @@ instance Issuable 'RequestLevel where
3232 deriving stock (Eq, Ord, Show)
3333 issueIsUnsupported _ = False
3434 describeIssue RequestBodyRequired =
35− para "Expected the request body to be optional, but found it to be required."
35+ para "Request body has become required."
3636 describeIssue (RequestMediaTypeNotFound t) =
37− para $ "Couldn't find a request body for media type " <> (code . T.pack . show $ t) <> "."
37+ para $ "Media type " <> (code . T.pack . show $ t) <> " has been removed."
3838
3939instance Behavable 'RequestLevel 'PayloadLevel where
4040 data Behave 'RequestLevel 'PayloadLevel
src/OpenAPI/Checker/Validate/Responses.hs+2−2
@@ -73,9 +73,9 @@ instance Issuable 'ResponseLevel where
7373 deriving stock (Eq, Ord, Show)
7474 issueIsUnsupported _ = False
7575 describeIssue (ResponseMediaTypeMissing t) =
76− para $ "Couldn't find reponse for media type " <> (code . T.pack . show $ t) <> "."
76+ para $ "New media type was added: " <> (code . T.pack . show $ t) <> "."
7777 describeIssue (ResponseHeaderMissing h) =
78− para $ "Couldn't find header " <> code h <> "."
78+ para $ "New header was added " <> code h <> "."
7979
8080instance Behavable 'ResponseLevel 'PayloadLevel where
8181 data Behave 'ResponseLevel 'PayloadLevel
src/OpenAPI/Checker/Validate/Schema.hs+57−46
@@ -848,8 +848,15 @@ checkFormulas env beh (ProdCons (fp, ep) (fc, ec)) =
848848 (DNF pss, DNF css) -> F.for_ pss $ \(Conjunct ps) -> do
849849 anyOfAt
850850 beh'
851− (NoMatchingCondition $ SomeCondition <$> ps)
851+ (issueFromConjunct ps)
852852 [F.for_ cs $ checkImplication env beh' ps | Conjunct cs <- S.toList css]
853+ where
854+ issueFromConjunct :: Typeable t => [Condition t] -> Issue 'TypedSchemaLevel
855+ issueFromConjunct ps
856+ | Just e <- findExactly ps
857+ , all (satisfiesTyped e) ps =
858+ EnumDoesntSatisfy $ untypeValue e
859+ issueFromConjunct ps = NoMatchingCondition $ SomeCondition <$> ps
853860
854861checkContradiction
855862 :: Behavior 'TypedSchemaLevel
@@ -943,18 +950,20 @@ checkImplication env beh prods cons = case findExactly prods of
943950 anyOfAt beh NoMatchingProperties $
944951 NE.toList pm <&> \(props', madd') -> do
945952 F.for_ (S.fromList $ M.keys props <> M.keys props') $ \k -> do
946− let go sch sch' = checkCompatibility env (beh >>> step (InProperty k)) (ProdCons sch sch')
947− case (M.lookup k props', madd', M.lookup k props, madd) of
948− (Nothing, Nothing, _, _) -> pure () -- vacuously
949− (_, _, Nothing, Nothing) -> issueAt beh (UnexpectedProperty k)
950− (Just p', _, Just p, _) -> go (propRefSchema p') (propRefSchema p)
951− (Nothing, Just add', Just p, _) -> go add' (propRefSchema p)
952− (Just p', _, Nothing, Just add) -> go (propRefSchema p') add
953− (Nothing, Just _, Nothing, Just _) -> pure ()
954953 case (maybe False propRequired $ M.lookup k props', maybe False propRequired $ M.lookup k props) of
954+ -- producer does not require field, but consumer does (can fail)
955955 (False, True) -> issueAt beh (PropertyNowRequired k)
956− _ -> pure ()
957− pure ()
956+ _ -> do
957+ let go sch sch' = checkCompatibility env (beh >>> step (InProperty k)) (ProdCons sch sch')
958+ case (M.lookup k props', madd', M.lookup k props, madd) of
959+ -- (producer, additional producer, consumer, additional consumer)
960+ (Nothing, Nothing, _, _) -> pure () -- vacuously
961+ -- this ^ seems fishy. Producer does not produce anything, but consumer might expect a field.
962+ (_, _, Nothing, Nothing) -> issueAt beh (UnexpectedProperty k)
963+ (Just p', _, Just p, _) -> go (propRefSchema p') (propRefSchema p)
964+ (Nothing, Just add', Just p, _) -> go add' (propRefSchema p)
965+ (Just p', _, Nothing, Just add) -> go (propRefSchema p') add
966+ (Nothing, Just _, Nothing, Just _) -> pure ()
958967 case (madd', madd) of
959968 (Nothing, _) -> pure () -- vacuously
960969 (_, Nothing) -> issueAt beh NoAdditionalProperties
@@ -974,14 +983,16 @@ checkImplication env beh prods cons = case findExactly prods of
974983 else issueAt beh (MatchingMinPropertiesWeak ProdCons {producer = m', consumer = m})
975984 Nothing -> issueAt beh (NoMatchingMinProperties m)
976985 where
977− findExactly (Exactly x : _) = Just x
978− findExactly (_ : xs) = findExactly xs
979− findExactly [] = Nothing
980986 findRelevant combine extr =
981987 fmap (foldr1 combine) . NE.nonEmpty . mapMaybe extr
982988 lcmScientific (toRational -> a) (toRational -> b) =
983989 fromRational $ lcm (numerator a) (numerator b) % gcd (denominator a) (denominator b)
984990
991+findExactly :: [Condition t] -> Maybe (TypedValue t)
992+findExactly (Exactly x : _) = Just x
993+findExactly (_ : xs) = findExactly xs
994+findExactly [] = Nothing
995+
985996instance Issuable 'TypedSchemaLevel where
986997 data Issue 'TypedSchemaLevel
987998 = -- | producer produces a specific value ($1), consumer has a condition that is not satisfied by said value
@@ -1010,7 +1021,7 @@ instance Issuable 'TypedSchemaLevel where
10101021 NoMatchingMinLength Integer
10111022 | -- | consumer declares a minimum length of the string ($1), producer declares a weaker (lower) limit ($2)
10121023 MatchingMinLengthWeak (ProdCons Integer)
1013− | -- | consumer declares the string value must matrix a regex ($1), producer doesn't declare or declares different regex (TODO: #32)
1024+ | -- | consumer declares the string value must match a regex ($1), producer doesn't declare or declares different regex (TODO: #32)
10141025 NoMatchingPattern Pattern
10151026 | -- | consumer declares the items of an array must satisfy some condition, producer doesn't
10161027 NoMatchingItems
@@ -1040,44 +1051,44 @@ instance Issuable 'TypedSchemaLevel where
10401051 NoMatchingMinProperties Integer
10411052 | -- | consumer declares a minimum number of properties in the object ($1), producer declares a weaker (lower) limit ($2)
10421053 MatchingMinPropertiesWeak (ProdCons Integer)
1043− | -- | consumer declares that the value must satisfy a disjunction of some conditions, but producer's requirements couldn't be matched against any single one of them (TODO: split heuristic #71)
1054+ | -- | producer declares that the value must satisfy a disjunction of some conditions, but consumer's requirements couldn't be matched against any single one of them (TODO: split heuristic #71)
10441055 NoMatchingCondition [SomeCondition]
10451056 | -- | consumer indicates that values of this type are now allowed, but the producer does not do so (currently we only check immediate contradictions, c.f. #70)
10461057 NoContradiction
10471058 deriving stock (Eq, Ord, Show)
10481059 issueIsUnsupported _ = False
1049− describeIssue (EnumDoesntSatisfy v) = para "The following enum value will yield an error:" <> showJSONValue v
1050− describeIssue (NoMatchingEnum v) = para "The following enum value is not supported:" <> showJSONValue v
1051− describeIssue (NoMatchingMaximum b) = para $ "Unexpected upper bound " <> showBound b <> "."
1052− describeIssue (MatchingMaximumWeak (ProdCons p c)) = para $ "Expected upper bound " <> showBound p <> " but but found " <> showBound c <> "."
1053− describeIssue (NoMatchingMinimum b) = para $ "Unexpected lower bound " <> showBound b <> "."
1054− describeIssue (MatchingMinimumWeak (ProdCons p c)) = para $ "Expected lower bound " <> showBound p <> " but but found " <> showBound c <> "."
1055− describeIssue (NoMatchingMultipleOf n) = para $ "Didn't expect the value to be a multiple of " <> show' n <> " but it was."
1056− describeIssue (MatchingMultipleOfWeak (ProdCons p c)) = para $ "Expected the value to be a multiple of " <> show' p <> " but found a multiple of " <> show' c <> "."
1057− describeIssue (NoMatchingFormat f) = para $ "Unexpected format: " <> code f <> "."
1058− describeIssue (NoMatchingMaxLength n) = para $ "Unexpected maximum length of the string " <> show' n <> "."
1059− describeIssue (MatchingMaxLengthWeak (ProdCons p c)) = para $ "Expected the maximum length of the string to be " <> show' p <> "but it was " <> show' c <> "."
1060− describeIssue (NoMatchingMinLength n) = para $ "Unexpected minimum length of the string " <> show' n <> "."
1061− describeIssue (MatchingMinLengthWeak (ProdCons p c)) = para $ "Expected the minimum length of the string to be " <> show' p <> "but it was " <> show' c <> "."
1062− describeIssue (NoMatchingPattern p) = para "Unexpected pattern (regular expression): " <> codeBlock p
1063− describeIssue NoMatchingItems = para "Couldn't find any matching items."
1064− describeIssue (NoMatchingMaxItems n) = para $ "Unexpected maximum length of the array " <> show' n <> "."
1065− describeIssue (MatchingMaxItemsWeak (ProdCons p c)) = para $ "Expected the maximum length of the array to be " <> show' p <> "but it was " <> show' c <> "."
1066− describeIssue (NoMatchingMinItems n) = para $ "Unexpected minimum length of the array " <> show' n <> "."
1067− describeIssue (MatchingMinItemsWeak (ProdCons p c)) = para $ "Expected the minimum length of the array to be " <> show' p <> "but it was " <> show' c <> "."
1068− describeIssue NoMatchingUniqueItems = para "Didn't expect the items to be unique, but they were."
1069− describeIssue NoMatchingProperties = para "Couldn't find matching properties."
1070− describeIssue (UnexpectedProperty p) = para $ "Expected the property " <> code p <> " to be allowed, but it wasn't."
1071− describeIssue (PropertyNowRequired p) = para $ "Don't have a required property " <> code p <> "."
1072− describeIssue NoAdditionalProperties = para "Expected additional properties to be allowed, but they weren't."
1073− describeIssue (NoMatchingMaxProperties n) = para $ "Unexpected maximum number of properties " <> show' n <> "."
1074− describeIssue (MatchingMaxPropertiesWeak (ProdCons p c)) = para $ "Expected the maximum number of properties to be " <> show' p <> "but it was " <> show' c <> "."
1075− describeIssue (NoMatchingMinProperties n) = para $ "Unexpected minimum number of properties " <> show' n <> "."
1076− describeIssue (MatchingMinPropertiesWeak (ProdCons p c)) = para $ "Expected the minimum number of properties to be " <> show' p <> "but it was " <> show' c <> "."
1060+ describeIssue (EnumDoesntSatisfy v) = para "The following enum value was added:" <> showJSONValue v
1061+ describeIssue (NoMatchingEnum v) = para "The following enum value has been removed:" <> showJSONValue v
1062+ describeIssue (NoMatchingMaximum b) = para $ "Upper bound has been added:" <> showBound b <> "."
1063+ describeIssue (MatchingMaximumWeak (ProdCons p c)) = para $ "Upper bound changed from " <> showBound p <> " to " <> showBound c <> "."
1064+ describeIssue (NoMatchingMinimum b) = para $ "Lower bound has been added: " <> showBound b <> "."
1065+ describeIssue (MatchingMinimumWeak (ProdCons p c)) = para $ "Lower bound changed from " <> showBound p <> " to " <> showBound c <> "."
1066+ describeIssue (NoMatchingMultipleOf n) = para $ "Value is now a multiple of " <> show' n <> "."
1067+ describeIssue (MatchingMultipleOfWeak (ProdCons p c)) = para $ "Value changed from being a multiple of " <> show' p <> " to being a multiple of " <> show' c <> "."
1068+ describeIssue (NoMatchingFormat f) = para $ "Format added: " <> code f <> "."
1069+ describeIssue (NoMatchingMaxLength n) = para $ "Maximum length added: " <> show' n <> "."
1070+ describeIssue (MatchingMaxLengthWeak (ProdCons p c)) = para $ "Maximum length of the string changed from " <> show' p <> " to " <> show' c <> "."
1071+ describeIssue (NoMatchingMinLength n) = para $ "Minimum length of the string added: " <> show' n <> "."
1072+ describeIssue (MatchingMinLengthWeak (ProdCons p c)) = para $ "Minimum length of the string changed from " <> show' p <> " to " <> show' c <> "."
1073+ describeIssue (NoMatchingPattern p) = para "Pattern (regular expression) added: " <> codeBlock p
1074+ describeIssue NoMatchingItems = para "Array item schema has been added."
1075+ describeIssue (NoMatchingMaxItems n) = para $ "Maximum length of the array has been added " <> show' n <> "."
1076+ describeIssue (MatchingMaxItemsWeak (ProdCons p c)) = para $ "Maximum length of the array changed from " <> show' p <> " to " <> show' c <> "."
1077+ describeIssue (NoMatchingMinItems n) = para $ "Minimum length of the array added: " <> show' n <> "."
1078+ describeIssue (MatchingMinItemsWeak (ProdCons p c)) = para $ "Minimum length of the array changed from " <> show' p <> " to " <> show' c <> "."
1079+ describeIssue NoMatchingUniqueItems = para "Items are now required to be unique."
1080+ describeIssue NoMatchingProperties = para "Property added."
1081+ describeIssue (UnexpectedProperty p) = para $ "Property " <> code p <> " has been removed."
1082+ describeIssue (PropertyNowRequired p) = para $ "Property " <> code p <> " has become required."
1083+ describeIssue NoAdditionalProperties = para "Additional properties have been removed."
1084+ describeIssue (NoMatchingMaxProperties n) = para $ "Maximum number of properties has been added: " <> show' n <> "."
1085+ describeIssue (MatchingMaxPropertiesWeak (ProdCons p c)) = para $ "Maximum number of properties has changed from " <> show' p <> " to " <> show' c <> "."
1086+ describeIssue (NoMatchingMinProperties n) = para $ "Minimum number of properties added: " <> show' n <> "."
1087+ describeIssue (MatchingMinPropertiesWeak (ProdCons p c)) = para $ "Minimum number of properties has changed from " <> show' p <> " to " <> show' c <> "."
10771088 describeIssue (NoMatchingCondition conds) =
1078− para "Expected the following conditions to hold, but they didn't:"
1089+ para "Expected the following conditions to hold, but they didn't (please file a bug if you see this):"
10791090 <> bulletList ((\(SomeCondition c) -> showCondition c) <$> conds)
1080− describeIssue NoContradiction = para "Expected the type to be allowed, but it wasn't."
1091+ describeIssue NoContradiction = para "The type has been removed."
10811092
10821093showJSONValue :: A.Value -> Blocks
10831094showJSONValue v = codeBlockWith ("", ["json"], mempty) (T.decodeUtf8 . BSL.toStrict . A.encode $ v)
src/OpenAPI/Checker/Validate/Server.hs+3−3
@@ -135,12 +135,12 @@ instance Issuable 'ServerLevel where
135135 deriving stock (Eq, Ord, Show)
136136 issueIsUnsupported _ = False
137137 describeIssue (EnumValueNotConsumed _ v) =
138− para $ "Enum value " <> code v <> " is not supported."
138+ para $ "Enum value " <> code v <> " has been removed."
139139 describeIssue (ConsumerNotOpen _) =
140− para $ "Expected a variable to be open (any value), but it wasn't."
140+ para $ "A variable has been changed from being open to being closed."
141141 describeIssue (ServerVariableNotDefined k) =
142142 para $ "Variable " <> code k <> " is not defined."
143− describeIssue ServerNotMatched = para $ "Couldn't find a matching server."
143+ describeIssue ServerNotMatched = para $ "The server was removed."
144144
145145instance Subtree ProcessedServer where
146146 type SubtreeLevel ProcessedServer = 'ServerLevel
stack.yaml+1−1
@@ -1,4 +1,4 @@
1−resolver: nightly-2021-06-01
1+resolver: nightly-2021-06-10
22
33extra-deps:
44 - open-union-0.4.0.0
stack.yaml.lock+4−4
@@ -20,7 +20,7 @@ packages:
2020 hackage: type-fun-0.1.3
2121snapshots:
2222- completed:
23− size: 587963
24− url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/nightly/2021/6/1.yaml
25− sha256: 6f13285c82266d1d06f7f68366a5190dcbc6758ae8806813005cf56daa6bb9be
26− original: nightly-2021-06-01
23+ size: 585361
24+ url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/nightly/2021/6/10.yaml
25+ sha256: ef53458d54ca6084c6d8eb5219d03b38878e999af607cf006d5be86669d9a696
26+ original: nightly-2021-06-10
test/Spec/Golden/TraceTree.hs+2−1
@@ -21,6 +21,7 @@ import OpenAPI.Checker.Validate.OpenApi ()
2121import Spec.Golden.Extra
2222import Test.Tasty (TestTree, testGroup)
2323import Text.Pandoc.Class
24+import Text.Pandoc.Options
2425import Text.Pandoc.Writers
2526import Prelude hiding (id, (.))
2627
@@ -42,7 +43,7 @@ tests = do
4243 "report.md"
4344 ("a.yaml", "b.yaml")
4445 Yaml.decodeFileThrow
45− (runPandoc . writeMarkdown def . generateReport . runChecker)
46+ (runPandoc . writeMarkdown def {writerExtensions = githubMarkdownExtensions} . generateReport . runChecker)
4647
4748 return $ testGroup "Golden tests" [traceTreeTests, reportTests]
4849
test/golden/common/maximum-lowered/report.md+12−4
@@ -1,7 +1,15 @@
1−# **POST** /test
1+# Summary
22
3−## JSON Request
3+| [⚠️ Breaking changes](#breaking-changes) | 🤷 Unsupported feature changes |
4+|------------------------------------------|-------------------------------|
5+| 1 | 0 |
46
5−### `$(Number)`
7+# <span id="breaking-changes"></span>⚠️ Breaking changes
68
7−Expected upper bound 3.0 inclusive but but found 2.0 inclusive.
9+## **POST** /test
10+
11+### JSON Request
12+
13+#### `$(Number)`
14+
15+Upper bound changed from 3.0 inclusive to 2.0 inclusive.
test/golden/common/pathItem/operation/parameters/allowEmptyValue/reset/report.md+10−2
@@ -1,5 +1,13 @@
1−# **POST** /test
1+# Summary
22
3−## Parameter test1
3+| [⚠️ Breaking changes](#breaking-changes) | 🤷 Unsupported feature changes |
4+|------------------------------------------|-------------------------------|
5+| 1 | 0 |
6+
7+# <span id="breaking-changes"></span>⚠️ Breaking changes
8+
9+## **POST** /test
10+
11+### Parameter test1
412
513Expected that an empty parameter is allowed, but it isn't.
test/golden/common/pathItem/operation/parameters/change/report.md+13−5
@@ -1,9 +1,17 @@
1−# **POST** /test
1+# Summary
22
3−## Parameter test
3+| [⚠️ Breaking changes](#breaking-changes) | 🤷 Unsupported feature changes |
4+|------------------------------------------|-------------------------------|
5+| 1 | 0 |
46
5−### JSON Schema
7+# <span id="breaking-changes"></span>⚠️ Breaking changes
68
7−#### `$(String)`
9+## **POST** /test
810
9−Expected the type to be allowed, but it wasn't.
11+### Parameter test
12+
13+#### JSON Schema
14+
15+##### `$(String)`
16+
17+The type has been removed.
test/golden/common/pathItem/operation/parameters/required/set/report.md+11−3
@@ -1,5 +1,13 @@
1−# **POST** /test
1+# Summary
22
3−## Parameter test1
3+| [⚠️ Breaking changes](#breaking-changes) | 🤷 Unsupported feature changes |
4+|------------------------------------------|-------------------------------|
5+| 1 | 0 |
46
5−Expected the parameter to be optional, but it is required.
7+# <span id="breaking-changes"></span>⚠️ Breaking changes
8+
9+## **POST** /test
10+
11+### Parameter test1
12+
13+Parameter has become required.
test/golden/common/pathItem/operation/parameters/required/true/add/report.md+10−2
@@ -1,3 +1,11 @@
1−# **POST** /test
1+# Summary
22
3−Parameter test2 is not supported.
3+| [⚠️ Breaking changes](#breaking-changes) | 🤷 Unsupported feature changes |
4+|------------------------------------------|-------------------------------|
5+| 1 | 0 |
6+
7+# <span id="breaking-changes"></span>⚠️ Breaking changes
8+
9+## **POST** /test
10+
11+Parameter `test2` has become required.
test/golden/common/pathItem/operation/requestBody/mediaTypeObject/change/report.md+12−4
@@ -1,7 +1,15 @@
1−# **POST** /test
1+# Summary
22
3−## JSON Request
3+| [⚠️ Breaking changes](#breaking-changes) | 🤷 Unsupported feature changes |
4+|------------------------------------------|-------------------------------|
5+| 1 | 0 |
46
5−### `$(String)`
7+# <span id="breaking-changes"></span>⚠️ Breaking changes
68
7−Expected the type to be allowed, but it wasn't.
9+## **POST** /test
10+
11+### JSON Request
12+
13+#### `$(String)`
14+
15+The type has been removed.
test/golden/common/pathItem/operation/requestBody/mediaTypeObject/del/report.md+11−4
@@ -1,6 +1,13 @@
1−# **POST** /test
1+# Summary
22
3−## Request
3+| [⚠️ Breaking changes](#breaking-changes) | 🤷 Unsupported feature changes |
4+|------------------------------------------|-------------------------------|
5+| 1 | 0 |
46
5−Couldn't find a request body for media type
6−`application/x-www-form-urlencoded`.
7+# <span id="breaking-changes"></span>⚠️ Breaking changes
8+
9+## **POST** /test
10+
11+### Request
12+
13+Media type `application/x-www-form-urlencoded` has been removed.
test/golden/common/pathItem/operation/requestBody/required/set/report.md+11−3
@@ -1,5 +1,13 @@
1−# **POST** /test
1+# Summary
22
3−## Request
3+| [⚠️ Breaking changes](#breaking-changes) | 🤷 Unsupported feature changes |
4+|------------------------------------------|-------------------------------|
5+| 1 | 0 |
46
5−Expected the request body to be optional, but found it to be required.
7+# <span id="breaking-changes"></span>⚠️ Breaking changes
8+
9+## **POST** /test
10+
11+### Request
12+
13+Request body has become required.
test/golden/common/pathItem/operation/responses/add/report.md+10−2
@@ -1,3 +1,11 @@
1−# **POST** /test
1+# Summary
22
3−Reponse code 500 is not supported.
3+| [⚠️ Breaking changes](#breaking-changes) | 🤷 Unsupported feature changes |
4+|------------------------------------------|-------------------------------|
5+| 1 | 0 |
6+
7+# <span id="breaking-changes"></span>⚠️ Breaking changes
8+
9+## **POST** /test
10+
11+Reponse code 500 has been added.
test/golden/common/pathItem/operation/responses/change/headers/mandatory/del/report.md+11−3
@@ -1,5 +1,13 @@
1−# **POST** /test
1+# Summary
22
3−## Response code 200
3+| [⚠️ Breaking changes](#breaking-changes) | 🤷 Unsupported feature changes |
4+|------------------------------------------|-------------------------------|
5+| 1 | 0 |
46
5−Couldn't find header `Test2`.
7+# <span id="breaking-changes"></span>⚠️ Breaking changes
8+
9+## **POST** /test
10+
11+### Response code 200
12+
13+New header was added `Test2`.
test/golden/common/pathItem/operation/responses/change/mediaTypeObject/add/report.md+11−4
@@ -1,6 +1,13 @@
1−# **POST** /test
1+# Summary
22
3−## Response code 200
3+| [⚠️ Breaking changes](#breaking-changes) | 🤷 Unsupported feature changes |
4+|------------------------------------------|-------------------------------|
5+| 1 | 0 |
46
5−Couldn't find reponse for media type
6−`application/x-www-form-urlencoded`.
7+# <span id="breaking-changes"></span>⚠️ Breaking changes
8+
9+## **POST** /test
10+
11+### Response code 200
12+
13+New media type was added: `application/x-www-form-urlencoded`.
test/golden/common/pathItem/operation/responses/change/mediaTypeObject/change/report.md+12−4
@@ -1,7 +1,15 @@
1−# **POST** /test
1+# Summary
22
3−## JSON Response – 200
3+| [⚠️ Breaking changes](#breaking-changes) | 🤷 Unsupported feature changes |
4+|------------------------------------------|-------------------------------|
5+| 1 | 0 |
46
5−### `$(Number)`
7+# <span id="breaking-changes"></span>⚠️ Breaking changes
68
7−Expected the type to be allowed, but it wasn't.
9+## **POST** /test
10+
11+### JSON Response – 200
12+
13+#### `$(Number)`
14+
15+The type has been removed.
test/golden/common/property-removed/report.md+15−7
@@ -1,13 +1,21 @@
1−# **POST** /test
1+# Summary
22
3−## JSON Request
3+| [⚠️ Breaking changes](#breaking-changes) | 🤷 Unsupported feature changes |
4+|------------------------------------------|-------------------------------|
5+| 2 | 0 |
46
5−### `$(Object)`
7+# <span id="breaking-changes"></span>⚠️ Breaking changes
68
7−Expected the property `property2` to be allowed, but it wasn't.
9+## **POST** /test
810
9−## JSON Response – 200
11+### JSON Request
1012
11−### `$(Object)`
13+#### `$(Object)`
1214
13−Don't have a required property `property2`.
15+Property `property2` has been removed.
16+
17+### JSON Response – 200
18+
19+#### `$(Object)`
20+
21+Property `property2` has become required.
test/golden/common/property-required/report.md+12−4
@@ -1,7 +1,15 @@
1−# **POST** /test
1+# Summary
22
3−## JSON Request
3+| [⚠️ Breaking changes](#breaking-changes) | 🤷 Unsupported feature changes |
4+|------------------------------------------|-------------------------------|
5+| 1 | 0 |
46
5−### `$(Object)`
7+# <span id="breaking-changes"></span>⚠️ Breaking changes
68
7−Don't have a required property `property2`.
9+## **POST** /test
10+
11+### JSON Request
12+
13+#### `$(Object)`
14+
15+Property `property2` has become required.
test/golden/common/security-scheme/report.md+16−8
@@ -1,15 +1,23 @@
1−# **POST** /oauth/check
1+# Summary
22
3−## Security requirement 0
3+| [⚠️ Breaking changes](#breaking-changes) | 🤷 Unsupported feature changes |
4+|------------------------------------------|-------------------------------|
5+| 2 | 0 |
46
5−### oauth
7+# <span id="breaking-changes"></span>⚠️ Breaking changes
68
7−Security scheme not met.
9+## **POST** /oauth/check
810
9−# **GET** /oauth/sign\_out
11+### Security requirement 0
1012
11−## Security requirement 1
13+#### oauth
1214
13−### oauth
15+Security scheme has been removed.
1416
15−Security scheme not met.
17+## **GET** /oauth/sign\_out
18+
19+### Security requirement 1
20+
21+#### oauth
22+
23+Security scheme has been removed.
test/golden/common/servers/report.md+14−6
@@ -1,11 +1,19 @@
1−# **GET** /pets
1+# Summary
22
3−## Server `http://missing.url`
3+| [⚠️ Breaking changes](#breaking-changes) | 🤷 Unsupported feature changes |
4+|------------------------------------------|-------------------------------|
5+| 3 | 0 |
46
5−Couldn't find a matching server.
7+# <span id="breaking-changes"></span>⚠️ Breaking changes
68
7−## Server `http://{x}variable.path/{y}/{openVariable1}/{openVariable2}`
9+## **GET** /pets
810
9−Enum value `a` is not supported.
11+### Server `http://missing.url`
1012
11−Expected a variable to be open (any value), but it wasn't.
13+The server was removed.
14+
15+### Server `http://{x}variable.path/{y}/{openVariable1}/{openVariable2}`
16+
17+Enum value `a` has been removed.
18+
19+A variable has been changed from being open to being closed.
test/golden/common/unguarded-recursive/report.md+10−2
@@ -1,5 +1,13 @@
1−# **GET** /api/foo
1+# Summary
22
3−## JSON Response – 200
3+| ⚠️ Breaking changes | [🤷 Unsupported feature changes](#unsupported-changes) |
4+|---------------------|-------------------------------------------------------|
5+| 0 | 1 |
6+
7+# <span id="unsupported-changes"></span>🤷 Unsupported feature changes
8+
9+## **GET** /api/foo
10+
11+### JSON Response – 200
412
513Encountered recursion that is too complex for OpenApi Diff to untangle.