mirror of
https://github.com/ilyakooo0/compaREST.git
synced 2024-10-26 16:10:59 +03:00
Add disjointness heuristic with the help of partitioning (#107)
* Try to detect disjointness in oneOf via partitioning * Split OpenAPI.Checker.Validate.Schema into modules * Refactor schema code * Tweak error messages for NoContradiction * Refined reports Co-authored-by: iko <ilyakooo0@gmail.com>
This commit is contained in:
parent
2a7f02ae1e
commit
7029d2439b
@ -130,6 +130,13 @@ library
|
||||
, OpenAPI.Checker.Validate.RequestBody
|
||||
, OpenAPI.Checker.Validate.Responses
|
||||
, OpenAPI.Checker.Validate.Schema
|
||||
, OpenAPI.Checker.Validate.Schema.TypedJson
|
||||
, OpenAPI.Checker.Validate.Schema.DNF
|
||||
, OpenAPI.Checker.Validate.Schema.Issues
|
||||
, OpenAPI.Checker.Validate.Schema.JsonFormula
|
||||
, OpenAPI.Checker.Validate.Schema.Partition
|
||||
, OpenAPI.Checker.Validate.Schema.Process
|
||||
, OpenAPI.Checker.Validate.Schema.Traced
|
||||
, OpenAPI.Checker.Validate.SecurityRequirement
|
||||
, OpenAPI.Checker.Validate.Server
|
||||
, OpenAPI.Checker.Validate.Sums
|
||||
|
@ -37,7 +37,8 @@ import qualified OpenAPI.Checker.PathsPrefixTree as P hiding (empty)
|
||||
import OpenAPI.Checker.Report.Jet
|
||||
import OpenAPI.Checker.Subtree (invertIssueOrientationP)
|
||||
import OpenAPI.Checker.Validate.OpenApi
|
||||
import OpenAPI.Checker.Validate.Schema
|
||||
import OpenAPI.Checker.Validate.Schema.TypedJson
|
||||
import OpenAPI.Checker.Validate.Schema.Issues
|
||||
import Text.Pandoc.Builder
|
||||
|
||||
type Changes = P.PathsPrefixTree Behave AnIssue 'APILevel
|
||||
|
File diff suppressed because it is too large
Load Diff
101
src/OpenAPI/Checker/Validate/Schema/DNF.hs
Normal file
101
src/OpenAPI/Checker/Validate/Schema/DNF.hs
Normal file
@ -0,0 +1,101 @@
|
||||
module OpenAPI.Checker.Validate.Schema.DNF
|
||||
( DNF (..)
|
||||
, Disjunct (..)
|
||||
, pattern SingleDisjunct
|
||||
, pattern TopDNF
|
||||
, pattern BottomDNF
|
||||
, pattern LiteralDNF
|
||||
, foldDNF
|
||||
, forDNF
|
||||
)
|
||||
where
|
||||
|
||||
import Algebra.Lattice
|
||||
import Control.Applicative
|
||||
import Data.Foldable
|
||||
import qualified Data.Set as S
|
||||
|
||||
-- | A boolean formula (without "not") represented as a Disjunctive Normal Form:
|
||||
-- the formula is a disjunction of a set of clauses, each of which is a
|
||||
-- conjunction of a set of some elementary formulas.
|
||||
-- Invariant: no two disjuncts imply eachother
|
||||
newtype DNF a = DNF (S.Set (Disjunct a))
|
||||
deriving stock (Eq, Ord, Show)
|
||||
|
||||
-- A disjunct is a thing that is to be disjuncted. Itself it is a conjunction of some literals.
|
||||
newtype Disjunct a = Disjunct (S.Set a)
|
||||
deriving stock (Eq, Ord, Show)
|
||||
|
||||
disjImplies :: Ord a => Disjunct a -> Disjunct a -> Bool
|
||||
disjImplies (Disjunct xs) (Disjunct ys) = ys `S.isSubsetOf` xs
|
||||
|
||||
disjConjunction :: Ord a => Disjunct a -> Disjunct a -> Disjunct a
|
||||
disjConjunction (Disjunct xs) (Disjunct ys) = Disjunct $ xs `S.union` ys
|
||||
|
||||
disjAdd :: Ord a => DNF a -> Disjunct a -> DNF a
|
||||
disjAdd (DNF yss) xs
|
||||
| any (xs `disjImplies`) yss = DNF yss
|
||||
| otherwise = DNF $ S.insert xs $ S.filter (not . (`disjImplies` xs)) yss
|
||||
|
||||
instance Ord a => Lattice (DNF a) where
|
||||
xss \/ DNF yss = S.foldl' disjAdd xss yss
|
||||
DNF xss /\ DNF yss =
|
||||
foldl' disjAdd bottom $
|
||||
liftA2 disjConjunction (S.toList xss) (S.toList yss)
|
||||
|
||||
pattern BottomDNF :: DNF a
|
||||
pattern BottomDNF <-
|
||||
DNF (S.null -> True)
|
||||
where
|
||||
BottomDNF = DNF S.empty
|
||||
|
||||
isSingleton :: S.Set a -> Maybe a
|
||||
isSingleton s
|
||||
| S.size s == 1 = S.lookupMin s
|
||||
| otherwise = Nothing
|
||||
|
||||
pattern SingleDisjunct :: Ord a => Disjunct a -> DNF a
|
||||
pattern SingleDisjunct xs <-
|
||||
DNF (isSingleton -> Just xs)
|
||||
where
|
||||
SingleDisjunct xs = DNF $ S.singleton xs
|
||||
|
||||
pattern TopDNF :: DNF a
|
||||
pattern TopDNF <-
|
||||
DNF (isSingleton -> Just (Disjunct (S.null -> True)))
|
||||
where
|
||||
TopDNF = DNF $ S.singleton $ Disjunct S.empty
|
||||
|
||||
pattern LiteralDNF :: Ord a => a -> DNF a
|
||||
pattern LiteralDNF x <-
|
||||
SingleDisjunct (Disjunct (isSingleton -> Just x))
|
||||
where
|
||||
LiteralDNF x = SingleDisjunct $ Disjunct $ S.singleton x
|
||||
|
||||
instance Ord a => BoundedJoinSemiLattice (DNF a) where
|
||||
bottom = BottomDNF
|
||||
|
||||
instance Ord a => BoundedMeetSemiLattice (DNF a) where
|
||||
top = TopDNF
|
||||
|
||||
foldDisjunct :: BoundedMeetSemiLattice l => (a -> l) -> Disjunct a -> l
|
||||
foldDisjunct f (Disjunct xs) = S.foldl' (\y l -> y /\ f l) top xs
|
||||
|
||||
foldDNF :: BoundedLattice l => (a -> l) -> DNF a -> l
|
||||
foldDNF f (DNF xss) = S.foldl' (\y xs -> y \/ foldDisjunct f xs) bottom xss
|
||||
|
||||
newtype LiftA f a = LiftA {getLiftA :: f a}
|
||||
deriving newtype (Functor, Applicative)
|
||||
|
||||
instance (Lattice a, Applicative f) => Lattice (LiftA f a) where
|
||||
(/\) = liftA2 (/\)
|
||||
(\/) = liftA2 (\/)
|
||||
|
||||
instance (BoundedJoinSemiLattice a, Applicative f) => BoundedJoinSemiLattice (LiftA f a) where
|
||||
bottom = pure bottom
|
||||
|
||||
instance (BoundedMeetSemiLattice a, Applicative f) => BoundedMeetSemiLattice (LiftA f a) where
|
||||
top = pure top
|
||||
|
||||
forDNF :: (BoundedLattice l, Applicative f) => (a -> f l) -> DNF a -> f l
|
||||
forDNF f = getLiftA . foldDNF (LiftA . f)
|
222
src/OpenAPI/Checker/Validate/Schema/Issues.hs
Normal file
222
src/OpenAPI/Checker/Validate/Schema/Issues.hs
Normal file
@ -0,0 +1,222 @@
|
||||
{-# OPTIONS_GHC -Wno-orphans #-}
|
||||
|
||||
module OpenAPI.Checker.Validate.Schema.Issues
|
||||
( Issue (..)
|
||||
, Behave (..)
|
||||
)
|
||||
where
|
||||
|
||||
import qualified Data.Aeson as A
|
||||
import Data.OpenApi
|
||||
import Data.Scientific
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
import OpenAPI.Checker.Behavior
|
||||
import OpenAPI.Checker.Subtree
|
||||
import OpenAPI.Checker.Validate.Schema.JsonFormula
|
||||
import OpenAPI.Checker.Validate.Schema.Partition
|
||||
import OpenAPI.Checker.Validate.Schema.TypedJson
|
||||
import Text.Pandoc.Builder hiding (Format, Null)
|
||||
|
||||
instance Issuable 'TypedSchemaLevel where
|
||||
data Issue 'TypedSchemaLevel
|
||||
= -- | 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 match 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 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)
|
||||
| -- | producer declares that the value must satisfy a disjunction of some conditions, but consumer's requirements couldn't be matched against any single one of them (TODO: split heuristic #71)
|
||||
NoMatchingCondition (Maybe Partition) [SomeCondition]
|
||||
| -- | consumer indicates that no values of this type are allowed, but we weren't able to conclude that in the producer (currently only immediate contradictions are checked, c.f. #70)
|
||||
TypeBecomesEmpty
|
||||
| -- | consumer indicates that no values in a particular partition are allowed, but we weren't able to conclude this in the producer
|
||||
PartitionBecomesEmpty Partition
|
||||
deriving stock (Eq, Ord, Show)
|
||||
issueIsUnsupported _ = False
|
||||
describeIssue Forward (EnumDoesntSatisfy v) = para "The following enum value was removed:" <> showJSONValue v
|
||||
describeIssue Backward (EnumDoesntSatisfy v) = para "The following enum value was added:" <> showJSONValue v
|
||||
describeIssue Forward (NoMatchingEnum v) = para "The following enum value has been added:" <> showJSONValue v
|
||||
describeIssue Backward (NoMatchingEnum v) = para "The following enum value has been removed:" <> 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 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 mPart conds) =
|
||||
para
|
||||
(case mPart of
|
||||
Nothing -> "Could not verify that the following conditions hold (please file a bug if you see this):"
|
||||
Just locPart ->
|
||||
"In cases where " <> showPartition locPart
|
||||
<> " – could not verify that the following conditions hold (please file a bug if you see this):")
|
||||
<> bulletList ((\(SomeCondition c) -> showCondition c) <$> conds)
|
||||
describeIssue Forward TypeBecomesEmpty = para "The type has been removed."
|
||||
describeIssue Backward TypeBecomesEmpty = para "The type has been added."
|
||||
describeIssue Forward (PartitionBecomesEmpty part) = para $ "The case where " <> showPartition part <> " – has been removed."
|
||||
describeIssue Backward (PartitionBecomesEmpty part) = para $ "The case where " <> showPartition part <> " – has been added."
|
||||
|
||||
show' :: Show x => x -> Inlines
|
||||
show' = str . T.pack . show
|
||||
|
||||
instance Issuable 'SchemaLevel where
|
||||
data Issue 'SchemaLevel
|
||||
= -- | Some (openapi-supported) feature that we do not support was encountered in the schema
|
||||
NotSupported Text
|
||||
| -- | We couldn't prove that the branches of a oneOf are disjoint, and we will treat it as an anyOf, meaning we don't check whether the overlaps are excluded in a compatible way
|
||||
OneOfNotDisjoint
|
||||
| -- | The schema is actually invalid
|
||||
InvalidSchema Text
|
||||
| -- | The schema contains a reference loop along "anyOf"/"allOf"/"oneOf".
|
||||
UnguardedRecursion
|
||||
| -- | Producer doesn't place any restrictions on the types, but the consumer does. List what types remain available in the consumer.
|
||||
TypesRestricted [JsonType]
|
||||
| -- | in the producer this field used to be handled as part of "additionalProperties", and the consumer this is a specific "properties" entry. Only thrown when this change actually causes other issues
|
||||
AdditionalToProperty
|
||||
| -- | in the consumer this field used to be handled as part of "additionalProperties", and the producer this is a specific "properties" entry. Only thrown when this change actually causes other issues
|
||||
PropertyToAdditional
|
||||
| -- | consumer requires a property that is not required/allowed in the producer
|
||||
PropertyNowRequired
|
||||
| -- | producer allows a property that is not allowed in the consumer
|
||||
UnexpectedProperty
|
||||
deriving stock (Eq, Ord, Show)
|
||||
issueIsUnsupported = \case
|
||||
NotSupported _ -> True
|
||||
OneOfNotDisjoint -> True
|
||||
InvalidSchema _ -> True
|
||||
UnguardedRecursion -> True
|
||||
_ -> False
|
||||
|
||||
describeIssue _ (NotSupported i) =
|
||||
para (emph "Encountered a feature that OpenApi Diff does not support: " <> text i <> ".")
|
||||
describeIssue _ OneOfNotDisjoint =
|
||||
para $
|
||||
"Could not deduce that " <> code "oneOf"
|
||||
<> " cases don't overlap. Treating the "
|
||||
<> code "oneOf"
|
||||
<> " as an "
|
||||
<> code "anyOf"
|
||||
<> ". Reported errors might not be accurate."
|
||||
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."
|
||||
describeIssue Forward (TypesRestricted tys) = case tys of
|
||||
[] -> para "No longer has any valid values." -- weird
|
||||
_ -> para "Values are now limited to the following types: " <> bulletList (para . describeJSONType <$> tys)
|
||||
describeIssue Backward (TypesRestricted tys) = case tys of
|
||||
[] -> para "Any value of any type is now allowed." -- weird
|
||||
_ -> para "Values are no longer limited to the following types: " <> bulletList (para . describeJSONType <$> tys)
|
||||
describeIssue Forward AdditionalToProperty = para "The property was previously implicitly described by the catch-all \"additional properties\" case. It is now explicitly defined."
|
||||
describeIssue Backward AdditionalToProperty = para "The property was previously explicitly defined. It is now implicitly described by the catch-all \"additional properties\" case."
|
||||
describeIssue Forward PropertyToAdditional = para "The property was previously explicitly defined. It is now implicitly described by the catch-all \"additional properties\" case."
|
||||
describeIssue Backward PropertyToAdditional = para "The property was previously implicitly described by the catch-all \"additional properties\" case. It is now explicitly defined."
|
||||
describeIssue Forward PropertyNowRequired = para "The property has become required."
|
||||
describeIssue Backward PropertyNowRequired = para "The property may not be present."
|
||||
describeIssue Forward UnexpectedProperty = para "The property has been removed."
|
||||
describeIssue Backward UnexpectedProperty = para "The property has been added."
|
||||
|
||||
instance Behavable 'SchemaLevel 'TypedSchemaLevel where
|
||||
data Behave 'SchemaLevel 'TypedSchemaLevel
|
||||
= OfType JsonType
|
||||
deriving stock (Eq, Ord, Show)
|
||||
|
||||
describeBehaviour (OfType t) = describeJSONType t
|
||||
|
||||
instance Behavable 'TypedSchemaLevel 'TypedSchemaLevel where
|
||||
data Behave 'TypedSchemaLevel 'TypedSchemaLevel
|
||||
= InPartition Partition
|
||||
deriving stock (Eq, Ord, Show)
|
||||
|
||||
describeBehaviour (InPartition partition) = "In cases where " <> showPartition partition
|
||||
|
||||
instance Behavable 'TypedSchemaLevel 'SchemaLevel where
|
||||
data Behave 'TypedSchemaLevel 'SchemaLevel
|
||||
= InItems
|
||||
| InProperty Text
|
||||
| InAdditionalProperty
|
||||
deriving stock (Eq, Ord, Show)
|
||||
|
||||
describeBehaviour InItems = "Items"
|
||||
describeBehaviour (InProperty p) = "Property " <> code p
|
||||
describeBehaviour InAdditionalProperty = "Additional properties"
|
224
src/OpenAPI/Checker/Validate/Schema/JsonFormula.hs
Normal file
224
src/OpenAPI/Checker/Validate/Schema/JsonFormula.hs
Normal file
@ -0,0 +1,224 @@
|
||||
module OpenAPI.Checker.Validate.Schema.JsonFormula
|
||||
( Bound (..)
|
||||
, showBound
|
||||
, Property (..)
|
||||
, Condition (..)
|
||||
, showCondition
|
||||
, satisfiesTyped
|
||||
, checkStringFormat
|
||||
, checkNumberFormat
|
||||
, SomeCondition (..)
|
||||
, JsonFormula (..)
|
||||
, satisfiesFormula
|
||||
, satisfies
|
||||
, showJSONValue
|
||||
, showJSONValueInline
|
||||
)
|
||||
where
|
||||
|
||||
import Algebra.Lattice
|
||||
import qualified Data.Aeson as A
|
||||
import qualified Data.ByteString.Lazy as BSL
|
||||
import qualified Data.Foldable as F
|
||||
import qualified Data.HashMap.Strict as HM
|
||||
import Data.Functor
|
||||
import Data.Int
|
||||
import Data.Kind
|
||||
import qualified Data.Map as M
|
||||
import Data.Maybe
|
||||
import Data.OpenApi
|
||||
import Data.Ord
|
||||
import Data.Ratio
|
||||
import Data.Scientific
|
||||
import qualified Data.Set as S
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.Encoding as T
|
||||
import Data.Typeable
|
||||
import OpenAPI.Checker.Orphans ()
|
||||
import OpenAPI.Checker.Subtree
|
||||
import OpenAPI.Checker.Validate.Schema.DNF
|
||||
import OpenAPI.Checker.Validate.Schema.TypedJson
|
||||
import Text.Pandoc.Builder hiding (Format, Null)
|
||||
import Text.Regex.Pcre2
|
||||
|
||||
data Bound a = Exclusive !a | Inclusive !a
|
||||
deriving stock (Eq, Show, Functor)
|
||||
|
||||
-- | The order is lexicographical on @a * Bool@.
|
||||
instance Ord a => Ord (Bound a) where
|
||||
Exclusive a `compare` Exclusive b = compare a b
|
||||
Exclusive a `compare` Inclusive b = if a <= b then LT else GT
|
||||
Inclusive a `compare` Exclusive b = if a < b then LT else GT
|
||||
Inclusive a `compare` Inclusive b = compare a b
|
||||
|
||||
showBound :: Show a => Bound a -> Inlines
|
||||
showBound (Inclusive x) = show' x <> " inclusive"
|
||||
showBound (Exclusive x) = show' x <> " exclusive"
|
||||
|
||||
data Property = Property
|
||||
{ propRequired :: Bool
|
||||
, propFormula :: ForeachType JsonFormula
|
||||
, propRefSchema :: Traced (Referenced Schema)
|
||||
}
|
||||
deriving stock (Eq, Ord, Show)
|
||||
|
||||
-- | A primitive structural condition for the "top level" of a JSON value (of a specific type)
|
||||
data Condition :: JsonType -> Type where
|
||||
Exactly :: TypedValue t -> Condition t
|
||||
Maximum :: !(Bound Scientific) -> Condition 'Number
|
||||
Minimum
|
||||
:: !(Down (Bound (Down Scientific)))
|
||||
-> Condition 'Number -- ^ this has the right Ord
|
||||
MultipleOf :: !Scientific -> Condition 'Number
|
||||
NumberFormat :: !Format -> Condition 'Number
|
||||
MaxLength :: !Integer -> Condition 'String
|
||||
MinLength :: !Integer -> Condition 'String
|
||||
Pattern :: !Pattern -> Condition 'String
|
||||
StringFormat :: !Format -> Condition 'String
|
||||
Items
|
||||
:: !(ForeachType JsonFormula)
|
||||
-> !(Traced (Referenced Schema))
|
||||
-> Condition 'Array
|
||||
MaxItems :: !Integer -> Condition 'Array
|
||||
MinItems :: !Integer -> Condition 'Array
|
||||
UniqueItems :: Condition 'Array
|
||||
Properties
|
||||
:: !(M.Map Text Property)
|
||||
-> !(ForeachType JsonFormula) -- ^ formula for additional properties
|
||||
-> !(Maybe (Traced (Referenced Schema))) -- ^ schema for additional properties, Nothing means bottom
|
||||
-> Condition 'Object
|
||||
MaxProperties :: !Integer -> Condition 'Object
|
||||
MinProperties :: !Integer -> Condition 'Object
|
||||
|
||||
deriving stock instance Eq (Condition t)
|
||||
|
||||
deriving stock instance Ord (Condition t)
|
||||
|
||||
deriving stock instance Show (Condition t)
|
||||
|
||||
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 -> case getJsonFormula $ f i of
|
||||
BottomDNF -> mempty
|
||||
(DNF conds) ->
|
||||
[ para (describeJSONType t)
|
||||
<> bulletList
|
||||
(S.toList conds <&> \case
|
||||
Disjunct (S.toList -> []) -> para "Empty"
|
||||
Disjunct (S.toList -> cond) -> bulletList (showCondition <$> cond))
|
||||
])
|
||||
|
||||
showJSONValue :: A.Value -> Blocks
|
||||
showJSONValue v = codeBlockWith ("", ["json"], mempty) (T.decodeUtf8 . BSL.toStrict . A.encode $ v)
|
||||
|
||||
showJSONValueInline :: A.Value -> Inlines
|
||||
showJSONValueInline v = code (T.decodeUtf8 . BSL.toStrict . A.encode $ v)
|
||||
|
||||
show' :: Show x => x -> Inlines
|
||||
show' = str . T.pack . show
|
||||
|
||||
satisfiesTyped :: TypedValue t -> Condition t -> Bool
|
||||
satisfiesTyped e (Exactly e') = e == e'
|
||||
satisfiesTyped (TNumber n) (Maximum (Exclusive m)) = n < m
|
||||
satisfiesTyped (TNumber n) (Maximum (Inclusive m)) = n <= m
|
||||
satisfiesTyped (TNumber n) (Minimum (Down (Exclusive (Down m)))) = n > m
|
||||
satisfiesTyped (TNumber n) (Minimum (Down (Inclusive (Down m)))) = n >= m
|
||||
satisfiesTyped (TNumber n) (MultipleOf m) = denominator (toRational n / toRational m) == 1 -- TODO: could be better #36
|
||||
satisfiesTyped (TNumber n) (NumberFormat f) = checkNumberFormat f n
|
||||
satisfiesTyped (TString s) (MaxLength m) = fromIntegral (T.length s) <= m
|
||||
satisfiesTyped (TString s) (MinLength m) = fromIntegral (T.length s) >= m
|
||||
satisfiesTyped (TString s) (Pattern p) = isJust $ match p s -- TODO: regex stuff #32
|
||||
satisfiesTyped (TString s) (StringFormat f) = checkStringFormat f s
|
||||
satisfiesTyped (TArray a) (Items f _) = all (`satisfies` f) a
|
||||
satisfiesTyped (TArray a) (MaxItems m) = fromIntegral (F.length a) <= m
|
||||
satisfiesTyped (TArray a) (MinItems m) = fromIntegral (F.length a) >= m
|
||||
satisfiesTyped (TArray a) UniqueItems = S.size (S.fromList $ F.toList a) == F.length a -- TODO: could be better #36
|
||||
satisfiesTyped (TObject o) (Properties props additional _) =
|
||||
all (`HM.member` o) (M.keys (M.filter propRequired props))
|
||||
&& all (\(k, v) -> satisfies v $ maybe additional propFormula $ M.lookup k props) (HM.toList o)
|
||||
satisfiesTyped (TObject o) (MaxProperties m) = fromIntegral (HM.size o) <= m
|
||||
satisfiesTyped (TObject o) (MinProperties m) = fromIntegral (HM.size o) >= m
|
||||
|
||||
checkNumberFormat :: Format -> Scientific -> Bool
|
||||
checkNumberFormat "int32" (toRational -> n) =
|
||||
denominator n == 1
|
||||
&& n >= toRational (minBound :: Int32)
|
||||
&& n <= toRational (maxBound :: Int32)
|
||||
checkNumberFormat "int64" (toRational -> n) =
|
||||
denominator n == 1
|
||||
&& n >= toRational (minBound :: Int64)
|
||||
&& n <= toRational (maxBound :: Int64)
|
||||
checkNumberFormat "float" _n = True
|
||||
checkNumberFormat "double" _n = True
|
||||
checkNumberFormat f _n = error $ "Invalid number format: " <> T.unpack f
|
||||
|
||||
checkStringFormat :: Format -> Text -> Bool
|
||||
checkStringFormat "byte" _s = True -- TODO: regex stuff #32
|
||||
checkStringFormat "binary" _s = True
|
||||
checkStringFormat "date" _s = True
|
||||
checkStringFormat "date-time" _s = True
|
||||
checkStringFormat "password" _s = True
|
||||
checkStringFormat "uuid" _s = True
|
||||
checkStringFormat f _s = error $ "Invalid string format: " <> T.unpack f
|
||||
|
||||
data SomeCondition where
|
||||
SomeCondition :: Typeable t => Condition t -> SomeCondition
|
||||
|
||||
instance Eq SomeCondition where
|
||||
SomeCondition x == SomeCondition y = case cast x of
|
||||
Just x' -> x' == y
|
||||
Nothing -> False
|
||||
|
||||
instance Ord SomeCondition where
|
||||
compare (SomeCondition x) (SomeCondition y) = case cast x of
|
||||
Just x' -> compare x' y
|
||||
Nothing -> compare (typeRep x) (typeRep y)
|
||||
|
||||
deriving stock instance Show SomeCondition
|
||||
|
||||
newtype JsonFormula t = JsonFormula {getJsonFormula :: DNF (Condition t)}
|
||||
deriving stock (Eq, Ord, Show)
|
||||
deriving newtype (Lattice, BoundedJoinSemiLattice, BoundedMeetSemiLattice)
|
||||
|
||||
satisfiesFormula :: TypedValue t -> JsonFormula t -> Bool
|
||||
satisfiesFormula val = foldDNF (satisfiesTyped val) . getJsonFormula
|
||||
|
||||
satisfies :: A.Value -> ForeachType JsonFormula -> Bool
|
||||
satisfies val p = case val of
|
||||
A.Null -> satisfiesFormula TNull $ forNull p
|
||||
A.Bool b -> satisfiesFormula (TBool b) $ forBoolean p
|
||||
A.Number n -> satisfiesFormula (TNumber n) $ forNumber p
|
||||
A.String s -> satisfiesFormula (TString s) $ forString p
|
||||
A.Array a -> satisfiesFormula (TArray a) $ forArray p
|
||||
A.Object o -> satisfiesFormula (TObject o) $ forObject p
|
316
src/OpenAPI/Checker/Validate/Schema/Partition.hs
Normal file
316
src/OpenAPI/Checker/Validate/Schema/Partition.hs
Normal file
@ -0,0 +1,316 @@
|
||||
module OpenAPI.Checker.Validate.Schema.Partition
|
||||
( partitionSchema
|
||||
, partitionRefSchema
|
||||
, selectPartition
|
||||
, runPartitionM
|
||||
, tryPartition
|
||||
, showPartition
|
||||
, intersectSchema
|
||||
, intersectRefSchema
|
||||
, IntersectionResult (..)
|
||||
, runIntersectionM
|
||||
, Partition
|
||||
)
|
||||
where
|
||||
|
||||
import Algebra.Lattice
|
||||
import Algebra.Lattice.Lifted
|
||||
import Control.Applicative
|
||||
import Control.Monad.Reader hiding (ask)
|
||||
import qualified Control.Monad.Reader as R
|
||||
import Control.Monad.State
|
||||
import qualified Control.Monad.Trans.Reader as R (liftCatch)
|
||||
import qualified Control.Monad.Trans.Writer as W (liftCatch)
|
||||
import Control.Monad.Writer
|
||||
import qualified Data.Aeson as A
|
||||
import Data.Foldable
|
||||
import Data.Functor.Identity
|
||||
import qualified Data.HashMap.Strict.InsOrd as IOHM
|
||||
import Data.List (sortBy)
|
||||
import qualified Data.List as L
|
||||
import qualified Data.List.NonEmpty as NE
|
||||
import qualified Data.Map as M
|
||||
import Data.Maybe
|
||||
import Data.OpenApi
|
||||
import Data.Ord
|
||||
import qualified Data.Set as S
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
import OpenAPI.Checker.Memo
|
||||
import OpenAPI.Checker.References
|
||||
import OpenAPI.Checker.Subtree
|
||||
import OpenAPI.Checker.Validate.Schema.DNF
|
||||
import OpenAPI.Checker.Validate.Schema.JsonFormula
|
||||
import OpenAPI.Checker.Validate.Schema.Traced
|
||||
import OpenAPI.Checker.Validate.Schema.TypedJson
|
||||
import Text.Pandoc.Builder hiding (Format, Null)
|
||||
|
||||
data PartitionData
|
||||
= DByEnumValue (DNF (S.Set A.Value))
|
||||
| DByProperties (DNF (S.Set Text, S.Set Text)) -- optional, required
|
||||
deriving stock (Eq, Ord, Show)
|
||||
|
||||
conjPart :: PartitionData -> PartitionData -> Maybe PartitionData
|
||||
conjPart (DByEnumValue xss) (DByEnumValue yss) = Just . DByEnumValue $ xss /\ yss
|
||||
conjPart (DByProperties xss) (DByProperties yss) = Just . DByProperties $ xss /\ yss
|
||||
conjPart _ _ = Nothing
|
||||
|
||||
disjPart :: PartitionData -> PartitionData -> Maybe PartitionData
|
||||
disjPart (DByEnumValue xss) (DByEnumValue yss) = Just . DByEnumValue $ xss \/ yss
|
||||
disjPart (DByProperties xss) (DByProperties yss) = Just . DByProperties $ xss \/ yss
|
||||
disjPart _ _ = Nothing
|
||||
|
||||
newtype Partitions = Partitions (M.Map PartitionLocation (S.Set PartitionData))
|
||||
deriving stock (Eq, Ord, Show)
|
||||
|
||||
instance Lattice Partitions where
|
||||
Partitions xss /\ Partitions yss = Partitions $ M.unionWith conj xss yss
|
||||
where
|
||||
conj xs ys = S.fromList . catMaybes $ liftA2 conjPart (S.toList xs) (S.toList ys)
|
||||
Partitions xss \/ Partitions yss = Partitions $ M.intersectionWith disj xss yss
|
||||
where
|
||||
disj xs ys = S.fromList . catMaybes $ liftA2 disjPart (S.toList xs) (S.toList ys)
|
||||
|
||||
instance BoundedMeetSemiLattice Partitions where
|
||||
top = Partitions M.empty
|
||||
|
||||
-- The lattice has no bottom, but we use 'Lifted' to adjoin a free bottom element
|
||||
|
||||
type PartitionM = ReaderT (Traced (Definitions Schema)) (State (MemoState ()))
|
||||
|
||||
ignoreKnot :: KnotTier (Lifted Partitions) () PartitionM
|
||||
ignoreKnot =
|
||||
KnotTier
|
||||
{ onKnotFound = pure ()
|
||||
, onKnotUsed = \_ -> pure bottom
|
||||
, tieKnot = \_ -> pure
|
||||
}
|
||||
|
||||
singletonPart :: PartitionData -> Lifted Partitions
|
||||
singletonPart = Lift . Partitions . M.singleton PHere . S.singleton
|
||||
|
||||
partitionSchema :: Traced Schema -> PartitionM (Lifted Partitions)
|
||||
partitionSchema sch = do
|
||||
allClauses <- case tracedAllOf sch of
|
||||
Nothing -> pure []
|
||||
Just xs -> mapM partitionRefSchema xs
|
||||
|
||||
anyClause <- case tracedAnyOf sch of
|
||||
Nothing -> pure top
|
||||
Just xs -> joins <$> mapM partitionRefSchema xs
|
||||
|
||||
oneClause <- case tracedOneOf sch of
|
||||
Nothing -> pure top
|
||||
Just xs -> joins <$> mapM partitionRefSchema xs
|
||||
|
||||
byEnumClause <- case _schemaEnum $ extract sch of
|
||||
Nothing -> pure top
|
||||
Just xs ->
|
||||
pure . singletonPart $
|
||||
DByEnumValue $ LiteralDNF (S.fromList xs)
|
||||
|
||||
-- We can only partition by presence of a property if additional properties
|
||||
-- are disallowed, and the property is not optional
|
||||
let reqd = S.fromList $ _schemaRequired $ extract sch
|
||||
byPropertiesClause <- case _schemaAdditionalProperties $ extract sch of
|
||||
Just (AdditionalPropertiesAllowed False) -> do
|
||||
let props = S.fromList . IOHM.keys . _schemaProperties $ extract sch
|
||||
pure . singletonPart $
|
||||
DByProperties $ LiteralDNF (props S.\\ reqd, props `S.intersection` reqd)
|
||||
_ -> pure top
|
||||
|
||||
-- We can partition on something nested in a property only if the property is
|
||||
-- required
|
||||
let reqdProps = IOHM.filterWithKey (\k _ -> k `S.member` reqd) $ tracedProperties sch
|
||||
inPropertiesClauses <- forM (IOHM.toList reqdProps) $ \(k, rs) -> do
|
||||
f <- partitionRefSchema rs
|
||||
pure $ fmap (\(Partitions m) -> Partitions $ M.mapKeysMonotonic (PInProperty k) m) f
|
||||
|
||||
pure $ meets $ allClauses <> [anyClause, oneClause, byEnumClause, byPropertiesClause] <> inPropertiesClauses
|
||||
|
||||
partitionRefSchema :: Traced (Referenced Schema) -> PartitionM (Lifted Partitions)
|
||||
partitionRefSchema x = do
|
||||
defs <- R.ask
|
||||
memoWithKnot ignoreKnot (partitionSchema $ dereference defs x) (ask x)
|
||||
|
||||
partitionCondition :: Condition t -> PartitionM (Lifted Partitions)
|
||||
partitionCondition = \case
|
||||
Exactly x ->
|
||||
pure . singletonPart $
|
||||
DByEnumValue $ LiteralDNF (S.singleton $ untypeValue x)
|
||||
Properties props _ madd -> do
|
||||
let byProps = case madd of
|
||||
Just _ -> top
|
||||
Nothing ->
|
||||
singletonPart $
|
||||
DByProperties $ LiteralDNF
|
||||
( M.keysSet $ M.filter (not . propRequired) props
|
||||
, M.keysSet $ M.filter propRequired props
|
||||
)
|
||||
inProps <- forM (M.toList $ M.filter propRequired props) $ \(k, prop) -> do
|
||||
f <- partitionRefSchema $ propRefSchema prop
|
||||
pure $ fmap (\(Partitions m) -> Partitions $ M.mapKeysMonotonic (PInProperty k) m) f
|
||||
pure $ byProps /\ meets inProps
|
||||
_ -> pure top
|
||||
|
||||
runPartitionM :: Traced (Definitions Schema) -> PartitionM a -> a
|
||||
runPartitionM defs = runIdentity . runMemo () . (`runReaderT` defs)
|
||||
|
||||
partitionJsonFormulas
|
||||
:: ProdCons (Traced (Definitions Schema))
|
||||
-> ProdCons (JsonFormula t)
|
||||
-> Lifted Partitions
|
||||
partitionJsonFormulas defs pc = producer pcPart \/ consumer pcPart
|
||||
where
|
||||
pcPart = partitionFormula <$> defs <*> pc
|
||||
partitionFormula def (JsonFormula xss) = runPartitionM def $ forDNF partitionCondition xss
|
||||
|
||||
selectPartition :: Lifted Partitions -> Maybe (PartitionLocation, S.Set PartitionChoice)
|
||||
selectPartition Bottom = Nothing
|
||||
selectPartition (Lift (Partitions m)) =
|
||||
go [(loc, part) | (loc, parts) <- sortBy (comparing $ locLength . fst) $ M.toList m, part <- S.toList parts]
|
||||
where
|
||||
locLength :: PartitionLocation -> Int
|
||||
locLength = walk 0
|
||||
where
|
||||
walk !n PHere = n
|
||||
walk !n (PInProperty _ l) = walk (n + 1) l
|
||||
go [] = Nothing
|
||||
-- Skip partitioning by property for now
|
||||
go ((_, DByProperties _) : ps) = go ps
|
||||
-- Don't partition by enum value at the root (this reports removed enum values as contradictions in their respective partitions)
|
||||
go ((PHere, DByEnumValue _) : ps) = go ps
|
||||
go ((loc, DByEnumValue (DNF xss)) : ps)
|
||||
-- Check that no disjunction branches are unresticted
|
||||
| Just enums <- traverse (\(Disjunct xs) -> fmap (foldr1 S.intersection) . NE.nonEmpty . S.toList $ xs) . S.toList $ xss =
|
||||
-- TODO: improve
|
||||
Just (loc, S.map (CByEnumValue . S.singleton) $ S.unions enums)
|
||||
| otherwise = go ps
|
||||
|
||||
-- This essentially has 3 cases:
|
||||
-- Nothing -- we have produced a bottom schema
|
||||
-- Just (False, _) -- there's been no change to the schema
|
||||
-- Just (True, x) -- x is a new schema
|
||||
type IntersectionM = ReaderT (Traced (Definitions Schema)) (WriterT Any Maybe)
|
||||
|
||||
mBottom :: IntersectionM a
|
||||
mBottom = lift . lift $ Nothing
|
||||
|
||||
catchBottom :: IntersectionM a -> IntersectionM a -> IntersectionM a
|
||||
catchBottom act handler = R.liftCatch (W.liftCatch (\a h -> a <|> h ())) act (\_ -> handler)
|
||||
|
||||
mChange :: IntersectionM ()
|
||||
mChange = tell $ Any True
|
||||
|
||||
data IntersectionResult a = Disjoint | Same a | New a
|
||||
deriving stock (Eq, Ord, Show)
|
||||
|
||||
runIntersectionM :: Traced (Definitions Schema) -> IntersectionM a -> IntersectionResult a
|
||||
runIntersectionM defs act = case runWriterT $ runReaderT act defs of
|
||||
Nothing -> Disjoint
|
||||
Just (x, Any False) -> Same x
|
||||
Just (x, Any True) -> New x
|
||||
|
||||
intersectSchema
|
||||
:: PartitionLocation
|
||||
-> PartitionChoice
|
||||
-> Traced Schema
|
||||
-> IntersectionM Schema
|
||||
intersectSchema loc part sch = do
|
||||
allOf' <- forM (tracedAllOf sch) $ \rss ->
|
||||
-- Assuming i ranges over a nonempty set (checked in processSchema)
|
||||
-- (⋂_i A[i]) ∩ X = ⋂_i (A[i] ∩ X)
|
||||
-- If any intersections are empty, the result is empty. If any intersections are a change, the result is a change.
|
||||
traverse (intersectRefSchema loc part) rss
|
||||
anyOf' <- forM (tracedAnyOf sch) $ \rss -> do
|
||||
-- (⋃_i A[i]) ∩ X = ⋃_i (A[i] ∩ X)
|
||||
-- Collect only the nonempty A[i] ∩ X, unless there are none, in which case the result is empty.
|
||||
-- If any schema is empty, we remove it from the list which constitutes a change.
|
||||
mSchemas <- forM rss $ \rs -> catchBottom (Just <$> intersectRefSchema loc part rs) (mChange >> pure Nothing)
|
||||
case catMaybes mSchemas of
|
||||
[] -> mBottom
|
||||
schs -> pure schs
|
||||
oneOf' <- forM (tracedOneOf sch) $ \rss -> do
|
||||
-- Same as anyOf'. By intersecting we're only making them more disjoint if anything.
|
||||
mSchemas <- forM rss $ \rs -> catchBottom (Just <$> intersectRefSchema loc part rs) (mChange >> pure Nothing)
|
||||
case catMaybes mSchemas of
|
||||
[] -> mBottom
|
||||
schs -> pure schs
|
||||
let sch' = (extract sch) {_schemaAllOf = allOf', _schemaAnyOf = anyOf', _schemaOneOf = oneOf'}
|
||||
-- Now the local changes:
|
||||
case loc of
|
||||
PInProperty k loc' -> case IOHM.lookup k $ tracedProperties sch of
|
||||
Nothing -> error $ "Partitioning via absent property: " <> T.unpack k
|
||||
Just prop -> do
|
||||
prop' <- intersectRefSchema loc' part prop
|
||||
pure $ sch' {_schemaProperties = IOHM.adjust (const prop') k $ _schemaProperties sch'}
|
||||
PHere -> case part of
|
||||
CByEnumValue vals -> do
|
||||
enum' <- case _schemaEnum sch' of
|
||||
Nothing -> do
|
||||
mChange
|
||||
pure $ S.toList vals
|
||||
Just xs -> do
|
||||
when (any (`S.notMember` vals) xs) mChange
|
||||
case filter (`S.member` vals) xs of
|
||||
[] -> mBottom
|
||||
xs' -> pure xs'
|
||||
pure $ sch' {_schemaEnum = Just enum'}
|
||||
CByProperties {} -> error "CByProperties not implemented"
|
||||
|
||||
intersectRefSchema
|
||||
:: PartitionLocation
|
||||
-> PartitionChoice
|
||||
-> Traced (Referenced Schema)
|
||||
-> IntersectionM (Referenced Schema)
|
||||
intersectRefSchema loc part rs = do
|
||||
defs <- R.ask
|
||||
Inline <$> intersectSchema loc part (dereference defs rs)
|
||||
|
||||
intersectCondition :: Traced (Definitions Schema) -> PartitionLocation -> PartitionChoice -> Condition t -> DNF (Condition t)
|
||||
intersectCondition _defs PHere (CByEnumValue values) cond@(Exactly x) =
|
||||
if untypeValue x `S.member` values then LiteralDNF cond else bottom
|
||||
intersectCondition defs (PInProperty k loc) part cond@(Properties props add madd) = case M.lookup k props of
|
||||
Nothing -> LiteralDNF cond -- shouldn't happen
|
||||
Just prop -> case runIntersectionM defs $ intersectRefSchema loc part $ propRefSchema prop of
|
||||
New rs' ->
|
||||
let trs' = traced (ask (propRefSchema prop) >>> step (Partitioned (loc, part))) rs'
|
||||
in LiteralDNF $ Properties (M.insert k prop {propRefSchema = trs'} props) add madd
|
||||
Same _ -> LiteralDNF cond
|
||||
Disjoint -> bottom
|
||||
intersectCondition _defs _loc _part cond = LiteralDNF cond
|
||||
|
||||
intersectFormula :: Traced (Definitions Schema) -> PartitionLocation -> PartitionChoice -> JsonFormula t -> JsonFormula t
|
||||
intersectFormula defs loc part = JsonFormula . foldDNF (intersectCondition defs loc part) . getJsonFormula
|
||||
|
||||
tryPartition :: ProdCons (Traced (Definitions Schema)) -> ProdCons (JsonFormula t) -> [(Maybe Partition, ProdCons (JsonFormula t))]
|
||||
tryPartition defs pc = case selectPartition $ partitionJsonFormulas defs pc of
|
||||
Nothing -> [(Nothing, pc)]
|
||||
Just (loc, parts) -> [(Just (loc, part), intersectFormula <$> defs <*> pure loc <*> pure part <*> pc) | part <- S.toList parts]
|
||||
|
||||
showPartition :: Partition -> Inlines
|
||||
showPartition = \case
|
||||
(partition, CByEnumValue (S.toList -> [v])) ->
|
||||
renderPartitionLocation partition <> " is " <> showJSONValueInline v
|
||||
(partition, CByEnumValue (S.toList -> vs)) ->
|
||||
renderPartitionLocation partition <> " has values: "
|
||||
<> (fold . L.intersperse ", " . fmap showJSONValueInline $ vs)
|
||||
(partition, CByProperties (S.toList -> incl) (S.toList -> [])) ->
|
||||
renderPartitionLocation partition <> " contains the properties: " <> listCodes incl
|
||||
(partition, CByProperties (S.toList -> []) (S.toList -> excl)) ->
|
||||
renderPartitionLocation partition <> " does not contain the properties: " <> listCodes excl
|
||||
(partition, CByProperties (S.toList -> incl) (S.toList -> excl)) ->
|
||||
renderPartitionLocation partition
|
||||
<> " contains the properties "
|
||||
<> listCodes incl
|
||||
<> " and does not contain the properties "
|
||||
<> listCodes excl
|
||||
where
|
||||
listCodes :: [Text] -> Inlines
|
||||
listCodes = fold . L.intersperse ", " . fmap code
|
||||
renderPartitionLocation :: PartitionLocation -> Inlines
|
||||
renderPartitionLocation p = code $ "$" <> renderPartitionLocation' p
|
||||
where
|
||||
renderPartitionLocation' :: PartitionLocation -> Text
|
||||
renderPartitionLocation' PHere = mempty
|
||||
renderPartitionLocation' (PInProperty prop rest) = "." <> prop <> renderPartitionLocation' rest
|
372
src/OpenAPI/Checker/Validate/Schema/Process.hs
Normal file
372
src/OpenAPI/Checker/Validate/Schema/Process.hs
Normal file
@ -0,0 +1,372 @@
|
||||
module OpenAPI.Checker.Validate.Schema.Process
|
||||
( schemaToFormula
|
||||
)
|
||||
where
|
||||
|
||||
import Algebra.Lattice
|
||||
import qualified Control.Monad.Reader as R
|
||||
import Control.Monad.Reader hiding (ask)
|
||||
import Control.Monad.State
|
||||
import Control.Monad.Writer
|
||||
import qualified Data.Aeson as A
|
||||
import Data.Functor.Identity
|
||||
import qualified Data.HashMap.Strict.InsOrd as IOHM
|
||||
import qualified Data.Map as M
|
||||
import Data.Maybe
|
||||
import Data.OpenApi hiding (get)
|
||||
import Data.Ord
|
||||
import qualified Data.Set as S
|
||||
import OpenAPI.Checker.Behavior
|
||||
import OpenAPI.Checker.Memo
|
||||
import OpenAPI.Checker.Paths
|
||||
import qualified OpenAPI.Checker.PathsPrefixTree as P
|
||||
import OpenAPI.Checker.References
|
||||
import OpenAPI.Checker.Subtree
|
||||
import OpenAPI.Checker.Validate.Schema.DNF
|
||||
import OpenAPI.Checker.Validate.Schema.Issues
|
||||
import OpenAPI.Checker.Validate.Schema.JsonFormula
|
||||
import OpenAPI.Checker.Validate.Schema.Partition
|
||||
import OpenAPI.Checker.Validate.Schema.Traced
|
||||
import OpenAPI.Checker.Validate.Schema.TypedJson
|
||||
|
||||
-- | A fake writer monad that doesn't actually record anything and allows lazy recursion.
|
||||
newtype Silent w a = Silent {runSilent :: a}
|
||||
deriving stock (Functor)
|
||||
deriving (Applicative, Monad) via Identity
|
||||
|
||||
instance Monoid w => MonadWriter w (Silent w) where
|
||||
tell _ = Silent ()
|
||||
listen (Silent x) = Silent (x, mempty)
|
||||
pass (Silent (x, _)) = Silent x
|
||||
|
||||
instance MonadState (MemoState ()) (Silent w) where
|
||||
get = Silent $ runIdentity $ runMemo () get
|
||||
put _ = pure ()
|
||||
|
||||
type ProcessM = StateT (MemoState ()) (ReaderT (Traced (Definitions Schema)) (Writer (P.PathsPrefixTree Behave AnIssue 'SchemaLevel)))
|
||||
|
||||
type SilentM = ReaderT (Traced (Definitions Schema)) (Silent (P.PathsPrefixTree Behave AnIssue 'SchemaLevel))
|
||||
|
||||
-- Either SilentM or ProcessM
|
||||
type MonadProcess m =
|
||||
( MonadReader (Traced (Definitions Schema)) m
|
||||
, MonadWriter (P.PathsPrefixTree Behave AnIssue 'SchemaLevel) m
|
||||
, MonadState (MemoState ()) m
|
||||
)
|
||||
|
||||
warn :: MonadProcess m => Issue 'SchemaLevel -> m ()
|
||||
warn issue = tell $ P.singleton $ AnItem Root $ anIssue issue
|
||||
|
||||
-- | Ignore warnings but allow a recursive loop that lazily computes a recursive 'Condition'.
|
||||
silently :: MonadProcess m => SilentM a -> m a
|
||||
silently m = do
|
||||
defs <- R.ask
|
||||
pure . runSilent $ runReaderT m defs
|
||||
|
||||
warnKnot :: MonadProcess m => KnotTier (ForeachType JsonFormula) () m
|
||||
warnKnot =
|
||||
KnotTier
|
||||
{ onKnotFound = warn UnguardedRecursion
|
||||
, onKnotUsed = \_ -> pure bottom
|
||||
, tieKnot = \_ -> pure
|
||||
}
|
||||
|
||||
processRefSchema
|
||||
:: MonadProcess m
|
||||
=> Traced (Referenced Schema)
|
||||
-> m (ForeachType JsonFormula)
|
||||
processRefSchema x = do
|
||||
defs <- R.ask
|
||||
memoWithKnot warnKnot (processSchema $ dereference defs x) (ask x)
|
||||
|
||||
-- | Turn a schema into a tuple of 'JsonFormula's that describes the condition
|
||||
-- for every possible type of a JSON value. The conditions are independent, and
|
||||
-- are thus checked independently.
|
||||
processSchema
|
||||
:: MonadProcess m
|
||||
=> Traced Schema
|
||||
-> m (ForeachType JsonFormula)
|
||||
processSchema sch@(extract -> Schema {..}) = do
|
||||
let singletonFormula :: Condition t -> JsonFormula t
|
||||
singletonFormula = JsonFormula . LiteralDNF
|
||||
|
||||
allClauses <- case tracedAllOf sch of
|
||||
Nothing -> pure []
|
||||
Just [] -> [] <$ warn (InvalidSchema "no items in allOf")
|
||||
Just xs -> mapM processRefSchema xs
|
||||
|
||||
anyClause <- case tracedAnyOf sch of
|
||||
Nothing -> pure top
|
||||
Just [] -> bottom <$ warn (InvalidSchema "no items in anyOf")
|
||||
Just xs -> joins <$> mapM processRefSchema xs
|
||||
|
||||
oneClause <- case tracedOneOf sch of
|
||||
Nothing -> pure top
|
||||
Just [] -> bottom <$ warn (InvalidSchema "no items in oneOf")
|
||||
Just xs -> do
|
||||
checkOneOfDisjoint xs >>= \case
|
||||
True -> pure ()
|
||||
False -> warn OneOfNotDisjoint
|
||||
joins <$> mapM processRefSchema xs
|
||||
|
||||
case _schemaNot of
|
||||
Nothing -> pure ()
|
||||
Just _ -> warn (NotSupported "not clause is unsupported")
|
||||
|
||||
let typeClause = case _schemaType of
|
||||
Nothing -> top
|
||||
Just OpenApiNull ->
|
||||
bottom
|
||||
{ forNull = top
|
||||
}
|
||||
Just OpenApiBoolean ->
|
||||
bottom
|
||||
{ forBoolean = top
|
||||
}
|
||||
Just OpenApiNumber ->
|
||||
bottom
|
||||
{ forNumber = top
|
||||
}
|
||||
Just OpenApiInteger ->
|
||||
bottom
|
||||
{ forNumber = singletonFormula $ MultipleOf 1
|
||||
}
|
||||
Just OpenApiString ->
|
||||
bottom
|
||||
{ forString = top
|
||||
}
|
||||
Just OpenApiArray ->
|
||||
bottom
|
||||
{ forArray = top
|
||||
}
|
||||
Just OpenApiObject ->
|
||||
bottom
|
||||
{ forObject = top
|
||||
}
|
||||
|
||||
let valueEnum A.Null =
|
||||
bottom
|
||||
{ forNull = singletonFormula $ Exactly TNull
|
||||
}
|
||||
valueEnum (A.Bool b) =
|
||||
bottom
|
||||
{ forBoolean = singletonFormula $ Exactly $ TBool b
|
||||
}
|
||||
valueEnum (A.Number n) =
|
||||
bottom
|
||||
{ forNumber = singletonFormula $ Exactly $ TNumber n
|
||||
}
|
||||
valueEnum (A.String s) =
|
||||
bottom
|
||||
{ forString = singletonFormula $ Exactly $ TString s
|
||||
}
|
||||
valueEnum (A.Array a) =
|
||||
bottom
|
||||
{ forArray = singletonFormula $ Exactly $ TArray a
|
||||
}
|
||||
valueEnum (A.Object o) =
|
||||
bottom
|
||||
{ forObject = singletonFormula $ Exactly $ TObject o
|
||||
}
|
||||
enumClause <- case _schemaEnum of
|
||||
Nothing -> pure top
|
||||
Just [] -> bottom <$ warn (InvalidSchema "no items in enum")
|
||||
Just xs -> pure $ joins (valueEnum <$> xs)
|
||||
|
||||
let maximumClause = case _schemaMaximum of
|
||||
Nothing -> top
|
||||
Just n ->
|
||||
top
|
||||
{ forNumber = singletonFormula $
|
||||
Maximum $
|
||||
case _schemaExclusiveMaximum of
|
||||
Just True -> Exclusive n
|
||||
_ -> Inclusive n
|
||||
}
|
||||
|
||||
minimumClause = case _schemaMinimum of
|
||||
Nothing -> top
|
||||
Just n ->
|
||||
top
|
||||
{ forNumber = singletonFormula $
|
||||
Minimum $
|
||||
Down $
|
||||
case _schemaExclusiveMinimum of
|
||||
Just True -> Exclusive $ Down n
|
||||
_ -> Inclusive $ Down n
|
||||
}
|
||||
|
||||
multipleOfClause = case _schemaMultipleOf of
|
||||
Nothing -> top
|
||||
Just n ->
|
||||
top
|
||||
{ forNumber = singletonFormula $ MultipleOf n
|
||||
}
|
||||
|
||||
formatClause <- case _schemaFormat of
|
||||
Nothing -> pure top
|
||||
Just f
|
||||
| f `elem` ["int32", "int64", "float", "double"] ->
|
||||
pure
|
||||
top
|
||||
{ forNumber = singletonFormula $ NumberFormat f
|
||||
}
|
||||
Just f
|
||||
| f `elem` ["byte", "binary", "date", "date-time", "password", "uuid"] ->
|
||||
pure
|
||||
top
|
||||
{ forString = singletonFormula $ StringFormat f
|
||||
}
|
||||
Just f -> top <$ warn (NotSupported $ "Unknown format: " <> f)
|
||||
|
||||
let maxLengthClause = case _schemaMaxLength of
|
||||
Nothing -> top
|
||||
Just n ->
|
||||
top
|
||||
{ forString = singletonFormula $ MaxLength n
|
||||
}
|
||||
|
||||
minLengthClause = case _schemaMinLength of
|
||||
Nothing -> top
|
||||
Just n ->
|
||||
top
|
||||
{ forString = singletonFormula $ MinLength n
|
||||
}
|
||||
|
||||
patternClause = case _schemaPattern of
|
||||
Nothing -> top
|
||||
Just p ->
|
||||
top
|
||||
{ forString = singletonFormula $ Pattern p
|
||||
}
|
||||
|
||||
itemsClause <- case tracedItems sch of
|
||||
Nothing -> pure top
|
||||
Just (Left rs) -> do
|
||||
f <- silently $ processRefSchema rs
|
||||
pure top {forArray = singletonFormula $ Items f rs}
|
||||
Just (Right _) -> top <$ warn (NotSupported "array in items is not supported")
|
||||
|
||||
let maxItemsClause = case _schemaMaxItems of
|
||||
Nothing -> top
|
||||
Just n ->
|
||||
top
|
||||
{ forArray = singletonFormula $ MaxItems n
|
||||
}
|
||||
|
||||
minItemsClause = case _schemaMinItems of
|
||||
Nothing -> top
|
||||
Just n ->
|
||||
top
|
||||
{ forArray = singletonFormula $ MinItems n
|
||||
}
|
||||
|
||||
uniqueItemsClause = case _schemaUniqueItems of
|
||||
Just True ->
|
||||
top
|
||||
{ forArray = singletonFormula UniqueItems
|
||||
}
|
||||
_ -> top
|
||||
|
||||
(addProps, addPropSchema) <- case tracedAdditionalProperties sch of
|
||||
Just (Right rs) -> (,Just rs) <$> silently (processRefSchema rs)
|
||||
Just (Left False) -> pure (bottom, Nothing)
|
||||
_ -> pure (top, Just $ traced (ask sch `Snoc` AdditionalPropertiesStep) $ Inline mempty)
|
||||
propList <- forM (S.toList . S.fromList $ IOHM.keys _schemaProperties <> _schemaRequired) $ \k -> do
|
||||
(f, psch) <- case IOHM.lookup k $ tracedProperties sch of
|
||||
Just rs -> (,rs) <$> silently (processRefSchema rs)
|
||||
Nothing ->
|
||||
let fakeSchema = traced (ask sch `Snoc` AdditionalPropertiesStep) $ Inline mempty
|
||||
in -- The mempty here is incorrect, but if addPropSchema was Nothing, then
|
||||
-- addProps is bottom, and k is in _schemaRequired. We handle this situation
|
||||
-- below and short-circuit the entire Properties condition to bottom
|
||||
pure (addProps, fromMaybe fakeSchema addPropSchema)
|
||||
pure (k, Property (k `elem` _schemaRequired) f psch)
|
||||
let allBottom f = getAll $
|
||||
foldType $ \_ ty -> case getJsonFormula $ ty f of
|
||||
BottomDNF -> All True
|
||||
_ -> All False
|
||||
allTop f = getAll $
|
||||
foldType $ \_ ty -> case getJsonFormula $ ty f of
|
||||
TopDNF -> All True
|
||||
_ -> All False
|
||||
-- remove optional fields whose schemata match that of additional props
|
||||
propMap = M.filter (\p -> propRequired p || propFormula p /= addProps) $ M.fromList propList
|
||||
propertiesClause
|
||||
| any (\p -> propRequired p && allBottom (propFormula p)) propMap =
|
||||
bottom -- if any required field has unsatisfiable schema
|
||||
| M.null propMap
|
||||
, allTop addProps =
|
||||
top -- if all fields are optional and have trivial schemata
|
||||
| otherwise =
|
||||
top
|
||||
{ forObject = singletonFormula $ Properties propMap addProps addPropSchema
|
||||
}
|
||||
|
||||
maxPropertiesClause = case _schemaMaxProperties of
|
||||
Nothing -> top
|
||||
Just n ->
|
||||
top
|
||||
{ forObject = singletonFormula $ MaxProperties n
|
||||
}
|
||||
|
||||
minPropertiesClause = case _schemaMinProperties of
|
||||
Nothing -> top
|
||||
Just n ->
|
||||
top
|
||||
{ forObject = singletonFormula $ MinProperties n
|
||||
}
|
||||
|
||||
nullableClause
|
||||
| Just True <- _schemaNullable =
|
||||
bottom
|
||||
{ forNull = singletonFormula $ Exactly TNull
|
||||
}
|
||||
| otherwise = bottom
|
||||
|
||||
pure $
|
||||
nullableClause
|
||||
\/ meets
|
||||
(allClauses
|
||||
<> [ anyClause
|
||||
, oneClause
|
||||
, typeClause
|
||||
, enumClause
|
||||
, maximumClause
|
||||
, minimumClause
|
||||
, multipleOfClause
|
||||
, formatClause
|
||||
, maxLengthClause
|
||||
, minLengthClause
|
||||
, patternClause
|
||||
, itemsClause
|
||||
, maxItemsClause
|
||||
, minItemsClause
|
||||
, uniqueItemsClause
|
||||
, propertiesClause
|
||||
, maxPropertiesClause
|
||||
, minPropertiesClause
|
||||
])
|
||||
|
||||
{- TODO: ReadOnly/WriteOnly #68 -}
|
||||
|
||||
checkOneOfDisjoint :: MonadProcess m => [Traced (Referenced Schema)] -> m Bool
|
||||
checkOneOfDisjoint schs = do
|
||||
defs <- R.ask
|
||||
pure $ case selectPartition $ joins $ runPartitionM defs $ traverse partitionRefSchema schs of
|
||||
Nothing -> False
|
||||
Just (loc, parts) ->
|
||||
let intersects part sch = case runIntersectionM defs $ intersectRefSchema loc part sch of
|
||||
Disjoint -> False
|
||||
_ -> True
|
||||
in all (\part -> 1 >= length (filter (intersects part) schs)) parts
|
||||
where
|
||||
|
||||
runProcessM :: Traced (Definitions Schema) -> ProcessM a -> (a, P.PathsPrefixTree Behave AnIssue 'SchemaLevel)
|
||||
runProcessM defs = runWriter . (`runReaderT` defs) . runMemo ()
|
||||
|
||||
schemaToFormula
|
||||
:: Traced (Definitions Schema)
|
||||
-> Traced Schema
|
||||
-> (ForeachType JsonFormula, P.PathsPrefixTree Behave AnIssue 'SchemaLevel)
|
||||
schemaToFormula defs rs = runProcessM defs $ processSchema rs
|
114
src/OpenAPI/Checker/Validate/Schema/Traced.hs
Normal file
114
src/OpenAPI/Checker/Validate/Schema/Traced.hs
Normal file
@ -0,0 +1,114 @@
|
||||
{-# OPTIONS_GHC -Wno-orphans #-}
|
||||
|
||||
module OpenAPI.Checker.Validate.Schema.Traced
|
||||
( Step (..)
|
||||
, tracedAllOf
|
||||
, tracedAnyOf
|
||||
, tracedOneOf
|
||||
, tracedItems
|
||||
, tracedAdditionalProperties
|
||||
, tracedDiscriminator
|
||||
, tracedProperties
|
||||
, tracedConjunct
|
||||
, PartitionLocation (..)
|
||||
, PartitionChoice (..)
|
||||
, Partition
|
||||
)
|
||||
where
|
||||
|
||||
import qualified Data.Aeson as A
|
||||
import Data.Functor
|
||||
import qualified Data.HashMap.Strict.InsOrd as IOHM
|
||||
import qualified Data.List.NonEmpty as NE
|
||||
import Data.OpenApi
|
||||
import qualified Data.Set as S
|
||||
import Data.Text (Text)
|
||||
import OpenAPI.Checker.Subtree
|
||||
|
||||
data PartitionChoice
|
||||
= CByEnumValue (S.Set A.Value)
|
||||
| CByProperties (S.Set Text) (S.Set Text) -- included, excluded
|
||||
deriving stock (Eq, Ord, Show)
|
||||
|
||||
data PartitionLocation
|
||||
= PHere
|
||||
| PInProperty Text PartitionLocation
|
||||
deriving stock (Eq, Ord, Show)
|
||||
|
||||
type Partition = (PartitionLocation, PartitionChoice)
|
||||
|
||||
instance Steppable Schema (Referenced Schema) where
|
||||
data Step Schema (Referenced Schema)
|
||||
= AllOfStep Int
|
||||
| OneOfStep Int
|
||||
| AnyOfStep Int
|
||||
| ItemsObjectStep
|
||||
| ItemsArrayStep Int
|
||||
| AdditionalPropertiesStep
|
||||
| NotStep
|
||||
deriving stock (Eq, Ord, Show)
|
||||
|
||||
instance Steppable (Referenced Schema) (Referenced Schema) where
|
||||
data Step (Referenced Schema) (Referenced Schema)
|
||||
= -- | Invariant (for better memoization only): the "tail" of the trace is
|
||||
-- the "least" of the traces of the conjuncted schemata
|
||||
ConjunctedWith (NE.NonEmpty (Trace (Referenced Schema)))
|
||||
| Partitioned Partition
|
||||
deriving stock (Eq, Ord, Show)
|
||||
|
||||
instance Steppable Schema (Definitions (Referenced Schema)) where
|
||||
data Step Schema (Definitions (Referenced Schema)) = PropertiesStep
|
||||
deriving stock (Eq, Ord, Show)
|
||||
|
||||
instance Steppable Schema Discriminator where
|
||||
data Step Schema Discriminator = DiscriminatorStep
|
||||
deriving stock (Eq, Ord, Show)
|
||||
|
||||
instance Steppable Discriminator (Definitions (Referenced Schema)) where
|
||||
data Step Discriminator (Definitions (Referenced Schema)) = DiscriminatorMapping
|
||||
deriving stock (Eq, Ord, Show)
|
||||
|
||||
tracedAllOf :: Traced Schema -> Maybe [Traced (Referenced Schema)]
|
||||
tracedAllOf sch =
|
||||
_schemaAllOf (extract sch) <&> \xs ->
|
||||
[traced (ask sch >>> step (AllOfStep i)) x | (i, x) <- zip [0 ..] xs]
|
||||
|
||||
tracedAnyOf :: Traced Schema -> Maybe [Traced (Referenced Schema)]
|
||||
tracedAnyOf sch =
|
||||
_schemaAnyOf (extract sch) <&> \xs ->
|
||||
[traced (ask sch >>> step (AnyOfStep i)) x | (i, x) <- zip [0 ..] xs]
|
||||
|
||||
tracedOneOf :: Traced Schema -> Maybe [Traced (Referenced Schema)]
|
||||
tracedOneOf sch =
|
||||
_schemaOneOf (extract sch) <&> \xs ->
|
||||
[traced (ask sch >>> step (OneOfStep i)) x | (i, x) <- zip [0 ..] xs]
|
||||
|
||||
tracedItems :: Traced Schema -> Maybe (Either (Traced (Referenced Schema)) [Traced (Referenced Schema)])
|
||||
tracedItems sch =
|
||||
_schemaItems (extract sch) <&> \case
|
||||
OpenApiItemsObject x -> Left $ traced (ask sch >>> step ItemsObjectStep) x
|
||||
OpenApiItemsArray xs ->
|
||||
Right
|
||||
[traced (ask sch >>> step (ItemsArrayStep i)) x | (i, x) <- zip [0 ..] xs]
|
||||
|
||||
tracedAdditionalProperties :: Traced Schema -> Maybe (Either Bool (Traced (Referenced Schema)))
|
||||
tracedAdditionalProperties sch =
|
||||
_schemaAdditionalProperties (extract sch) <&> \case
|
||||
AdditionalPropertiesAllowed b -> Left b
|
||||
AdditionalPropertiesSchema x -> Right $ traced (ask sch >>> step AdditionalPropertiesStep) x
|
||||
|
||||
tracedDiscriminator :: Traced Schema -> Maybe (Traced Discriminator)
|
||||
tracedDiscriminator = sequence . stepTraced DiscriminatorStep . fmap _schemaDiscriminator
|
||||
|
||||
tracedProperties :: Traced Schema -> IOHM.InsOrdHashMap Text (Traced (Referenced Schema))
|
||||
tracedProperties sch =
|
||||
IOHM.mapWithKey
|
||||
(\k -> traced (ask sch >>> step PropertiesStep >>> step (InsOrdHashMapKeyStep k)))
|
||||
(_schemaProperties $ extract sch)
|
||||
|
||||
tracedConjunct :: NE.NonEmpty (Traced (Referenced Schema)) -> Traced (Referenced Schema)
|
||||
tracedConjunct refSchemas = case NE.sortWith ask refSchemas of
|
||||
(rs NE.:| []) -> rs
|
||||
(rs1 NE.:| rs2 : rss) ->
|
||||
traced (ask rs1 >>> step (ConjunctedWith $ ask <$> rs2 NE.:| rss)) $
|
||||
Inline mempty {_schemaAllOf = Just $ extract <$> rs1 : rs2 : rss}
|
118
src/OpenAPI/Checker/Validate/Schema/TypedJson.hs
Normal file
118
src/OpenAPI/Checker/Validate/Schema/TypedJson.hs
Normal file
@ -0,0 +1,118 @@
|
||||
module OpenAPI.Checker.Validate.Schema.TypedJson
|
||||
( JsonType (..)
|
||||
, describeJSONType
|
||||
, TypedValue (..)
|
||||
, untypeValue
|
||||
, ForeachType (..)
|
||||
, foldType
|
||||
, forType_
|
||||
)
|
||||
where
|
||||
|
||||
import Algebra.Lattice
|
||||
import qualified Data.Aeson as A
|
||||
import Data.Kind
|
||||
import Data.Monoid
|
||||
import Data.Scientific
|
||||
import Data.String
|
||||
import Data.Text (Text)
|
||||
import Data.Typeable
|
||||
|
||||
-- | Type of a JSON value
|
||||
data JsonType
|
||||
= Null
|
||||
| Boolean
|
||||
| Number
|
||||
| String
|
||||
| Array
|
||||
| Object
|
||||
deriving stock (Eq, Ord, Show)
|
||||
|
||||
describeJSONType :: IsString s => JsonType -> s
|
||||
describeJSONType = \case
|
||||
Null -> "Null"
|
||||
Boolean -> "Boolean"
|
||||
Number -> "Number"
|
||||
String -> "String"
|
||||
Array -> "Array"
|
||||
Object -> "Object"
|
||||
|
||||
-- | A 'A.Value' whose type we know
|
||||
data TypedValue :: JsonType -> Type where
|
||||
TNull :: TypedValue 'Null
|
||||
TBool :: !Bool -> TypedValue 'Boolean
|
||||
TNumber :: !Scientific -> TypedValue 'Number
|
||||
TString :: !Text -> TypedValue 'String
|
||||
TArray :: !A.Array -> TypedValue 'Array
|
||||
TObject :: !A.Object -> TypedValue 'Object
|
||||
|
||||
deriving stock instance Eq (TypedValue t)
|
||||
|
||||
deriving stock instance Ord (TypedValue t)
|
||||
|
||||
deriving stock instance Show (TypedValue t)
|
||||
|
||||
untypeValue :: TypedValue t -> A.Value
|
||||
untypeValue TNull = A.Null
|
||||
untypeValue (TBool b) = A.Bool b
|
||||
untypeValue (TNumber n) = A.Number n
|
||||
untypeValue (TString s) = A.String s
|
||||
untypeValue (TArray a) = A.Array a
|
||||
untypeValue (TObject o) = A.Object o
|
||||
|
||||
data ForeachType (f :: JsonType -> Type) = ForeachType
|
||||
{ forNull :: f 'Null
|
||||
, forBoolean :: f 'Boolean
|
||||
, forNumber :: f 'Number
|
||||
, forString :: f 'String
|
||||
, forArray :: f 'Array
|
||||
, forObject :: f 'Object
|
||||
}
|
||||
|
||||
deriving stock instance (forall x. Typeable x => Eq (f x)) => Eq (ForeachType f)
|
||||
|
||||
deriving stock instance (forall x. Typeable x => Ord (f x)) => Ord (ForeachType f)
|
||||
|
||||
deriving stock instance (forall x. Typeable x => Show (f x)) => Show (ForeachType f)
|
||||
|
||||
foldType :: Monoid m => (forall x. Typeable x => JsonType -> (ForeachType f -> f x) -> m) -> m
|
||||
foldType k =
|
||||
k Null forNull
|
||||
<> k Boolean forBoolean
|
||||
<> k Number forNumber
|
||||
<> k String forString
|
||||
<> k Array forArray
|
||||
<> k Object forObject
|
||||
|
||||
forType_ :: Applicative m => (forall x. Typeable x => JsonType -> (ForeachType f -> f x) -> m ()) -> m ()
|
||||
forType_ k = getAp $ foldType (\ty proj -> Ap $ k ty proj)
|
||||
|
||||
broadcastType :: (forall x. Typeable x => f x) -> ForeachType f
|
||||
broadcastType k = ForeachType
|
||||
{ forNull = k
|
||||
, forBoolean = k
|
||||
, forNumber = k
|
||||
, forString = k
|
||||
, forArray = k
|
||||
, forObject = k
|
||||
}
|
||||
|
||||
zipType :: (forall x. Typeable x => f x -> g x -> h x) -> ForeachType f -> ForeachType g -> ForeachType h
|
||||
zipType k f1 f2 = ForeachType
|
||||
{ forNull = k (forNull f1) (forNull f2)
|
||||
, forBoolean = k (forBoolean f1) (forBoolean f2)
|
||||
, forNumber = k (forNumber f1) (forNumber f2)
|
||||
, forString = k (forString f1) (forString f2)
|
||||
, forArray = k (forArray f1) (forArray f2)
|
||||
, forObject = k (forObject f1) (forObject f2)
|
||||
}
|
||||
|
||||
instance (forall x. Lattice (f x)) => Lattice (ForeachType f) where
|
||||
(\/) = zipType (\/)
|
||||
(/\) = zipType (/\)
|
||||
|
||||
instance (forall x. BoundedJoinSemiLattice (f x)) => BoundedJoinSemiLattice (ForeachType f) where
|
||||
bottom = broadcastType bottom
|
||||
|
||||
instance (forall x. BoundedMeetSemiLattice (f x)) => BoundedMeetSemiLattice (ForeachType f) where
|
||||
top = broadcastType top
|
39
test/golden/common/bad-oneof-unchanged/a.yaml
Normal file
39
test/golden/common/bad-oneof-unchanged/a.yaml
Normal file
@ -0,0 +1,39 @@
|
||||
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:
|
||||
oneOf:
|
||||
- type: object
|
||||
required: ["tag", "prop_A"]
|
||||
properties:
|
||||
tag:
|
||||
enum: ["A"]
|
||||
prop_A:
|
||||
type: string
|
||||
- type: object
|
||||
required: ["tag", "prop_B"]
|
||||
properties:
|
||||
tag:
|
||||
enum: ["A"]
|
||||
prop_B:
|
||||
type: number
|
39
test/golden/common/bad-oneof-unchanged/b.yaml
Normal file
39
test/golden/common/bad-oneof-unchanged/b.yaml
Normal file
@ -0,0 +1,39 @@
|
||||
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:
|
||||
oneOf:
|
||||
- type: object
|
||||
required: ["tag", "prop_B"]
|
||||
properties:
|
||||
tag:
|
||||
enum: ["A"]
|
||||
prop_B:
|
||||
type: number
|
||||
- type: object
|
||||
required: ["tag", "prop_A"]
|
||||
properties:
|
||||
tag:
|
||||
enum: ["A"]
|
||||
prop_A:
|
||||
type: string
|
19
test/golden/common/bad-oneof-unchanged/report.md
Normal file
19
test/golden/common/bad-oneof-unchanged/report.md
Normal file
@ -0,0 +1,19 @@
|
||||
# Summary
|
||||
|
||||
| ⚠️ Breaking changes | 🙆 Non-breaking changes | [🤷 Unsupported feature changes](#unsupported-changes) |
|
||||
|---------------------|------------------------|-------------------------------------------------------|
|
||||
| 0 | 0 | 2 |
|
||||
|
||||
# <span id="unsupported-changes"></span>🤷 Unsupported feature changes
|
||||
|
||||
## **POST** /test
|
||||
|
||||
### 📱➡️ JSON Request
|
||||
|
||||
Could not deduce that `oneOf` cases don't overlap. Treating the `oneOf`
|
||||
as an `anyOf`. Reported errors might not be accurate.
|
||||
|
||||
### 📱⬅️ JSON Response – 200
|
||||
|
||||
Could not deduce that `oneOf` cases don't overlap. Treating the `oneOf`
|
||||
as an `anyOf`. Reported errors might not be accurate.
|
18
test/golden/common/bad-oneof-unchanged/trace-tree.yaml
Normal file
18
test/golden/common/bad-oneof-unchanged/trace-tree.yaml
Normal file
@ -0,0 +1,18 @@
|
||||
breakingChanges:
|
||||
AtPath "/test":
|
||||
InOperation PostMethod:
|
||||
InRequest:
|
||||
InPayload:
|
||||
PayloadSchema: OneOfNotDisjoint
|
||||
WithStatusCode 200:
|
||||
ResponsePayload:
|
||||
PayloadSchema: OneOfNotDisjoint
|
||||
nonBreakingChanges:
|
||||
AtPath "/test":
|
||||
InOperation PostMethod:
|
||||
InRequest:
|
||||
InPayload:
|
||||
PayloadSchema: OneOfNotDisjoint
|
||||
WithStatusCode 200:
|
||||
ResponsePayload:
|
||||
PayloadSchema: OneOfNotDisjoint
|
@ -14,7 +14,7 @@
|
||||
|
||||
##### `$(String)`
|
||||
|
||||
The value has been removed.
|
||||
The type has been removed.
|
||||
|
||||
# <span id="non-breaking-changes"></span>🙆 Non-breaking changes
|
||||
|
||||
@ -26,4 +26,4 @@ The value has been removed.
|
||||
|
||||
##### `$(Number)`
|
||||
|
||||
The value has been added.
|
||||
The type has been added.
|
||||
|
@ -3,10 +3,10 @@ breakingChanges:
|
||||
InOperation PostMethod:
|
||||
InParam "test":
|
||||
InParamSchema:
|
||||
OfType String: NoContradiction
|
||||
OfType String: TypeBecomesEmpty
|
||||
nonBreakingChanges:
|
||||
AtPath "/test":
|
||||
InOperation PostMethod:
|
||||
InParam "test":
|
||||
InParamSchema:
|
||||
OfType Number: NoContradiction
|
||||
OfType Number: TypeBecomesEmpty
|
||||
|
@ -12,7 +12,7 @@
|
||||
|
||||
#### `$(String)`
|
||||
|
||||
The value has been removed.
|
||||
The type has been removed.
|
||||
|
||||
# <span id="non-breaking-changes"></span>🙆 Non-breaking changes
|
||||
|
||||
@ -22,4 +22,4 @@ The value has been removed.
|
||||
|
||||
#### `$(Number)`
|
||||
|
||||
The value has been added.
|
||||
The type has been added.
|
||||
|
@ -4,11 +4,11 @@ breakingChanges:
|
||||
InRequest:
|
||||
InPayload:
|
||||
PayloadSchema:
|
||||
OfType String: NoContradiction
|
||||
OfType String: TypeBecomesEmpty
|
||||
nonBreakingChanges:
|
||||
AtPath "/test":
|
||||
InOperation PostMethod:
|
||||
InRequest:
|
||||
InPayload:
|
||||
PayloadSchema:
|
||||
OfType Number: NoContradiction
|
||||
OfType Number: TypeBecomesEmpty
|
||||
|
@ -12,7 +12,7 @@
|
||||
|
||||
#### `$(Number)`
|
||||
|
||||
The value has been added.
|
||||
The type has been added.
|
||||
|
||||
# <span id="non-breaking-changes"></span>🙆 Non-breaking changes
|
||||
|
||||
@ -22,4 +22,4 @@ The value has been added.
|
||||
|
||||
#### `$(String)`
|
||||
|
||||
The value has been removed.
|
||||
The type has been removed.
|
||||
|
@ -4,11 +4,11 @@ breakingChanges:
|
||||
WithStatusCode 200:
|
||||
ResponsePayload:
|
||||
PayloadSchema:
|
||||
OfType Number: NoContradiction
|
||||
OfType Number: TypeBecomesEmpty
|
||||
nonBreakingChanges:
|
||||
AtPath "/test":
|
||||
InOperation PostMethod:
|
||||
WithStatusCode 200:
|
||||
ResponsePayload:
|
||||
PayloadSchema:
|
||||
OfType String: NoContradiction
|
||||
OfType String: TypeBecomesEmpty
|
||||
|
@ -32,7 +32,7 @@ Values are now limited to the following types:
|
||||
|
||||
#### `$(Array)`
|
||||
|
||||
The value has been removed.
|
||||
The type has been removed.
|
||||
|
||||
## **POST** /test4
|
||||
|
||||
@ -40,7 +40,7 @@ The value has been removed.
|
||||
|
||||
#### `$(Object)`
|
||||
|
||||
The value has been removed.
|
||||
The type has been removed.
|
||||
|
||||
## **POST** /test5
|
||||
|
||||
@ -82,7 +82,7 @@ Values are now limited to the following types:
|
||||
|
||||
#### `$(Array)`
|
||||
|
||||
The value has been removed.
|
||||
The type has been removed.
|
||||
|
||||
## **POST** /test4
|
||||
|
||||
@ -90,7 +90,7 @@ The value has been removed.
|
||||
|
||||
#### `$(Object)`
|
||||
|
||||
The value has been removed.
|
||||
The type has been removed.
|
||||
|
||||
## **POST** /test5
|
||||
|
||||
|
@ -11,13 +11,13 @@ breakingChanges:
|
||||
InRequest:
|
||||
InPayload:
|
||||
PayloadSchema:
|
||||
OfType Array: NoContradiction
|
||||
OfType Array: TypeBecomesEmpty
|
||||
AtPath "/test4":
|
||||
InOperation PostMethod:
|
||||
InRequest:
|
||||
InPayload:
|
||||
PayloadSchema:
|
||||
OfType Object: NoContradiction
|
||||
OfType Object: TypeBecomesEmpty
|
||||
AtPath "/test1":
|
||||
InOperation PostMethod:
|
||||
InRequest:
|
||||
@ -41,13 +41,13 @@ nonBreakingChanges:
|
||||
WithStatusCode 200:
|
||||
ResponsePayload:
|
||||
PayloadSchema:
|
||||
OfType Array: NoContradiction
|
||||
OfType Array: TypeBecomesEmpty
|
||||
AtPath "/test4":
|
||||
InOperation PostMethod:
|
||||
WithStatusCode 200:
|
||||
ResponsePayload:
|
||||
PayloadSchema:
|
||||
OfType Object: NoContradiction
|
||||
OfType Object: TypeBecomesEmpty
|
||||
AtPath "/test1":
|
||||
InOperation PostMethod:
|
||||
WithStatusCode 200:
|
||||
|
@ -10,9 +10,9 @@
|
||||
|
||||
### 📱⬅️ JSON Response – 200
|
||||
|
||||
#### In cases where `$.tag` is `"C"`
|
||||
#### `$(Object)`
|
||||
|
||||
The value has been added.
|
||||
The case where `$.tag` is `"C"` – has been added.
|
||||
|
||||
# <span id="non-breaking-changes"></span>🙆 Non-breaking changes
|
||||
|
||||
@ -20,6 +20,6 @@ The value has been added.
|
||||
|
||||
### 📱➡️ JSON Request
|
||||
|
||||
#### In cases where `$.tag` is `"C"`
|
||||
#### `$(Object)`
|
||||
|
||||
The value has been added.
|
||||
The case where `$.tag` is `"C"` – has been added.
|
||||
|
@ -4,13 +4,13 @@ breakingChanges:
|
||||
WithStatusCode 200:
|
||||
ResponsePayload:
|
||||
PayloadSchema:
|
||||
OfType Object:
|
||||
InPartition (PInProperty "tag" PHere,CByEnumValue (fromList [String "C"])): NoContradiction
|
||||
OfType Object: PartitionBecomesEmpty (PInProperty "tag" PHere,CByEnumValue
|
||||
(fromList [String "C"]))
|
||||
nonBreakingChanges:
|
||||
AtPath "/test":
|
||||
InOperation PostMethod:
|
||||
InRequest:
|
||||
InPayload:
|
||||
PayloadSchema:
|
||||
OfType Object:
|
||||
InPartition (PInProperty "tag" PHere,CByEnumValue (fromList [String "C"])): NoContradiction
|
||||
OfType Object: PartitionBecomesEmpty (PInProperty "tag" PHere,CByEnumValue
|
||||
(fromList [String "C"]))
|
||||
|
@ -14,7 +14,7 @@
|
||||
|
||||
##### `$.prop_B(Number)`
|
||||
|
||||
The value has been removed.
|
||||
The type has been removed.
|
||||
|
||||
### 📱⬅️ JSON Response – 200
|
||||
|
||||
@ -22,7 +22,7 @@ The value has been removed.
|
||||
|
||||
##### `$.prop_B(String)`
|
||||
|
||||
The value has been added.
|
||||
The type has been added.
|
||||
|
||||
# <span id="non-breaking-changes"></span>🙆 Non-breaking changes
|
||||
|
||||
@ -34,7 +34,7 @@ The value has been added.
|
||||
|
||||
##### `$.prop_B(String)`
|
||||
|
||||
The value has been added.
|
||||
The type has been added.
|
||||
|
||||
### 📱⬅️ JSON Response – 200
|
||||
|
||||
@ -42,4 +42,4 @@ The value has been added.
|
||||
|
||||
##### `$.prop_B(Number)`
|
||||
|
||||
The value has been removed.
|
||||
The type has been removed.
|
||||
|
@ -7,14 +7,14 @@ breakingChanges:
|
||||
OfType Object:
|
||||
InPartition (PInProperty "tag" PHere,CByEnumValue (fromList [String "B"])):
|
||||
InProperty "prop_B":
|
||||
OfType Number: NoContradiction
|
||||
OfType Number: TypeBecomesEmpty
|
||||
WithStatusCode 200:
|
||||
ResponsePayload:
|
||||
PayloadSchema:
|
||||
OfType Object:
|
||||
InPartition (PInProperty "tag" PHere,CByEnumValue (fromList [String "B"])):
|
||||
InProperty "prop_B":
|
||||
OfType String: NoContradiction
|
||||
OfType String: TypeBecomesEmpty
|
||||
nonBreakingChanges:
|
||||
AtPath "/test":
|
||||
InOperation PostMethod:
|
||||
@ -24,11 +24,11 @@ nonBreakingChanges:
|
||||
OfType Object:
|
||||
InPartition (PInProperty "tag" PHere,CByEnumValue (fromList [String "B"])):
|
||||
InProperty "prop_B":
|
||||
OfType String: NoContradiction
|
||||
OfType String: TypeBecomesEmpty
|
||||
WithStatusCode 200:
|
||||
ResponsePayload:
|
||||
PayloadSchema:
|
||||
OfType Object:
|
||||
InPartition (PInProperty "tag" PHere,CByEnumValue (fromList [String "B"])):
|
||||
InProperty "prop_B":
|
||||
OfType Number: NoContradiction
|
||||
OfType Number: TypeBecomesEmpty
|
||||
|
@ -14,7 +14,7 @@
|
||||
|
||||
##### `$.prop_B(Number)`
|
||||
|
||||
The value has been removed.
|
||||
The type has been removed.
|
||||
|
||||
### 📱⬅️ JSON Response – 200
|
||||
|
||||
@ -22,7 +22,7 @@ The value has been removed.
|
||||
|
||||
##### `$.prop_B(String)`
|
||||
|
||||
The value has been added.
|
||||
The type has been added.
|
||||
|
||||
# <span id="non-breaking-changes"></span>🙆 Non-breaking changes
|
||||
|
||||
@ -34,7 +34,7 @@ The value has been added.
|
||||
|
||||
##### `$.prop_B(String)`
|
||||
|
||||
The value has been added.
|
||||
The type has been added.
|
||||
|
||||
### 📱⬅️ JSON Response – 200
|
||||
|
||||
@ -42,4 +42,4 @@ The value has been added.
|
||||
|
||||
##### `$.prop_B(Number)`
|
||||
|
||||
The value has been removed.
|
||||
The type has been removed.
|
||||
|
@ -7,14 +7,14 @@ breakingChanges:
|
||||
OfType Object:
|
||||
InPartition (PInProperty "desc" (PInProperty "name" PHere),CByEnumValue (fromList [String "B"])):
|
||||
InProperty "prop_B":
|
||||
OfType Number: NoContradiction
|
||||
OfType Number: TypeBecomesEmpty
|
||||
WithStatusCode 200:
|
||||
ResponsePayload:
|
||||
PayloadSchema:
|
||||
OfType Object:
|
||||
InPartition (PInProperty "desc" (PInProperty "name" PHere),CByEnumValue (fromList [String "B"])):
|
||||
InProperty "prop_B":
|
||||
OfType String: NoContradiction
|
||||
OfType String: TypeBecomesEmpty
|
||||
nonBreakingChanges:
|
||||
AtPath "/test":
|
||||
InOperation PostMethod:
|
||||
@ -24,11 +24,11 @@ nonBreakingChanges:
|
||||
OfType Object:
|
||||
InPartition (PInProperty "desc" (PInProperty "name" PHere),CByEnumValue (fromList [String "B"])):
|
||||
InProperty "prop_B":
|
||||
OfType String: NoContradiction
|
||||
OfType String: TypeBecomesEmpty
|
||||
WithStatusCode 200:
|
||||
ResponsePayload:
|
||||
PayloadSchema:
|
||||
OfType Object:
|
||||
InPartition (PInProperty "desc" (PInProperty "name" PHere),CByEnumValue (fromList [String "B"])):
|
||||
InProperty "prop_B":
|
||||
OfType Number: NoContradiction
|
||||
OfType Number: TypeBecomesEmpty
|
||||
|
Loading…
Reference in New Issue
Block a user