@@ -17,12 +17,13 @@ import Algebra.Lattice
1717import Control.Applicative
1818import Control.Arrow
1919import Control.Comonad.Env hiding (env)
20−import Control.Lens hiding (cons)
20+import Control.Lens hiding (cons, para)
2121import Control.Monad.Reader hiding (ask)
2222import qualified Control.Monad.Reader as R
2323import Control.Monad.State
2424import Control.Monad.Writer
2525import qualified Data.Aeson as A
26+import qualified Data.ByteString.Lazy as BSL
2627import Data.Coerce
2728import qualified Data.Foldable as F
2829import Data.HList
@@ -40,8 +41,8 @@ import Data.Scientific
4041import qualified Data.Set as S
4142import Data.Text (Text)
4243import qualified Data.Text as T hiding (singleton)
44+import qualified Data.Text.Encoding as T
4345import Data.Typeable
44−import Text.Regex.Pcre2
4546import OpenAPI.Checker.Behavior
4647import OpenAPI.Checker.Memo
4748import OpenAPI.Checker.Orphans ()
@@ -49,6 +50,8 @@ import OpenAPI.Checker.Paths
4950import qualified OpenAPI.Checker.PathsPrefixTree as P
5051import OpenAPI.Checker.References
5152import OpenAPI.Checker.Subtree
53+import Text.Pandoc.Builder hiding (Format, Null)
54+import Text.Regex.Pcre2
5255
5356-- | Type of a JSON value
5457data JsonType
@@ -84,7 +87,7 @@ untypeValue (TArray a) = A.Array a
8487untypeValue (TObject o) = A.Object o
8588
8689data Bound a = Exclusive !a | Inclusive !a
87− deriving (Eq, Show)
90+ deriving (Eq, Show, Functor)
8891
8992-- | The order is lexicographical on @a * Bool@.
9093instance Ord a => Ord (Bound a) where
@@ -128,6 +131,45 @@ data Condition :: JsonType -> Type where
128131 MaxProperties :: !Integer -> Condition 'Object
129132 MinProperties :: !Integer -> Condition 'Object
130133
134+showCondition :: Condition a -> Blocks
135+showCondition = \case
136+ (Exactly v) -> para "The value should be:" <> showJSONValue (untypeValue v)
137+ (Maximum b) -> para $ "The value should be less than " <> showBound b <> "."
138+ (Minimum (Down b)) -> para $ "The value should be more than " <> showBound (getDown <$> b) <> "."
139+ (MultipleOf n) -> para $ "The value should be a multiple of " <> show' n <> "."
140+ (NumberFormat p) -> para $ "The number should have the following format:" <> code p <> "."
141+ (Pattern p) -> para "The value should satisfy the following pattern (regular expression):" <> codeBlock p
142+ (StringFormat p) -> para $ "The string should have the following format:" <> code p <> "."
143+ (MaxLength p) -> para $ "The length of the string should be less than or equal to " <> show' p <> "."
144+ (MinLength p) -> para $ "The length of the string should be more than or equal to " <> show' p <> "."
145+ (Items i _) -> para "The items of the array should satisfy:" <> showForEachJsonFormula i
146+ (MaxItems n) -> para $ "The length of the array should be less than or equal to " <> show' n <> "."
147+ (MinItems n) -> para $ "The length of the array should be more than or equal to " <> show' n <> "."
148+ UniqueItems -> para "The elements in the array should be unique."
149+ (Properties props additional _) ->
150+ bulletList $
151+ (M.toList props
152+ <&> (\(k, p) ->
153+ para (code k)
154+ <> para (strong $ if propRequired p then "Required" else "Optional")
155+ <> showForEachJsonFormula (propFormula p)))
156+ <> [ para (emph "Additional properties")
157+ <> showForEachJsonFormula additional
158+ ]
159+ (MaxProperties n) -> para $ "The maximum number of fields should be " <> show' n <> "."
160+ (MinProperties n) -> para $ "The minimum number of fields should be " <> show' n <> "."
161+ where
162+ showForEachJsonFormula :: ForeachType JsonFormula -> Blocks
163+ showForEachJsonFormula i =
164+ bulletList $
165+ foldType
166+ (\t f ->
167+ let (DNF conds') = f i
168+ conds = S.toList <$> S.toList conds'
169+ in [ para (describeJSONType t)
170+ <> bulletList (conds <&> \cond -> bulletList (showCondition <$> cond))
171+ ])
172+
131173satisfiesTyped :: TypedValue t -> Condition t -> Bool
132174satisfiesTyped e (Exactly e') = e == e'
133175satisfiesTyped (TNumber n) (Maximum (Exclusive m)) = n < m
@@ -363,10 +405,6 @@ instance
363405 , forObject = top
364406 }
365407
366−instance Behavable 'SchemaLevel 'SchemaLevel where
367− data Behave 'SchemaLevel 'SchemaLevel
368− deriving (Eq, Ord, Show)
369−
370408instance Steppable Schema (Referenced Schema) where
371409 data Step Schema (Referenced Schema)
372410 = AllOfStep Int
@@ -396,7 +434,7 @@ parseDiscriminatorValue v = case A.fromJSON @(Referenced Schema) $ A.object ["$r
396434 A.Error _ -> Ref $ Reference v
397435
398436-- | A fake writer monad that doesn't actually record anything and allows lazy recursion.
399−newtype Silent q f r a = Silent { runSilent :: a }
437+newtype Silent q f r a = Silent {runSilent :: a}
400438 deriving stock (Functor)
401439 deriving (Applicative, Monad) via Identity
402440
@@ -427,11 +465,12 @@ silently m = do
427465 pure . runSilent $ runReaderT m defs
428466
429467warnKnot :: MonadProcess m => KnotTier (ForeachType JsonFormula) () m
430−warnKnot = KnotTier
431− { onKnotFound = warn UnguardedRecursion
432− , onKnotUsed = \_ -> pure bottom
433− , tieKnot = \_ -> pure
434− }
468+warnKnot =
469+ KnotTier
470+ { onKnotFound = warn UnguardedRecursion
471+ , onKnotUsed = \_ -> pure bottom
472+ , tieKnot = \_ -> pure
473+ }
435474
436475processRefSchema
437476 :: MonadProcess m
@@ -835,19 +874,19 @@ checkImplication env beh prods cons = case findExactly prods of
835874 Just m' ->
836875 if m' <= m
837876 then pure ()
838− else issueAt beh (MatchingMaximumWeak m m')
877+ else issueAt beh (MatchingMaximumWeak $ ProdCons {producer = m', consumer = m})
839878 Nothing -> issueAt beh (NoMatchingMaximum m)
840879 Minimum m -> case findRelevant max (\case Minimum m' -> Just m'; _ -> Nothing) prods of
841880 Just m' ->
842881 if m' >= m
843882 then pure ()
844− else issueAt beh (MatchingMinimumWeak (coerce m) (coerce m'))
883+ else issueAt beh (MatchingMinimumWeak ProdCons {producer = coerce m', consumer = coerce m})
845884 Nothing -> issueAt beh (NoMatchingMinimum (coerce m))
846885 MultipleOf m -> case findRelevant lcmScientific (\case MultipleOf m' -> Just m'; _ -> Nothing) prods of
847886 Just m' ->
848887 if lcmScientific m m' == m'
849888 then pure ()
850− else issueAt beh (MatchingMultipleOfWeak m m')
889+ else issueAt beh (MatchingMultipleOfWeak $ ProdCons {producer = m', consumer = m})
851890 Nothing -> issueAt beh (NoMatchingMultipleOf m)
852891 NumberFormat f ->
853892 if any (\case NumberFormat f' -> f == f'; _ -> False) prods
@@ -857,13 +896,13 @@ checkImplication env beh prods cons = case findExactly prods of
857896 Just m' ->
858897 if m' <= m
859898 then pure ()
860− else issueAt beh (MatchingMaxLengthWeak m m')
899+ else issueAt beh (MatchingMaxLengthWeak $ ProdCons {producer = m', consumer = m})
861900 Nothing -> issueAt beh (NoMatchingMaxLength m)
862901 MinLength m -> case findRelevant max (\case MinLength m' -> Just m'; _ -> Nothing) prods of
863902 Just m' ->
864903 if m' >= m
865904 then pure ()
866− else issueAt beh (MatchingMinLengthWeak m m')
905+ else issueAt beh (MatchingMinLengthWeak $ ProdCons {producer = m', consumer = m})
867906 Nothing -> issueAt beh (NoMatchingMinLength m)
868907 Pattern p ->
869908 if any (\case Pattern p' -> p == p'; _ -> False) prods
@@ -883,50 +922,52 @@ checkImplication env beh prods cons = case findExactly prods of
883922 Just m' ->
884923 if m' <= m
885924 then pure ()
886− else issueAt beh (MatchingMaxItemsWeak m m')
925+ else issueAt beh (MatchingMaxItemsWeak ProdCons {producer = m', consumer = m})
887926 Nothing -> issueAt beh (NoMatchingMaxItems m)
888927 MinItems m -> case findRelevant max (\case MinItems m' -> Just m'; _ -> Nothing) prods of
889928 Just m' ->
890929 if m' >= m
891930 then pure ()
892− else issueAt beh (MatchingMinItemsWeak m m')
931+ else issueAt beh (MatchingMinItemsWeak ProdCons {producer = m', consumer = m})
893932 Nothing -> issueAt beh (NoMatchingMinItems m)
894933 UniqueItems ->
895934 if any (== UniqueItems) $ prods
896935 then pure ()
897936 else issueAt beh NoMatchingUniqueItems
898937 Properties props _ madd -> case findRelevant (<>) (\case Properties props' _ madd' -> Just $ (props', madd') NE.:| []; _ -> Nothing) prods of
899− Just pm -> anyOfAt beh NoMatchingProperties $ NE.toList pm <&> \(props', madd') -> do
900− F.for_ (S.fromList $ M.keys props <> M.keys props') $ \k -> do
901− let go sch sch' = checkCompatibility env (beh >>> step (InProperty k)) (ProdCons sch sch')
902− case (M.lookup k props', madd', M.lookup k props, madd) of
903− (Nothing, Nothing, _, _) -> pure () -- vacuously
904− (_, _, Nothing, Nothing) -> issueAt beh (UnexpectedProperty k)
905− (Just p', _, Just p, _) -> go (propRefSchema p') (propRefSchema p)
906− (Nothing, Just add', Just p, _) -> go add' (propRefSchema p)
907− (Just p', _, Nothing, Just add) -> go (propRefSchema p') add
908− (Nothing, Just _, Nothing, Just _) -> pure ()
909− case (maybe False propRequired $ M.lookup k props', maybe False propRequired $ M.lookup k props) of
910− (False, True) -> issueAt beh (PropertyNowRequired k)
911− _ -> pure ()
912− pure ()
913− case (madd', madd) of
914− (Nothing, _) -> pure () -- vacuously
915− (_, Nothing) -> issueAt beh NoAdditionalProperties
916− (Just add', Just add) -> checkCompatibility env (beh >>> step InAdditionalProperty) (ProdCons add' add)
917− pure ()
938+ Just pm ->
939+ anyOfAt beh NoMatchingProperties $
940+ NE.toList pm <&> \(props', madd') -> do
941+ F.for_ (S.fromList $ M.keys props <> M.keys props') $ \k -> do
942+ let go sch sch' = checkCompatibility env (beh >>> step (InProperty k)) (ProdCons sch sch')
943+ case (M.lookup k props', madd', M.lookup k props, madd) of
944+ (Nothing, Nothing, _, _) -> pure () -- vacuously
945+ (_, _, Nothing, Nothing) -> issueAt beh (UnexpectedProperty k)
946+ (Just p', _, Just p, _) -> go (propRefSchema p') (propRefSchema p)
947+ (Nothing, Just add', Just p, _) -> go add' (propRefSchema p)
948+ (Just p', _, Nothing, Just add) -> go (propRefSchema p') add
949+ (Nothing, Just _, Nothing, Just _) -> pure ()
950+ case (maybe False propRequired $ M.lookup k props', maybe False propRequired $ M.lookup k props) of
951+ (False, True) -> issueAt beh (PropertyNowRequired k)
952+ _ -> pure ()
953+ pure ()
954+ case (madd', madd) of
955+ (Nothing, _) -> pure () -- vacuously
956+ (_, Nothing) -> issueAt beh NoAdditionalProperties
957+ (Just add', Just add) -> checkCompatibility env (beh >>> step InAdditionalProperty) (ProdCons add' add)
958+ pure ()
918959 Nothing -> issueAt beh NoMatchingProperties
919960 MaxProperties m -> case findRelevant min (\case MaxProperties m' -> Just m'; _ -> Nothing) prods of
920961 Just m' ->
921962 if m' <= m
922963 then pure ()
923− else issueAt beh (MatchingMaxPropertiesWeak m m')
964+ else issueAt beh (MatchingMaxPropertiesWeak ProdCons {producer = m', consumer = m})
924965 Nothing -> issueAt beh (NoMatchingMaxProperties m)
925966 MinProperties m -> case findRelevant max (\case MinProperties m' -> Just m'; _ -> Nothing) prods of
926967 Just m' ->
927968 if m' >= m
928969 then pure ()
929− else issueAt beh (MatchingMinPropertiesWeak m m')
970+ else issueAt beh (MatchingMinPropertiesWeak ProdCons {producer = m', consumer = m})
930971 Nothing -> issueAt beh (NoMatchingMinProperties m)
931972 where
932973 findExactly (Exactly x : _) = Just x
@@ -939,85 +980,145 @@ checkImplication env beh prods cons = case findExactly prods of
939980
940981instance Issuable 'TypedSchemaLevel where
941982 data Issue 'TypedSchemaLevel
942− = EnumDoesntSatisfy A.Value
943− -- ^ producer produces a specific value ($1), consumer has a condition that is not satisfied by said value
944− | NoMatchingEnum A.Value
945− -- ^ producer produces a specific value ($1) which is not listed in the consumer's list of specific values
946− | NoMatchingMaximum (Bound Scientific)
947− -- ^ producer declares a maximum numeric value ($1), consumer doesnt
948− | MatchingMaximumWeak (Bound Scientific) (Bound Scientific)
949− -- ^ producer declares a maximum numeric value ($1), consumer declares a weaker (higher) limit ($2)
950− | NoMatchingMinimum (Bound Scientific)
951− -- ^ producer declares a minimum numeric value, consumer doesnt
952− | MatchingMinimumWeak (Bound Scientific) (Bound Scientific)
953− -- ^ producer declares a minimum numeric value ($1), consumer declares a weaker (lower) limit ($2)
954− | NoMatchingMultipleOf Scientific
955− -- ^ producer declares that the numeric value must be a multiple of $1, consumer doesn't
956− | MatchingMultipleOfWeak Scientific Scientific
957− -- ^ producer declares that the numeric value must be a multiple of $1, consumer declares a weaker condition (multiple of $2)
958− | NoMatchingFormat Format
959− -- ^ producer declares a string/number format, consumer declares none or a different format (TODO: improve via regex #32)
960− | NoMatchingMaxLength Integer
961− -- ^ producer declares a maximum length of the string ($1), consumer doesn't.
962− | MatchingMaxLengthWeak Integer Integer
963− -- ^ producer declares a maximum length of the string ($1), consumer declares a weaker (higher) limit ($2)
964− | NoMatchingMinLength Integer
965− -- ^ producer declares a minimum length of the string ($1), consumer doesn't.
966− | MatchingMinLengthWeak Integer Integer
967− -- ^ producer declares a minimum length of the string ($1), consumer declares a weaker (lower) limit ($2)
968− | NoMatchingPattern Pattern
969− -- ^ producer declares the string value must matrix a regex ($1), consumer doesn't declare or declares different regex (TODO: #32)
970− | NoMatchingItems
971− -- ^ producer declares the items of an array must satisfy some condition, consumer doesn't
972− | NoMatchingMaxItems Integer
973− -- ^ producer declares a maximum length of the array ($1), consumer doesn't.
974− | MatchingMaxItemsWeak Integer Integer
975− -- ^ producer declares a maximum length of the array ($1), consumer declares a weaker (higher) limit ($2)
976− | NoMatchingMinItems Integer
977− -- ^ producer declares a minimum length of the array ($1), consumer doesn't.
978− | MatchingMinItemsWeak Integer Integer
979− -- ^ producer declares a minimum length of the array ($1), consumer declares a weaker (lower) limit ($2)
980− | NoMatchingUniqueItems
981− -- ^ producer declares that items must be unique, consumer doesn't
982− | NoMatchingProperties
983− -- ^ producer declares the properties of an object must satisfy some condition, consumer doesn't
984− | UnexpectedProperty Text
985− -- ^ producer allows a property that is not allowed in the consumer
986− | PropertyNowRequired Text
987− -- ^ consumer requires a property that is not required/allowed in the consumer
988− | NoAdditionalProperties
989− -- ^ producer allows additional properties, consumer doesn't
990− | NoMatchingMaxProperties Integer
991− -- ^ producer declares a maximum number of properties in the object ($1), consumer doesn't.
992− | MatchingMaxPropertiesWeak Integer Integer
993− -- ^ producer declares a maximum number of properties in the object ($1), consumer declares a weaker (higher) limit ($2)
994− | NoMatchingMinProperties Integer
995− -- ^ producer declares a minimum number of properties in the object ($1), consumer doesn't.
996− | MatchingMinPropertiesWeak Integer Integer
997− -- ^ producer declares a minimum number of properties in the object ($1), consumer declares a weaker (lower) limit ($2)
998− | NoMatchingCondition [SomeCondition]
999− -- ^ 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)
1000− | NoContradiction
1001− -- ^ 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)
983+ = -- | producer produces a specific value ($1), consumer has a condition that is not satisfied by said value
984+ EnumDoesntSatisfy A.Value
985+ | -- | consumer only expects a specific value which the producer does not produce.
986+ NoMatchingEnum A.Value
987+ | -- | consumer declares a maximum numeric value ($1), producer doesn't
988+ NoMatchingMaximum (Bound Scientific)
989+ | -- | consumer declares a maximum numeric value ($1), producer declares a weaker (higher) limit ($2)
990+ MatchingMaximumWeak (ProdCons (Bound Scientific))
991+ | -- | consumer declares a minimum numeric value, producer doesn't
992+ NoMatchingMinimum (Bound Scientific)
993+ | -- | consumer declares a minimum numeric value ($1), producer declares a weaker (lower) limit ($2)
994+ MatchingMinimumWeak (ProdCons (Bound Scientific))
995+ | -- | consumer declares that the numeric value must be a multiple of $1, producer doesn't
996+ NoMatchingMultipleOf Scientific
997+ | -- | consumer declares that the numeric value must be a multiple of $1, producer declares a weaker condition (multiple of $2)
998+ MatchingMultipleOfWeak (ProdCons Scientific)
999+ | -- | consumer declares a string/number format, producer declares none or a different format (TODO: improve via regex #32)
1000+ NoMatchingFormat Format
1001+ | -- | consumer declares a maximum length of the string ($1), producer doesn't.
1002+ NoMatchingMaxLength Integer
1003+ | -- | consumer declares a maximum length of the string ($1), producer declares a weaker (higher) limit ($2)
1004+ MatchingMaxLengthWeak (ProdCons Integer)
1005+ | -- | consumer declares a minimum length of the string ($1), producer doesn't.
1006+ NoMatchingMinLength Integer
1007+ | -- | consumer declares a minimum length of the string ($1), producer declares a weaker (lower) limit ($2)
1008+ MatchingMinLengthWeak (ProdCons Integer)
1009+ | -- | consumer declares the string value must matrix a regex ($1), producer doesn't declare or declares different regex (TODO: #32)
1010+ NoMatchingPattern Pattern
1011+ | -- | consumer declares the items of an array must satisfy some condition, producer doesn't
1012+ NoMatchingItems
1013+ | -- | consumer declares a maximum length of the array ($1), producer doesn't.
1014+ NoMatchingMaxItems Integer
1015+ | -- | consumer declares a maximum length of the array ($1), producer declares a weaker (higher) limit ($2)
1016+ MatchingMaxItemsWeak (ProdCons Integer)
1017+ | -- | consumer declares a minimum length of the array ($1), producer doesn't.
1018+ NoMatchingMinItems Integer
1019+ | -- | consumer declares a minimum length of the array ($1), producer declares a weaker (lower) limit ($2)
1020+ MatchingMinItemsWeak (ProdCons Integer)
1021+ | -- | consumer declares that items must be unique, producer doesn't
1022+ NoMatchingUniqueItems
1023+ | -- | consumer declares the properties of an object must satisfy some condition, producer doesn't
1024+ NoMatchingProperties
1025+ | -- | producer allows a property that is not allowed in the consumer
1026+ UnexpectedProperty Text
1027+ | -- | consumer requires a property that is not required/allowed in the producer
1028+ PropertyNowRequired Text
1029+ | -- | producer allows additional properties, consumer doesn't
1030+ NoAdditionalProperties
1031+ | -- | consumer declares a maximum number of properties in the object ($1), producer doesn't.
1032+ NoMatchingMaxProperties Integer
1033+ | -- | consumer declares a maximum number of properties in the object ($1), producer declares a weaker (higher) limit ($2)
1034+ MatchingMaxPropertiesWeak (ProdCons Integer)
1035+ | -- | consumer declares a minimum number of properties in the object ($1), producer doesn't.
1036+ NoMatchingMinProperties Integer
1037+ | -- | consumer declares a minimum number of properties in the object ($1), producer declares a weaker (lower) limit ($2)
1038+ MatchingMinPropertiesWeak (ProdCons Integer)
1039+ | -- | 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)
1040+ NoMatchingCondition [SomeCondition]
1041+ | -- | 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)
1042+ NoContradiction
10021043 deriving stock (Eq, Ord, Show)
10031044 issueIsUnsupported _ = False
1045+ describeIssue (EnumDoesntSatisfy v) = para "The following enum value will yield an error:" <> showJSONValue v
1046+ describeIssue (NoMatchingEnum v) = para "The following enum value is not supported:" <> showJSONValue v
1047+ describeIssue (NoMatchingMaximum b) = para $ "Unexpected upper bound " <> showBound b <> "."
1048+ describeIssue (MatchingMaximumWeak (ProdCons p c)) = para $ "Expected upper bound " <> showBound p <> " but but found " <> showBound c <> "."
1049+ describeIssue (NoMatchingMinimum b) = para $ "Unexpected lower bound " <> showBound b <> "."
1050+ describeIssue (MatchingMinimumWeak (ProdCons p c)) = para $ "Expected lower bound " <> showBound p <> " but but found " <> showBound c <> "."
1051+ describeIssue (NoMatchingMultipleOf n) = para $ "Didn't expect the value to be a multiple of " <> show' n <> " but it was."
1052+ describeIssue (MatchingMultipleOfWeak (ProdCons p c)) = para $ "Expected the value to be a multiple of " <> show' p <> " but found a multiple of " <> show' c <> "."
1053+ describeIssue (NoMatchingFormat f) = para $ "Unexpected format: " <> code f <> "."
1054+ describeIssue (NoMatchingMaxLength n) = para $ "Unexpected maximum length of the string " <> show' n <> "."
1055+ describeIssue (MatchingMaxLengthWeak (ProdCons p c)) = para $ "Expected the maximum length of the string to be " <> show' p <> "but it was " <> show' c <> "."
1056+ describeIssue (NoMatchingMinLength n) = para $ "Unexpected minimum length of the string " <> show' n <> "."
1057+ describeIssue (MatchingMinLengthWeak (ProdCons p c)) = para $ "Expected the minimum length of the string to be " <> show' p <> "but it was " <> show' c <> "."
1058+ describeIssue (NoMatchingPattern p) = para "Unexpected pattern (regular expression): " <> codeBlock p
1059+ describeIssue NoMatchingItems = para "Couldn't find any matching items."
1060+ describeIssue (NoMatchingMaxItems n) = para $ "Unexpected maximum length of the array " <> show' n <> "."
1061+ describeIssue (MatchingMaxItemsWeak (ProdCons p c)) = para $ "Expected the maximum length of the array to be " <> show' p <> "but it was " <> show' c <> "."
1062+ describeIssue (NoMatchingMinItems n) = para $ "Unexpected minimum length of the array " <> show' n <> "."
1063+ describeIssue (MatchingMinItemsWeak (ProdCons p c)) = para $ "Expected the minimum length of the array to be " <> show' p <> "but it was " <> show' c <> "."
1064+ describeIssue NoMatchingUniqueItems = para "Didn't expect the items to be unique, but they were."
1065+ describeIssue NoMatchingProperties = para "Couldn't find matching properties."
1066+ describeIssue (UnexpectedProperty p) = para $ "Expected the property " <> code p <> " to be allowed, but it wasn't."
1067+ describeIssue (PropertyNowRequired p) = para $ "Don't have a required property " <> code p <> "."
1068+ describeIssue NoAdditionalProperties = para "Expected additional properties to be allowed, but they weren't."
1069+ describeIssue (NoMatchingMaxProperties n) = para $ "Unexpected maximum number of properties " <> show' n <> "."
1070+ describeIssue (MatchingMaxPropertiesWeak (ProdCons p c)) = para $ "Expected the maximum number of properties to be " <> show' p <> "but it was " <> show' c <> "."
1071+ describeIssue (NoMatchingMinProperties n) = para $ "Unexpected minimum number of properties " <> show' n <> "."
1072+ describeIssue (MatchingMinPropertiesWeak (ProdCons p c)) = para $ "Expected the minimum number of properties to be " <> show' p <> "but it was " <> show' c <> "."
1073+ describeIssue (NoMatchingCondition conds) =
1074+ para "Expected the following conditions to hold, but they didn't:"
1075+ <> bulletList ((\(SomeCondition c) -> showCondition c) <$> conds)
1076+ describeIssue NoContradiction = para "Expected the type to be allowed, but it wasn't."
1077+
1078+showJSONValue :: A.Value -> Blocks
1079+showJSONValue v = codeBlockWith ("", ["json"], mempty) (T.decodeUtf8 . BSL.toStrict . A.encode $ v)
1080+
1081+showBound :: Show a => Bound a -> Inlines
1082+showBound (Inclusive x) = show' x <> " inclusive"
1083+showBound (Exclusive x) = show' x <> " exclusive"
1084+
1085+show' :: Show x => x -> Inlines
1086+show' = str . T.pack . show
10041087
10051088instance Issuable 'SchemaLevel where
10061089 data Issue 'SchemaLevel
1007− = NotSupported Text
1008− -- ^ Some (openapi-supported) feature that we do not support was encountered in the schema
1009− | InvalidSchema Text
1010− -- ^ The schema is actually invalid
1011− | UnguardedRecursion
1012− -- ^ The schema contains a reference loop along "anyOf"/"allOf"/"oneOf".
1090+ = -- | Some (openapi-supported) feature that we do not support was encountered in the schema
1091+ NotSupported Text
1092+ | -- | The schema is actually invalid
1093+ InvalidSchema Text
1094+ | -- | The schema contains a reference loop along "anyOf"/"allOf"/"oneOf".
1095+ UnguardedRecursion
10131096 deriving stock (Eq, Ord, Show)
10141097 issueIsUnsupported _ = True
10151098
1099+ describeIssue (NotSupported i) =
1100+ para (emph "Encountered a feature that OpenApi Diff does not support: " <> text i <> ".")
1101+ describeIssue (InvalidSchema i) =
1102+ para (emph "The schema is invalid: " <> text i <> ".")
1103+ describeIssue UnguardedRecursion =
1104+ para "Encountered recursion that is too complex for OpenApi Diff to untangle."
1105+
10161106instance Behavable 'SchemaLevel 'TypedSchemaLevel where
10171107 data Behave 'SchemaLevel 'TypedSchemaLevel
10181108 = OfType JsonType
10191109 deriving stock (Eq, Ord, Show)
10201110
1111+ describeBehaviour (OfType t) = describeJSONType t
1112+
1113+describeJSONType :: JsonType -> Inlines
1114+describeJSONType = \case
1115+ Null -> "Null"
1116+ Boolean -> "Boolean"
1117+ Number -> "Number"
1118+ String -> "String"
1119+ Array -> "Array"
1120+ Object -> "Object"
1121+
10211122instance Behavable 'TypedSchemaLevel 'SchemaLevel where
10221123 data Behave 'TypedSchemaLevel 'SchemaLevel
10231124 = InItems
@@ -1025,6 +1126,10 @@ instance Behavable 'TypedSchemaLevel 'SchemaLevel where
10251126 | InAdditionalProperty
10261127 deriving stock (Eq, Ord, Show)
10271128
1129+ describeBehaviour InItems = "Items"
1130+ describeBehaviour (InProperty p) = "Property " <> code p
1131+ describeBehaviour InAdditionalProperty = "Additional properties"
1132+
10281133instance Subtree Schema where
10291134 type SubtreeLevel Schema = 'SchemaLevel
10301135 type CheckEnv Schema = '[ProdCons (Traced (Definitions Schema))]