221ff1e · typeable/hjsonschema

README.md+1−1

compare with master

unifiedsplit

@@ -8,7 +8,7 @@ NOTE: You CANNOT use untrusted JSON data to make schemas. Schemas with circular

8

9# Example

10

11−See [here](https://github.com/seagreen/hjsonschema/blob/master/examples/Standard.hs).

11+See [here](https://github.com/seagreen/hjsonschema/blob/master/examples/Simple.hs).

12

13# Tests

14

examples/CustomSchema.hs+9−6

@@ -1,11 +1,14 @@

1−{-# LANGUAGE OverloadedStrings #-}

2−

3−-- | A custom schema made up of one validator from 'Data.Validator.Draft4'

1+-- | A custom schema specification using one validator from

4−-- and one original validator.

2+-- 'Data.Validator.Draft4' and one original validator.

5--

3--

6-- This is a simple example because it doesn't allow references (so it

4-- This is a simple example because it doesn't allow references (so it

7-- doesn't need to define an 'embed' function @Schema -> [Schema]@ for use

5-- doesn't need to define an 'embed' function @Schema -> [Schema]@ for use

8-- with 'fetchReferencedSchemas'.

6-- with 'fetchReferencedSchemas'.

7+--

8+-- For a full example see 'Data.JsonSchema.Draft4' and its submodules.

9+-- Code use between schema specifications will likely be OK but not great.

10+-- All the 'Data.Validator' code as well as the 'Data.JsonSchema.Fetch' code

11+-- is reusable, but there's a lot of boilerplate to tie it together.

9

12

10module CustomSchema where

13module CustomSchema where

11

14

@@ -36,8 +39,8 @@ data Schema = Schema

36 , _schemaOddLength :: Maybe Bool

39 , _schemaOddLength :: Maybe Bool

37 }

40 }

38

41

39−-- | Since every 'Schema' is valid we don't need to bother defining something

42+-- | If our 'Schema's themselves could be invalid we might want to write

40−-- like 'Data.JsonSchema.Draft4.checkValidity' for this schema.

43+-- something like 'Data.JsonSchema.Draft4.schemaValidityy' for them.

41validate :: Schema -> Value -> [FR.Failure CustomError]

44validate :: Schema -> Value -> [FR.Failure CustomError]

42validate s (String x) = concat

45validate s (String x) = concat

43 [ f _schemaMaxLength (FR.setFailure MaxLength) (fmap maybeToList . VA.maxLength)

46 [ f _schemaMaxLength (FR.setFailure MaxLength) (fmap maybeToList . VA.maxLength)

examples/Full.hsnew file+34

@@ -0,0 +1,34 @@

1+-- | Step by step validation using 'D4.referencesViaFilesystem' and

2+-- 'D4.checkSchema'. This means the actual validation invovles no IO.

3+

4+module Full where

5+

6+import Data.Aeson

7+

8+import qualified Data.JsonSchema.Draft4 as D4

9+

10+schema :: D4.Schema

11+schema = D4.emptySchema { D4._schemaRef = Just "./unique.json" }

12+

13+schemaContext :: D4.SchemaWithURI D4.Schema

14+schemaContext = D4.SchemaWithURI

15+ { D4._swSchema = schema

16+ , D4._swURI = Just "./examples/json/imaginary.json"

17+ }

18+

19+badData :: Value

20+badData = toJSON (["foo", "foo"] :: [String])

21+

22+example :: IO ()

23+example = do

24+ res <- D4.referencesViaFilesystem schemaContext

25+ case res of

26+ Left _ -> error "Couldn't fetch referenced schemas."

27+ Right references -> do

28+ let validate = case D4.checkSchema references schemaContext of

29+ Left _ -> error "Not a valid schema."

30+ Right f -> f

31+ case validate badData of

32+ [] -> error "We validated bad data."

33+ [D4.Invalid (D4.Ref D4.UniqueItems) _ _] -> return () -- Success.

34+ e -> error "We got a different failure than expected."

examples/PrettyShowFailure.hs+8−13

@@ -1,4 +1,11 @@

1−{-# LANGUAGE OverloadedStrings #-}

1+-- | 'D4.Invalid's contain a JSON Pointer to the subset of the data that

2+-- caused validation to fail, but they don't contain that data itself.

3+--

4+-- If you want to display the invalid subset of the data here's how you

5+-- resolve the JSON Pointer (which has the field name

6+-- 'D4._invalidOffendingData') against the original data.

7+--

8+-- NOTE: You have to have hjsonpointer in your build-depends.

2

9

3module PrettyShowFailure where

10module PrettyShowFailure where

4

11

@@ -20,18 +27,6 @@ failure = D4.Invalid

20

27

21example :: IO ()

28example :: IO ()

22example =

29example =

23− -- 'D4.Invalid's contain the sequence of embedded validators that caused

24− -- the invalidation, the contents of the final validator in that sequence,

25− -- and a JSON Pointer to the subset of data that caused validation to fail.

26− --

27− -- They don't actually contain that subset of data, since it can be derived

28− -- from the original data and the JSON Pointer.

29− --

30− -- If you want to display the invalid subset of the data here's how you

31− -- resolve the JSON Pointer (which has the field name

32− -- 'D4._failureOffendingData') against the original data.

33− --

34− -- NOTE: You have to have hjsonpointer in your build-depends.

35 case AP.resolve (D4._invalidOffendingData failure) badData of

30 case AP.resolve (D4._invalidOffendingData failure) badData of

36 Left _ -> error "Couldn't resolve pointer."

31 Left _ -> error "Couldn't resolve pointer."

37 Right _ -> return () -- Success. We could feed the 'Right' value into

32 Right _ -> return () -- Success. We could feed the 'Right' value into

examples/Simple.hsnew file+39

@@ -0,0 +1,39 @@

1+-- | Fetch any referenced schemas, check that our original schema is itself

2+-- valid, then validate our data.

3+--

4+-- To fetch schemas using HTTP instead of from the filesystem use

5+-- 'D4.fetchHTTPAndValidate'.

6+

7+module Simple where

8+

9+import Data.Aeson

10+import qualified Data.List.NonEmpty as NE

11+

12+import qualified Data.JsonSchema.Draft4 as D4

13+

14+schema :: D4.Schema

15+schema = D4.emptySchema { D4._schemaRef = Just "./unique.json" }

16+

17+schemaContext :: D4.SchemaWithURI D4.Schema

18+schemaContext = D4.SchemaWithURI

19+ { D4._swSchema = schema

20+ , D4._swURI = Just "./examples/json/imaginary.json"

21+ -- ^ For this example we're pretending we found 'schema' at this location.

22+ -- Its relative links will be resolved from here.

23+ }

24+

25+badData :: Value

26+badData = toJSON (["foo", "foo"] :: [String])

27+

28+example :: IO ()

29+example = do

30+ res <- D4.fetchFilesystemAndValidate schemaContext badData

31+ case res of

32+ Right () -> error "We validated bad data."

33+ Left (D4.FVRead _) -> error ("Error fetching a referenced schema"

34+ ++ " (either during IO or parsing).")

35+ Left (D4.FVSchema _) -> error "Our 'schema' itself was invalid."

36+ Left (D4.FVData failures) ->

37+ case NE.toList failures of

38+ [D4.Invalid (D4.Ref D4.UniqueItems) _ _] -> return () -- Success.

39+ _ -> error "Got more invalidation reasons than we expected."

examples/Standard.hsdeleted−49

@@ -1,49 +0,0 @@

1−{-# LANGUAGE OverloadedStrings #-}

2−

3−module Standard where

4−

5−import Data.Aeson

6−import qualified Data.Vector as V

7−

8−import qualified Data.JsonSchema.Draft4 as D4

9−

10−schema :: D4.Schema

11−schema = D4.emptySchema { D4._schemaUniqueItems = Just True }

12−

13−schemaContext :: D4.SchemaWithURI D4.Schema

14−schemaContext = D4.SchemaWithURI

15− { D4._swSchema = schema

16− , D4._swURI = Nothing

17− -- ^ If your schema has relative references to other schemas

18− -- then you'll need to give its URI here.

19− }

20−

21−badData :: Value

22−badData = Array (V.fromList ["foo", "foo"])

23−

24−example :: IO ()

25−example = do

26− -- Since we know our schema doesn't reference any other schemas we could

27− -- skip this step and use @ReferencedSchemas schema mempty@ instead.

28− --

29− -- If we make a mistake and out schema does include references to other

30− -- schemas then those references will always return 'D4.RefResolution'

31− -- validation failures.

32− cache <- makeCache

33−

34− let validate = case D4.checkSchema cache schemaContext of

35− Left _ -> error "Not a valid schema."

36− Right f -> f

37−

38− case validate badData of

39− [] -> error "We validated bad data."

40− [D4.Invalid D4.UniqueItems _ _] -> return () -- Success.

41− _ -> error "We got a different failure than expected."

42−

43− where

44− makeCache :: IO (D4.ReferencedSchemas D4.Schema)

45− makeCache = do

46− res <- D4.referencesViaHTTP schemaContext

47− case res of

48− Left _ -> error "Couldn't fetch referenced schemas."

49− Right cache -> return cache

examples/json/unique.jsonnew file+3

@@ -0,0 +1,3 @@

1+{

2+ "uniqueItems": true

3+}

hjsonschema.cabal+3−2

@@ -69,9 +69,9 @@ test-suite local

69 , Shared

70 -- from ./examples:

71 , CustomSchema

72+ , Full

72 , PrettyShowFailure

73 , PrettyShowFailure

73− , Standard

74+ , Simple

74−

75 default-language: Haskell2010

76 ghc-options: -Wall -fno-warn-orphans

77 default-extensions: OverloadedStrings

@@ -81,6 +81,7 @@ test-suite local

81 , filepath

82 , hjsonpointer

83 , hjsonschema

84+ , semigroups

84 , text

85 , text

85 , QuickCheck

86 , QuickCheck

86 , unordered-containers

87 , unordered-containers

src/Data/JsonSchema/Draft4.hs+4−3

@@ -97,7 +97,9 @@ fetchFilesystemAndValidate sw v = do

97 Nothing -> Right ()

98 Just failures -> Left (FVData failures)

99

100+-- | Check the that a schema itself is valid.

101+--

100−-- | Check the validity of a schema and return a function to validate data.

102+-- Return a function to validate data.

101checkSchema

103checkSchema

102 :: ReferencedSchemas Schema

104 :: ReferencedSchemas Schema

103 -> SchemaWithURI Schema

105 -> SchemaWithURI Schema

@@ -120,8 +122,7 @@ referencesViaFilesystem

120 -> IO (Either FilesystemFailure (ReferencedSchemas Schema))

122 -> IO (Either FilesystemFailure (ReferencedSchemas Schema))

121referencesViaFilesystem = FE.referencesViaFilesystem' draft4Spec

123referencesViaFilesystem = FE.referencesViaFilesystem' draft4Spec

122

124

123−-- | In normal situations just use 'checkSchema', which is a combination of

125+-- | Check that a schema itself is valid.

124−-- 'schemaValidity' and 'runValidate'.

125schemaValidity :: Schema -> [Invalid]

126schemaValidity :: Schema -> [Invalid]

126schemaValidity = IN.runValidate referenced (SchemaWithURI d4 Nothing) . toJSON

127schemaValidity = IN.runValidate referenced (SchemaWithURI d4 Nothing) . toJSON

127 where

128 where

test/Local.hs+9−7

@@ -12,9 +12,10 @@ import qualified Test.Tasty.HUnit as HU

12import Test.Tasty.QuickCheck (testProperty)

13

14-- Examples

15−import qualified CustomSchema as C

15+import qualified CustomSchema

16+import qualified Full

16−import qualified PrettyShowFailure as P

17+import qualified PrettyShowFailure

17−import qualified Standard as S

18+import qualified Simple

18

19

19import Data.JsonSchema.Draft4

20import Data.JsonSchema.Draft4

20import Local.Failure (correctPaths)

21import Local.Failure (correctPaths)

@@ -30,7 +31,7 @@ main = do

30 filenames <- filter isLocal . filter (".json" `isSuffixOf`) <$> getDirectoryContents dir

31 filenames <- filter isLocal . filter (".json" `isSuffixOf`) <$> getDirectoryContents dir

31 ts <- readSchemaTests dir filenames

32 ts <- readSchemaTests dir filenames

32 defaultMain . testGroup "Tests not requiring an HTTP server" $

33 defaultMain . testGroup "Tests not requiring an HTTP server" $

33− testGroup "Check that examples compile" exampleTests

34+ testGroup "Check that examples compile and don't throw errors" exampleTests

34 : testGroup "QuickCheck tests" quickCheckTests

35 : testGroup "QuickCheck tests" quickCheckTests

35 : testGroup "Report the path to invalid data correctly" correctPaths

36 : testGroup "Report the path to invalid data correctly" correctPaths

36 : testGroup "Test the referencesViaFilesystem function" fetchFromFilesystem

37 : testGroup "Test the referencesViaFilesystem function" fetchFromFilesystem

@@ -46,7 +47,8 @@ quickCheckTests =

46

47

47exampleTests :: [TestTree]

48exampleTests :: [TestTree]

48exampleTests =

49exampleTests =

49− [ HU.testCase "Standard Example" S.example

50+ [ HU.testCase "CustomSchema example" CustomSchema.example

51+ , HU.testCase "Full example" Full.example

50− , HU.testCase "PrettyShowFailure Example" P.example

52+ , HU.testCase "PrettyShowFailure example" PrettyShowFailure.example

51− , HU.testCase "CustomSchema Example" C.example

53+ , HU.testCase "Simple example" Simple.example

52 ]

54 ]