Added non-breaking changes to reports (#82)

* bumped resolver

* Added non-breaking changes to report

* Removed dead file

* Added backward issue descriptions

* Issue description reversing

* Changed wording slightly
This commit is contained in:
iko 2021-06-21 20:52:48 +03:00 committed by GitHub
parent 695c8fb31d
commit 2440f23829
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
90 changed files with 872 additions and 287 deletions

View File

@ -5,19 +5,14 @@ import Control.Monad.Except
import Data.Aeson
import qualified Data.ByteString.Lazy as BSL
import Data.Default
import Data.HList
import qualified Data.Text.IO as T
import qualified Data.Yaml as Yaml
import FormatHeuristic
import OpenAPI.Checker.Behavior
import OpenAPI.Checker.Options
import OpenAPI.Checker.Paths
import OpenAPI.Checker.PathsPrefixTree
import OpenAPI.Checker.Report
import OpenAPI.Checker.Subtree
import OpenAPI.Checker.Run
import System.Exit
import System.IO
import Text.Pandoc
import Text.Pandoc hiding (report)
main :: IO ()
main = do
@ -33,23 +28,27 @@ main = do
fail "Exiting"
Right s -> pure s
Right s -> pure s
a <- traced (step ClientSchema) <$> parseSchema (clientFile opts)
b <- traced (step ServerSchema) <$> parseSchema (serverFile opts)
let result = runCompatFormula $ checkCompatibility HNil Root (ProdCons a b)
runPandocIO :: PandocIO a -> ExceptT Errors IO a
a <- parseSchema (clientFile opts)
b <- parseSchema (serverFile opts)
let runPandocIO :: PandocIO a -> ExceptT Errors IO a
runPandocIO x = lift (runIO x) >>= either (throwError . DocumentError) pure
options = def {writerExtensions = githubMarkdownExtensions}
output :: Either (PathsPrefixTree Behave AnIssue 'APILevel) () -> ExceptT Errors IO ()
output = case outputMode opts of
StdoutMode -> lift . T.putStrLn <=< runPandocIO . writeMarkdown options . generateReport
write :: Pandoc -> ExceptT Errors IO ()
write = case outputMode opts of
StdoutMode -> lift . T.putStrLn <=< runPandocIO . writeMarkdown options
FileMode f -> case formatFromFilePath f of
Nothing -> \_ -> throwError UnknownOutputFormat
Just (TextWriter writer) -> lift . T.writeFile f <=< runPandocIO . writer options . generateReport
Just (ByteStringWriter writer) -> lift . BSL.writeFile f <=< runPandocIO . writer options . generateReport
either handler pure <=< runExceptT $ output result
case result of
Right () -> exitSuccess
Left _ -> exitWith $ ExitFailure 1
Just (TextWriter writer) -> lift . T.writeFile f <=< runPandocIO . writer options
Just (ByteStringWriter writer) -> lift . BSL.writeFile f <=< runPandocIO . writer options
-- output :: Either (PathsPrefixTree Behave AnIssue 'APILevel) () -> ExceptT Errors IO ()
-- output inp = do
-- undefined
(report, status) = runReport (a, b)
either handler pure <=< runExceptT $ write report
case status of
NoBreakingChanges -> exitSuccess
BreakingChanges -> exitWith $ ExitFailure 1
OnlyUnsupportedChanges -> exitWith $ ExitFailure 2
data Errors
= DocumentError PandocError

View File

@ -35,7 +35,7 @@ common common-options
-Wno-missing-local-signatures
-Wno-unsafe
default-language: Haskell2010
build-depends: base >= 4.12.0.0 && < 4.15
build-depends: base >= 4.12.0.0 && < 4.16
, bytestring
, text
@ -104,6 +104,7 @@ library
, transformers
, mtl
, aeson
, generic-data
hs-source-dirs: src
exposed-modules: Data.HList
, OpenAPI.Checker.Behavior
@ -134,6 +135,7 @@ library
, OpenAPI.Checker.Report
, Data.OpenUnion.Extra
, OpenAPI.Checker.Report.Jet
, OpenAPI.Checker.Run
executable openapi-diff
import: common-options

View File

@ -2,6 +2,8 @@ module OpenAPI.Checker.Behavior
( BehaviorLevel (..)
, Behavable (..)
, Issuable (..)
, Orientation (..)
, toggleOrientation
, Behavior
, AnIssue (..)
)
@ -43,9 +45,25 @@ type instance AdditionalQuiverConstraints Behave a b = Behavable a b
class (Typeable l, Ord (Issue l), Show (Issue l)) => Issuable (l :: BehaviorLevel) where
data Issue l :: Type
describeIssue :: Issue l -> Blocks
-- | The same issues can be rendered in multiple places and might
-- require different ways of represnting them to the user.
--
-- In practice each issue requires a maximum of two different representations:
-- based on the context the issue might need to be rendered as "opposite" ('Backward')
-- for example when rendering non-breaking changes everything should be
-- reversed (a consequence of the way we generate non-breaking changes).
describeIssue :: Orientation -> Issue l -> Blocks
issueIsUnsupported :: Issue l -> Bool
data Orientation = Forward | Backward
deriving stock (Eq, Ord)
toggleOrientation :: Orientation -> Orientation
toggleOrientation Forward = Backward
toggleOrientation Backward = Forward
-- | A set of interactions having common unifying features
type Behavior = Paths Behave 'APILevel

View File

@ -1,15 +1,20 @@
module OpenAPI.Checker.Report
( generateReport
, ReportInput (..)
, ReportStatus (..)
, Pandoc
)
where
import Control.Monad.Free hiding (unfoldM)
import Control.Monad.Reader
import Control.Monad.Writer
import Data.Aeson (ToJSON)
import Data.Either
import Data.Foldable
import Data.Function
import Data.Functor
import Data.Functor.Const
import Data.List.NonEmpty
import qualified Data.List.NonEmpty as NE
import qualified Data.Map as M
@ -22,6 +27,7 @@ import Data.Text (Text)
import qualified Data.Text as T
import Data.TypeRepMap hiding (empty)
import Data.Typeable
import Generic.Data
import OpenAPI.Checker.Behavior
import OpenAPI.Checker.Paths
import OpenAPI.Checker.PathsPrefixTree hiding (empty)
@ -31,27 +37,79 @@ import OpenAPI.Checker.Validate.OpenApi
import OpenAPI.Checker.Validate.Schema
import Text.Pandoc.Builder
generateReport :: Either (P.PathsPrefixTree Behave AnIssue 'APILevel) () -> Pandoc
generateReport (Right ()) = doc $ header 1 "No breaking changes found ✨"
generateReport (Left errs) = doc $
runReportMonad jets $ do
let (unsupported, breaking) = P.partition (\(AnIssue i) -> issueIsUnsupported i) errs
breakingChangesPresent = not $ P.null breaking
unsupportedChangesPresent = not $ P.null unsupported
smartHeader "Summary"
tell $
simpleTable
(para
<$> [ refOpt breakingChangesPresent breakingChangesId "⚠️ Breaking changes"
, refOpt unsupportedChangesPresent unsupportedChangesId "🤷 Unsupported feature changes"
])
[para . show' <$> [P.size breaking, P.size unsupported]]
when breakingChangesPresent $ do
smartHeader $ anchor breakingChangesId <> "⚠️ Breaking changes"
incrementHeaders $ showErrs breaking
when unsupportedChangesPresent $ do
smartHeader $ anchor unsupportedChangesId <> "🤷 Unsupported feature changes"
incrementHeaders $ showErrs unsupported
type Changes = P.PathsPrefixTree Behave AnIssue 'APILevel
type ProcessedChanges a = P.PathsPrefixTree Behave (FunctorTuple (Const Orientation) AnIssue) a
data FunctorTuple f g a = FunctorTuple (f a) (g a)
deriving stock (Eq, Ord)
data ReportInput = ReportInput
{ breakingChanges :: Changes
, nonBreakingChanges :: Changes
}
deriving stock (Generic)
deriving (Semigroup, Monoid) via (Generically ReportInput)
deriving anyclass (ToJSON)
data ReportStatus
= BreakingChanges
| NoBreakingChanges
| -- | All changes that could be breaking are unsupported we don't know if
-- there actually are any breaking changes.
OnlyUnsupportedChanges
preprocessChanges :: Orientation -> Changes -> ProcessedChanges 'APILevel
preprocessChanges initialO = P.fromList . fmap process . P.toList
where
process :: AnItem Behave AnIssue 'APILevel -> AnItem Behave (FunctorTuple (Const Orientation) AnIssue) 'APILevel
process (AnItem paths issue) = AnItem paths $ FunctorTuple (Const $ toggle initialO) issue
where
(Endo toggle) = togglePaths paths
togglePaths :: Paths Behave a c -> Endo Orientation
togglePaths Root = mempty
togglePaths (rest `Snoc` (_ :: Behave b c)) = case eqT @c @'ResponseLevel of
Just Refl -> Endo toggleOrientation <> togglePaths rest
Nothing -> togglePaths rest
generateReport :: ReportInput -> (Pandoc, ReportStatus)
generateReport inp =
let partitionUnsupported = P.partition (\(AnIssue i) -> issueIsUnsupported i)
(bUnsupported, preprocessChanges Forward -> breaking) =
partitionUnsupported $ breakingChanges inp
(nbUnsupported, preprocessChanges Backward -> nonBreaking) =
partitionUnsupported $ nonBreakingChanges inp
unsupported = preprocessChanges Forward $ bUnsupported <> nbUnsupported
breakingChangesPresent = not $ P.null breaking
nonBreakingChangesPresent = not $ P.null nonBreaking
unsupportedChangesPresent = not $ P.null unsupported
report = doc $
runReportMonad jets $ do
smartHeader "Summary"
tell $
simpleTable
(para
<$> [ refOpt breakingChangesPresent breakingChangesId "⚠️ Breaking changes"
, refOpt nonBreakingChangesPresent nonBreakingChangesId "🙆 Non-breaking changes"
, refOpt unsupportedChangesPresent unsupportedChangesId "🤷 Unsupported feature changes"
])
[para . show' <$> [P.size breaking, P.size nonBreaking, P.size unsupported]]
when breakingChangesPresent $ do
smartHeader $ anchor breakingChangesId <> "⚠️ Breaking changes"
incrementHeaders $ showErrs breaking
when nonBreakingChangesPresent $ do
smartHeader $ anchor nonBreakingChangesId <> "🙆 Non-breaking changes"
incrementHeaders $ showErrs nonBreaking
when unsupportedChangesPresent $ do
smartHeader $ anchor unsupportedChangesId <> "🤷 Unsupported feature changes"
incrementHeaders $ showErrs unsupported
status =
if
| breakingChangesPresent -> BreakingChanges
| unsupportedChangesPresent -> OnlyUnsupportedChanges
| otherwise -> NoBreakingChanges
in (report, status)
where
anchor :: Text -> Inlines
anchor a = spanWith (a, [], []) mempty
@ -60,11 +118,10 @@ generateReport (Left errs) = doc $
refOpt False _ i = i
refOpt True a i = link ("#" <> a) "" i
breakingChangesId :: Text
breakingChangesId, nonBreakingChangesId, unsupportedChangesId :: Text
breakingChangesId = "breaking-changes"
unsupportedChangesId :: Text
unsupportedChangesId = "unsupported-changes"
nonBreakingChangesId = "non-breaking-changes"
data ReportState = ReportState
{ sourceJets :: [ReportJet' Behave Inlines]
@ -88,22 +145,24 @@ smartHeader i = do
h <- asks headerLevel
tell $ header h i
showErrs :: forall a. Typeable a => P.PathsPrefixTree Behave AnIssue a -> ReportMonad ()
showErrs :: forall a. Typeable a => ProcessedChanges a -> ReportMonad ()
showErrs x@(P.PathsPrefixNode currentIssues _) = do
let -- Extract this pattern if more cases like this arise
(removedPaths :: [Issue 'APILevel], otherIssues :: Set (AnIssue a)) = case eqT @a @'APILevel of
Just Refl ->
let (p, o) =
S.partition
(\(AnIssue u) -> case u of
NoPathsMatched {} -> True
AllPathsFailed {} -> True)
currentIssues
p' = S.toList p <&> (\(AnIssue i) -> i)
in (p', o)
Nothing -> (mempty, currentIssues)
( removedPaths :: [Issue 'APILevel]
, otherIssues :: Set (FunctorTuple (Const Orientation) AnIssue a)
) = case eqT @a @'APILevel of
Just Refl ->
let (p, o) =
S.partition
(\(FunctorTuple _ (AnIssue u)) -> case u of
NoPathsMatched {} -> True
AllPathsFailed {} -> True)
currentIssues
p' = S.toList p <&> (\(FunctorTuple _ (AnIssue i)) -> i)
in (p', o)
Nothing -> (mempty, currentIssues)
jts <- asks sourceJets
for_ otherIssues $ \(AnIssue i) -> tell . describeIssue $ i
for_ otherIssues $ \(FunctorTuple (Const ori) (AnIssue i)) -> tell . describeIssue ori $ i
unless ([] == removedPaths) $ do
smartHeader "Removed paths"
tell $
@ -135,9 +194,9 @@ jets =
<$> [ constructReportJet jsonPathJet
, constructReportJet $ \p@(AtPath _) op@(InOperation _) ->
strong (describeBehaviour op) <> " " <> describeBehaviour p :: Inlines
, constructReportJet $ \InRequest InPayload PayloadSchema -> "JSON Request" :: Inlines
, constructReportJet $ \InRequest InPayload PayloadSchema -> "📱➡️ JSON Request" :: Inlines
, constructReportJet $ \(WithStatusCode c) ResponsePayload PayloadSchema ->
"JSON Response " <> str (T.pack . show $ c) :: Inlines
"📱⬅️ JSON Response " <> str (T.pack . show $ c) :: Inlines
]
where
unwrapReportJetResult :: ReportJetResult Behave x -> ReportJet' Behave x
@ -177,8 +236,8 @@ jets =
observeJetShowErrs
:: ReportJet' Behave Inlines
-> P.PathsPrefixTree Behave AnIssue a
-> ReportMonad (P.PathsPrefixTree Behave AnIssue a)
-> ProcessedChanges a
-> ReportMonad (ProcessedChanges a)
observeJetShowErrs jet p = case observeJetShowErrs' jet p of
Just m -> m
Nothing -> pure p
@ -186,8 +245,8 @@ observeJetShowErrs jet p = case observeJetShowErrs' jet p of
observeJetShowErrs'
:: forall a.
ReportJet' Behave Inlines
-> P.PathsPrefixTree Behave AnIssue a
-> Maybe (ReportMonad (P.PathsPrefixTree Behave AnIssue a))
-> ProcessedChanges a
-> Maybe (ReportMonad (ProcessedChanges a))
observeJetShowErrs' (ReportJet jet) (P.PathsPrefixNode currentIssues subIssues) =
let results =
subIssues >>= \(WrapTypeable (AStep m)) ->

View File

@ -0,0 +1,30 @@
module OpenAPI.Checker.Run
( runChecker
, runReport
, module OpenAPI.Checker.Report
)
where
import Data.HList
import Data.OpenApi (OpenApi)
import OpenAPI.Checker.Paths
import OpenAPI.Checker.Report
import OpenAPI.Checker.Subtree
import OpenAPI.Checker.Validate.OpenApi ()
runChecker :: (OpenApi, OpenApi) -> ReportInput
runChecker (client, server) =
ReportInput
{ breakingChanges = run client server
, nonBreakingChanges = run server client
}
where
toPC p c =
ProdCons
{ producer = traced (step ClientSchema) p
, consumer = traced (step ServerSchema) c
}
run p c = either id mempty . runCompatFormula . checkCompatibility HNil Root $ toPC p c
runReport :: (OpenApi, OpenApi) -> (Pandoc, ReportStatus)
runReport = generateReport . runChecker

View File

@ -1,6 +0,0 @@
module OpenAPI.Checker.Subtree.Deriving (EqSubtree (..)) where
import Control.Monad
import OpenAPI.Checker.Subtree
newtype EqSubtree t = EqSubtree t

View File

@ -51,9 +51,11 @@ instance Issuable 'HeaderLevel where
| HeaderSchemaRequired
deriving stock (Eq, Ord, Show)
issueIsUnsupported _ = False
describeIssue RequiredHeaderMissing = para "Header has become required."
describeIssue NonEmptyHeaderRequired = para "The header does not allow empty values anymore."
describeIssue HeaderSchemaRequired = para "Expected header schema, but it is not present."
describeIssue Forward RequiredHeaderMissing = para "Header has become required."
describeIssue Backward RequiredHeaderMissing = para "Header is no longer required."
describeIssue Forward NonEmptyHeaderRequired = para "The header does not allow empty values anymore."
describeIssue Backward NonEmptyHeaderRequired = para "The header now allows empty values."
describeIssue _ HeaderSchemaRequired = para "Expected header schema, but it is not present."
instance Behavable 'HeaderLevel 'SchemaLevel where
data Behave 'HeaderLevel 'SchemaLevel

View File

@ -19,4 +19,4 @@ instance Issuable 'LinkLevel where
deriving stock (Eq, Ord, Show)
issueIsUnsupported = \case
LinksUnsupported -> True
describeIssue LinksUnsupported = para "OpenApi Diff does not currently support Link Objects."
describeIssue _ LinksUnsupported = para "OpenApi Diff does not currently support Link Objects."

View File

@ -42,9 +42,10 @@ instance Issuable 'PayloadLevel where
EncodingNotSupported -> True
_ -> False
describeIssue MediaTypeSchemaRequired = para "Media type expected, but was not specified."
describeIssue (MediaEncodingMissing enc) = para $ "Media encoding " <> str enc <> " added."
describeIssue EncodingNotSupported = para "OpenApi Diff does not currently support media encodings other than JSON."
describeIssue _ MediaTypeSchemaRequired = para "Media type expected, but was not specified."
describeIssue Forward (MediaEncodingMissing enc) = para $ "Media encoding " <> str enc <> " has been removed."
describeIssue Backward (MediaEncodingMissing enc) = para $ "Media encoding " <> str enc <> " added."
describeIssue _ EncodingNotSupported = para "OpenApi Diff does not currently support media encodings other than JSON."
instance Behavable 'PayloadLevel 'SchemaLevel where
data Behave 'PayloadLevel 'SchemaLevel
@ -153,11 +154,16 @@ instance Issuable 'OperationLevel where
deriving stock (Eq, Ord, Show)
issueIsUnsupported = \case
_ -> False
describeIssue (ResponseCodeNotFound c) =
describeIssue Forward (ResponseCodeNotFound c) =
para $ "Reponse code " <> (str . T.pack . show $ c) <> " has been added."
describeIssue (ParamNotMatched param) =
describeIssue Backward (ResponseCodeNotFound c) =
para $ "Reponse code " <> (str . T.pack . show $ c) <> " has been removed."
describeIssue Forward (ParamNotMatched param) =
para $ "Parameter " <> code param <> " has become required."
describeIssue (PathFragmentNotMatched i) =
describeIssue Backward (ParamNotMatched param) =
para $ "Parameter " <> code param <> " is no longer required."
describeIssue _ (PathFragmentNotMatched i) =
-- TODO: Indices are meaningless in this context. Replace with a better error.
para $ "Path fragment " <> (str . T.pack . show $ i) <> " not matched."
describeIssue NoRequestBody = para "Request body has been added."
describeIssue Forward NoRequestBody = para "Request body has been added."
describeIssue Backward NoRequestBody = para "Request body has been removed."

View File

@ -104,8 +104,9 @@ instance Issuable 'SecurityRequirementLevel where
| UndefinedSecurityScheme Text
deriving stock (Eq, Ord, Show)
issueIsUnsupported _ = False
describeIssue SecurityRequirementNotMet = para "Security scheme has been removed."
describeIssue (UndefinedSecurityScheme k) = para $ "Security scheme " <> code k <> " is not defined."
describeIssue Forward SecurityRequirementNotMet = para "Security scheme has been removed."
describeIssue Backward SecurityRequirementNotMet = para "Security scheme was added."
describeIssue _ (UndefinedSecurityScheme k) = para $ "Security scheme " <> code k <> " is not defined."
instance Issuable 'SecuritySchemeLevel where
data Issue 'SecuritySchemeLevel
@ -129,26 +130,33 @@ instance Issuable 'SecuritySchemeLevel where
| ScopeNotDefined Text
deriving stock (Eq, Ord, Show)
issueIsUnsupported _ = False
describeIssue RefreshUrlsDontMatch = para "Refresh URL changed."
describeIssue (HttpSchemeTypesDontMatch _ _) = para "HTTP scheme type changed."
describeIssue (ApiKeyParamsDontMatch _ _) = para "API Key parameters changed."
describeIssue (OpenIdConnectUrlsDontMatch _ _) = para "OpenaId Connect URL changed."
describeIssue (CustomHttpSchemesDontMatch e a) =
describeIssue _ RefreshUrlsDontMatch = para "Refresh URL changed."
describeIssue _ (HttpSchemeTypesDontMatch _ _) = para "HTTP scheme type changed."
describeIssue _ (ApiKeyParamsDontMatch _ _) = para "API Key parameters changed."
describeIssue _ (OpenIdConnectUrlsDontMatch _ _) = para "OpenaId Connect URL changed."
describeIssue _ (CustomHttpSchemesDontMatch e a) =
para $ "Changed HTTP scheme from " <> code e <> " to " <> code a <> "."
describeIssue ConsumerDoesNotSupportImplicitFlow = para "Implicit flow support has been removed."
describeIssue ConsumerDoesNotSupportPasswordFlow = para "Password flow support has been removed."
describeIssue ConsumerDoesNotSupportClientCridentialsFlow = para "Client Cridentials flow support has been removed."
describeIssue ConsumerDoesNotSupportAuthorizationCodeFlow = para "Authorization Code flow support has been removed."
describeIssue SecuritySchemeNotMatched = para "Security scheme has been removed."
describeIssue OAuth2ImplicitFlowNotEqual = para "Implicit Flow changed."
describeIssue OAuth2PasswordFlowNotEqual = para "Password Flow changed."
describeIssue OAuth2ClientCredentialsFlowNotEqual = para "Client Cridentials Flow changed."
describeIssue OAuth2AuthorizationCodeFlowNotEqual = para "Authorization Code Flow changed."
describeIssue (ScopesMissing ss) =
describeIssue Forward ConsumerDoesNotSupportImplicitFlow = para "Implicit flow support has been removed."
describeIssue Backward ConsumerDoesNotSupportImplicitFlow = para "Implicit flow support has been added."
describeIssue Forward ConsumerDoesNotSupportPasswordFlow = para "Password flow support has been removed."
describeIssue Backward ConsumerDoesNotSupportPasswordFlow = para "Password flow support has been added."
describeIssue Forward ConsumerDoesNotSupportClientCridentialsFlow = para "Client Cridentials flow support has been removed."
describeIssue Backward ConsumerDoesNotSupportClientCridentialsFlow = para "Client Cridentials flow support has been added."
describeIssue Forward ConsumerDoesNotSupportAuthorizationCodeFlow = para "Authorization Code flow support has been removed."
describeIssue Backward ConsumerDoesNotSupportAuthorizationCodeFlow = para "Authorization Code flow support has been added."
describeIssue Forward SecuritySchemeNotMatched = para "Security scheme has been removed."
describeIssue Backward SecuritySchemeNotMatched = para "Security scheme has been added."
describeIssue _ OAuth2ImplicitFlowNotEqual = para "Implicit Flow changed."
describeIssue _ OAuth2PasswordFlowNotEqual = para "Password Flow changed."
describeIssue _ OAuth2ClientCredentialsFlowNotEqual = para "Client Cridentials Flow changed."
describeIssue _ OAuth2AuthorizationCodeFlowNotEqual = para "Authorization Code Flow changed."
describeIssue Forward (ScopesMissing ss) =
para "New scopes required:" <> bulletList (S.toList ss <&> codeBlock)
describeIssue DifferentSecuritySchemes = para "Completely different security scheme types."
describeIssue CanNotHaveScopes = para "The specified security scheme can not have scopes."
describeIssue (ScopeNotDefined k) = para $ "Scope with key " <> code k <> " is not defined."
describeIssue Backward (ScopesMissing ss) =
para "Scopes no longer required:" <> bulletList (S.toList ss <&> codeBlock)
describeIssue _ DifferentSecuritySchemes = para "Completely different security scheme types."
describeIssue _ CanNotHaveScopes = para "The specified security scheme can not have scopes."
describeIssue _ (ScopeNotDefined k) = para $ "Scope with key " <> code k <> " is not defined."
instance Behavable 'SecurityRequirementLevel 'SecuritySchemeLevel where
data Behave 'SecurityRequirementLevel 'SecuritySchemeLevel

View File

@ -359,8 +359,10 @@ instance Issuable 'APILevel where
-- When several paths match given but all checks failed
deriving stock (Eq, Ord, Show)
issueIsUnsupported _ = False
describeIssue (NoPathsMatched p) = para $ "The path " <> (code . T.pack) p <> " has been removed."
describeIssue (AllPathsFailed p) = para $ "The path " <> (code . T.pack) p <> " has been removed."
describeIssue Forward (NoPathsMatched p) = para $ "The path " <> (code . T.pack) p <> " has been removed."
describeIssue Backward (NoPathsMatched p) = para $ "The path " <> (code . T.pack) p <> " has been added."
describeIssue Forward (AllPathsFailed p) = para $ "The path " <> (code . T.pack) p <> " has been removed."
describeIssue Backward (AllPathsFailed p) = para $ "The path " <> (code . T.pack) p <> " has been added."
instance Behavable 'APILevel 'PathLevel where
data Behave 'APILevel 'PathLevel
@ -462,7 +464,8 @@ instance Issuable 'PathLevel where
= OperationMissing OperationMethod
deriving stock (Eq, Ord, Show)
issueIsUnsupported _ = False
describeIssue (OperationMissing op) = para $ "Method " <> strong (showMethod op) <> " has been removed."
describeIssue Forward (OperationMissing op) = para $ "Method " <> strong (showMethod op) <> " has been removed."
describeIssue Backward (OperationMissing op) = para $ "Method " <> strong (showMethod op) <> " has been added."
instance Behavable 'PathLevel 'OperationLevel where
data Behave 'PathLevel 'OperationLevel
@ -579,7 +582,7 @@ instance Issuable 'CallbackLevel where
deriving stock (Eq, Ord, Show)
issueIsUnsupported = \case
CallbacksUnsupported -> True
describeIssue CallbacksUnsupported = para "OpenApi Diff does not currently support callbacks."
describeIssue _ CallbacksUnsupported = para "OpenApi Diff does not currently support callbacks."
tracedCallbackPathItems :: Traced Callback -> Traced ProcessedPathItems
tracedCallbackPathItems (Traced t (Callback x)) =

View File

@ -69,13 +69,15 @@ instance Issuable 'PathFragmentLevel where
| PathFragmentsDontMatch Text Text
deriving stock (Eq, Ord, Show)
issueIsUnsupported _ = False
describeIssue ParamNameMismatch = para "The path fragments don't match."
describeIssue ParamEmptinessIncompatible = para "Expected that an empty parameter is allowed, but it isn't."
describeIssue ParamRequired = para "Parameter has become required."
describeIssue ParamPlaceIncompatible = para "Parameters in incompatible locations."
describeIssue ParamStyleMismatch = para "Different parameter styles (encodings)."
describeIssue ParamSchemaMismatch = para "Expected a schema, but didn't find one."
describeIssue (PathFragmentsDontMatch e a) = para $ "Parameter changed from " <> code e <> " to " <> code a <> "."
describeIssue _ ParamNameMismatch = para "The path fragments don't match."
describeIssue Forward ParamEmptinessIncompatible = para "The parameter can no longer be empty."
describeIssue Backward ParamEmptinessIncompatible = para "The parameter can now be empty."
describeIssue Forward ParamRequired = para "Parameter has become required."
describeIssue Backward ParamRequired = para "Parameter is no longer required."
describeIssue _ ParamPlaceIncompatible = para "Parameters in incompatible locations."
describeIssue _ ParamStyleMismatch = para "Different parameter styles (encodings)."
describeIssue _ ParamSchemaMismatch = para "Expected a schema, but didn't find one."
describeIssue _ (PathFragmentsDontMatch e a) = para $ "Parameter changed from " <> code e <> " to " <> code a <> "."
instance Behavable 'PathFragmentLevel 'SchemaLevel where
data Behave 'PathFragmentLevel 'SchemaLevel

View File

@ -31,10 +31,14 @@ instance Issuable 'RequestLevel where
| RequestMediaTypeNotFound MediaType
deriving stock (Eq, Ord, Show)
issueIsUnsupported _ = False
describeIssue RequestBodyRequired =
describeIssue Forward RequestBodyRequired =
para "Request body has become required."
describeIssue (RequestMediaTypeNotFound t) =
describeIssue Backward RequestBodyRequired =
para "Request body is no longer required."
describeIssue Forward (RequestMediaTypeNotFound t) =
para $ "Media type " <> (code . T.pack . show $ t) <> " has been removed."
describeIssue Backward (RequestMediaTypeNotFound t) =
para $ "Media type " <> (code . T.pack . show $ t) <> " has been added."
instance Behavable 'RequestLevel 'PayloadLevel where
data Behave 'RequestLevel 'PayloadLevel

View File

@ -72,10 +72,14 @@ instance Issuable 'ResponseLevel where
| ResponseHeaderMissing HeaderName
deriving stock (Eq, Ord, Show)
issueIsUnsupported _ = False
describeIssue (ResponseMediaTypeMissing t) =
describeIssue Forward (ResponseMediaTypeMissing t) =
para $ "Media type was removed: " <> (code . T.pack . show $ t) <> "."
describeIssue Backward (ResponseMediaTypeMissing t) =
para $ "New media type was added: " <> (code . T.pack . show $ t) <> "."
describeIssue (ResponseHeaderMissing h) =
describeIssue Forward (ResponseHeaderMissing h) =
para $ "New header was added " <> code h <> "."
describeIssue Backward (ResponseHeaderMissing h) =
para $ "Header was removed " <> code h <> "."
instance Behavable 'ResponseLevel 'PayloadLevel where
data Behave 'ResponseLevel 'PayloadLevel

View File

@ -1057,38 +1057,58 @@ instance Issuable 'TypedSchemaLevel where
NoContradiction
deriving stock (Eq, Ord, Show)
issueIsUnsupported _ = False
describeIssue (EnumDoesntSatisfy v) = para "The following enum value was added:" <> showJSONValue v
describeIssue (NoMatchingEnum v) = para "The following enum value has been removed:" <> showJSONValue v
describeIssue (NoMatchingMaximum b) = para $ "Upper bound has been added:" <> showBound b <> "."
describeIssue (MatchingMaximumWeak (ProdCons p c)) = para $ "Upper bound changed from " <> showBound p <> " to " <> showBound c <> "."
describeIssue (NoMatchingMinimum b) = para $ "Lower bound has been added: " <> showBound b <> "."
describeIssue (MatchingMinimumWeak (ProdCons p c)) = para $ "Lower bound changed from " <> showBound p <> " to " <> showBound c <> "."
describeIssue (NoMatchingMultipleOf n) = para $ "Value is now a multiple of " <> show' n <> "."
describeIssue (MatchingMultipleOfWeak (ProdCons p c)) = para $ "Value changed from being a multiple of " <> show' p <> " to being a multiple of " <> show' c <> "."
describeIssue (NoMatchingFormat f) = para $ "Format added: " <> code f <> "."
describeIssue (NoMatchingMaxLength n) = para $ "Maximum length added: " <> show' n <> "."
describeIssue (MatchingMaxLengthWeak (ProdCons p c)) = para $ "Maximum length of the string changed from " <> show' p <> " to " <> show' c <> "."
describeIssue (NoMatchingMinLength n) = para $ "Minimum length of the string added: " <> show' n <> "."
describeIssue (MatchingMinLengthWeak (ProdCons p c)) = para $ "Minimum length of the string changed from " <> show' p <> " to " <> show' c <> "."
describeIssue (NoMatchingPattern p) = para "Pattern (regular expression) added: " <> codeBlock p
describeIssue NoMatchingItems = para "Array item schema has been added."
describeIssue (NoMatchingMaxItems n) = para $ "Maximum length of the array has been added " <> show' n <> "."
describeIssue (MatchingMaxItemsWeak (ProdCons p c)) = para $ "Maximum length of the array changed from " <> show' p <> " to " <> show' c <> "."
describeIssue (NoMatchingMinItems n) = para $ "Minimum length of the array added: " <> show' n <> "."
describeIssue (MatchingMinItemsWeak (ProdCons p c)) = para $ "Minimum length of the array changed from " <> show' p <> " to " <> show' c <> "."
describeIssue NoMatchingUniqueItems = para "Items are now required to be unique."
describeIssue NoMatchingProperties = para "Property added."
describeIssue (UnexpectedProperty p) = para $ "Property " <> code p <> " has been removed."
describeIssue (PropertyNowRequired p) = para $ "Property " <> code p <> " has become required."
describeIssue NoAdditionalProperties = para "Additional properties have been removed."
describeIssue (NoMatchingMaxProperties n) = para $ "Maximum number of properties has been added: " <> show' n <> "."
describeIssue (MatchingMaxPropertiesWeak (ProdCons p c)) = para $ "Maximum number of properties has changed from " <> show' p <> " to " <> show' c <> "."
describeIssue (NoMatchingMinProperties n) = para $ "Minimum number of properties added: " <> show' n <> "."
describeIssue (MatchingMinPropertiesWeak (ProdCons p c)) = para $ "Minimum number of properties has changed from " <> show' p <> " to " <> show' c <> "."
describeIssue (NoMatchingCondition conds) =
describeIssue Forward (EnumDoesntSatisfy v) = para "The following enum value was added:" <> showJSONValue v
describeIssue Backward (EnumDoesntSatisfy v) = para "The following enum value was removed:" <> showJSONValue v
describeIssue Forward (NoMatchingEnum v) = para "The following enum value has been removed:" <> showJSONValue v
describeIssue Backward (NoMatchingEnum v) = para "The following enum value has been added:" <> showJSONValue v
describeIssue Forward (NoMatchingMaximum b) = para $ "Upper bound has been added:" <> showBound b <> "."
describeIssue Backward (NoMatchingMaximum b) = para $ "Upper bound has been removed:" <> showBound b <> "."
describeIssue _ (MatchingMaximumWeak (ProdCons p c)) = para $ "Upper bound changed from " <> showBound p <> " to " <> showBound c <> "."
describeIssue Forward (NoMatchingMinimum b) = para $ "Lower bound has been added: " <> showBound b <> "."
describeIssue Backward (NoMatchingMinimum b) = para $ "Lower bound has been removed: " <> showBound b <> "."
describeIssue _ (MatchingMinimumWeak (ProdCons p c)) = para $ "Lower bound changed from " <> showBound p <> " to " <> showBound c <> "."
describeIssue Forward (NoMatchingMultipleOf n) = para $ "Value is now a multiple of " <> show' n <> "."
describeIssue Backward (NoMatchingMultipleOf n) = para $ "Value is no longer a multiple of " <> show' n <> "."
describeIssue _ (MatchingMultipleOfWeak (ProdCons p c)) = para $ "Value changed from being a multiple of " <> show' p <> " to being a multiple of " <> show' c <> "."
describeIssue Forward (NoMatchingFormat f) = para $ "Format added: " <> code f <> "."
describeIssue Backward (NoMatchingFormat f) = para $ "Format removed: " <> code f <> "."
describeIssue Forward (NoMatchingMaxLength n) = para $ "Maximum length added: " <> show' n <> "."
describeIssue Backward (NoMatchingMaxLength n) = para $ "Maximum length removed: " <> show' n <> "."
describeIssue _ (MatchingMaxLengthWeak (ProdCons p c)) = para $ "Maximum length of the string changed from " <> show' p <> " to " <> show' c <> "."
describeIssue Forward (NoMatchingMinLength n) = para $ "Minimum length of the string added: " <> show' n <> "."
describeIssue Backward (NoMatchingMinLength n) = para $ "Minimum length of the string removed: " <> show' n <> "."
describeIssue _ (MatchingMinLengthWeak (ProdCons p c)) = para $ "Minimum length of the string changed from " <> show' p <> " to " <> show' c <> "."
describeIssue Forward (NoMatchingPattern p) = para "Pattern (regular expression) added: " <> codeBlock p
describeIssue Backward (NoMatchingPattern p) = para "Pattern (regular expression) removed: " <> codeBlock p
describeIssue Forward NoMatchingItems = para "Array item schema has been added."
describeIssue Backward NoMatchingItems = para "Array item schema has been removed."
describeIssue Forward (NoMatchingMaxItems n) = para $ "Maximum length of the array has been added " <> show' n <> "."
describeIssue Backward (NoMatchingMaxItems n) = para $ "Maximum length of the array has been removed " <> show' n <> "."
describeIssue _ (MatchingMaxItemsWeak (ProdCons p c)) = para $ "Maximum length of the array changed from " <> show' p <> " to " <> show' c <> "."
describeIssue Forward (NoMatchingMinItems n) = para $ "Minimum length of the array added: " <> show' n <> "."
describeIssue Backward (NoMatchingMinItems n) = para $ "Minimum length of the array removed: " <> show' n <> "."
describeIssue _ (MatchingMinItemsWeak (ProdCons p c)) = para $ "Minimum length of the array changed from " <> show' p <> " to " <> show' c <> "."
describeIssue Forward NoMatchingUniqueItems = para "Items are now required to be unique."
describeIssue Backward NoMatchingUniqueItems = para "Items are no longer required to be unique."
describeIssue Forward NoMatchingProperties = para "Property added."
describeIssue Backward NoMatchingProperties = para "Property removed."
describeIssue Forward (UnexpectedProperty p) = para $ "Property " <> code p <> " has been removed."
describeIssue Backward (UnexpectedProperty p) = para $ "Property " <> code p <> " has been added."
describeIssue Forward (PropertyNowRequired p) = para $ "Property " <> code p <> " has become required."
describeIssue Backward (PropertyNowRequired p) = para $ "Property " <> code p <> " may not be present."
describeIssue Forward NoAdditionalProperties = para "Additional properties have been removed."
describeIssue Backward NoAdditionalProperties = para "Additional properties have been added."
describeIssue Forward (NoMatchingMaxProperties n) = para $ "Maximum number of properties has been added: " <> show' n <> "."
describeIssue Backward (NoMatchingMaxProperties n) = para $ "Maximum number of properties has been removed: " <> show' n <> "."
describeIssue _ (MatchingMaxPropertiesWeak (ProdCons p c)) = para $ "Maximum number of properties has changed from " <> show' p <> " to " <> show' c <> "."
describeIssue Forward (NoMatchingMinProperties n) = para $ "Minimum number of properties added: " <> show' n <> "."
describeIssue Backward (NoMatchingMinProperties n) = para $ "Minimum number of properties removed: " <> show' n <> "."
describeIssue _ (MatchingMinPropertiesWeak (ProdCons p c)) = para $ "Minimum number of properties has changed from " <> show' p <> " to " <> show' c <> "."
describeIssue _ (NoMatchingCondition conds) =
para "Expected the following conditions to hold, but they didn't (please file a bug if you see this):"
<> bulletList ((\(SomeCondition c) -> showCondition c) <$> conds)
describeIssue NoContradiction = para "The type has been removed."
describeIssue Forward NoContradiction = para "The type has been removed."
describeIssue Backward NoContradiction = para "The type has been added."
showJSONValue :: A.Value -> Blocks
showJSONValue v = codeBlockWith ("", ["json"], mempty) (T.decodeUtf8 . BSL.toStrict . A.encode $ v)
@ -1111,11 +1131,11 @@ instance Issuable 'SchemaLevel where
deriving stock (Eq, Ord, Show)
issueIsUnsupported _ = True
describeIssue (NotSupported i) =
describeIssue _ (NotSupported i) =
para (emph "Encountered a feature that OpenApi Diff does not support: " <> text i <> ".")
describeIssue (InvalidSchema i) =
describeIssue _ (InvalidSchema i) =
para (emph "The schema is invalid: " <> text i <> ".")
describeIssue UnguardedRecursion =
describeIssue _ UnguardedRecursion =
para "Encountered recursion that is too complex for OpenApi Diff to untangle."
instance Behavable 'SchemaLevel 'TypedSchemaLevel where

View File

@ -134,13 +134,18 @@ instance Issuable 'ServerLevel where
| ServerNotMatched
deriving stock (Eq, Ord, Show)
issueIsUnsupported _ = False
describeIssue (EnumValueNotConsumed _ v) =
describeIssue Forward (EnumValueNotConsumed _ v) =
para $ "Enum value " <> code v <> " has been removed."
describeIssue (ConsumerNotOpen _) =
describeIssue Backward (EnumValueNotConsumed _ v) =
para $ "Enum value " <> code v <> " has been added."
describeIssue Forward (ConsumerNotOpen _) =
para $ "A variable has been changed from being open to being closed."
describeIssue (ServerVariableNotDefined k) =
describeIssue Backward (ConsumerNotOpen _) =
para $ "A variable has been changed from being closed to being open."
describeIssue _ (ServerVariableNotDefined k) =
para $ "Variable " <> code k <> " is not defined."
describeIssue ServerNotMatched = para $ "The server was removed."
describeIssue Forward ServerNotMatched = para $ "The server was removed."
describeIssue Backward ServerNotMatched = para $ "The server was added."
instance Subtree ProcessedServer where
type SubtreeLevel ProcessedServer = 'ServerLevel

View File

@ -1,4 +1,4 @@
resolver: nightly-2021-06-10
resolver: lts-18.0
extra-deps:
- open-union-0.4.0.0

View File

@ -20,7 +20,7 @@ packages:
hackage: type-fun-0.1.3
snapshots:
- completed:
size: 585361
url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/nightly/2021/6/10.yaml
sha256: ef53458d54ca6084c6d8eb5219d03b38878e999af607cf006d5be86669d9a696
original: nightly-2021-06-10
size: 585393
url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/18/0.yaml
sha256: c632012da648385b9fa3c29f4e0afd56ead299f1c5528ee789058be410e883c0
original: lts-18.0

View File

@ -9,4 +9,4 @@ main = defaultMain =<< tests
tests :: IO TestTree
tests = do
goldenReportTree <- Spec.Golden.TraceTree.tests
return . localOption (mkTimeout 1000000) $ goldenReportTree
return . localOption (mkTimeout 5000000) $ goldenReportTree

View File

@ -7,16 +7,10 @@ import Control.Category
import Control.Exception
import qualified Data.ByteString.Lazy as BSL
import Data.Default
import Data.HList
import Data.OpenApi
import Data.Text (Text)
import qualified Data.Text.Encoding as T
import qualified Data.Yaml as Yaml
import OpenAPI.Checker.Behavior
import OpenAPI.Checker.Paths
import OpenAPI.Checker.PathsPrefixTree
import OpenAPI.Checker.Report
import OpenAPI.Checker.Subtree
import OpenAPI.Checker.Run
import OpenAPI.Checker.Validate.OpenApi ()
import Spec.Golden.Extra
import Test.Tasty (TestTree, testGroup)
@ -43,18 +37,9 @@ tests = do
"report.md"
("a.yaml", "b.yaml")
Yaml.decodeFileThrow
(runPandoc . writeMarkdown def {writerExtensions = githubMarkdownExtensions} . generateReport . runChecker)
(runPandoc . writeMarkdown def {writerExtensions = githubMarkdownExtensions} . fst . runReport)
return $ testGroup "Golden tests" [traceTreeTests, reportTests]
runPandoc :: PandocPure Text -> IO BSL.ByteString
runPandoc = either throwIO (pure . BSL.fromStrict . T.encodeUtf8) . runPure
runChecker :: (OpenApi, OpenApi) -> Either (PathsPrefixTree Behave AnIssue 'APILevel) ()
runChecker = runCompatFormula . checkCompatibility HNil Root . toPC
where
toPC (c, s) =
ProdCons
{ producer = traced (step ClientSchema) c
, consumer = traced (step ServerSchema) s
}

View File

@ -1 +1,5 @@
# No breaking changes found ✨
# Summary
| ⚠️ Breaking changes | 🙆 Non-breaking changes | 🤷 Unsupported feature changes |
|---------------------|------------------------|-------------------------------|
| 0 | 0 | 0 |

View File

@ -1 +1,2 @@
Right: []
breakingChanges: {}
nonBreakingChanges: {}

View File

@ -1 +1,5 @@
# No breaking changes found ✨
# Summary
| ⚠️ Breaking changes | 🙆 Non-breaking changes | 🤷 Unsupported feature changes |
|---------------------|------------------------|-------------------------------|
| 0 | 0 | 0 |

View File

@ -1 +1,2 @@
Right: []
breakingChanges: {}
nonBreakingChanges: {}

View File

@ -1 +1,5 @@
# No breaking changes found ✨
# Summary
| ⚠️ Breaking changes | 🙆 Non-breaking changes | 🤷 Unsupported feature changes |
|---------------------|------------------------|-------------------------------|
| 0 | 0 | 0 |

View File

@ -1 +1,2 @@
Right: []
breakingChanges: {}
nonBreakingChanges: {}

View File

@ -1,14 +1,24 @@
# Summary
| [⚠️ Breaking changes](#breaking-changes) | 🤷 Unsupported feature changes |
|------------------------------------------|-------------------------------|
| 1 | 0 |
| [⚠️ Breaking changes](#breaking-changes) | [🙆 Non-breaking changes](#non-breaking-changes) | 🤷 Unsupported feature changes |
|------------------------------------------|-------------------------------------------------|-------------------------------|
| 1 | 1 | 0 |
# <span id="breaking-changes"></span>⚠️ Breaking changes
## **POST** /test
### JSON Request
### 📱➡️ JSON Request
#### `$(Number)`
Upper bound changed from 3.0 inclusive to 2.0 inclusive.
# <span id="non-breaking-changes"></span>🙆 Non-breaking changes
## **POST** /test
### 📱⬅️ JSON Response 200
#### `$(Number)`

View File

@ -1,4 +1,4 @@
Left:
breakingChanges:
AtPath "/test":
InOperation PostMethod:
InRequest:
@ -6,3 +6,11 @@ Left:
PayloadSchema:
OfType Number: MatchingMaximumWeak (ProdCons {producer = Inclusive 3.0,
consumer = Inclusive 2.0})
nonBreakingChanges:
AtPath "/test":
InOperation PostMethod:
WithStatusCode 200:
ResponsePayload:
PayloadSchema:
OfType Number: MatchingMaximumWeak (ProdCons {producer = Inclusive 3.0,
consumer = Inclusive 2.0})

View File

@ -1,8 +1,8 @@
# Summary
| [⚠️ Breaking changes](#breaking-changes) | 🤷 Unsupported feature changes |
|------------------------------------------|-------------------------------|
| 1 | 0 |
| [⚠️ Breaking changes](#breaking-changes) | 🙆 Non-breaking changes | 🤷 Unsupported feature changes |
|------------------------------------------|------------------------|-------------------------------|
| 1 | 0 | 0 |
# <span id="breaking-changes"></span>⚠️ Breaking changes
@ -10,4 +10,4 @@
### Parameter test1
Expected that an empty parameter is allowed, but it isn't.
The parameter can no longer be empty.

View File

@ -1,4 +1,5 @@
Left:
breakingChanges:
AtPath "/test":
InOperation PostMethod:
InParam "test1": ParamEmptinessIncompatible
nonBreakingChanges: {}

View File

@ -1 +1,13 @@
# No breaking changes found ✨
# Summary
| ⚠️ Breaking changes | [🙆 Non-breaking changes](#non-breaking-changes) | 🤷 Unsupported feature changes |
|---------------------|-------------------------------------------------|-------------------------------|
| 0 | 1 | 0 |
# <span id="non-breaking-changes"></span>🙆 Non-breaking changes
## **POST** /test
### Parameter test1
The parameter can now be empty.

View File

@ -1 +1,5 @@
Right: []
breakingChanges: {}
nonBreakingChanges:
AtPath "/test":
InOperation PostMethod:
InParam "test1": ParamEmptinessIncompatible

View File

@ -1,8 +1,8 @@
# Summary
| [⚠️ Breaking changes](#breaking-changes) | 🤷 Unsupported feature changes |
|------------------------------------------|-------------------------------|
| 1 | 0 |
| [⚠️ Breaking changes](#breaking-changes) | [🙆 Non-breaking changes](#non-breaking-changes) | 🤷 Unsupported feature changes |
|------------------------------------------|-------------------------------------------------|-------------------------------|
| 1 | 1 | 0 |
# <span id="breaking-changes"></span>⚠️ Breaking changes
@ -15,3 +15,15 @@
##### `$(String)`
The type has been removed.
# <span id="non-breaking-changes"></span>🙆 Non-breaking changes
## **POST** /test
### Parameter test
#### JSON Schema
##### `$(Number)`
The type has been added.

View File

@ -1,6 +1,12 @@
Left:
breakingChanges:
AtPath "/test":
InOperation PostMethod:
InParam "test":
InParamSchema:
OfType String: NoContradiction
nonBreakingChanges:
AtPath "/test":
InOperation PostMethod:
InParam "test":
InParamSchema:
OfType Number: NoContradiction

View File

@ -1 +1,5 @@
# No breaking changes found ✨
# Summary
| ⚠️ Breaking changes | 🙆 Non-breaking changes | 🤷 Unsupported feature changes |
|---------------------|------------------------|-------------------------------|
| 0 | 0 | 0 |

View File

@ -1 +1,2 @@
Right: []
breakingChanges: {}
nonBreakingChanges: {}

View File

@ -1 +1,5 @@
# No breaking changes found ✨
# Summary
| ⚠️ Breaking changes | 🙆 Non-breaking changes | 🤷 Unsupported feature changes |
|---------------------|------------------------|-------------------------------|
| 0 | 0 | 0 |

View File

@ -1 +1,2 @@
Right: []
breakingChanges: {}
nonBreakingChanges: {}

View File

@ -1 +1,13 @@
# No breaking changes found ✨
# Summary
| ⚠️ Breaking changes | [🙆 Non-breaking changes](#non-breaking-changes) | 🤷 Unsupported feature changes |
|---------------------|-------------------------------------------------|-------------------------------|
| 0 | 1 | 0 |
# <span id="non-breaking-changes"></span>🙆 Non-breaking changes
## **POST** /test
### Parameter test1
Parameter is no longer required.

View File

@ -1 +1,5 @@
Right: []
breakingChanges: {}
nonBreakingChanges:
AtPath "/test":
InOperation PostMethod:
InParam "test1": ParamRequired

View File

@ -1,8 +1,8 @@
# Summary
| [⚠️ Breaking changes](#breaking-changes) | 🤷 Unsupported feature changes |
|------------------------------------------|-------------------------------|
| 1 | 0 |
| [⚠️ Breaking changes](#breaking-changes) | 🙆 Non-breaking changes | 🤷 Unsupported feature changes |
|------------------------------------------|------------------------|-------------------------------|
| 1 | 0 | 0 |
# <span id="breaking-changes"></span>⚠️ Breaking changes

View File

@ -1,4 +1,5 @@
Left:
breakingChanges:
AtPath "/test":
InOperation PostMethod:
InParam "test1": ParamRequired
nonBreakingChanges: {}

View File

@ -1,8 +1,8 @@
# Summary
| [⚠️ Breaking changes](#breaking-changes) | 🤷 Unsupported feature changes |
|------------------------------------------|-------------------------------|
| 1 | 0 |
| [⚠️ Breaking changes](#breaking-changes) | 🙆 Non-breaking changes | 🤷 Unsupported feature changes |
|------------------------------------------|------------------------|-------------------------------|
| 1 | 0 | 0 |
# <span id="breaking-changes"></span>⚠️ Breaking changes

View File

@ -1,3 +1,4 @@
Left:
breakingChanges:
AtPath "/test":
InOperation PostMethod: ParamNotMatched "test2"
nonBreakingChanges: {}

View File

@ -1 +1,11 @@
# No breaking changes found ✨
# Summary
| ⚠️ Breaking changes | [🙆 Non-breaking changes](#non-breaking-changes) | 🤷 Unsupported feature changes |
|---------------------|-------------------------------------------------|-------------------------------|
| 0 | 1 | 0 |
# <span id="non-breaking-changes"></span>🙆 Non-breaking changes
## **POST** /test
Parameter `test2` is no longer required.

View File

@ -1 +1,4 @@
Right: []
breakingChanges: {}
nonBreakingChanges:
AtPath "/test":
InOperation PostMethod: ParamNotMatched "test2"

View File

@ -1 +1,13 @@
# No breaking changes found ✨
# Summary
| ⚠️ Breaking changes | [🙆 Non-breaking changes](#non-breaking-changes) | 🤷 Unsupported feature changes |
|---------------------|-------------------------------------------------|-------------------------------|
| 0 | 1 | 0 |
# <span id="non-breaking-changes"></span>🙆 Non-breaking changes
## **POST** /test
### Request
Media type `application/x-www-form-urlencoded` has been added.

View File

@ -1 +1,5 @@
Right: []
breakingChanges: {}
nonBreakingChanges:
AtPath "/test":
InOperation PostMethod:
InRequest: RequestMediaTypeNotFound application/x-www-form-urlencoded

View File

@ -1,15 +1,25 @@
# Summary
| [⚠️ Breaking changes](#breaking-changes) | 🤷 Unsupported feature changes |
|------------------------------------------|-------------------------------|
| 1 | 0 |
| [⚠️ Breaking changes](#breaking-changes) | [🙆 Non-breaking changes](#non-breaking-changes) | 🤷 Unsupported feature changes |
|------------------------------------------|-------------------------------------------------|-------------------------------|
| 1 | 1 | 0 |
# <span id="breaking-changes"></span>⚠️ Breaking changes
## **POST** /test
### JSON Request
### 📱➡️ JSON Request
#### `$(String)`
The type has been removed.
# <span id="non-breaking-changes"></span>🙆 Non-breaking changes
## **POST** /test
### 📱➡️ JSON Request
#### `$(Number)`
The type has been added.

View File

@ -1,7 +1,14 @@
Left:
breakingChanges:
AtPath "/test":
InOperation PostMethod:
InRequest:
InPayload:
PayloadSchema:
OfType String: NoContradiction
nonBreakingChanges:
AtPath "/test":
InOperation PostMethod:
InRequest:
InPayload:
PayloadSchema:
OfType Number: NoContradiction

View File

@ -1,8 +1,8 @@
# Summary
| [⚠️ Breaking changes](#breaking-changes) | 🤷 Unsupported feature changes |
|------------------------------------------|-------------------------------|
| 1 | 0 |
| [⚠️ Breaking changes](#breaking-changes) | 🙆 Non-breaking changes | 🤷 Unsupported feature changes |
|------------------------------------------|------------------------|-------------------------------|
| 1 | 0 | 0 |
# <span id="breaking-changes"></span>⚠️ Breaking changes

View File

@ -1,4 +1,5 @@
Left:
breakingChanges:
AtPath "/test":
InOperation PostMethod:
InRequest: RequestMediaTypeNotFound application/x-www-form-urlencoded
nonBreakingChanges: {}

View File

@ -1 +1,13 @@
# No breaking changes found ✨
# Summary
| ⚠️ Breaking changes | [🙆 Non-breaking changes](#non-breaking-changes) | 🤷 Unsupported feature changes |
|---------------------|-------------------------------------------------|-------------------------------|
| 0 | 1 | 0 |
# <span id="non-breaking-changes"></span>🙆 Non-breaking changes
## **POST** /test
### Request
Request body is no longer required.

View File

@ -1 +1,5 @@
Right: []
breakingChanges: {}
nonBreakingChanges:
AtPath "/test":
InOperation PostMethod:
InRequest: RequestBodyRequired

View File

@ -1,8 +1,8 @@
# Summary
| [⚠️ Breaking changes](#breaking-changes) | 🤷 Unsupported feature changes |
|------------------------------------------|-------------------------------|
| 1 | 0 |
| [⚠️ Breaking changes](#breaking-changes) | 🙆 Non-breaking changes | 🤷 Unsupported feature changes |
|------------------------------------------|------------------------|-------------------------------|
| 1 | 0 | 0 |
# <span id="breaking-changes"></span>⚠️ Breaking changes

View File

@ -1,4 +1,5 @@
Left:
breakingChanges:
AtPath "/test":
InOperation PostMethod:
InRequest: RequestBodyRequired
nonBreakingChanges: {}

View File

@ -1,8 +1,8 @@
# Summary
| [⚠️ Breaking changes](#breaking-changes) | 🤷 Unsupported feature changes |
|------------------------------------------|-------------------------------|
| 1 | 0 |
| [⚠️ Breaking changes](#breaking-changes) | 🙆 Non-breaking changes | 🤷 Unsupported feature changes |
|------------------------------------------|------------------------|-------------------------------|
| 1 | 0 | 0 |
# <span id="breaking-changes"></span>⚠️ Breaking changes

View File

@ -1,3 +1,4 @@
Left:
breakingChanges:
AtPath "/test":
InOperation PostMethod: ResponseCodeNotFound 500
nonBreakingChanges: {}

View File

@ -1 +1,13 @@
# No breaking changes found ✨
# Summary
| ⚠️ Breaking changes | [🙆 Non-breaking changes](#non-breaking-changes) | 🤷 Unsupported feature changes |
|---------------------|-------------------------------------------------|-------------------------------|
| 0 | 1 | 0 |
# <span id="non-breaking-changes"></span>🙆 Non-breaking changes
## **POST** /test
### Response code 200
New header was added `Test2`.

View File

@ -1 +1,5 @@
Right: []
breakingChanges: {}
nonBreakingChanges:
AtPath "/test":
InOperation PostMethod:
WithStatusCode 200: ResponseHeaderMissing "Test2"

View File

@ -1,8 +1,8 @@
# Summary
| [⚠️ Breaking changes](#breaking-changes) | 🤷 Unsupported feature changes |
|------------------------------------------|-------------------------------|
| 1 | 0 |
| [⚠️ Breaking changes](#breaking-changes) | 🙆 Non-breaking changes | 🤷 Unsupported feature changes |
|------------------------------------------|------------------------|-------------------------------|
| 1 | 0 | 0 |
# <span id="breaking-changes"></span>⚠️ Breaking changes
@ -10,4 +10,4 @@
### Response code 200
New header was added `Test2`.
Header was removed `Test2`.

View File

@ -1,4 +1,5 @@
Left:
breakingChanges:
AtPath "/test":
InOperation PostMethod:
WithStatusCode 200: ResponseHeaderMissing "Test2"
nonBreakingChanges: {}

View File

@ -1 +1,5 @@
# No breaking changes found ✨
# Summary
| ⚠️ Breaking changes | 🙆 Non-breaking changes | 🤷 Unsupported feature changes |
|---------------------|------------------------|-------------------------------|
| 0 | 0 | 0 |

View File

@ -1 +1,2 @@
Right: []
breakingChanges: {}
nonBreakingChanges: {}

View File

@ -1 +1,5 @@
# No breaking changes found ✨
# Summary
| ⚠️ Breaking changes | 🙆 Non-breaking changes | 🤷 Unsupported feature changes |
|---------------------|------------------------|-------------------------------|
| 0 | 0 | 0 |

View File

@ -1 +1,2 @@
Right: []
breakingChanges: {}
nonBreakingChanges: {}

View File

@ -1,8 +1,8 @@
# Summary
| [⚠️ Breaking changes](#breaking-changes) | 🤷 Unsupported feature changes |
|------------------------------------------|-------------------------------|
| 1 | 0 |
| [⚠️ Breaking changes](#breaking-changes) | 🙆 Non-breaking changes | 🤷 Unsupported feature changes |
|------------------------------------------|------------------------|-------------------------------|
| 1 | 0 | 0 |
# <span id="breaking-changes"></span>⚠️ Breaking changes

View File

@ -1,4 +1,5 @@
Left:
breakingChanges:
AtPath "/test":
InOperation PostMethod:
WithStatusCode 200: ResponseMediaTypeMissing application/x-www-form-urlencoded
nonBreakingChanges: {}

View File

@ -1,15 +1,25 @@
# Summary
| [⚠️ Breaking changes](#breaking-changes) | 🤷 Unsupported feature changes |
|------------------------------------------|-------------------------------|
| 1 | 0 |
| [⚠️ Breaking changes](#breaking-changes) | [🙆 Non-breaking changes](#non-breaking-changes) | 🤷 Unsupported feature changes |
|------------------------------------------|-------------------------------------------------|-------------------------------|
| 1 | 1 | 0 |
# <span id="breaking-changes"></span>⚠️ Breaking changes
## **POST** /test
### JSON Response 200
### 📱⬅️ JSON Response 200
#### `$(Number)`
The type has been added.
# <span id="non-breaking-changes"></span>🙆 Non-breaking changes
## **POST** /test
### 📱⬅️ JSON Response 200
#### `$(String)`
The type has been removed.

View File

@ -1,7 +1,14 @@
Left:
breakingChanges:
AtPath "/test":
InOperation PostMethod:
WithStatusCode 200:
ResponsePayload:
PayloadSchema:
OfType Number: NoContradiction
nonBreakingChanges:
AtPath "/test":
InOperation PostMethod:
WithStatusCode 200:
ResponsePayload:
PayloadSchema:
OfType String: NoContradiction

View File

@ -1 +1,13 @@
# No breaking changes found ✨
# Summary
| ⚠️ Breaking changes | [🙆 Non-breaking changes](#non-breaking-changes) | 🤷 Unsupported feature changes |
|---------------------|-------------------------------------------------|-------------------------------|
| 0 | 1 | 0 |
# <span id="non-breaking-changes"></span>🙆 Non-breaking changes
## **POST** /test
### Response code 200
Media type was removed: `application/x-www-form-urlencoded`.

View File

@ -1 +1,5 @@
Right: []
breakingChanges: {}
nonBreakingChanges:
AtPath "/test":
InOperation PostMethod:
WithStatusCode 200: ResponseMediaTypeMissing application/x-www-form-urlencoded

View File

@ -1 +1,11 @@
# No breaking changes found ✨
# Summary
| ⚠️ Breaking changes | [🙆 Non-breaking changes](#non-breaking-changes) | 🤷 Unsupported feature changes |
|---------------------|-------------------------------------------------|-------------------------------|
| 0 | 1 | 0 |
# <span id="non-breaking-changes"></span>🙆 Non-breaking changes
## **POST** /test
Reponse code 500 has been removed.

View File

@ -1 +1,4 @@
Right: []
breakingChanges: {}
nonBreakingChanges:
AtPath "/test":
InOperation PostMethod: ResponseCodeNotFound 500

View File

@ -0,0 +1,32 @@
openapi: "3.0.0"
info:
version: 1.0.0
title: Test
servers:
- url: http://localhost/
paths:
/test:
post:
requestBody:
content:
application/json:
schema:
$ref: "#/components/schemas/Test"
responses:
"200":
description: test
content:
application/json:
schema:
$ref: "#/components/schemas/Test"
components:
schemas:
Test:
required:
- property1
- property2
properties:
property1:
type: string
property2:
type: number

View File

@ -0,0 +1,29 @@
openapi: "3.0.0"
info:
version: 1.0.0
title: Test
servers:
- url: http://localhost/
paths:
/test:
post:
requestBody:
content:
application/json:
schema:
$ref: "#/components/schemas/Test"
responses:
"200":
description: test
content:
application/json:
schema:
$ref: "#/components/schemas/Test"
components:
schemas:
Test:
required:
- property1
properties:
property1:
type: string

View File

@ -0,0 +1,25 @@
# Summary
| [⚠️ Breaking changes](#breaking-changes) | [🙆 Non-breaking changes](#non-breaking-changes) | 🤷 Unsupported feature changes |
|------------------------------------------|-------------------------------------------------|-------------------------------|
| 1 | 1 | 0 |
# <span id="breaking-changes"></span>⚠️ Breaking changes
## **POST** /test
### 📱⬅️ JSON Response 200
#### `$(Object)`
Property `property2` may not be present.
# <span id="non-breaking-changes"></span>🙆 Non-breaking changes
## **POST** /test
### 📱➡️ JSON Request
#### `$(Object)`
Property `property2` may not be present.

View File

@ -0,0 +1,14 @@
breakingChanges:
AtPath "/test":
InOperation PostMethod:
WithStatusCode 200:
ResponsePayload:
PayloadSchema:
OfType Object: PropertyNowRequired "property2"
nonBreakingChanges:
AtPath "/test":
InOperation PostMethod:
InRequest:
InPayload:
PayloadSchema:
OfType Object: PropertyNowRequired "property2"

View File

@ -1,21 +1,37 @@
# Summary
| [⚠️ Breaking changes](#breaking-changes) | 🤷 Unsupported feature changes |
|------------------------------------------|-------------------------------|
| 2 | 0 |
| [⚠️ Breaking changes](#breaking-changes) | [🙆 Non-breaking changes](#non-breaking-changes) | 🤷 Unsupported feature changes |
|------------------------------------------|-------------------------------------------------|-------------------------------|
| 2 | 2 | 0 |
# <span id="breaking-changes"></span>⚠️ Breaking changes
## **POST** /test
### JSON Request
### 📱➡️ JSON Request
#### `$(Object)`
Property `property2` has been removed.
### JSON Response 200
### 📱⬅️ JSON Response 200
#### `$(Object)`
Property `property2` has become required.
Property `property2` may not be present.
# <span id="non-breaking-changes"></span>🙆 Non-breaking changes
## **POST** /test
### 📱➡️ JSON Request
#### `$(Object)`
Property `property2` may not be present.
### 📱⬅️ JSON Response 200
#### `$(Object)`
Property `property2` has been removed.

View File

@ -1,4 +1,4 @@
Left:
breakingChanges:
AtPath "/test":
InOperation PostMethod:
InRequest:
@ -9,3 +9,14 @@ Left:
ResponsePayload:
PayloadSchema:
OfType Object: PropertyNowRequired "property2"
nonBreakingChanges:
AtPath "/test":
InOperation PostMethod:
InRequest:
InPayload:
PayloadSchema:
OfType Object: PropertyNowRequired "property2"
WithStatusCode 200:
ResponsePayload:
PayloadSchema:
OfType Object: UnexpectedProperty "property2"

View File

@ -1,14 +1,24 @@
# Summary
| [⚠️ Breaking changes](#breaking-changes) | 🤷 Unsupported feature changes |
|------------------------------------------|-------------------------------|
| 1 | 0 |
| [⚠️ Breaking changes](#breaking-changes) | [🙆 Non-breaking changes](#non-breaking-changes) | 🤷 Unsupported feature changes |
|------------------------------------------|-------------------------------------------------|-------------------------------|
| 1 | 1 | 0 |
# <span id="breaking-changes"></span>⚠️ Breaking changes
## **POST** /test
### JSON Request
### 📱➡️ JSON Request
#### `$(Object)`
Property `property2` has become required.
# <span id="non-breaking-changes"></span>🙆 Non-breaking changes
## **POST** /test
### 📱⬅️ JSON Response 200
#### `$(Object)`

View File

@ -1,7 +1,14 @@
Left:
breakingChanges:
AtPath "/test":
InOperation PostMethod:
InRequest:
InPayload:
PayloadSchema:
OfType Object: PropertyNowRequired "property2"
nonBreakingChanges:
AtPath "/test":
InOperation PostMethod:
WithStatusCode 200:
ResponsePayload:
PayloadSchema:
OfType Object: PropertyNowRequired "property2"

View File

@ -1 +1,19 @@
# No breaking changes found ✨
# Summary
| ⚠️ Breaking changes | [🙆 Non-breaking changes](#non-breaking-changes) | 🤷 Unsupported feature changes |
|---------------------|-------------------------------------------------|-------------------------------|
| 0 | 1 | 0 |
# <span id="non-breaking-changes"></span>🙆 Non-breaking changes
## **GET** /api/foo
### 📱⬅️ JSON Response 200
#### `$.leaf.value.foo(String)`
The following enum value has been removed:
``` json
"a"
```

View File

@ -1 +1,14 @@
Right: []
breakingChanges: {}
nonBreakingChanges:
AtPath "/api/foo":
InOperation GetMethod:
WithStatusCode 200:
ResponsePayload:
PayloadSchema:
OfType Object:
InProperty "leaf":
OfType Object:
InProperty "value":
OfType Object:
InProperty "foo":
OfType String: NoMatchingEnum (String "a")

View File

@ -1,8 +1,8 @@
# Summary
| [⚠️ Breaking changes](#breaking-changes) | 🤷 Unsupported feature changes |
|------------------------------------------|-------------------------------|
| 2 | 0 |
| [⚠️ Breaking changes](#breaking-changes) | [🙆 Non-breaking changes](#non-breaking-changes) | 🤷 Unsupported feature changes |
|------------------------------------------|-------------------------------------------------|-------------------------------|
| 2 | 1 | 0 |
# <span id="breaking-changes"></span>⚠️ Breaking changes
@ -21,3 +21,13 @@ Security scheme has been removed.
#### oauth
Security scheme has been removed.
# <span id="non-breaking-changes"></span>🙆 Non-breaking changes
## **POST** /oauth/check
### Security requirement 0
#### spa-oauth
Security scheme has been added.

View File

@ -1,4 +1,4 @@
Left:
breakingChanges:
AtPath "/oauth/sign_out":
InOperation GetMethod:
SecurityRequirementStep 1:
@ -7,3 +7,8 @@ Left:
InOperation PostMethod:
SecurityRequirementStep 0:
SecuritySchemeStep "oauth": SecuritySchemeNotMatched
nonBreakingChanges:
AtPath "/oauth/check":
InOperation PostMethod:
SecurityRequirementStep 0:
SecuritySchemeStep "spa-oauth": SecuritySchemeNotMatched

View File

@ -1,8 +1,8 @@
# Summary
| [⚠️ Breaking changes](#breaking-changes) | 🤷 Unsupported feature changes |
|------------------------------------------|-------------------------------|
| 3 | 0 |
| [⚠️ Breaking changes](#breaking-changes) | [🙆 Non-breaking changes](#non-breaking-changes) | 🤷 Unsupported feature changes |
|------------------------------------------|-------------------------------------------------|-------------------------------|
| 3 | 1 | 0 |
# <span id="breaking-changes"></span>⚠️ Breaking changes
@ -17,3 +17,11 @@ The server was removed.
Enum value `a` has been removed.
A variable has been changed from being open to being closed.
# <span id="non-breaking-changes"></span>🙆 Non-breaking changes
## **GET** /pets
### Server `http://{x}variable.path/{y}/{openVariable1}/{openVariable2}`
Enum value `bbb` has been added.

View File

@ -1,7 +1,12 @@
Left:
breakingChanges:
AtPath "/pets":
InOperation GetMethod:
InServer "http://{x}variable.path/{y}/{openVariable1}/{openVariable2}":
- EnumValueNotConsumed 1 "a"
- ConsumerNotOpen 7
InServer "http://missing.url": ServerNotMatched
nonBreakingChanges:
AtPath "/pets":
InOperation GetMethod:
InServer "http://{x}variable.path/{y}/{openVariable1}/{openVariable2}": EnumValueNotConsumed
3 "bbb"

View File

@ -1,13 +1,13 @@
# Summary
| ⚠️ Breaking changes | [🤷 Unsupported feature changes](#unsupported-changes) |
|---------------------|-------------------------------------------------------|
| 0 | 1 |
| ⚠️ Breaking changes | 🙆 Non-breaking changes | [🤷 Unsupported feature changes](#unsupported-changes) |
|---------------------|------------------------|-------------------------------------------------------|
| 0 | 0 | 1 |
# <span id="unsupported-changes"></span>🤷 Unsupported feature changes
## **GET** /api/foo
### JSON Response 200
### 📱⬅️ JSON Response 200
Encountered recursion that is too complex for OpenApi Diff to untangle.

View File

@ -1,4 +1,10 @@
Left:
breakingChanges:
AtPath "/api/foo":
InOperation GetMethod:
WithStatusCode 200:
ResponsePayload:
PayloadSchema: UnguardedRecursion
nonBreakingChanges:
AtPath "/api/foo":
InOperation GetMethod:
WithStatusCode 200: