mirror of
https://github.com/ilyakooo0/compaREST.git
synced 2024-10-26 07:57:59 +03:00
Added report generation (#73)
* first stab * Made things compile * Fixed headers * Implemented jets * Added method-path jet * Added yet more jets * Rerun tests * Updated formatting * Added some issue descriptions * resolved producer/consumer mixup in schema * Added UnguardedRecursion descriptions * Added condition formatting * Added jet docs * Added different format outputs
This commit is contained in:
parent
f39734fc00
commit
218336b11e
69
app/FormatHeuristic.hs
Normal file
69
app/FormatHeuristic.hs
Normal file
@ -0,0 +1,69 @@
|
||||
-- |
|
||||
-- Originally based on:
|
||||
-- https://github.com/jgm/pandoc/blob/master/src/Text/Pandoc/App/FormatHeuristics.hs
|
||||
module FormatHeuristic
|
||||
( formatFromFilePath
|
||||
)
|
||||
where
|
||||
|
||||
import Data.Char (toLower)
|
||||
import System.FilePath (takeExtension)
|
||||
import Text.Pandoc
|
||||
|
||||
formatFromFilePath :: PandocMonad m => FilePath -> Maybe (Writer m)
|
||||
formatFromFilePath x =
|
||||
case takeExtension (map toLower x) of
|
||||
".adoc" -> f "asciidoc"
|
||||
".asciidoc" -> f "asciidoc"
|
||||
".context" -> f "context"
|
||||
".ctx" -> f "context"
|
||||
".db" -> f "docbook"
|
||||
".doc" -> f "doc" -- so we get an "unknown reader" error
|
||||
".docx" -> f "docx"
|
||||
".dokuwiki" -> f "dokuwiki"
|
||||
".epub" -> f "epub"
|
||||
".fb2" -> f "fb2"
|
||||
".htm" -> f "html"
|
||||
".html" -> f "html"
|
||||
".icml" -> f "icml"
|
||||
".json" -> f "json"
|
||||
".latex" -> f "latex"
|
||||
".lhs" -> f "markdown+lhs"
|
||||
".ltx" -> f "latex"
|
||||
".markdown" -> f "markdown"
|
||||
".mkdn" -> f "markdown"
|
||||
".mkd" -> f "markdown"
|
||||
".mdwn" -> f "markdown"
|
||||
".mdown" -> f "markdown"
|
||||
".Rmd" -> f "markdown"
|
||||
".md" -> f "markdown"
|
||||
".ms" -> f "ms"
|
||||
".muse" -> f "muse"
|
||||
".native" -> f "native"
|
||||
".odt" -> f "odt"
|
||||
".opml" -> f "opml"
|
||||
".org" -> f "org"
|
||||
".pdf" -> f "pdf" -- so we get an "unknown reader" error
|
||||
".pptx" -> f "pptx"
|
||||
".roff" -> f "ms"
|
||||
".rst" -> f "rst"
|
||||
".rtf" -> f "rtf"
|
||||
".s5" -> f "s5"
|
||||
".t2t" -> f "t2t"
|
||||
".tei" -> f "tei"
|
||||
".tei.xml" -> f "tei"
|
||||
".tex" -> f "latex"
|
||||
".texi" -> f "texinfo"
|
||||
".texinfo" -> f "texinfo"
|
||||
".text" -> f "markdown"
|
||||
".textile" -> f "textile"
|
||||
".txt" -> f "markdown"
|
||||
".wiki" -> f "mediawiki"
|
||||
".xhtml" -> f "html"
|
||||
".ipynb" -> f "ipynb"
|
||||
".csv" -> f "csv"
|
||||
".bib" -> f "biblatex"
|
||||
['.', y] | y `elem` ['1' .. '9'] -> f "man"
|
||||
_ -> Nothing
|
||||
where
|
||||
f k = lookup k writers
|
62
app/Main.hs
62
app/Main.hs
@ -1,7 +1,63 @@
|
||||
module Main (main) where
|
||||
|
||||
import OpenAPI.Checker.Run (runChecker)
|
||||
|
||||
import Control.Monad
|
||||
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 System.Exit
|
||||
import System.IO
|
||||
import Text.Pandoc
|
||||
|
||||
main :: IO ()
|
||||
main = runChecker
|
||||
main = do
|
||||
opts <- execParser optionsParserInfo
|
||||
let parseSchema path =
|
||||
eitherDecodeFileStrict path >>= \case
|
||||
Left jsonErr -> do
|
||||
Yaml.decodeFileEither path >>= \case
|
||||
Left yamlErr -> do
|
||||
putStrLn "Could not parse as json or yaml"
|
||||
print jsonErr
|
||||
print yamlErr
|
||||
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
|
||||
runPandocIO x = lift (runIO x) >>= either (throwError . DocumentError) pure
|
||||
output :: Either (PathsPrefixTree Behave AnIssue 'APILevel) () -> ExceptT Errors IO ()
|
||||
output = case outputMode opts of
|
||||
StdoutMode -> lift . T.putStrLn <=< runPandocIO . writeMarkdown def . generateReport
|
||||
FileMode f -> case formatFromFilePath f of
|
||||
Nothing -> \_ -> throwError UnknownOutputFormat
|
||||
Just (TextWriter writer) -> lift . T.writeFile f <=< runPandocIO . writer def . generateReport
|
||||
Just (ByteStringWriter writer) -> lift . BSL.writeFile f <=< runPandocIO . writer def . generateReport
|
||||
either handler pure <=< runExceptT $ output result
|
||||
case result of
|
||||
Right () -> exitSuccess
|
||||
Left _ -> exitWith $ ExitFailure 1
|
||||
|
||||
data Errors
|
||||
= DocumentError PandocError
|
||||
| UnknownOutputFormat
|
||||
|
||||
handler :: Errors -> IO a
|
||||
handler (DocumentError err) = do
|
||||
T.hPutStrLn stderr (renderError err)
|
||||
exitWith $ ExitFailure 100
|
||||
handler UnknownOutputFormat = do
|
||||
T.hPutStrLn stderr "Could not determine output format from file extension."
|
||||
exitWith $ ExitFailure 101
|
||||
|
@ -63,6 +63,7 @@ common common-options
|
||||
, vector
|
||||
, yaml
|
||||
, hashable
|
||||
, pandoc-types
|
||||
|
||||
default-extensions: ApplicativeDo
|
||||
, BangPatterns
|
||||
@ -117,7 +118,6 @@ library
|
||||
, OpenAPI.Checker.Paths
|
||||
, OpenAPI.Checker.PathsPrefixTree
|
||||
, OpenAPI.Checker.References
|
||||
, OpenAPI.Checker.Run
|
||||
, OpenAPI.Checker.Subtree
|
||||
, OpenAPI.Checker.Validate.MediaTypeObject
|
||||
, OpenAPI.Checker.Validate.OpenApi
|
||||
@ -136,15 +136,24 @@ library
|
||||
, OpenAPI.Checker.Common
|
||||
, OpenAPI.Checker.Validate.SecurityScheme
|
||||
, OpenAPI.Checker.Validate.OAuth2Flows
|
||||
, OpenAPI.Checker.Report
|
||||
|
||||
executable openapi-diff
|
||||
import: common-options
|
||||
hs-source-dirs: app
|
||||
main-is: Main.hs
|
||||
build-depends: openapi-diff
|
||||
build-depends:
|
||||
openapi-diff
|
||||
, pandoc
|
||||
, data-default
|
||||
, bytestring
|
||||
, yaml
|
||||
, filepath
|
||||
ghc-options: -threaded
|
||||
-rtsopts
|
||||
-with-rtsopts=-N
|
||||
other-modules:
|
||||
FormatHeuristic
|
||||
|
||||
test-suite openapi-diff-test
|
||||
import: common-options
|
||||
@ -163,6 +172,8 @@ test-suite openapi-diff-test
|
||||
, yaml
|
||||
, directory
|
||||
, filepath
|
||||
, pandoc
|
||||
, data-default
|
||||
ghc-options: -threaded
|
||||
-rtsopts
|
||||
-with-rtsopts=-N
|
||||
|
@ -9,9 +9,9 @@ where
|
||||
|
||||
import Data.Aeson
|
||||
import Data.Kind
|
||||
import Data.Text as T
|
||||
import Data.Typeable
|
||||
import OpenAPI.Checker.Paths
|
||||
import Text.Pandoc.Builder
|
||||
|
||||
-- | Kind
|
||||
data BehaviorLevel
|
||||
@ -37,18 +37,20 @@ class
|
||||
Behavable (a :: BehaviorLevel) (b :: BehaviorLevel)
|
||||
where
|
||||
data Behave a b
|
||||
describeBehaviour :: Behave a b -> Inlines
|
||||
|
||||
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 -> Text
|
||||
describeIssue = T.pack . show -- TODO: remove this default
|
||||
describeIssue :: Issue l -> Blocks
|
||||
issueIsUnsupported :: Issue l -> Bool
|
||||
|
||||
-- | A set of interactions having common unifying features
|
||||
type Behavior = Paths Behave 'APILevel
|
||||
|
||||
instance Issuable l => ToJSON (Issue l) where
|
||||
toJSON = toJSON . describeIssue
|
||||
toJSON = toJSON . show
|
||||
|
||||
data AnIssue (l :: BehaviorLevel) where
|
||||
AnIssue :: Issuable l => Issue l -> AnIssue l
|
||||
|
@ -3,6 +3,7 @@
|
||||
-- structure.
|
||||
module OpenAPI.Checker.Paths
|
||||
( NiceQuiver
|
||||
, AdditionalQuiverConstraints
|
||||
, Paths (..)
|
||||
, DiffPaths (..)
|
||||
, catDiffPaths
|
||||
@ -24,7 +25,10 @@ import Data.Type.Equality
|
||||
import Type.Reflection
|
||||
import Prelude hiding ((.))
|
||||
|
||||
type NiceQuiver (q :: k -> j -> Type) (a :: k) (b :: j) = (Typeable q, Typeable a, Typeable b, Ord (q a b), Show (q a b))
|
||||
type NiceQuiver (q :: k -> j -> Type) (a :: k) (b :: j) =
|
||||
(Typeable q, Typeable a, Typeable b, Ord (q a b), Show (q a b), AdditionalQuiverConstraints q a b)
|
||||
|
||||
type family AdditionalQuiverConstraints (q :: k -> j -> Type) (a :: k) (b :: j) :: Constraint
|
||||
|
||||
-- | All the possible ways to navigate between nodes in a heterogeneous tree
|
||||
-- form a quiver. The hom-sets of the free category constructed from this quiver
|
||||
|
@ -1,7 +1,8 @@
|
||||
{-# LANGUAGE QuantifiedConstraints #-}
|
||||
|
||||
module OpenAPI.Checker.PathsPrefixTree
|
||||
( PathsPrefixTree
|
||||
( PathsPrefixTree (PathsPrefixNode)
|
||||
, AStep (..)
|
||||
, empty
|
||||
, singleton
|
||||
, fromList
|
||||
@ -24,6 +25,7 @@ import qualified Data.Text as T
|
||||
import Data.Type.Equality
|
||||
import qualified Data.TypeRepMap as TRM
|
||||
import qualified Data.Vector as V
|
||||
import qualified GHC.Exts as Exts
|
||||
import qualified GHC.Exts as TRM
|
||||
import OpenAPI.Checker.Paths
|
||||
import Type.Reflection
|
||||
@ -35,6 +37,15 @@ data PathsPrefixTree (q :: k -> k -> Type) (f :: k -> Type) (r :: k) = PathsPref
|
||||
, snocItems :: !(TRM.TypeRepMap (AStep q f r))
|
||||
}
|
||||
|
||||
pattern PathsPrefixNode :: Ord (f r) => S.Set (f r) -> [TRM.WrapTypeable (AStep q f r)] -> PathsPrefixTree q f r
|
||||
pattern PathsPrefixNode s steps <-
|
||||
(\(PathsPrefixTree aset m) -> (toSet aset, Exts.toList m) -> (s, steps))
|
||||
where
|
||||
PathsPrefixNode s steps | S.null s = PathsPrefixTree AnEmptySet (Exts.fromList steps)
|
||||
PathsPrefixNode s steps = PathsPrefixTree (ASet s) (Exts.fromList steps)
|
||||
|
||||
{-# COMPLETE PathsPrefixNode #-}
|
||||
|
||||
instance (forall a. ToJSON (f a)) => ToJSON (PathsPrefixTree q f r) where
|
||||
toJSON =
|
||||
Object . getMergableObject
|
||||
@ -78,6 +89,10 @@ data ASet (a :: Type) where
|
||||
AnEmptySet :: ASet a
|
||||
ASet :: Ord a => S.Set a -> ASet a
|
||||
|
||||
toSet :: ASet a -> S.Set a
|
||||
toSet AnEmptySet = S.empty
|
||||
toSet (ASet s) = s
|
||||
|
||||
instance ToJSON a => ToJSON (ASet a) where
|
||||
toJSON =
|
||||
toJSON . \case
|
||||
@ -123,6 +138,7 @@ instance Semigroup (PathsPrefixTree q f r) where
|
||||
PathsPrefixTree r1 s1 <> PathsPrefixTree r2 s2 =
|
||||
PathsPrefixTree (r1 <> r2) (TRM.unionWith joinSteps s1 s2)
|
||||
where
|
||||
joinSteps :: AStep q f r a -> AStep q f r a -> AStep q f r a
|
||||
joinSteps (AStep m1) (AStep m2) = AStep $ M.unionWith (<>) m1 m2
|
||||
|
||||
instance Monoid (PathsPrefixTree q f r) where
|
||||
@ -135,7 +151,7 @@ fromList :: [AnItem q f r] -> PathsPrefixTree q f r
|
||||
fromList = foldMap singleton
|
||||
|
||||
null :: PathsPrefixTree q f r -> Bool
|
||||
null (PathsPrefixTree AnEmptySet s) = TRM.size s == 0
|
||||
null (PathsPrefixTree AnEmptySet s) = all (\(TRM.WrapTypeable (AStep x)) -> all null x) (Exts.toList s)
|
||||
null _ = False
|
||||
|
||||
foldWith
|
||||
@ -161,11 +177,11 @@ toList :: PathsPrefixTree q f r -> [AnItem q f r]
|
||||
toList t = appEndo (foldWith (\xs f -> Endo (AnItem xs f :)) t) []
|
||||
|
||||
-- | Select a subtree by prefix
|
||||
filter :: Paths q r a -> PathsPrefixTree q f r -> PathsPrefixTree q f a
|
||||
filter :: forall q f r a. Paths q r a -> PathsPrefixTree q f r -> PathsPrefixTree q f a
|
||||
filter Root t = t
|
||||
filter (Snoc xs x) t =
|
||||
foldMap (\(AStep m) -> fold $ M.lookup x m) $
|
||||
TRM.lookup $ snocItems $ filter xs t
|
||||
TRM.lookup @a $ snocItems $ filter xs t
|
||||
|
||||
-- | Embed a subtree in a larger tree with given prefix
|
||||
embed :: Paths q r a -> PathsPrefixTree q f a -> PathsPrefixTree q f r
|
||||
|
136
src/OpenAPI/Checker/Report.hs
Normal file
136
src/OpenAPI/Checker/Report.hs
Normal file
@ -0,0 +1,136 @@
|
||||
module OpenAPI.Checker.Report
|
||||
( generateReport
|
||||
)
|
||||
where
|
||||
|
||||
import Control.Monad.Reader
|
||||
import Control.Monad.Writer
|
||||
import Data.Foldable
|
||||
import Data.Functor
|
||||
import qualified Data.Map as M
|
||||
import Data.Maybe
|
||||
import qualified Data.Text as T
|
||||
import Data.Traversable
|
||||
import Data.TypeRepMap hiding (empty)
|
||||
import Data.Typeable
|
||||
import OpenAPI.Checker.Behavior
|
||||
import OpenAPI.Checker.Paths
|
||||
import OpenAPI.Checker.PathsPrefixTree hiding (empty)
|
||||
import qualified OpenAPI.Checker.PathsPrefixTree as P hiding (empty)
|
||||
import OpenAPI.Checker.Validate.OpenApi
|
||||
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 $ showErrs errs
|
||||
|
||||
data ReportState = ReportState
|
||||
{ sourceJets :: [SomeReportJet Behave]
|
||||
, headerLevel :: Int
|
||||
}
|
||||
|
||||
type ReportMonad = ReaderT ReportState (Writer Blocks)
|
||||
|
||||
runReportMonad :: [SomeReportJet Behave] -> ReportMonad () -> Blocks
|
||||
runReportMonad jts =
|
||||
execWriter
|
||||
. flip
|
||||
runReaderT
|
||||
ReportState
|
||||
{ sourceJets = jts
|
||||
, headerLevel = 1
|
||||
}
|
||||
|
||||
smartHeader :: Inlines -> ReportMonad ()
|
||||
smartHeader i = do
|
||||
h <- asks headerLevel
|
||||
tell $ header h i
|
||||
|
||||
showErrs :: Typeable a => P.PathsPrefixTree Behave AnIssue a -> ReportMonad ()
|
||||
showErrs x@(P.PathsPrefixNode currentIssues _) = do
|
||||
jts <- asks sourceJets
|
||||
for_ currentIssues $ \(AnIssue i) -> tell . describeIssue $ i
|
||||
unfoldM x (observeSomeJetShowErrs <$> jts) $ \(P.PathsPrefixNode _ subIssues) -> do
|
||||
for_ subIssues $ \(WrapTypeable (AStep m)) ->
|
||||
for_ (M.toList m) $ \(bhv, subErrors) -> do
|
||||
unless (P.null subErrors) $ do
|
||||
smartHeader $ describeBehaviour bhv
|
||||
incrementHeaders $ showErrs subErrors
|
||||
|
||||
unfoldM :: Monad m => a -> [a -> m a] -> (a -> m ()) -> m ()
|
||||
unfoldM a [] g = g a
|
||||
unfoldM a (f : ff) g = do
|
||||
a' <- f a
|
||||
unfoldM a' ff g
|
||||
|
||||
observeSomeJetShowErrs
|
||||
:: forall a.
|
||||
Typeable a
|
||||
=> SomeReportJet Behave
|
||||
-> P.PathsPrefixTree Behave AnIssue a
|
||||
-> ReportMonad (P.PathsPrefixTree Behave AnIssue a)
|
||||
observeSomeJetShowErrs (SomeReportJet (Proxy :: Proxy a') f) x
|
||||
| Just Refl <- eqT @a @a' = observeJetShowErrs f x
|
||||
observeSomeJetShowErrs _ x = pure x
|
||||
|
||||
observeJetShowErrs :: ReportJet Behave a -> P.PathsPrefixTree Behave AnIssue a -> ReportMonad (P.PathsPrefixTree Behave AnIssue a)
|
||||
observeJetShowErrs jet (P.PathsPrefixNode currentIssues subIssues) = do
|
||||
rest <- fmap (fold . join) $
|
||||
for subIssues $ \(WrapTypeable (AStep m)) -> fmap catMaybes $
|
||||
for (M.toList m) $ \(bhv, subErrs) ->
|
||||
case applyReportJet jet bhv of
|
||||
Just (Left h) -> do
|
||||
smartHeader h
|
||||
incrementHeaders $ showErrs subErrs
|
||||
return Nothing
|
||||
Just (Right jet') -> do
|
||||
rest <- observeJetShowErrs jet' subErrs
|
||||
return $ Just $ embed (step bhv) rest
|
||||
Nothing -> return $ Just $ embed (step bhv) subErrs
|
||||
return $ PathsPrefixNode currentIssues mempty <> rest
|
||||
|
||||
-- | A "jet" is a way of simplifying expressions from "outside". The "jetted"
|
||||
-- expressions should still be completely valid and correct without the jets.
|
||||
-- Jets just make the expression more "optimized" by identifying patterns and
|
||||
-- replacing the expressions with "better" ones that have the same sematics.
|
||||
--
|
||||
-- The tem "jet" in this context was introduced in the Urbit project:
|
||||
-- https://urbit.org/docs/vere/jetting/
|
||||
--
|
||||
-- The pattern fits well for simplifying 'Behaviour' tree paths.
|
||||
class ConstructReportJet f a b c where
|
||||
constructReportJet :: (f a b -> c) -> ReportJet f a
|
||||
|
||||
instance (ConstructReportJet f b c d, Typeable b) => ConstructReportJet f a b (f b c -> d) where
|
||||
constructReportJet f = ReportJet Proxy $ \x -> constructReportJet $ f x
|
||||
|
||||
instance Typeable b => ConstructReportJet f a b Inlines where
|
||||
constructReportJet f = TerminalJet Proxy f
|
||||
|
||||
constructSomeReportJet :: (ConstructReportJet f a b c, Typeable a) => (f a b -> c) -> SomeReportJet f
|
||||
constructSomeReportJet = SomeReportJet Proxy . constructReportJet
|
||||
|
||||
data ReportJet f a where
|
||||
ReportJet :: Typeable b => Proxy b -> (f a b -> ReportJet f b) -> ReportJet f a
|
||||
TerminalJet :: Typeable b => Proxy b -> (f a b -> Inlines) -> ReportJet f a
|
||||
|
||||
data SomeReportJet f where
|
||||
SomeReportJet :: Typeable a => Proxy a -> ReportJet f a -> SomeReportJet f
|
||||
|
||||
applyReportJet :: forall f a b. Typeable b => ReportJet f a -> f a b -> Maybe (Either Inlines (ReportJet f b))
|
||||
applyReportJet (TerminalJet (Proxy :: Proxy b') f) x = eqT @b @b' <&> \Refl -> Left $ f x
|
||||
applyReportJet (ReportJet (Proxy :: Proxy b') f) x = eqT @b @b' <&> \Refl -> Right $ f x
|
||||
|
||||
incrementHeaders :: ReportMonad x -> ReportMonad x
|
||||
incrementHeaders m = do
|
||||
l <- asks headerLevel
|
||||
local (\x -> x {headerLevel = l + 1}) m
|
||||
|
||||
jets :: [SomeReportJet Behave]
|
||||
jets =
|
||||
[ constructSomeReportJet $ \p@(AtPath _) op@(InOperation _) ->
|
||||
strong (describeBehaviour op) <> " " <> describeBehaviour p :: Inlines
|
||||
, constructSomeReportJet $ \InRequest InPayload PayloadSchema -> "JSON Request" :: Inlines
|
||||
, constructSomeReportJet $ \(WithStatusCode c) ResponsePayload PayloadSchema ->
|
||||
"JSON Response – " <> str (T.pack . show $ c) :: Inlines
|
||||
]
|
@ -1,40 +0,0 @@
|
||||
module OpenAPI.Checker.Run (runChecker) where
|
||||
|
||||
import Data.Aeson
|
||||
import qualified Data.ByteString.Char8 as BSC
|
||||
import Data.HList
|
||||
import qualified Data.Yaml as Yaml
|
||||
import OpenAPI.Checker.Options
|
||||
import OpenAPI.Checker.Paths
|
||||
import OpenAPI.Checker.Subtree
|
||||
import OpenAPI.Checker.Validate.OpenApi ()
|
||||
import System.Exit
|
||||
import Prelude hiding (id, (.))
|
||||
|
||||
runChecker :: IO ()
|
||||
runChecker = do
|
||||
opts <- execParser optionsParserInfo
|
||||
let parseSchema path =
|
||||
eitherDecodeFileStrict path >>= \case
|
||||
Left jsonErr -> do
|
||||
Yaml.decodeFileEither path >>= \case
|
||||
Left yamlErr -> do
|
||||
putStrLn "Could not parse as json or yaml"
|
||||
print jsonErr
|
||||
print yamlErr
|
||||
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 report = runCompatFormula $ checkCompatibility HNil Root (ProdCons a b)
|
||||
output = case outputMode opts of
|
||||
StdoutMode -> BSC.putStrLn
|
||||
FileMode f -> BSC.writeFile f
|
||||
case report of
|
||||
Right () -> do
|
||||
output "No breaking changes found"
|
||||
exitSuccess
|
||||
Left e -> do
|
||||
output $ Yaml.encode e
|
||||
exitFailure
|
@ -64,7 +64,7 @@ import OpenAPI.Checker.Paths
|
||||
import qualified OpenAPI.Checker.PathsPrefixTree as P
|
||||
|
||||
class
|
||||
NiceQuiver Step a b =>
|
||||
(Typeable Step, Typeable a, Typeable b, Ord (Step a b), Show (Step a b)) =>
|
||||
Steppable (a :: Type) (b :: Type)
|
||||
where
|
||||
-- | How to get from an @a@ node to a @b@ node
|
||||
@ -80,6 +80,8 @@ instance Steppable TraceRoot OpenApi where
|
||||
|
||||
type Trace = Paths Step TraceRoot
|
||||
|
||||
type instance AdditionalQuiverConstraints Step a b = ()
|
||||
|
||||
type Traced' a b = Env (Trace a) b
|
||||
|
||||
type Traced a = Traced' a a
|
||||
@ -128,10 +130,12 @@ type SemanticCompatFormula = CompatFormula' Behave AnIssue 'APILevel
|
||||
|
||||
type StructuralCompatFormula = CompatFormula' VoidQuiver Proxy ()
|
||||
|
||||
data VoidQuiver a b where
|
||||
data VoidQuiver a b
|
||||
|
||||
deriving stock instance Eq (VoidQuiver a b)
|
||||
|
||||
type instance AdditionalQuiverConstraints VoidQuiver a b = ()
|
||||
|
||||
deriving stock instance Ord (VoidQuiver a b)
|
||||
|
||||
deriving stock instance Show (VoidQuiver a b)
|
||||
@ -297,10 +301,13 @@ memo
|
||||
-> (ProdCons (Traced a) -> CompatFormula' q f r ())
|
||||
-> (ProdCons (Traced a) -> CompatFormula' q f r ())
|
||||
memo bhv k f pc = Compose $ do
|
||||
formula' <- memoWithKnot fixpointKnot (do
|
||||
formula' <-
|
||||
memoWithKnot
|
||||
fixpointKnot
|
||||
(do
|
||||
formula <- getCompose $ f pc
|
||||
pure $ mapErrors (P.filter bhv) formula
|
||||
) (k, ask <$> pc)
|
||||
pure $ mapErrors (P.filter bhv) formula)
|
||||
(k, ask <$> pc)
|
||||
pure $ mapErrors (P.embed bhv) formula'
|
||||
|
||||
data MemoKey = SemanticMemoKey | StructuralMemoKey
|
||||
|
@ -13,6 +13,7 @@ import OpenAPI.Checker.Behavior
|
||||
import OpenAPI.Checker.References ()
|
||||
import OpenAPI.Checker.Subtree
|
||||
import OpenAPI.Checker.Validate.Schema ()
|
||||
import Text.Pandoc.Builder
|
||||
|
||||
instance Subtree Header where
|
||||
type SubtreeLevel Header = 'HeaderLevel
|
||||
@ -50,8 +51,12 @@ instance Issuable 'HeaderLevel where
|
||||
| HeaderSchemaRequired
|
||||
deriving stock (Eq, Ord, Show)
|
||||
issueIsUnsupported _ = False
|
||||
describeIssue RequiredHeaderMissing = para "Header expected, but missing."
|
||||
describeIssue NonEmptyHeaderRequired = para "Empty header not allowed."
|
||||
describeIssue HeaderSchemaRequired = para "Expected header schema, but it is not present."
|
||||
|
||||
instance Behavable 'HeaderLevel 'SchemaLevel where
|
||||
data Behave 'HeaderLevel 'SchemaLevel
|
||||
= InSchema
|
||||
deriving stock (Eq, Ord, Show)
|
||||
describeBehaviour InSchema = "JSON Schema"
|
||||
|
@ -5,6 +5,7 @@ module OpenAPI.Checker.Validate.Link () where
|
||||
import Data.OpenApi
|
||||
import OpenAPI.Checker.Behavior
|
||||
import OpenAPI.Checker.Subtree
|
||||
import Text.Pandoc.Builder
|
||||
|
||||
instance Subtree Link where
|
||||
type SubtreeLevel Link = 'LinkLevel
|
||||
@ -18,3 +19,4 @@ instance Issuable 'LinkLevel where
|
||||
deriving (Eq, Ord, Show)
|
||||
issueIsUnsupported = \case
|
||||
LinksUnsupported -> True
|
||||
describeIssue LinksUnsupported = para "OpenApi Diff does not currently support Link Objects."
|
||||
|
@ -6,19 +6,22 @@ module OpenAPI.Checker.Validate.MediaTypeObject
|
||||
)
|
||||
where
|
||||
|
||||
import Control.Lens
|
||||
import Control.Lens hiding (para)
|
||||
import Data.Foldable as F
|
||||
import Data.HList
|
||||
import Data.HashMap.Strict.InsOrd as IOHM
|
||||
import Data.Map.Strict as M
|
||||
import Data.OpenApi
|
||||
import Data.String
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
import Network.HTTP.Media (MediaType, mainType, subType)
|
||||
import OpenAPI.Checker.Behavior
|
||||
import OpenAPI.Checker.Subtree
|
||||
import OpenAPI.Checker.Validate.Header ()
|
||||
import OpenAPI.Checker.Validate.Products
|
||||
import OpenAPI.Checker.Validate.Schema ()
|
||||
import Text.Pandoc.Builder
|
||||
|
||||
tracedSchema :: Traced MediaTypeObject -> Maybe (Traced (Referenced Schema))
|
||||
tracedSchema mto = _mediaTypeObjectSchema (extract mto) <&> traced (ask mto >>> step MediaTypeSchema)
|
||||
@ -31,9 +34,7 @@ tracedEncoding mto =
|
||||
|
||||
instance Issuable 'PayloadLevel where
|
||||
data Issue 'PayloadLevel
|
||||
= PayloadMediaTypeNotFound
|
||||
| MediaEncodingIncompat
|
||||
| MediaTypeSchemaRequired
|
||||
= MediaTypeSchemaRequired
|
||||
| MediaEncodingMissing Text
|
||||
| EncodingNotSupported
|
||||
deriving (Eq, Ord, Show)
|
||||
@ -41,10 +42,15 @@ 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 <> " expected, but was not specified."
|
||||
describeIssue EncodingNotSupported = para "OpenApi Diff does not currently support media encodings other than JSON."
|
||||
|
||||
instance Behavable 'PayloadLevel 'SchemaLevel where
|
||||
data Behave 'PayloadLevel 'SchemaLevel
|
||||
= PayloadSchema
|
||||
deriving (Eq, Ord, Show)
|
||||
describeBehaviour PayloadSchema = "JSON Schema"
|
||||
|
||||
instance Subtree MediaTypeObject where
|
||||
type SubtreeLevel MediaTypeObject = 'PayloadLevel
|
||||
@ -136,15 +142,22 @@ instance Behavable 'OperationLevel 'ResponseLevel where
|
||||
data Behave 'OperationLevel 'ResponseLevel
|
||||
= WithStatusCode HttpStatusCode
|
||||
deriving stock (Eq, Ord, Show)
|
||||
describeBehaviour (WithStatusCode c) = "Response code " <> (fromString . show $ c)
|
||||
|
||||
instance Issuable 'OperationLevel where
|
||||
data Issue 'OperationLevel
|
||||
= ResponseCodeNotFound HttpStatusCode
|
||||
| CallbacksNotSupported
|
||||
| ParamNotMatched Text
|
||||
| PathFragmentNotMatched Int
|
||||
| NoRequestBody
|
||||
deriving stock (Eq, Ord, Show)
|
||||
issueIsUnsupported = \case
|
||||
CallbacksNotSupported -> True
|
||||
_ -> False
|
||||
describeIssue (ResponseCodeNotFound c) =
|
||||
para $ "Reponse code " <> (str . T.pack . show $ c) <> " is not supported."
|
||||
describeIssue (ParamNotMatched param) =
|
||||
para $ "Parameter " <> str param <> " is not supported."
|
||||
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 not specified."
|
||||
|
@ -9,6 +9,7 @@ where
|
||||
|
||||
import Control.Monad
|
||||
import Data.Function
|
||||
import Data.Functor
|
||||
import qualified Data.HashMap.Strict.InsOrd as IOHM
|
||||
import Data.OpenApi
|
||||
import Data.Proxy
|
||||
@ -18,6 +19,7 @@ import Data.Text (Text)
|
||||
import OpenAPI.Checker.Behavior
|
||||
import OpenAPI.Checker.Orphans ()
|
||||
import OpenAPI.Checker.Subtree
|
||||
import Text.Pandoc.Builder
|
||||
|
||||
instance Subtree OAuth2Flows where
|
||||
type CheckEnv OAuth2Flows = '[]
|
||||
@ -102,6 +104,8 @@ instance Issuable 'SecurityRequirementLevel where
|
||||
| UndefinedSecurityScheme Text
|
||||
deriving stock (Eq, Ord, Show)
|
||||
issueIsUnsupported _ = False
|
||||
describeIssue SecurityRequirementNotMet = para "Security scheme was not met."
|
||||
describeIssue (UndefinedSecurityScheme k) = para $ "Security scheme " <> code k <> " is not defined."
|
||||
|
||||
instance Issuable 'SecuritySchemeLevel where
|
||||
data Issue 'SecuritySchemeLevel
|
||||
@ -125,8 +129,29 @@ instance Issuable 'SecuritySchemeLevel where
|
||||
| ScopeNotDefined Text
|
||||
deriving stock (Eq, Ord, Show)
|
||||
issueIsUnsupported _ = False
|
||||
describeIssue RefreshUrlsDontMatch = para "Refresh URLs differ."
|
||||
describeIssue (HttpSchemeTypesDontMatch _ _) = para "HTTP scheme types don't match."
|
||||
describeIssue (ApiKeyParamsDontMatch _ _) = para "API Key parameters don't match."
|
||||
describeIssue (OpenIdConnectUrlsDontMatch _ _) = para "OpenaId Connect URLs don't match."
|
||||
describeIssue (CustomHttpSchemesDontMatch e a) =
|
||||
para $ "Expected HTTP scheme " <> code e <> " but got " <> code a <> "."
|
||||
describeIssue ConsumerDoesNotSupportImplicitFlow = para "Implicit flow not supported."
|
||||
describeIssue ConsumerDoesNotSupportPasswordFlow = para "Password flow not supported."
|
||||
describeIssue ConsumerDoesNotSupportClientCridentialsFlow = para "Client Cridentials flow not supported."
|
||||
describeIssue ConsumerDoesNotSupportAuthorizationCodeFlow = para "Authorization Code flow not supported."
|
||||
describeIssue SecuritySchemeNotMatched = para "Security scheme not met."
|
||||
describeIssue OAuth2ImplicitFlowNotEqual = para "Implicit Flows don't match."
|
||||
describeIssue OAuth2PasswordFlowNotEqual = para "Password Flows don't match."
|
||||
describeIssue OAuth2ClientCredentialsFlowNotEqual = para "Client Cridentials Flows don't match."
|
||||
describeIssue OAuth2AuthorizationCodeFlowNotEqual = para "Authorization Code Flows don't match."
|
||||
describeIssue (ScopesMissing ss) =
|
||||
para "Scopes missing:" <> 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
|
||||
= SecuritySchemeStep Text
|
||||
deriving stock (Eq, Ord, Show)
|
||||
describeBehaviour (SecuritySchemeStep s) = text s
|
||||
|
@ -3,7 +3,7 @@
|
||||
{-# OPTIONS_GHC -fconstraint-solver-iterations=0 #-}
|
||||
|
||||
module OpenAPI.Checker.Validate.OpenApi
|
||||
(
|
||||
( Behave (..)
|
||||
)
|
||||
where
|
||||
|
||||
|
@ -13,6 +13,7 @@ module OpenAPI.Checker.Validate.Operation
|
||||
, ProcessedPathItems (..)
|
||||
, processPathItems
|
||||
, Step (..)
|
||||
, Behave (..)
|
||||
)
|
||||
where
|
||||
|
||||
@ -27,6 +28,7 @@ import qualified Data.List as L
|
||||
import Data.Map.Strict as M
|
||||
import Data.Maybe
|
||||
import Data.OpenApi
|
||||
import Data.String
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
import OpenAPI.Checker.Behavior
|
||||
@ -36,11 +38,12 @@ import OpenAPI.Checker.Validate.MediaTypeObject
|
||||
import OpenAPI.Checker.Validate.OAuth2Flows
|
||||
import OpenAPI.Checker.Validate.PathFragment
|
||||
import OpenAPI.Checker.Validate.Products
|
||||
import OpenAPI.Checker.Validate.RequestBody ()
|
||||
import OpenAPI.Checker.Validate.Responses ()
|
||||
import OpenAPI.Checker.Validate.RequestBody
|
||||
import OpenAPI.Checker.Validate.Responses
|
||||
import OpenAPI.Checker.Validate.SecurityRequirement ()
|
||||
import OpenAPI.Checker.Validate.Server ()
|
||||
import OpenAPI.Checker.Validate.Sums
|
||||
import Text.Pandoc.Builder
|
||||
|
||||
data MatchedOperation = MatchedOperation
|
||||
{ operation :: !Operation
|
||||
@ -95,18 +98,24 @@ getServers env oper =
|
||||
instance Behavable 'OperationLevel 'PathFragmentLevel where
|
||||
data Behave 'OperationLevel 'PathFragmentLevel
|
||||
= InParam Text
|
||||
| InFragment Int
|
||||
| InFragment (PathFragment Text)
|
||||
deriving stock (Eq, Ord, Show)
|
||||
describeBehaviour (InParam p) = "Parameter " <> text p
|
||||
describeBehaviour (InFragment (StaticPath p)) = "Static fragment " <> code p
|
||||
describeBehaviour (InFragment (DynamicPath p)) = "Dynamic fragment " <> code p
|
||||
|
||||
instance Behavable 'OperationLevel 'RequestLevel where
|
||||
data Behave 'OperationLevel 'RequestLevel
|
||||
= InRequest
|
||||
deriving stock (Eq, Ord, Show)
|
||||
describeBehaviour InRequest = "Request"
|
||||
|
||||
instance Behavable 'OperationLevel 'SecurityRequirementLevel where
|
||||
data Behave 'OperationLevel 'SecurityRequirementLevel
|
||||
= SecurityRequirementStep Int
|
||||
deriving stock (Eq, Ord, Show)
|
||||
describeBehaviour (SecurityRequirementStep i) =
|
||||
"Security requirement " <> (text . T.pack . show $ i)
|
||||
|
||||
instance Subtree MatchedOperation where
|
||||
type SubtreeLevel MatchedOperation = 'OperationLevel
|
||||
@ -202,7 +211,8 @@ instance Subtree MatchedOperation where
|
||||
fragments = getFragments <$> pathParams <*> prodCons
|
||||
getFragments params mop = getPathFragments (extract mop) params
|
||||
-- Feed path parameters to the fragments getter
|
||||
check idx frags = checkCompatibility @PathFragmentParam env (beh >>> step (InFragment idx)) frags
|
||||
check _ frags@(ProdCons (Traced _ p) _) =
|
||||
checkCompatibility @PathFragmentParam env (beh >>> step (InFragment $ _paramName . extract <$> p)) frags
|
||||
elements =
|
||||
fragments <&> \frags -> M.fromList $
|
||||
zip [0 :: Int ..] $ do
|
||||
@ -348,12 +358,16 @@ 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 <> " did not match anything."
|
||||
describeIssue (AllPathsFailed p) = para $ "The path " <> (code . T.pack) p <> " did not match anything."
|
||||
|
||||
instance Behavable 'APILevel 'PathLevel where
|
||||
data Behave 'APILevel 'PathLevel
|
||||
= AtPath (ProdCons FilePath) -- TODO: why are there two?
|
||||
= AtPath FilePath
|
||||
deriving stock (Eq, Ord, Show)
|
||||
|
||||
describeBehaviour (AtPath p) = str (T.pack p)
|
||||
|
||||
instance Subtree ProcessedPathItems where
|
||||
type SubtreeLevel ProcessedPathItems = 'APILevel
|
||||
type
|
||||
@ -376,15 +390,16 @@ instance Subtree ProcessedPathItems where
|
||||
-- one way
|
||||
for_ (unProcessedPathItems . extract $ p) $ \prodItem -> do
|
||||
let prodPath = path prodItem
|
||||
beh' = beh >>> step (AtPath prodPath)
|
||||
matchedItems = do
|
||||
consItem <- unProcessedPathItems . extract $ c
|
||||
F.toList $ matchingPathItems $ ProdCons prodItem consItem
|
||||
case matchedItems of
|
||||
[] -> issueAt beh $ NoPathsMatched prodPath
|
||||
[match] -> checkCompatibility env (beh >>> step (AtPath $ matchedPath <$> match)) (retraced <$> pc <*> match)
|
||||
[match] -> checkCompatibility env beh' (retraced <$> pc <*> match)
|
||||
matches -> anyOfAt beh (AllPathsFailed prodPath) $ do
|
||||
match <- matches
|
||||
pure $ checkCompatibility env (beh >>> step (AtPath $ matchedPath <$> match)) (retraced <$> pc <*> match)
|
||||
pure $ checkCompatibility env beh' (retraced <$> pc <*> match)
|
||||
where
|
||||
retraced pc mpi = traced (ask pc >>> step (MatchedPathStep $ matchedPath mpi)) mpi
|
||||
|
||||
@ -429,7 +444,6 @@ tracedMatchedPathItemParameters mpi =
|
||||
| (i, x) <- L.zip [0 ..] $ _pathItemParameters . pathItem $ extract mpi
|
||||
]
|
||||
|
||||
-- TODO: simplify?
|
||||
tracedFragments :: Traced MatchedPathItem -> [Env (Trace PathFragmentParam) (PathFragment Text)]
|
||||
tracedFragments mpi =
|
||||
[ env (ask mpi >>> step (PathFragmentStep i)) x
|
||||
@ -447,12 +461,26 @@ instance Issuable 'PathLevel where
|
||||
= OperationMissing OperationMethod
|
||||
deriving stock (Eq, Ord, Show)
|
||||
issueIsUnsupported _ = False
|
||||
describeIssue (OperationMissing op) = para $ "Method " <> strong (showMethod op) <> " is not defined."
|
||||
|
||||
instance Behavable 'PathLevel 'OperationLevel where
|
||||
data Behave 'PathLevel 'OperationLevel
|
||||
= InOperation OperationMethod
|
||||
deriving (Eq, Ord, Show)
|
||||
|
||||
describeBehaviour (InOperation method) = showMethod method
|
||||
|
||||
showMethod :: IsString s => OperationMethod -> s
|
||||
showMethod = \case
|
||||
GetMethod -> "GET"
|
||||
PutMethod -> "PUT"
|
||||
PostMethod -> "POST"
|
||||
DeleteMethod -> "DELETE"
|
||||
OptionsMethod -> "OPTIONS"
|
||||
HeadMethod -> "HEAD"
|
||||
PatchMethod -> "PATCH"
|
||||
TraceMethod -> "TRACE"
|
||||
|
||||
instance Subtree MatchedPathItem where
|
||||
type SubtreeLevel MatchedPathItem = 'PathLevel
|
||||
type
|
||||
@ -550,6 +578,7 @@ instance Issuable 'CallbackLevel where
|
||||
deriving (Eq, Ord, Show)
|
||||
issueIsUnsupported = \case
|
||||
CallbacksUnsupported -> True
|
||||
describeIssue CallbacksUnsupported = para "OpenApi Diff does not currently support callbacks."
|
||||
|
||||
tracedCallbackPathItems :: Traced Callback -> Traced ProcessedPathItems
|
||||
tracedCallbackPathItems (Traced t (Callback x)) =
|
||||
@ -562,3 +591,5 @@ instance Steppable Callback ProcessedPathItems where
|
||||
instance Behavable 'OperationLevel 'CallbackLevel where
|
||||
data Behave 'OperationLevel 'CallbackLevel = OperationCallback Text
|
||||
deriving stock (Eq, Ord, Show)
|
||||
|
||||
describeBehaviour (OperationCallback key) = "Operation " <> code key
|
||||
|
@ -6,7 +6,7 @@ module OpenAPI.Checker.Validate.Param
|
||||
, Issue (..)
|
||||
) where
|
||||
|
||||
import Control.Lens
|
||||
import Control.Lens hiding (para)
|
||||
import Control.Monad
|
||||
import Data.Maybe
|
||||
import Data.OpenApi
|
||||
@ -15,6 +15,7 @@ import OpenAPI.Checker.Behavior
|
||||
import OpenAPI.Checker.Orphans ()
|
||||
import OpenAPI.Checker.Subtree
|
||||
import OpenAPI.Checker.Validate.Schema ()
|
||||
import Text.Pandoc.Builder
|
||||
|
||||
-- | The type is normalized encoding style of the parameter. If two encoding
|
||||
-- styles are equal then parameters are compatible with their encoding style
|
||||
@ -62,12 +63,21 @@ instance Issuable 'PathFragmentLevel where
|
||||
| PathFragmentsDontMatch Text Text
|
||||
deriving (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 "Expected the parameter to be optional, but it is 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 $ "Expected " <> code e <> " but got " <> code a <> "."
|
||||
|
||||
instance Behavable 'PathFragmentLevel 'SchemaLevel where
|
||||
data Behave 'PathFragmentLevel 'SchemaLevel
|
||||
= InParamSchema
|
||||
deriving (Eq, Ord, Show)
|
||||
|
||||
describeBehaviour InParamSchema = "JSON Schema"
|
||||
|
||||
instance Subtree Param where
|
||||
type SubtreeLevel Param = 'PathFragmentLevel
|
||||
type CheckEnv Param = '[ProdCons (Traced (Definitions Schema))]
|
||||
|
@ -32,7 +32,7 @@ parsePath = fmap partition . T.splitOn "/" . T.pack
|
||||
data PathFragment param
|
||||
= StaticPath Text
|
||||
| DynamicPath param
|
||||
deriving stock (Eq, Ord)
|
||||
deriving stock (Eq, Ord, Show, Functor)
|
||||
|
||||
type PathFragmentParam = PathFragment (Traced Param)
|
||||
|
||||
|
@ -2,6 +2,7 @@
|
||||
|
||||
module OpenAPI.Checker.Validate.RequestBody
|
||||
( Issue (..)
|
||||
, Behave (..)
|
||||
)
|
||||
where
|
||||
|
||||
@ -10,11 +11,13 @@ import Data.HashMap.Strict.InsOrd as IOHM
|
||||
import Data.Map.Strict as M
|
||||
import Data.Maybe
|
||||
import Data.OpenApi
|
||||
import qualified Data.Text as T
|
||||
import Network.HTTP.Media (MediaType)
|
||||
import OpenAPI.Checker.Behavior
|
||||
import OpenAPI.Checker.Subtree
|
||||
import OpenAPI.Checker.Validate.MediaTypeObject
|
||||
import OpenAPI.Checker.Validate.Sums
|
||||
import Text.Pandoc.Builder
|
||||
|
||||
-- TODO: Use RequestMediaTypeObjectMapping
|
||||
tracedContent :: Traced RequestBody -> IOHM.InsOrdHashMap MediaType (Traced MediaTypeObject)
|
||||
@ -28,11 +31,16 @@ instance Issuable 'RequestLevel where
|
||||
| RequestMediaTypeNotFound MediaType
|
||||
deriving stock (Eq, Ord, Show)
|
||||
issueIsUnsupported _ = False
|
||||
describeIssue RequestBodyRequired =
|
||||
para "Expected the request body to be optional, but found it to be required."
|
||||
describeIssue (RequestMediaTypeNotFound t) =
|
||||
para $ "Couldn't find a request body for media type " <> (code . T.pack . show $ t) <> "."
|
||||
|
||||
instance Behavable 'RequestLevel 'PayloadLevel where
|
||||
data Behave 'RequestLevel 'PayloadLevel
|
||||
= InPayload
|
||||
deriving stock (Eq, Ord, Show)
|
||||
describeBehaviour InPayload = "Payload"
|
||||
|
||||
instance Subtree RequestBody where
|
||||
type SubtreeLevel RequestBody = 'RequestLevel
|
||||
|
@ -2,7 +2,7 @@
|
||||
{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
|
||||
|
||||
module OpenAPI.Checker.Validate.Responses
|
||||
(
|
||||
( Behave (..)
|
||||
)
|
||||
where
|
||||
|
||||
@ -11,6 +11,7 @@ import Data.HashMap.Strict.InsOrd as IOHM
|
||||
import Data.Map.Strict as M
|
||||
import Data.Maybe
|
||||
import Data.OpenApi
|
||||
import qualified Data.Text as T
|
||||
import Network.HTTP.Media (MediaType)
|
||||
import OpenAPI.Checker.Behavior
|
||||
import OpenAPI.Checker.References
|
||||
@ -21,6 +22,7 @@ import OpenAPI.Checker.Validate.MediaTypeObject
|
||||
import OpenAPI.Checker.Validate.Products
|
||||
import OpenAPI.Checker.Validate.Schema ()
|
||||
import OpenAPI.Checker.Validate.Sums
|
||||
import Text.Pandoc.Builder
|
||||
|
||||
tracedResponses :: Traced Responses -> IOHM.InsOrdHashMap HttpStatusCode (Traced (Referenced Response))
|
||||
tracedResponses resp =
|
||||
@ -70,17 +72,25 @@ instance Issuable 'ResponseLevel where
|
||||
| ResponseHeaderMissing HeaderName
|
||||
deriving stock (Eq, Ord, Show)
|
||||
issueIsUnsupported _ = False
|
||||
describeIssue (ResponseMediaTypeMissing t) =
|
||||
para $ "Couldn't find reponse for media type " <> (code . T.pack . show $ t) <> "."
|
||||
describeIssue (ResponseHeaderMissing h) =
|
||||
para $ "Couldn't find header " <> code h <> "."
|
||||
|
||||
instance Behavable 'ResponseLevel 'PayloadLevel where
|
||||
data Behave 'ResponseLevel 'PayloadLevel
|
||||
= ResponsePayload
|
||||
deriving stock (Eq, Ord, Show)
|
||||
|
||||
describeBehaviour ResponsePayload = "Payload"
|
||||
|
||||
instance Behavable 'ResponseLevel 'HeaderLevel where
|
||||
data Behave 'ResponseLevel 'HeaderLevel
|
||||
= InHeader HeaderName
|
||||
deriving stock (Eq, Ord, Show)
|
||||
|
||||
describeBehaviour (InHeader name) = "Header " <> code name
|
||||
|
||||
instance Subtree Response where
|
||||
type SubtreeLevel Response = 'ResponseLevel
|
||||
type
|
||||
|
@ -17,12 +17,13 @@ import Algebra.Lattice
|
||||
import Control.Applicative
|
||||
import Control.Arrow
|
||||
import Control.Comonad.Env hiding (env)
|
||||
import Control.Lens hiding (cons)
|
||||
import Control.Lens hiding (cons, para)
|
||||
import Control.Monad.Reader hiding (ask)
|
||||
import qualified Control.Monad.Reader as R
|
||||
import Control.Monad.State
|
||||
import Control.Monad.Writer
|
||||
import qualified Data.Aeson as A
|
||||
import qualified Data.ByteString.Lazy as BSL
|
||||
import Data.Coerce
|
||||
import qualified Data.Foldable as F
|
||||
import Data.HList
|
||||
@ -40,8 +41,8 @@ import Data.Scientific
|
||||
import qualified Data.Set as S
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as T hiding (singleton)
|
||||
import qualified Data.Text.Encoding as T
|
||||
import Data.Typeable
|
||||
import Text.Regex.Pcre2
|
||||
import OpenAPI.Checker.Behavior
|
||||
import OpenAPI.Checker.Memo
|
||||
import OpenAPI.Checker.Orphans ()
|
||||
@ -49,6 +50,8 @@ import OpenAPI.Checker.Paths
|
||||
import qualified OpenAPI.Checker.PathsPrefixTree as P
|
||||
import OpenAPI.Checker.References
|
||||
import OpenAPI.Checker.Subtree
|
||||
import Text.Pandoc.Builder hiding (Format, Null)
|
||||
import Text.Regex.Pcre2
|
||||
|
||||
-- | Type of a JSON value
|
||||
data JsonType
|
||||
@ -84,7 +87,7 @@ untypeValue (TArray a) = A.Array a
|
||||
untypeValue (TObject o) = A.Object o
|
||||
|
||||
data Bound a = Exclusive !a | Inclusive !a
|
||||
deriving (Eq, Show)
|
||||
deriving (Eq, Show, Functor)
|
||||
|
||||
-- | The order is lexicographical on @a * Bool@.
|
||||
instance Ord a => Ord (Bound a) where
|
||||
@ -128,6 +131,45 @@ data Condition :: JsonType -> Type where
|
||||
MaxProperties :: !Integer -> Condition 'Object
|
||||
MinProperties :: !Integer -> Condition 'Object
|
||||
|
||||
showCondition :: Condition a -> Blocks
|
||||
showCondition = \case
|
||||
(Exactly v) -> para "The value should be:" <> showJSONValue (untypeValue v)
|
||||
(Maximum b) -> para $ "The value should be less than " <> showBound b <> "."
|
||||
(Minimum (Down b)) -> para $ "The value should be more than " <> showBound (getDown <$> b) <> "."
|
||||
(MultipleOf n) -> para $ "The value should be a multiple of " <> show' n <> "."
|
||||
(NumberFormat p) -> para $ "The number should have the following format:" <> code p <> "."
|
||||
(Pattern p) -> para "The value should satisfy the following pattern (regular expression):" <> codeBlock p
|
||||
(StringFormat p) -> para $ "The string should have the following format:" <> code p <> "."
|
||||
(MaxLength p) -> para $ "The length of the string should be less than or equal to " <> show' p <> "."
|
||||
(MinLength p) -> para $ "The length of the string should be more than or equal to " <> show' p <> "."
|
||||
(Items i _) -> para "The items of the array should satisfy:" <> showForEachJsonFormula i
|
||||
(MaxItems n) -> para $ "The length of the array should be less than or equal to " <> show' n <> "."
|
||||
(MinItems n) -> para $ "The length of the array should be more than or equal to " <> show' n <> "."
|
||||
UniqueItems -> para "The elements in the array should be unique."
|
||||
(Properties props additional _) ->
|
||||
bulletList $
|
||||
(M.toList props
|
||||
<&> (\(k, p) ->
|
||||
para (code k)
|
||||
<> para (strong $ if propRequired p then "Required" else "Optional")
|
||||
<> showForEachJsonFormula (propFormula p)))
|
||||
<> [ para (emph "Additional properties")
|
||||
<> showForEachJsonFormula additional
|
||||
]
|
||||
(MaxProperties n) -> para $ "The maximum number of fields should be " <> show' n <> "."
|
||||
(MinProperties n) -> para $ "The minimum number of fields should be " <> show' n <> "."
|
||||
where
|
||||
showForEachJsonFormula :: ForeachType JsonFormula -> Blocks
|
||||
showForEachJsonFormula i =
|
||||
bulletList $
|
||||
foldType
|
||||
(\t f ->
|
||||
let (DNF conds') = f i
|
||||
conds = S.toList <$> S.toList conds'
|
||||
in [ para (describeJSONType t)
|
||||
<> bulletList (conds <&> \cond -> bulletList (showCondition <$> cond))
|
||||
])
|
||||
|
||||
satisfiesTyped :: TypedValue t -> Condition t -> Bool
|
||||
satisfiesTyped e (Exactly e') = e == e'
|
||||
satisfiesTyped (TNumber n) (Maximum (Exclusive m)) = n < m
|
||||
@ -363,10 +405,6 @@ instance
|
||||
, forObject = top
|
||||
}
|
||||
|
||||
instance Behavable 'SchemaLevel 'SchemaLevel where
|
||||
data Behave 'SchemaLevel 'SchemaLevel
|
||||
deriving (Eq, Ord, Show)
|
||||
|
||||
instance Steppable Schema (Referenced Schema) where
|
||||
data Step Schema (Referenced Schema)
|
||||
= AllOfStep Int
|
||||
@ -427,7 +465,8 @@ silently m = do
|
||||
pure . runSilent $ runReaderT m defs
|
||||
|
||||
warnKnot :: MonadProcess m => KnotTier (ForeachType JsonFormula) () m
|
||||
warnKnot = KnotTier
|
||||
warnKnot =
|
||||
KnotTier
|
||||
{ onKnotFound = warn UnguardedRecursion
|
||||
, onKnotUsed = \_ -> pure bottom
|
||||
, tieKnot = \_ -> pure
|
||||
@ -835,19 +874,19 @@ checkImplication env beh prods cons = case findExactly prods of
|
||||
Just m' ->
|
||||
if m' <= m
|
||||
then pure ()
|
||||
else issueAt beh (MatchingMaximumWeak m m')
|
||||
else issueAt beh (MatchingMaximumWeak $ ProdCons {producer = m', consumer = m})
|
||||
Nothing -> issueAt beh (NoMatchingMaximum m)
|
||||
Minimum m -> case findRelevant max (\case Minimum m' -> Just m'; _ -> Nothing) prods of
|
||||
Just m' ->
|
||||
if m' >= m
|
||||
then pure ()
|
||||
else issueAt beh (MatchingMinimumWeak (coerce m) (coerce m'))
|
||||
else issueAt beh (MatchingMinimumWeak ProdCons {producer = coerce m', consumer = coerce m})
|
||||
Nothing -> issueAt beh (NoMatchingMinimum (coerce m))
|
||||
MultipleOf m -> case findRelevant lcmScientific (\case MultipleOf m' -> Just m'; _ -> Nothing) prods of
|
||||
Just m' ->
|
||||
if lcmScientific m m' == m'
|
||||
then pure ()
|
||||
else issueAt beh (MatchingMultipleOfWeak m m')
|
||||
else issueAt beh (MatchingMultipleOfWeak $ ProdCons {producer = m', consumer = m})
|
||||
Nothing -> issueAt beh (NoMatchingMultipleOf m)
|
||||
NumberFormat f ->
|
||||
if any (\case NumberFormat f' -> f == f'; _ -> False) prods
|
||||
@ -857,13 +896,13 @@ checkImplication env beh prods cons = case findExactly prods of
|
||||
Just m' ->
|
||||
if m' <= m
|
||||
then pure ()
|
||||
else issueAt beh (MatchingMaxLengthWeak m m')
|
||||
else issueAt beh (MatchingMaxLengthWeak $ ProdCons {producer = m', consumer = m})
|
||||
Nothing -> issueAt beh (NoMatchingMaxLength m)
|
||||
MinLength m -> case findRelevant max (\case MinLength m' -> Just m'; _ -> Nothing) prods of
|
||||
Just m' ->
|
||||
if m' >= m
|
||||
then pure ()
|
||||
else issueAt beh (MatchingMinLengthWeak m m')
|
||||
else issueAt beh (MatchingMinLengthWeak $ ProdCons {producer = m', consumer = m})
|
||||
Nothing -> issueAt beh (NoMatchingMinLength m)
|
||||
Pattern p ->
|
||||
if any (\case Pattern p' -> p == p'; _ -> False) prods
|
||||
@ -883,20 +922,22 @@ checkImplication env beh prods cons = case findExactly prods of
|
||||
Just m' ->
|
||||
if m' <= m
|
||||
then pure ()
|
||||
else issueAt beh (MatchingMaxItemsWeak m m')
|
||||
else issueAt beh (MatchingMaxItemsWeak ProdCons {producer = m', consumer = m})
|
||||
Nothing -> issueAt beh (NoMatchingMaxItems m)
|
||||
MinItems m -> case findRelevant max (\case MinItems m' -> Just m'; _ -> Nothing) prods of
|
||||
Just m' ->
|
||||
if m' >= m
|
||||
then pure ()
|
||||
else issueAt beh (MatchingMinItemsWeak m m')
|
||||
else issueAt beh (MatchingMinItemsWeak ProdCons {producer = m', consumer = m})
|
||||
Nothing -> issueAt beh (NoMatchingMinItems m)
|
||||
UniqueItems ->
|
||||
if any (== UniqueItems) $ prods
|
||||
then pure ()
|
||||
else issueAt beh NoMatchingUniqueItems
|
||||
Properties props _ madd -> case findRelevant (<>) (\case Properties props' _ madd' -> Just $ (props', madd') NE.:| []; _ -> Nothing) prods of
|
||||
Just pm -> anyOfAt beh NoMatchingProperties $ NE.toList pm <&> \(props', madd') -> do
|
||||
Just pm ->
|
||||
anyOfAt beh NoMatchingProperties $
|
||||
NE.toList pm <&> \(props', madd') -> do
|
||||
F.for_ (S.fromList $ M.keys props <> M.keys props') $ \k -> do
|
||||
let go sch sch' = checkCompatibility env (beh >>> step (InProperty k)) (ProdCons sch sch')
|
||||
case (M.lookup k props', madd', M.lookup k props, madd) of
|
||||
@ -920,13 +961,13 @@ checkImplication env beh prods cons = case findExactly prods of
|
||||
Just m' ->
|
||||
if m' <= m
|
||||
then pure ()
|
||||
else issueAt beh (MatchingMaxPropertiesWeak m m')
|
||||
else issueAt beh (MatchingMaxPropertiesWeak ProdCons {producer = m', consumer = m})
|
||||
Nothing -> issueAt beh (NoMatchingMaxProperties m)
|
||||
MinProperties m -> case findRelevant max (\case MinProperties m' -> Just m'; _ -> Nothing) prods of
|
||||
Just m' ->
|
||||
if m' >= m
|
||||
then pure ()
|
||||
else issueAt beh (MatchingMinPropertiesWeak m m')
|
||||
else issueAt beh (MatchingMinPropertiesWeak ProdCons {producer = m', consumer = m})
|
||||
Nothing -> issueAt beh (NoMatchingMinProperties m)
|
||||
where
|
||||
findExactly (Exactly x : _) = Just x
|
||||
@ -939,85 +980,145 @@ checkImplication env beh prods cons = case findExactly prods of
|
||||
|
||||
instance Issuable 'TypedSchemaLevel where
|
||||
data Issue 'TypedSchemaLevel
|
||||
= EnumDoesntSatisfy A.Value
|
||||
-- ^ producer produces a specific value ($1), consumer has a condition that is not satisfied by said value
|
||||
| NoMatchingEnum A.Value
|
||||
-- ^ producer produces a specific value ($1) which is not listed in the consumer's list of specific values
|
||||
| NoMatchingMaximum (Bound Scientific)
|
||||
-- ^ producer declares a maximum numeric value ($1), consumer doesnt
|
||||
| MatchingMaximumWeak (Bound Scientific) (Bound Scientific)
|
||||
-- ^ producer declares a maximum numeric value ($1), consumer declares a weaker (higher) limit ($2)
|
||||
| NoMatchingMinimum (Bound Scientific)
|
||||
-- ^ producer declares a minimum numeric value, consumer doesnt
|
||||
| MatchingMinimumWeak (Bound Scientific) (Bound Scientific)
|
||||
-- ^ producer declares a minimum numeric value ($1), consumer declares a weaker (lower) limit ($2)
|
||||
| NoMatchingMultipleOf Scientific
|
||||
-- ^ producer declares that the numeric value must be a multiple of $1, consumer doesn't
|
||||
| MatchingMultipleOfWeak Scientific Scientific
|
||||
-- ^ producer declares that the numeric value must be a multiple of $1, consumer declares a weaker condition (multiple of $2)
|
||||
| NoMatchingFormat Format
|
||||
-- ^ producer declares a string/number format, consumer declares none or a different format (TODO: improve via regex #32)
|
||||
| NoMatchingMaxLength Integer
|
||||
-- ^ producer declares a maximum length of the string ($1), consumer doesn't.
|
||||
| MatchingMaxLengthWeak Integer Integer
|
||||
-- ^ producer declares a maximum length of the string ($1), consumer declares a weaker (higher) limit ($2)
|
||||
| NoMatchingMinLength Integer
|
||||
-- ^ producer declares a minimum length of the string ($1), consumer doesn't.
|
||||
| MatchingMinLengthWeak Integer Integer
|
||||
-- ^ producer declares a minimum length of the string ($1), consumer declares a weaker (lower) limit ($2)
|
||||
| NoMatchingPattern Pattern
|
||||
-- ^ producer declares the string value must matrix a regex ($1), consumer doesn't declare or declares different regex (TODO: #32)
|
||||
| NoMatchingItems
|
||||
-- ^ producer declares the items of an array must satisfy some condition, consumer doesn't
|
||||
| NoMatchingMaxItems Integer
|
||||
-- ^ producer declares a maximum length of the array ($1), consumer doesn't.
|
||||
| MatchingMaxItemsWeak Integer Integer
|
||||
-- ^ producer declares a maximum length of the array ($1), consumer declares a weaker (higher) limit ($2)
|
||||
| NoMatchingMinItems Integer
|
||||
-- ^ producer declares a minimum length of the array ($1), consumer doesn't.
|
||||
| MatchingMinItemsWeak Integer Integer
|
||||
-- ^ producer declares a minimum length of the array ($1), consumer declares a weaker (lower) limit ($2)
|
||||
| NoMatchingUniqueItems
|
||||
-- ^ producer declares that items must be unique, consumer doesn't
|
||||
| NoMatchingProperties
|
||||
-- ^ producer declares the properties of an object must satisfy some condition, consumer doesn't
|
||||
| UnexpectedProperty Text
|
||||
-- ^ producer allows a property that is not allowed in the consumer
|
||||
| PropertyNowRequired Text
|
||||
-- ^ consumer requires a property that is not required/allowed in the consumer
|
||||
| NoAdditionalProperties
|
||||
-- ^ producer allows additional properties, consumer doesn't
|
||||
| NoMatchingMaxProperties Integer
|
||||
-- ^ producer declares a maximum number of properties in the object ($1), consumer doesn't.
|
||||
| MatchingMaxPropertiesWeak Integer Integer
|
||||
-- ^ producer declares a maximum number of properties in the object ($1), consumer declares a weaker (higher) limit ($2)
|
||||
| NoMatchingMinProperties Integer
|
||||
-- ^ producer declares a minimum number of properties in the object ($1), consumer doesn't.
|
||||
| MatchingMinPropertiesWeak Integer Integer
|
||||
-- ^ producer declares a minimum number of properties in the object ($1), consumer declares a weaker (lower) limit ($2)
|
||||
| NoMatchingCondition [SomeCondition]
|
||||
-- ^ 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)
|
||||
| NoContradiction
|
||||
-- ^ producer indicates that values of this type are now allowed, but the consumer does not do so (currently we only check immediate contradictions, c.f. #70)
|
||||
= -- | producer produces a specific value ($1), consumer has a condition that is not satisfied by said value
|
||||
EnumDoesntSatisfy A.Value
|
||||
| -- | consumer only expects a specific value which the producer does not produce.
|
||||
NoMatchingEnum A.Value
|
||||
| -- | consumer declares a maximum numeric value ($1), producer doesn't
|
||||
NoMatchingMaximum (Bound Scientific)
|
||||
| -- | consumer declares a maximum numeric value ($1), producer declares a weaker (higher) limit ($2)
|
||||
MatchingMaximumWeak (ProdCons (Bound Scientific))
|
||||
| -- | consumer declares a minimum numeric value, producer doesn't
|
||||
NoMatchingMinimum (Bound Scientific)
|
||||
| -- | consumer declares a minimum numeric value ($1), producer declares a weaker (lower) limit ($2)
|
||||
MatchingMinimumWeak (ProdCons (Bound Scientific))
|
||||
| -- | consumer declares that the numeric value must be a multiple of $1, producer doesn't
|
||||
NoMatchingMultipleOf Scientific
|
||||
| -- | consumer declares that the numeric value must be a multiple of $1, producer declares a weaker condition (multiple of $2)
|
||||
MatchingMultipleOfWeak (ProdCons Scientific)
|
||||
| -- | consumer declares a string/number format, producer declares none or a different format (TODO: improve via regex #32)
|
||||
NoMatchingFormat Format
|
||||
| -- | consumer declares a maximum length of the string ($1), producer doesn't.
|
||||
NoMatchingMaxLength Integer
|
||||
| -- | consumer declares a maximum length of the string ($1), producer declares a weaker (higher) limit ($2)
|
||||
MatchingMaxLengthWeak (ProdCons Integer)
|
||||
| -- | consumer declares a minimum length of the string ($1), producer doesn't.
|
||||
NoMatchingMinLength Integer
|
||||
| -- | consumer declares a minimum length of the string ($1), producer declares a weaker (lower) limit ($2)
|
||||
MatchingMinLengthWeak (ProdCons Integer)
|
||||
| -- | consumer declares the string value must matrix a regex ($1), producer doesn't declare or declares different regex (TODO: #32)
|
||||
NoMatchingPattern Pattern
|
||||
| -- | consumer declares the items of an array must satisfy some condition, producer doesn't
|
||||
NoMatchingItems
|
||||
| -- | consumer declares a maximum length of the array ($1), producer doesn't.
|
||||
NoMatchingMaxItems Integer
|
||||
| -- | consumer declares a maximum length of the array ($1), producer declares a weaker (higher) limit ($2)
|
||||
MatchingMaxItemsWeak (ProdCons Integer)
|
||||
| -- | consumer declares a minimum length of the array ($1), producer doesn't.
|
||||
NoMatchingMinItems Integer
|
||||
| -- | consumer declares a minimum length of the array ($1), producer declares a weaker (lower) limit ($2)
|
||||
MatchingMinItemsWeak (ProdCons Integer)
|
||||
| -- | consumer declares that items must be unique, producer doesn't
|
||||
NoMatchingUniqueItems
|
||||
| -- | consumer declares the properties of an object must satisfy some condition, producer doesn't
|
||||
NoMatchingProperties
|
||||
| -- | producer allows a property that is not allowed in the consumer
|
||||
UnexpectedProperty Text
|
||||
| -- | consumer requires a property that is not required/allowed in the producer
|
||||
PropertyNowRequired Text
|
||||
| -- | producer allows additional properties, consumer doesn't
|
||||
NoAdditionalProperties
|
||||
| -- | consumer declares a maximum number of properties in the object ($1), producer doesn't.
|
||||
NoMatchingMaxProperties Integer
|
||||
| -- | consumer declares a maximum number of properties in the object ($1), producer declares a weaker (higher) limit ($2)
|
||||
MatchingMaxPropertiesWeak (ProdCons Integer)
|
||||
| -- | consumer declares a minimum number of properties in the object ($1), producer doesn't.
|
||||
NoMatchingMinProperties Integer
|
||||
| -- | consumer declares a minimum number of properties in the object ($1), producer declares a weaker (lower) limit ($2)
|
||||
MatchingMinPropertiesWeak (ProdCons Integer)
|
||||
| -- | 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)
|
||||
NoMatchingCondition [SomeCondition]
|
||||
| -- | 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)
|
||||
NoContradiction
|
||||
deriving stock (Eq, Ord, Show)
|
||||
issueIsUnsupported _ = False
|
||||
describeIssue (EnumDoesntSatisfy v) = para "The following enum value will yield an error:" <> showJSONValue v
|
||||
describeIssue (NoMatchingEnum v) = para "The following enum value is not supported:" <> showJSONValue v
|
||||
describeIssue (NoMatchingMaximum b) = para $ "Unexpected upper bound " <> showBound b <> "."
|
||||
describeIssue (MatchingMaximumWeak (ProdCons p c)) = para $ "Expected upper bound " <> showBound p <> " but but found " <> showBound c <> "."
|
||||
describeIssue (NoMatchingMinimum b) = para $ "Unexpected lower bound " <> showBound b <> "."
|
||||
describeIssue (MatchingMinimumWeak (ProdCons p c)) = para $ "Expected lower bound " <> showBound p <> " but but found " <> showBound c <> "."
|
||||
describeIssue (NoMatchingMultipleOf n) = para $ "Didn't expect the value to be a multiple of " <> show' n <> " but it was."
|
||||
describeIssue (MatchingMultipleOfWeak (ProdCons p c)) = para $ "Expected the value to be a multiple of " <> show' p <> " but found a multiple of " <> show' c <> "."
|
||||
describeIssue (NoMatchingFormat f) = para $ "Unexpected format: " <> code f <> "."
|
||||
describeIssue (NoMatchingMaxLength n) = para $ "Unexpected maximum length of the string " <> show' n <> "."
|
||||
describeIssue (MatchingMaxLengthWeak (ProdCons p c)) = para $ "Expected the maximum length of the string to be " <> show' p <> "but it was " <> show' c <> "."
|
||||
describeIssue (NoMatchingMinLength n) = para $ "Unexpected minimum length of the string " <> show' n <> "."
|
||||
describeIssue (MatchingMinLengthWeak (ProdCons p c)) = para $ "Expected the minimum length of the string to be " <> show' p <> "but it was " <> show' c <> "."
|
||||
describeIssue (NoMatchingPattern p) = para "Unexpected pattern (regular expression): " <> codeBlock p
|
||||
describeIssue NoMatchingItems = para "Couldn't find any matching items."
|
||||
describeIssue (NoMatchingMaxItems n) = para $ "Unexpected maximum length of the array " <> show' n <> "."
|
||||
describeIssue (MatchingMaxItemsWeak (ProdCons p c)) = para $ "Expected the maximum length of the array to be " <> show' p <> "but it was " <> show' c <> "."
|
||||
describeIssue (NoMatchingMinItems n) = para $ "Unexpected minimum length of the array " <> show' n <> "."
|
||||
describeIssue (MatchingMinItemsWeak (ProdCons p c)) = para $ "Expected the minimum length of the array to be " <> show' p <> "but it was " <> show' c <> "."
|
||||
describeIssue NoMatchingUniqueItems = para "Didn't expect the items to be unique, but they were."
|
||||
describeIssue NoMatchingProperties = para "Couldn't find matching properties."
|
||||
describeIssue (UnexpectedProperty p) = para $ "Expected the property " <> code p <> " to be allowed, but it wasn't."
|
||||
describeIssue (PropertyNowRequired p) = para $ "Don't have a required property " <> code p <> "."
|
||||
describeIssue NoAdditionalProperties = para "Expected additional properties to be allowed, but they weren't."
|
||||
describeIssue (NoMatchingMaxProperties n) = para $ "Unexpected maximum number of properties " <> show' n <> "."
|
||||
describeIssue (MatchingMaxPropertiesWeak (ProdCons p c)) = para $ "Expected the maximum number of properties to be " <> show' p <> "but it was " <> show' c <> "."
|
||||
describeIssue (NoMatchingMinProperties n) = para $ "Unexpected minimum number of properties " <> show' n <> "."
|
||||
describeIssue (MatchingMinPropertiesWeak (ProdCons p c)) = para $ "Expected the minimum number of properties to be " <> show' p <> "but it was " <> show' c <> "."
|
||||
describeIssue (NoMatchingCondition conds) =
|
||||
para "Expected the following conditions to hold, but they didn't:"
|
||||
<> bulletList ((\(SomeCondition c) -> showCondition c) <$> conds)
|
||||
describeIssue NoContradiction = para "Expected the type to be allowed, but it wasn't."
|
||||
|
||||
showJSONValue :: A.Value -> Blocks
|
||||
showJSONValue v = codeBlockWith ("", ["json"], mempty) (T.decodeUtf8 . BSL.toStrict . A.encode $ v)
|
||||
|
||||
showBound :: Show a => Bound a -> Inlines
|
||||
showBound (Inclusive x) = show' x <> " inclusive"
|
||||
showBound (Exclusive x) = show' x <> " exclusive"
|
||||
|
||||
show' :: Show x => x -> Inlines
|
||||
show' = str . T.pack . show
|
||||
|
||||
instance Issuable 'SchemaLevel where
|
||||
data Issue 'SchemaLevel
|
||||
= NotSupported Text
|
||||
-- ^ Some (openapi-supported) feature that we do not support was encountered in the schema
|
||||
| InvalidSchema Text
|
||||
-- ^ The schema is actually invalid
|
||||
| UnguardedRecursion
|
||||
-- ^ The schema contains a reference loop along "anyOf"/"allOf"/"oneOf".
|
||||
= -- | Some (openapi-supported) feature that we do not support was encountered in the schema
|
||||
NotSupported Text
|
||||
| -- | The schema is actually invalid
|
||||
InvalidSchema Text
|
||||
| -- | The schema contains a reference loop along "anyOf"/"allOf"/"oneOf".
|
||||
UnguardedRecursion
|
||||
deriving stock (Eq, Ord, Show)
|
||||
issueIsUnsupported _ = True
|
||||
|
||||
describeIssue (NotSupported i) =
|
||||
para (emph "Encountered a feature that OpenApi Diff does not support: " <> text i <> ".")
|
||||
describeIssue (InvalidSchema i) =
|
||||
para (emph "The schema is invalid: " <> text i <> ".")
|
||||
describeIssue UnguardedRecursion =
|
||||
para "Encountered recursion that is too complex for OpenApi Diff to untangle."
|
||||
|
||||
instance Behavable 'SchemaLevel 'TypedSchemaLevel where
|
||||
data Behave 'SchemaLevel 'TypedSchemaLevel
|
||||
= OfType JsonType
|
||||
deriving stock (Eq, Ord, Show)
|
||||
|
||||
describeBehaviour (OfType t) = describeJSONType t
|
||||
|
||||
describeJSONType :: JsonType -> Inlines
|
||||
describeJSONType = \case
|
||||
Null -> "Null"
|
||||
Boolean -> "Boolean"
|
||||
Number -> "Number"
|
||||
String -> "String"
|
||||
Array -> "Array"
|
||||
Object -> "Object"
|
||||
|
||||
instance Behavable 'TypedSchemaLevel 'SchemaLevel where
|
||||
data Behave 'TypedSchemaLevel 'SchemaLevel
|
||||
= InItems
|
||||
@ -1025,6 +1126,10 @@ instance Behavable 'TypedSchemaLevel 'SchemaLevel where
|
||||
| InAdditionalProperty
|
||||
deriving stock (Eq, Ord, Show)
|
||||
|
||||
describeBehaviour InItems = "Items"
|
||||
describeBehaviour (InProperty p) = "Property " <> code p
|
||||
describeBehaviour InAdditionalProperty = "Additional properties"
|
||||
|
||||
instance Subtree Schema where
|
||||
type SubtreeLevel Schema = 'SchemaLevel
|
||||
type CheckEnv Schema = '[ProdCons (Traced (Definitions Schema))]
|
||||
|
@ -28,6 +28,7 @@ import OpenAPI.Checker.Common
|
||||
import OpenAPI.Checker.Paths
|
||||
import OpenAPI.Checker.Subtree
|
||||
import OpenAPI.Checker.Validate.MediaTypeObject
|
||||
import Text.Pandoc.Builder
|
||||
import Prelude as P
|
||||
|
||||
tracedParsedServerUrlParts
|
||||
@ -45,6 +46,8 @@ instance Behavable 'OperationLevel 'ServerLevel where
|
||||
= InServer Text
|
||||
deriving stock (Eq, Ord, Show)
|
||||
|
||||
describeBehaviour (InServer n) = "Server " <> code n
|
||||
|
||||
instance Subtree [Server] where
|
||||
type SubtreeLevel [Server] = 'OperationLevel
|
||||
type CheckEnv [Server] = '[]
|
||||
@ -131,6 +134,13 @@ instance Issuable 'ServerLevel where
|
||||
| ServerNotMatched
|
||||
deriving stock (Eq, Ord, Show)
|
||||
issueIsUnsupported _ = False
|
||||
describeIssue (EnumValueNotConsumed _ v) =
|
||||
para $ "Enum value " <> code v <> " is not supported."
|
||||
describeIssue (ConsumerNotOpen _) =
|
||||
para $ "Expected a variable to be open (any value), but it wasn't."
|
||||
describeIssue (ServerVariableNotDefined k) =
|
||||
para $ "Variable " <> code k <> " is not defined."
|
||||
describeIssue ServerNotMatched = para $ "Couldn't find a matching server."
|
||||
|
||||
instance Subtree ProcessedServer where
|
||||
type SubtreeLevel ProcessedServer = 'ServerLevel
|
||||
|
@ -1 +1 @@
|
||||
resolver: lts-17.12
|
||||
resolver: nightly-2021-06-01
|
||||
|
@ -6,7 +6,7 @@
|
||||
packages: []
|
||||
snapshots:
|
||||
- completed:
|
||||
size: 567669
|
||||
url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/17/12.yaml
|
||||
sha256: facf6cac73b22a83ca955b580a98a7a09ed71f8f974c7a55d28e608c23e689a9
|
||||
original: lts-17.12
|
||||
size: 587963
|
||||
url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/nightly/2021/6/1.yaml
|
||||
sha256: 6f13285c82266d1d06f7f68366a5190dcbc6758ae8806813005cf56daa6bb9be
|
||||
original: nightly-2021-06-01
|
||||
|
@ -9,8 +9,4 @@ main = defaultMain =<< tests
|
||||
tests :: IO TestTree
|
||||
tests = do
|
||||
goldenReportTree <- Spec.Golden.TraceTree.tests
|
||||
return . localOption (mkTimeout 1000000) $
|
||||
testGroup
|
||||
"Golden tests"
|
||||
[ goldenReportTree
|
||||
]
|
||||
return . localOption (mkTimeout 1000000) $ goldenReportTree
|
||||
|
@ -8,15 +8,11 @@ where
|
||||
|
||||
import Control.Lens
|
||||
import Control.Monad
|
||||
import Data.Aeson hiding (Result)
|
||||
import qualified Data.ByteString.Lazy as BSL
|
||||
import qualified Data.Yaml as Yaml
|
||||
import OpenAPI.Checker.Subtree
|
||||
import System.Directory
|
||||
import System.FilePath
|
||||
import Test.Tasty
|
||||
import Test.Tasty.Golden
|
||||
import Test.Tasty.Providers
|
||||
|
||||
data TestInput t
|
||||
= TestInputNode TestName [TestInput t]
|
||||
@ -54,62 +50,40 @@ getGoldenInputsUniform
|
||||
getGoldenInputsUniform name f filepath inp = getGoldenInputs name filepath $ inp & each %~ (,f)
|
||||
|
||||
goldenInputsTree
|
||||
:: (Each s t (FilePath, FilePath -> IO a) a, ToJSON x, HasUnsupportedFeature x)
|
||||
:: (Each s t (FilePath, FilePath -> IO a) a)
|
||||
=> TestName
|
||||
-> FilePath -- ^ Root path
|
||||
-> FilePath -- ^ Name of golden file
|
||||
-> s
|
||||
-> (t -> x)
|
||||
-> (t -> IO BSL.ByteString)
|
||||
-> IO TestTree
|
||||
goldenInputsTree name filepath golden inp f = do
|
||||
runTestInputTree golden f <$> getGoldenInputs name filepath inp
|
||||
|
||||
runTestInputTree
|
||||
:: (ToJSON x, HasUnsupportedFeature x)
|
||||
=> FilePath
|
||||
-> (t -> x)
|
||||
:: FilePath
|
||||
-> (t -> IO BSL.ByteString)
|
||||
-> TestInput t
|
||||
-> TestTree
|
||||
runTestInputTree golden f (TestInputNode name rest) =
|
||||
testGroup name (runTestInputTree golden f <$> rest)
|
||||
runTestInputTree golden f (TestInputLeaf name t path)
|
||||
| testSupported name =
|
||||
runTestInputTree golden f (TestInputLeaf name t path) =
|
||||
goldenVsStringDiff
|
||||
name
|
||||
(\ref new -> ["diff", "-u", ref, new])
|
||||
(path </> golden)
|
||||
(pure . BSL.fromStrict . Yaml.encode . f $ t)
|
||||
runTestInputTree _ f (TestInputLeaf name t _) =
|
||||
reportResult name $
|
||||
if hasUnsupportedFeature (f t)
|
||||
then testPassed "Feature unsupported"
|
||||
else testFailed "Unexpected feature support"
|
||||
|
||||
reportResult :: TestName -> Result -> TestTree
|
||||
reportResult name result = singleTest name $ SimpleTestReporter result
|
||||
|
||||
newtype SimpleTestReporter = SimpleTestReporter Result
|
||||
|
||||
instance IsTest SimpleTestReporter where
|
||||
run _ (SimpleTestReporter result) _ = return result
|
||||
testOptions = mempty
|
||||
|
||||
testSupported :: TestName -> Bool
|
||||
testSupported ('x' : ' ' : _) = False
|
||||
testSupported _ = True
|
||||
(f t)
|
||||
|
||||
goldenInputsTreeUniform
|
||||
:: ( Each t h (FilePath, FilePath -> IO a) a
|
||||
, ToJSON x
|
||||
, Each s t FilePath (FilePath, FilePath -> IO a)
|
||||
, HasUnsupportedFeature x
|
||||
)
|
||||
=> String
|
||||
-> FilePath -- ^ Root path
|
||||
-> FilePath -- ^ Name of golden file
|
||||
-> s
|
||||
-> (FilePath -> IO a)
|
||||
-> (h -> x)
|
||||
-> (h -> IO BSL.ByteString)
|
||||
-> IO TestTree
|
||||
goldenInputsTreeUniform name filepath golden inp h =
|
||||
goldenInputsTree name filepath golden (inp & each %~ (,h))
|
||||
|
@ -4,26 +4,56 @@ module Spec.Golden.TraceTree
|
||||
where
|
||||
|
||||
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.Subtree
|
||||
import OpenAPI.Checker.Behavior
|
||||
import OpenAPI.Checker.Paths
|
||||
import OpenAPI.Checker.PathsPrefixTree
|
||||
import OpenAPI.Checker.Report
|
||||
import OpenAPI.Checker.Subtree
|
||||
import OpenAPI.Checker.Validate.OpenApi ()
|
||||
import Spec.Golden.Extra
|
||||
import Test.Tasty (TestTree)
|
||||
import Test.Tasty (TestTree, testGroup)
|
||||
import Text.Pandoc.Class
|
||||
import Text.Pandoc.Writers
|
||||
import Prelude hiding (id, (.))
|
||||
|
||||
tests :: IO TestTree
|
||||
tests =
|
||||
tests = do
|
||||
traceTreeTests <-
|
||||
goldenInputsTreeUniform
|
||||
"Golden TraceTree"
|
||||
"TraceTree"
|
||||
"test/golden/common"
|
||||
"trace-tree.yaml"
|
||||
("a.yaml", "b.yaml")
|
||||
Yaml.decodeFileThrow
|
||||
(runCompatFormula . checkCompatibility HNil Root . toPC)
|
||||
(pure . BSL.fromStrict . Yaml.encode . runChecker)
|
||||
|
||||
reportTests <-
|
||||
goldenInputsTreeUniform
|
||||
"Report"
|
||||
"test/golden/common"
|
||||
"report.md"
|
||||
("a.yaml", "b.yaml")
|
||||
Yaml.decodeFileThrow
|
||||
(runPandoc . writeMarkdown def . generateReport . runChecker)
|
||||
|
||||
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 (client, server) = ProdCons
|
||||
{ producer = traced (step ClientSchema) client
|
||||
, consumer = traced (step ServerSchema) server
|
||||
toPC (c, s) =
|
||||
ProdCons
|
||||
{ producer = traced (step ClientSchema) c
|
||||
, consumer = traced (step ServerSchema) s
|
||||
}
|
||||
|
1
test/golden/common/enum-anyof/report.md
Normal file
1
test/golden/common/enum-anyof/report.md
Normal file
@ -0,0 +1 @@
|
||||
# No breaking changes found ✨
|
1
test/golden/common/id/report.md
Normal file
1
test/golden/common/id/report.md
Normal file
@ -0,0 +1 @@
|
||||
# No breaking changes found ✨
|
1
test/golden/common/json/recursive/report.md
Normal file
1
test/golden/common/json/recursive/report.md
Normal file
@ -0,0 +1 @@
|
||||
# No breaking changes found ✨
|
7
test/golden/common/maximum-lowered/report.md
Normal file
7
test/golden/common/maximum-lowered/report.md
Normal file
@ -0,0 +1,7 @@
|
||||
# **POST** /test
|
||||
|
||||
## JSON Request
|
||||
|
||||
### Number
|
||||
|
||||
Expected upper bound 3.0 inclusive but but found 2.0 inclusive.
|
@ -1,7 +1,8 @@
|
||||
Left:
|
||||
AtPath (ProdCons {producer = "/test", consumer = "/test"}):
|
||||
AtPath "/test":
|
||||
InOperation PostMethod:
|
||||
InRequest:
|
||||
InPayload:
|
||||
PayloadSchema:
|
||||
OfType Number: MatchingMaximumWeak (Inclusive 2.0) (Inclusive 3.0)
|
||||
OfType Number: MatchingMaximumWeak (ProdCons {producer = Inclusive 3.0,
|
||||
consumer = Inclusive 2.0})
|
||||
|
@ -0,0 +1,5 @@
|
||||
# **POST** /test
|
||||
|
||||
## Parameter test1
|
||||
|
||||
Expected that an empty parameter is allowed, but it isn't.
|
@ -1,4 +1,4 @@
|
||||
Left:
|
||||
AtPath (ProdCons {producer = "/test", consumer = "/test"}):
|
||||
AtPath "/test":
|
||||
InOperation PostMethod:
|
||||
InParam "test1": ParamEmptinessIncompatible
|
||||
|
@ -0,0 +1 @@
|
||||
# No breaking changes found ✨
|
@ -0,0 +1,9 @@
|
||||
# **POST** /test
|
||||
|
||||
## Parameter test
|
||||
|
||||
### JSON Schema
|
||||
|
||||
#### String
|
||||
|
||||
Expected the type to be allowed, but it wasn't.
|
@ -1,5 +1,5 @@
|
||||
Left:
|
||||
AtPath (ProdCons {producer = "/test", consumer = "/test"}):
|
||||
AtPath "/test":
|
||||
InOperation PostMethod:
|
||||
InParam "test":
|
||||
InParamSchema:
|
||||
|
@ -0,0 +1 @@
|
||||
# No breaking changes found ✨
|
@ -0,0 +1 @@
|
||||
# No breaking changes found ✨
|
@ -0,0 +1 @@
|
||||
# No breaking changes found ✨
|
@ -0,0 +1,5 @@
|
||||
# **POST** /test
|
||||
|
||||
## Parameter test1
|
||||
|
||||
Expected the parameter to be optional, but it is required.
|
@ -1,4 +1,4 @@
|
||||
Left:
|
||||
AtPath (ProdCons {producer = "/test", consumer = "/test"}):
|
||||
AtPath "/test":
|
||||
InOperation PostMethod:
|
||||
InParam "test1": ParamRequired
|
||||
|
@ -0,0 +1,3 @@
|
||||
# **POST** /test
|
||||
|
||||
Parameter test2 is not supported.
|
@ -1,3 +1,3 @@
|
||||
Left:
|
||||
AtPath (ProdCons {producer = "/test", consumer = "/test"}):
|
||||
AtPath "/test":
|
||||
InOperation PostMethod: ParamNotMatched "test2"
|
||||
|
@ -0,0 +1 @@
|
||||
# No breaking changes found ✨
|
@ -0,0 +1 @@
|
||||
# No breaking changes found ✨
|
@ -0,0 +1,7 @@
|
||||
# **POST** /test
|
||||
|
||||
## JSON Request
|
||||
|
||||
### String
|
||||
|
||||
Expected the type to be allowed, but it wasn't.
|
@ -1,5 +1,5 @@
|
||||
Left:
|
||||
AtPath (ProdCons {producer = "/test", consumer = "/test"}):
|
||||
AtPath "/test":
|
||||
InOperation PostMethod:
|
||||
InRequest:
|
||||
InPayload:
|
||||
|
@ -0,0 +1,6 @@
|
||||
# **POST** /test
|
||||
|
||||
## Request
|
||||
|
||||
Couldn't find a request body for media type
|
||||
`application/x-www-form-urlencoded`.
|
@ -1,4 +1,4 @@
|
||||
Left:
|
||||
AtPath (ProdCons {producer = "/test", consumer = "/test"}):
|
||||
AtPath "/test":
|
||||
InOperation PostMethod:
|
||||
InRequest: RequestMediaTypeNotFound application/x-www-form-urlencoded
|
||||
|
@ -0,0 +1 @@
|
||||
# No breaking changes found ✨
|
@ -0,0 +1,5 @@
|
||||
# **POST** /test
|
||||
|
||||
## Request
|
||||
|
||||
Expected the request body to be optional, but found it to be required.
|
@ -1,4 +1,4 @@
|
||||
Left:
|
||||
AtPath (ProdCons {producer = "/test", consumer = "/test"}):
|
||||
AtPath "/test":
|
||||
InOperation PostMethod:
|
||||
InRequest: RequestBodyRequired
|
||||
|
@ -0,0 +1,3 @@
|
||||
# **POST** /test
|
||||
|
||||
Reponse code 500 is not supported.
|
@ -1,3 +1,3 @@
|
||||
Left:
|
||||
AtPath (ProdCons {producer = "/test", consumer = "/test"}):
|
||||
AtPath "/test":
|
||||
InOperation PostMethod: ResponseCodeNotFound 500
|
||||
|
@ -0,0 +1 @@
|
||||
# No breaking changes found ✨
|
@ -0,0 +1,5 @@
|
||||
# **POST** /test
|
||||
|
||||
## Response code 200
|
||||
|
||||
Couldn't find header `Test2`.
|
@ -1,4 +1,4 @@
|
||||
Left:
|
||||
AtPath (ProdCons {producer = "/test", consumer = "/test"}):
|
||||
AtPath "/test":
|
||||
InOperation PostMethod:
|
||||
WithStatusCode 200: ResponseHeaderMissing "Test2"
|
||||
|
@ -0,0 +1 @@
|
||||
# No breaking changes found ✨
|
@ -0,0 +1 @@
|
||||
# No breaking changes found ✨
|
@ -0,0 +1,6 @@
|
||||
# **POST** /test
|
||||
|
||||
## Response code 200
|
||||
|
||||
Couldn't find reponse for media type
|
||||
`application/x-www-form-urlencoded`.
|
@ -1,4 +1,4 @@
|
||||
Left:
|
||||
AtPath (ProdCons {producer = "/test", consumer = "/test"}):
|
||||
AtPath "/test":
|
||||
InOperation PostMethod:
|
||||
WithStatusCode 200: ResponseMediaTypeMissing application/x-www-form-urlencoded
|
||||
|
@ -0,0 +1,7 @@
|
||||
# **POST** /test
|
||||
|
||||
## JSON Response – 200
|
||||
|
||||
### Number
|
||||
|
||||
Expected the type to be allowed, but it wasn't.
|
@ -1,5 +1,5 @@
|
||||
Left:
|
||||
AtPath (ProdCons {producer = "/test", consumer = "/test"}):
|
||||
AtPath "/test":
|
||||
InOperation PostMethod:
|
||||
WithStatusCode 200:
|
||||
ResponsePayload:
|
||||
|
@ -0,0 +1 @@
|
||||
# No breaking changes found ✨
|
@ -0,0 +1 @@
|
||||
# No breaking changes found ✨
|
13
test/golden/common/property-removed/report.md
Normal file
13
test/golden/common/property-removed/report.md
Normal file
@ -0,0 +1,13 @@
|
||||
# **POST** /test
|
||||
|
||||
## JSON Request
|
||||
|
||||
### Object
|
||||
|
||||
Expected the property `property2` to be allowed, but it wasn't.
|
||||
|
||||
## JSON Response – 200
|
||||
|
||||
### Object
|
||||
|
||||
Don't have a required property `property2`.
|
@ -1,5 +1,5 @@
|
||||
Left:
|
||||
AtPath (ProdCons {producer = "/test", consumer = "/test"}):
|
||||
AtPath "/test":
|
||||
InOperation PostMethod:
|
||||
InRequest:
|
||||
InPayload:
|
||||
|
7
test/golden/common/property-required/report.md
Normal file
7
test/golden/common/property-required/report.md
Normal file
@ -0,0 +1,7 @@
|
||||
# **POST** /test
|
||||
|
||||
## JSON Request
|
||||
|
||||
### Object
|
||||
|
||||
Don't have a required property `property2`.
|
@ -1,5 +1,5 @@
|
||||
Left:
|
||||
AtPath (ProdCons {producer = "/test", consumer = "/test"}):
|
||||
AtPath "/test":
|
||||
InOperation PostMethod:
|
||||
InRequest:
|
||||
InPayload:
|
||||
|
1
test/golden/common/recursive/report.md
Normal file
1
test/golden/common/recursive/report.md
Normal file
@ -0,0 +1 @@
|
||||
# No breaking changes found ✨
|
15
test/golden/common/security-scheme/report.md
Normal file
15
test/golden/common/security-scheme/report.md
Normal file
@ -0,0 +1,15 @@
|
||||
# **POST** /oauth/check
|
||||
|
||||
## Security requirement 0
|
||||
|
||||
### oauth
|
||||
|
||||
Security scheme not met.
|
||||
|
||||
# **GET** /oauth/sign\_out
|
||||
|
||||
## Security requirement 1
|
||||
|
||||
### oauth
|
||||
|
||||
Security scheme not met.
|
@ -1,9 +1,9 @@
|
||||
Left:
|
||||
AtPath (ProdCons {producer = "/oauth/check", consumer = "/oauth/check"}):
|
||||
InOperation PostMethod:
|
||||
SecurityRequirementStep 0:
|
||||
SecuritySchemeStep "oauth": SecuritySchemeNotMatched
|
||||
AtPath (ProdCons {producer = "/oauth/sign_out", consumer = "/oauth/sign_out"}):
|
||||
AtPath "/oauth/sign_out":
|
||||
InOperation GetMethod:
|
||||
SecurityRequirementStep 1:
|
||||
SecuritySchemeStep "oauth": SecuritySchemeNotMatched
|
||||
AtPath "/oauth/check":
|
||||
InOperation PostMethod:
|
||||
SecurityRequirementStep 0:
|
||||
SecuritySchemeStep "oauth": SecuritySchemeNotMatched
|
||||
|
11
test/golden/common/servers/report.md
Normal file
11
test/golden/common/servers/report.md
Normal file
@ -0,0 +1,11 @@
|
||||
# **GET** /pets
|
||||
|
||||
## Server `http://missing.url`
|
||||
|
||||
Couldn't find a matching server.
|
||||
|
||||
## Server `http://{x}variable.path/{y}/{openVariable1}/{openVariable2}`
|
||||
|
||||
Enum value `a` is not supported.
|
||||
|
||||
Expected a variable to be open (any value), but it wasn't.
|
@ -1,5 +1,5 @@
|
||||
Left:
|
||||
AtPath (ProdCons {producer = "/pets", consumer = "/pets"}):
|
||||
AtPath "/pets":
|
||||
InOperation GetMethod:
|
||||
InServer "http://{x}variable.path/{y}/{openVariable1}/{openVariable2}":
|
||||
- EnumValueNotConsumed 1 "a"
|
||||
|
5
test/golden/common/unguarded-recursive/report.md
Normal file
5
test/golden/common/unguarded-recursive/report.md
Normal file
@ -0,0 +1,5 @@
|
||||
# **GET** /api/foo
|
||||
|
||||
## JSON Response – 200
|
||||
|
||||
Encountered recursion that is too complex for OpenApi Diff to untangle.
|
@ -1,5 +1,5 @@
|
||||
Left:
|
||||
AtPath (ProdCons {producer = "/api/foo", consumer = "/api/foo"}):
|
||||
AtPath "/api/foo":
|
||||
InOperation GetMethod:
|
||||
WithStatusCode 200:
|
||||
ResponsePayload:
|
||||
|
Loading…
Reference in New Issue
Block a user