Skip to content

Commit 911364d

Browse files
mstreammstream
committed
feat: add JSON validation against unrestricted schema types
1 parent 268bc8a commit 911364d

File tree

5 files changed

+263
-0
lines changed

5 files changed

+263
-0
lines changed

‎spago.dhall

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -10,6 +10,7 @@
1010
, "foldable-traversable"
1111
, "foreign-object"
1212
, "gen"
13+
, "integers"
1314
, "lists"
1415
, "maybe"
1516
, "node-process"

‎src/purs/JsonSchema.purs

Lines changed: 5 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -7,6 +7,11 @@ module JsonSchema
77
, JsonSchema(..)
88
, JsonStringSchemaSpec
99
, genSchema
10+
, genArraySchema
11+
, genIntegerSchema
12+
, genNumberSchema
13+
, genObjectSchema
14+
, genStringSchema
1015
) where
1116

1217
import Prelude

‎src/purs/JsonSchema/Validation.purs

Lines changed: 83 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,83 @@
1+
module JsonSchema.Validation (validateAgainst) where
2+
3+
import Prelude
4+
5+
import Data.Argonaut.Core (Json)
6+
import Data.Argonaut.Core as A
7+
import Data.Int as Int
8+
import Data.Maybe (isNothing)
9+
import Data.Set (Set)
10+
import Data.Set as Set
11+
import JsonSchema
12+
( JsonArraySchemaSpec
13+
, JsonIntegerSchemaSpec
14+
, JsonNumberSchemaSpec
15+
, JsonObjectSchemaSpec
16+
, JsonSchema(..)
17+
, JsonStringSchemaSpec
18+
)
19+
20+
validateAgainst ∷ Json → JsonSchema → Set String
21+
validateAgainst json schema = case schema of
22+
JsonArraySchema spec →
23+
validateAgainstArraySchema json spec
24+
JsonBooleanSchema →
25+
validateAgainstBooleanSchema json
26+
JsonIntegerSchema spec →
27+
validateAgainstIntegerSchema json spec
28+
JsonEmptySchema →
29+
Set.empty
30+
JsonNullSchema →
31+
validateAgainstNullSchema json
32+
JsonNumberSchema spec →
33+
validateAgainstNumberSchema json spec
34+
JsonObjectSchema spec →
35+
validateAgainstObjectSchema json spec
36+
JsonStringSchema spec →
37+
validateAgainstStringSchema json spec
38+
39+
validateAgainstArraySchema ∷ Json → JsonArraySchemaSpec → Set String
40+
validateAgainstArraySchema json spec =
41+
A.caseJsonArray
42+
(Set.singleton "Not an array")
43+
( \jsons →
44+
Set.empty
45+
)
46+
json
47+
48+
validateAgainstBooleanSchema ∷ Json → Set String
49+
validateAgainstBooleanSchema json =
50+
if A.isBoolean json then Set.empty else Set.singleton "Not a boolean."
51+
52+
validateAgainstIntegerSchema ∷ Json → JsonIntegerSchemaSpec → Set String
53+
validateAgainstIntegerSchema json spec =
54+
A.caseJsonNumber
55+
(Set.singleton "Not an integer")
56+
( \x →
57+
if isNothing $ Int.fromNumber x then
58+
Set.singleton "Not an integer"
59+
else
60+
Set.empty
61+
)
62+
json
63+
64+
validateAgainstNullSchema ∷ Json → Set String
65+
validateAgainstNullSchema json =
66+
if A.isNull json then Set.empty else Set.singleton "Not a null."
67+
68+
validateAgainstNumberSchema ∷ Json → JsonNumberSchemaSpec → Set String
69+
validateAgainstNumberSchema json spec =
70+
if A.isNumber json then Set.empty else Set.singleton "Not a number."
71+
72+
validateAgainstObjectSchema ∷ Json → JsonObjectSchemaSpec → Set String
73+
validateAgainstObjectSchema json spec =
74+
A.caseJsonObject
75+
(Set.singleton "Not an object")
76+
( \object →
77+
Set.empty
78+
)
79+
json
80+
81+
validateAgainstStringSchema ∷ Json → JsonStringSchemaSpec → Set String
82+
validateAgainstStringSchema json spec =
83+
if A.isString json then Set.empty else Set.singleton "Not a string."

‎test/unit/Main.purs

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -11,6 +11,7 @@ import Effect.Exception (throw)
1111
import Node.Process as Process
1212
import Test.Spec.JsonSchema.Codec as Codec
1313
import Test.Spec.JsonSchema.Diff as Diff
14+
import Test.Spec.JsonSchema.Validation as Validation
1415
import Test.Spec.Reporter (consoleReporter)
1516
import Test.Spec.Runner (defaultConfig, runSpecT)
1617
import Test.Types (TestSpec)
@@ -31,12 +32,15 @@ main = do
3132
pure [ Codec.spec ]
3233
"Diff" →
3334
pure [ Diff.spec ]
35+
"Validation" →
36+
pure [ Validation.spec ]
3437
_ →
3538
throw $ "Unknown module name \"" <> moduleName <> "\""
3639

3740
allSpecs =
3841
[ Codec.spec
3942
, Diff.spec
43+
, Validation.spec
4044
]
4145

4246
runTestSpecs ∷ ∀ f. Foldable f ⇒ f TestSpec → Aff Unit

‎test/unit/Test/Spec/JsonSchema/Validation.purs

Lines changed: 170 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,170 @@
1+
module Test.Spec.JsonSchema.Validation (spec) where
2+
3+
import Prelude
4+
5+
import Control.Alternative ((<|>))
6+
import Control.Alternative as Map
7+
import Control.Lazy (class Lazy)
8+
import Control.Monad.Gen (class MonadGen)
9+
import Control.Monad.Gen as Gen
10+
import Control.Monad.Rec.Class (class MonadRec)
11+
import Data.Argonaut.Core (Json)
12+
import Data.Argonaut.Core as A
13+
import Data.Argonaut.Gen as AGen
14+
import Data.Int as Int
15+
import Data.List (List)
16+
import Data.Maybe (Maybe(..), isNothing)
17+
import Data.Set (Set)
18+
import Data.Set as Set
19+
import Data.String.Gen as StringGen
20+
import Data.Tuple (Tuple(..))
21+
import Data.Tuple.Nested (type (/\), (/\))
22+
import Foreign.Object as Object
23+
import JsonSchema (JsonSchema(..))
24+
import JsonSchema as JsonSchema
25+
import JsonSchema.Validation as Validation
26+
import Test.QuickCheck (Result(..))
27+
import Test.Spec (describe)
28+
import Test.Types (TestSpec)
29+
import Test.Utils (TestLength(..), generativeTestCase)
30+
31+
spec ∷ TestSpec
32+
spec = describe "Validation" do
33+
34+
describe "violations" do
35+
36+
generativeTestCase Long
37+
"No JSON violates empty schema."
38+
do
39+
json ← AGen.genJson
40+
pure $ json `shouldNotViolate` JsonEmptySchema
41+
42+
generativeTestCase Long
43+
"No array JSON violates unrestricted array schema."
44+
do
45+
json ← A.fromArray <$> Gen.unfoldable AGen.genJson
46+
pure $ json `shouldNotViolate` JsonArraySchema
47+
{ itemsSchema: Nothing, uniqueItems: false }
48+
49+
generativeTestCase Long
50+
"Any non-array JSON violates any array schema."
51+
do
52+
json ← AGen.genJson `Gen.suchThat` not A.isArray
53+
schema ← JsonSchema.genArraySchema
54+
pure $ json `shouldViolate` schema
55+
56+
generativeTestCase Long
57+
"No boolean JSON violates boolean schema."
58+
do
59+
json ← A.fromBoolean <$> (pure false <|> pure true)
60+
pure $ json `shouldNotViolate` JsonBooleanSchema
61+
62+
generativeTestCase Long
63+
"Any non-boolean JSON violates boolean schema."
64+
do
65+
json ← AGen.genJson `Gen.suchThat` not A.isBoolean
66+
pure $ json `shouldViolate` JsonBooleanSchema
67+
68+
generativeTestCase Long
69+
"No integer JSON violates unrestricted integer schema."
70+
do
71+
json ← A.fromNumber
72+
<$> Int.toNumber
73+
<$> Gen.chooseInt bottom top
74+
pure $ json `shouldNotViolate` (JsonIntegerSchema {})
75+
76+
generativeTestCase Long
77+
"Any non-integer JSON violates any integer schema."
78+
do
79+
json ← AGen.genJson `Gen.suchThat`
80+
A.caseJsonNumber true (isNothing <<< Int.fromNumber)
81+
schema ← JsonSchema.genIntegerSchema
82+
pure $ json `shouldViolate` schema
83+
84+
generativeTestCase Long
85+
"No null JSON violates null schema."
86+
do
87+
json ← pure A.jsonNull
88+
pure $ json `shouldNotViolate` JsonNullSchema
89+
90+
generativeTestCase Long
91+
"Any non-null JSON violates null schema."
92+
do
93+
json ← AGen.genJson `Gen.suchThat` not A.isNull
94+
pure $ json `shouldViolate` JsonNullSchema
95+
96+
generativeTestCase Long
97+
"No number JSON violates unrestricted number schema."
98+
do
99+
json ← A.fromNumber <$> Gen.chooseFloat bottom top
100+
pure $ json `shouldNotViolate` (JsonNumberSchema {})
101+
102+
generativeTestCase Long
103+
"Any non-number JSON violates any number schema."
104+
do
105+
json ← AGen.genJson `Gen.suchThat` not A.isNumber
106+
schema ← JsonSchema.genNumberSchema
107+
pure $ json `shouldViolate` schema
108+
109+
generativeTestCase Long
110+
"No object JSON violates unrestricted object schema."
111+
do
112+
json ←
113+
A.fromObject
114+
<$> Object.fromFoldable
115+
<$> genKeyValuePairs
116+
117+
pure $ json `shouldNotViolate`
118+
(JsonObjectSchema { properties: Map.empty })
119+
120+
generativeTestCase Long
121+
"Any non-object JSON violates any object schema."
122+
do
123+
json ← AGen.genJson `Gen.suchThat` not A.isObject
124+
schema ← JsonSchema.genObjectSchema
125+
pure $ json `shouldViolate` schema
126+
127+
generativeTestCase Long
128+
"No string JSON violates unrestricted string schema."
129+
do
130+
json ← A.fromString <$> StringGen.genUnicodeString
131+
pure $ json `shouldNotViolate` (JsonStringSchema {})
132+
133+
generativeTestCase Long
134+
"Any non-string JSON violates any string schema."
135+
do
136+
json ← AGen.genJson `Gen.suchThat` not A.isString
137+
schema ← JsonSchema.genStringSchema
138+
pure $ json `shouldViolate` schema
139+
140+
genKeyValuePairs
141+
∷ ∀ m
142+
. Lazy (m Json)
143+
⇒ MonadGen m
144+
⇒ MonadRec m
145+
⇒ m (List (String /\ Json))
146+
genKeyValuePairs =
147+
Gen.unfoldable genKeyValuePair
148+
where
149+
genKeyValuePair = Tuple
150+
<$> StringGen.genUnicodeString
151+
<*> AGen.genJson
152+
153+
shouldNotViolate ∷ Json → JsonSchema → Result
154+
shouldNotViolate json schema =
155+
if Set.isEmpty violations then Success
156+
else Failed
157+
$ "Unexpected violations found: "
158+
<> show { json: A.stringify json, schema, violations }
159+
where
160+
violations ∷ Set String
161+
violations = json `Validation.validateAgainst` schema
162+
163+
shouldViolate ∷ Json → JsonSchema → Result
164+
shouldViolate json schema =
165+
if Set.isEmpty violations then Failed
166+
$ "No violations found: " <> show { json: A.stringify json, schema }
167+
else Success
168+
where
169+
violations ∷ Set String
170+
violations = json `Validation.validateAgainst` schema

0 commit comments

Comments
 (0)