git.iko.soy/typeable/swagger2
on master help sign in
Better error messages for validateToJSON
a9a7363Matthias Fischmann
src/Data/Swagger/Internal/Schema/Validation.hs+87−1
compare with master
unifiedsplit
@@ -27,6 +27,7 @@ import Control.Lens
27import Control.Monad (when)
27import Control.Monad (when)
28
28
29import Data.Aeson hiding (Result)
29import Data.Aeson hiding (Result)
30+import Data.Aeson.Encode.Pretty (encodePretty)
30import Data.Foldable (for_, sequenceA_,
31import Data.Foldable (for_, sequenceA_,
31 traverse_)
32 traverse_)
32import Data.HashMap.Strict (HashMap)
33import Data.HashMap.Strict (HashMap)
@@ -39,6 +40,8 @@ import Data.Proxy
39import Data.Scientific (Scientific, isInteger)
40import Data.Scientific (Scientific, isInteger)
40import Data.Text (Text)
41import Data.Text (Text)
41import qualified Data.Text as Text
42import qualified Data.Text as Text
43+import qualified Data.Text.Lazy as TL
44+import qualified Data.Text.Lazy.Encoding as TL
42import Data.Vector (Vector)
45import Data.Vector (Vector)
43import qualified Data.Vector as Vector
46import qualified Data.Vector as Vector
44
47
@@ -54,18 +57,101 @@ import Data.Swagger.Lens
54--
57--
55-- /NOTE:/ @'validateToJSON'@ does not perform string pattern validation.
58-- /NOTE:/ @'validateToJSON'@ does not perform string pattern validation.
56-- See @'validateToJSONWithPatternChecker'@.
59-- See @'validateToJSONWithPatternChecker'@.
60+--
61+-- See 'renderValidationErrors' on how the output is structured.
62+validatePrettyToJSON :: forall a. (ToJSON a, ToSchema a) => a -> Maybe String
63+validatePrettyToJSON = renderValidationErrors validateToJSON
64+
65+-- | Variant of 'validatePrettyToJSON' with typed output.
57validateToJSON :: forall a. (ToJSON a, ToSchema a) => a -> [ValidationError]
66validateToJSON :: forall a. (ToJSON a, ToSchema a) => a -> [ValidationError]
58validateToJSON = validateToJSONWithPatternChecker (\_pattern _str -> True)
67validateToJSON = validateToJSONWithPatternChecker (\_pattern _str -> True)
59
68
60-- | Validate @'ToJSON'@ instance matches @'ToSchema'@ for a given value and pattern checker.
69-- | Validate @'ToJSON'@ instance matches @'ToSchema'@ for a given value and pattern checker.
61-- This can be used with QuickCheck to ensure those instances are coherent.
70-- This can be used with QuickCheck to ensure those instances are coherent.
62--
71--
63−-- For validation without patterns see @'validateToJSON'@.
72+-- For validation without patterns see @'validateToJSON'@. See also:
73+-- 'renderValidationErrors'.
64validateToJSONWithPatternChecker :: forall a. (ToJSON a, ToSchema a) => (Pattern -> Text -> Bool) -> a -> [ValidationError]
74validateToJSONWithPatternChecker :: forall a. (ToJSON a, ToSchema a) => (Pattern -> Text -> Bool) -> a -> [ValidationError]
65validateToJSONWithPatternChecker checker = validateJSONWithPatternChecker checker defs sch . toJSON
75validateToJSONWithPatternChecker checker = validateJSONWithPatternChecker checker defs sch . toJSON
66 where
76 where
67 (defs, sch) = runDeclare (declareSchema (Proxy :: Proxy a)) mempty
77 (defs, sch) = runDeclare (declareSchema (Proxy :: Proxy a)) mempty
68
78
79+-- | Pretty print validation errors
80+-- together with actual JSON and Swagger Schema
81+-- (using 'encodePretty').
82+--
83+-- >>> import Data.Aeson as Aeson
84+-- >>> import Data.Foldable (traverse_)
85+-- >>> import GHC.Generics
86+-- >>> data Phone = Phone { value :: String } deriving (Generic)
87+-- >>> data Person = Person { name :: String, phone :: Phone } deriving (Generic)
88+-- >>> instance ToJSON Person where toJSON p = object [ "name" Aeson..= name p ]
89+-- >>> instance ToSchema Phone
90+-- >>> instance ToSchema Person
91+-- >>> let person = Person { name = "John", phone = Phone "123456" }
92+-- >>> traverse_ putStrLn $ renderValidationErrors validateToJSON person
93+-- Validation against the schema fails:
94+-- * property "phone" is required, but not found in "{\"name\":\"John\"}"
95+-- <BLANKLINE>
96+-- JSON value:
97+-- {
98+-- "name": "John"
99+-- }
100+-- <BLANKLINE>
101+-- Swagger Schema:
102+-- {
103+-- "required": [
104+-- "name",
105+-- "phone"
106+-- ],
107+-- "type": "object",
108+-- "properties": {
109+-- "phone": {
110+-- "$ref": "#/definitions/Phone"
111+-- },
112+-- "name": {
113+-- "type": "string"
114+-- }
115+-- }
116+-- }
117+-- <BLANKLINE>
118+-- Swagger Description Context:
119+-- {
120+-- "Phone": {
121+-- "required": [
122+-- "value"
123+-- ],
124+-- "type": "object",
125+-- "properties": {
126+-- "value": {
127+-- "type": "string"
128+-- }
129+-- }
130+-- }
131+-- }
132+-- <BLANKLINE>
133+renderValidationErrors
134+ :: forall a. (ToJSON a, ToSchema a)
135+ => (a -> [ValidationError]) -> a -> Maybe String
136+renderValidationErrors f x =
137+ case f x of
138+ [] -> Nothing
139+ errors -> Just $ unlines
140+ [ "Validation against the schema fails:"
141+ , unlines (map (" * " ++) errors)
142+ , "JSON value:"
143+ , ppJSONString (toJSON x)
144+ , ""
145+ , "Swagger Schema:"
146+ , ppJSONString (toJSON schema_)
147+ , ""
148+ , "Swagger Description Context:"
149+ , ppJSONString (toJSON refs_)
150+ ]
151+ where
152+ ppJSONString = TL.unpack . TL.decodeUtf8 . encodePretty
153+ (refs_, schema_) = runDeclare (declareSchema (Proxy :: Proxy a)) mempty
154+
69-- | Validate JSON @'Value'@ against Swagger @'Schema'@.
155-- | Validate JSON @'Value'@ against Swagger @'Schema'@.
70--
156--
71-- prop> validateJSON mempty (toSchema (Proxy :: Proxy Int)) (toJSON (x :: Int)) == []
157-- prop> validateJSON mempty (toSchema (Proxy :: Proxy Int)) (toJSON (x :: Int)) == []
src/Data/Swagger/Schema/Validation.hs+2
@@ -19,8 +19,10 @@ module Data.Swagger.Schema.Validation (
19 ValidationError,
19 ValidationError,
20
20
21 -- ** Using 'ToJSON' and 'ToSchema'
21 -- ** Using 'ToJSON' and 'ToSchema'
22+ validatePrettyToJSON,
22 validateToJSON,
23 validateToJSON,
23 validateToJSONWithPatternChecker,
24 validateToJSONWithPatternChecker,
25+ renderValidationErrors,
24
26
25 -- ** Using 'Value' and 'Schema'
27 -- ** Using 'Value' and 'Schema'
26 validateJSON,
28 validateJSON,
swagger2.cabal+1
@@ -63,6 +63,7 @@ library
63 -- GHC boot libraries
63 -- GHC boot libraries
64 build-depends:
64 build-depends:
65 base >=4.7 && <4.14
65 base >=4.7 && <4.14
66+ , aeson-pretty >=0.8.7 && <0.9
66 , bytestring >=0.10.4.0 && <0.11
67 , bytestring >=0.10.4.0 && <0.11
67 , containers >=0.5.5.1 && <0.7
68 , containers >=0.5.5.1 && <0.7
68 , template-haskell >=2.9.0.0 && <2.16
69 , template-haskell >=2.9.0.0 && <2.16