96ffacc..master · typeable/hjsonschema

.travis.yml+5−5

since splitsnapshots

unifiedsplit

@@ -26,15 +26,15 @@ before_cache:

26

27matrix:

28 include:

29− - compiler: "ghc-7.10.3"

30− # env: TEST=--disable-tests BENCH=--disable-benchmarks

31− addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-7.10.3], sources: [hvr-ghc]}}

32 - compiler: "ghc-8.0.2"

29 - compiler: "ghc-8.0.2"

33 # env: TEST=--disable-tests BENCH=--disable-benchmarks

30 # env: TEST=--disable-tests BENCH=--disable-benchmarks

34 addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-8.0.2], sources: [hvr-ghc]}}

31 addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-8.0.2], sources: [hvr-ghc]}}

35− - compiler: "ghc-8.2.1"

32+ - compiler: "ghc-8.2.2"

33+ # env: TEST=--disable-tests BENCH=--disable-benchmarks

34+ addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-8.2.2], sources: [hvr-ghc]}}

35+ - compiler: "ghc-8.4.1"

36 # env: TEST=--disable-tests BENCH=--disable-benchmarks

37− addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-8.2.1], sources: [hvr-ghc]}}

37+ addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-8.4.1], sources: [hvr-ghc]}}

38

39before_install:

40 - HC=${CC}

README.md+8−50

@@ -1,67 +1,25 @@

1−![hjsonschema logo](./logo.jpg)

1+# DEPRECATION NOTICE

2

3−A Haskell implementation of the most commonly used [JSON Schema](http://json-schema.org/) specification ([Draft 4](https://github.com/json-schema-org/json-schema-spec/wiki/Specification-Links#draft-4)).

3+`hjsonschema` was an attempt to build a very modular JSON Schema library. Validators have [a concrete type](src/JSONSchema/Validator/Types.hs) and can be mixed and matched into new [Specs](src/JSONSchema/Types.hs).

4

5−[Hackage](https://hackage.haskell.org/package/hjsonschema) / [GitHub](https://github.com/seagreen/hjsonschema) / [Travis CI](https://travis-ci.org/seagreen/hjsonschema)

5+However this flexibility came at the price of complicating the code. I don't think it was the right tradeoff, especially since situations where you'd want to change what validators make up a `Spec` at runtime seem rare.

6−

7−# Notes

8

6

9−+ As of 2017 [json-schema-org](https://github.com/json-schema-org/json-schema-spec) has begun releasing new drafts of the standard. Once this work stabilizes `hjsonschema` will add coverage for the latest draft.

7+Also, there are many parts of JSON Schema that `hjsonschema` doesn't implement properly (as you can see from the issue tracker). I'm hoping that a new JSON Schema library will come along that handles these correctly. In the meantime I'm happy to merge working fixes into here.

10

8

11−+ Requires [pcre](http://www.pcre.org/) (`pkgs.pcre` in Nixpkgs).

9+# Links

12

10

13−+ Schemas with circular references can cause infinite loops. hjsonschema does loop detection but it may not be solid yet -- please open an issue if you find a situation where it fails.

11+[Hackage](https://hackage.haskell.org/package/hjsonschema) / [GitHub](https://github.com/seagreen/hjsonschema) / [Travis CI](https://travis-ci.org/seagreen/hjsonschema)

14

12

15# Example

13# Example

16

14

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

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

18

16

19−# Tests

17+# System dependencies

20−

21−Run all tests:

22−

23−`stack test`

24−

25−Run only local tests:

26−

27−`stack test hjsonschema:local`

28−

29−Run remote tests (makes GETs to json-schema.org, also temporarily starts an HTTP server on port 1234):

30−

31−`stack test hjsonschema:remote`

32−

33−# Details

34−

35−## Goals

36−

37−+ Be a correct and fast implementation of the spec.

38

18

39−+ Be a useful reference for implementers in other languages. Haskell's high level nature, expressive type system and referential transparency suit this purpose well.

19++ Requires [pcre](http://www.pcre.org/) (`pkgs.pcre` in Nixpkgs).

40−

41−## Good Parts

42−

43−+ Passes all the required tests in the [language agnostic test suite](https://github.com/json-schema/JSON-Schema-Test-Suite). NOTE: due to an issue with the test suite this isn't true at the moment, see [#175](https://github.com/json-schema-org/JSON-Schema-Test-Suite/issues/175).

44−

45−+ Very modular, which should make it easy to support future versions of the specification.

46−

47−## Bad Parts

48−

49−+ Uses the [pcre-heavy](https://hackage.haskell.org/package/pcre-heavy) regular expression library for the "pattern" validator. It should use a library based on the ECMA 262 regex dialect, which the [spec](http://json-schema.org/latest/json-schema-validation.html#anchor33) requires.

50−

51−+ Currently doesn't support the optional `"format"` validators.

52

20

53## Vendoring

21## Vendoring

54

22

55+ `JSON-Schema-Test-Suite` is vendored from commit # c1b12bf699f29a04b4286711c6e3bbfba66f21e5 [here](https://github.com/json-schema-org/JSON-Schema-Test-Suite).

23+ `JSON-Schema-Test-Suite` is vendored from commit # c1b12bf699f29a04b4286711c6e3bbfba66f21e5 [here](https://github.com/json-schema-org/JSON-Schema-Test-Suite).

56

24

57+ `src/draft4.json` is from commit # c1b12bf699f29a04b4286711c6e3bbfba66f21e5 [here](https://github.com/json-schema/json-schema). The [root ref in remote ref](./JSON-Schema-Test-Suite/tests/draft4/refRemote.json) test has been modified to fix [#175](https://github.com/json-schema-org/JSON-Schema-Test-Suite/issues/175).

25+ `src/draft4.json` is from commit # c1b12bf699f29a04b4286711c6e3bbfba66f21e5 [here](https://github.com/json-schema/json-schema). The [root ref in remote ref](./JSON-Schema-Test-Suite/tests/draft4/refRemote.json) test has been modified to fix [#175](https://github.com/json-schema-org/JSON-Schema-Test-Suite/issues/175).

58−

59−+ `.travis.yml` was created with `make_travis_yml_2.hs` commit # ea6c7d177a97bfbfb2fdc4deba943d60d2aff199.

60−

61−## Credits

62−

63−[TJ Weigel](http://tjweigel.com/) created the logo.

64−

65−[Tim Baumann](https://github.com/timjb) wrote [aeson-schema](https://hackage.haskell.org/package/aeson-schema), on which hjsonschema's test code and its implementation of `SchemaGraph` were based.

66−

67−[Julian Berman](https://github.com/Julian) maintains the fantastic [language agnostic test suite](https://github.com/json-schema/JSON-Schema-Test-Suite).

changelog.md+15

@@ -1,3 +1,18 @@

1+# 1.8.0

2+

3++ Add GHC 8.4 support (thanks @4e6 !).

4++ Drop GHC 7.10 support.

5++ Fix JSON Pointer resolution error.

6+

7+# 1.8.0

8+

9++ Allow HTTPS references (thanks @creichert!).

10++ Use `safe-exceptions` to eliminate the risk of catching asynchronous exceptions.

11+

12+# 1.7.2

13+

14++ Remove upper bounds.

15+

1# 1.7.1

16# 1.7.1

2

17

3+ Bump http-types.

18+ Bump http-types.

examples/AlternateSchema.hs+13−18

@@ -5,28 +5,23 @@

5-- to copy this module instead of the 'JSONSchema.Draft4'. While it's

6-- less convenient to write schemas in Haskell without a record type, you

7-- can get the implementation finished with far fewer lines of code.

8−

9module AlternateSchema where

8module AlternateSchema where

10

9

11import Protolude

10import Protolude

12

11

13−import Data.Aeson (FromJSON(..), Value(..),

12+import Data.Aeson (FromJSON(..), Value(..), decodeStrict)

14− decodeStrict)

15−import qualified Data.Aeson as AE

13+import qualified Data.Aeson as AE

16−import qualified Data.HashMap.Strict as HM

14+import qualified Data.HashMap.Strict as HM

17−import Data.Maybe (fromMaybe)

15+import Data.Maybe (fromMaybe)

18−import Data.Profunctor (Profunctor (..))

16+import Data.Profunctor (Profunctor(..))

19−

17+

20−import JSONSchema.Draft4 (ValidatorFailure(..),

18+import JSONSchema.Draft4 (ValidatorFailure(..), metaSchemaBytes)

21− metaSchemaBytes)

22−import JSONSchema.Fetch (SchemaWithURI(..),

19+import JSONSchema.Fetch (SchemaWithURI(..), URISchemaMap(..))

23− URISchemaMap(..))

24−import qualified JSONSchema.Fetch as FE

20+import qualified JSONSchema.Fetch as FE

25−import JSONSchema.Types (Schema(..), Spec(..))

21+import JSONSchema.Types (Schema(..), Spec(..))

26−import qualified JSONSchema.Types as JT

22+import qualified JSONSchema.Types as JT

27−import qualified JSONSchema.Validator.Draft4 as D4

23+import qualified JSONSchema.Validator.Draft4 as D4

28−import JSONSchema.Validator.Reference (BaseURI(..),

24+import JSONSchema.Validator.Reference (BaseURI(..), Scope(..),

29− Scope(..),

30 updateResolutionScope)

25 updateResolutionScope)

31

26

32--------------------------------------------------

27--------------------------------------------------

examples/Simple.hs+4−5

@@ -1,14 +1,13 @@

1−

2module Simple where

1module Simple where

3

2

4import Protolude

3import Protolude

5

4

6−import Data.Aeson (Value(..), decodeStrict, toJSON)

5+import Data.Aeson (Value(..), decodeStrict, toJSON)

7−import qualified Data.ByteString as BS

6+import qualified Data.ByteString as BS

8import qualified Data.List.NonEmpty as NE

7import qualified Data.List.NonEmpty as NE

9−import Data.Maybe (fromMaybe)

8+import Data.Maybe (fromMaybe)

10

9

11−import qualified JSONSchema.Draft4 as D4

10+import qualified JSONSchema.Draft4 as D4

12

11

13badData :: Value

12badData :: Value

14badData = toJSON [True, True]

13badData = toJSON [True, True]

examples/TwoStep.hs+3−4

@@ -10,15 +10,14 @@

10-- 'fetchHTTPAndValidate' which fetched references over HTTP (though it

11-- didn't matter because the last schema didn't actually have any).

12-- This time we need to get them from the filesystem.

13−

14module TwoStep where

13module TwoStep where

15

14

16import Protolude

15import Protolude

17

16

18−import Data.Aeson (Value (..), toJSON)

17+import Data.Aeson (Value(..), toJSON)

19−import qualified Data.List.NonEmpty as NE

18+import qualified Data.List.NonEmpty as NE

20

19

21−import qualified JSONSchema.Draft4 as D4

20+import qualified JSONSchema.Draft4 as D4

22import qualified JSONSchema.Validator.Draft4 as VAL

21import qualified JSONSchema.Validator.Draft4 as VAL

23

22

24schema :: D4.Schema

23schema :: D4.Schema

hjsonschema.cabal+24−26

@@ -1,5 +1,5 @@

1name: hjsonschema

2−version: 1.7.1

2+version: 1.9.0

3synopsis: JSON Schema library

4homepage: https://github.com/seagreen/hjsonschema

5license: MIT

@@ -10,7 +10,7 @@ category: Data

10build-type: Simple

11cabal-version: >=1.10

12-- Rerun multi-ghc-travis (executable make-travis-yml-2) after changing:

13−Tested-With: GHC == 7.10.3, GHC == 8.0.2, GHC == 8.2.1

13+Tested-With: GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.1

14extra-source-files:

15 changelog.md

16 JSON-Schema-Test-Suite/remotes/*.json

@@ -34,7 +34,6 @@ library

34 NoImplicitPrelude

35 OverloadedStrings

36 ScopedTypeVariables

37− TupleSections

38 if impl(ghc >= 8)

37 if impl(ghc >= 8)

39 default-extensions: StrictData

38 default-extensions: StrictData

40 ghc-options:

39 ghc-options:

@@ -59,27 +58,28 @@ library

59 JSONSchema.Validator.Draft4.Object.Properties

58 JSONSchema.Validator.Draft4.Object.Properties

60 , Import

59 , Import

61 build-depends:

60 build-depends:

62− base >= 4.7 && < 4.11

61+ base >= 4.7 && < 5

63 -- 0.11 is for `.:!`:

62 -- 0.11 is for `.:!`:

64− , aeson >= 0.11 && < 1.3

63+ , aeson >= 0.11

65− , bytestring >= 0.10 && < 0.11

64+ , bytestring >= 0.10

66− , containers >= 0.5 && < 0.6

65+ , containers >= 0.5

67− , file-embed >= 0.0.8 && < 0.1

66+ , file-embed >= 0.0.8

68− , filepath >= 1.3 && < 1.5

67+ , filepath >= 1.3

69− , hashable >= 1.2 && < 1.3

68+ , hashable >= 1.2

70− , hjsonpointer >= 1.1 && < 1.4

69+ , hjsonpointer >= 1.1

71 -- 0.4.30 is for parseUrlThrow:

70 -- 0.4.30 is for parseUrlThrow:

72− , http-client >= 0.4.30 && < 0.6

71+ , http-client >= 0.4.30

72+ , http-client-tls >= 0.3

73− , http-types >= 0.8 && < 0.11

73+ , http-types >= 0.8

74− , pcre-heavy >= 1.0 && < 1.1

74+ , pcre-heavy >= 1.0

75− , profunctors >= 5.0 && < 5.3

75+ , profunctors >= 5.0

76− , protolude >= 0.1.10 && < 1.2

76+ , protolude >= 0.1.10

77− , QuickCheck >= 2.8 && < 2.11

77+ , QuickCheck >= 2.8

78+ , safe-exceptions >= 0.1.6

78− , scientific >= 0.3 && < 0.4

79+ , scientific >= 0.3

79− , semigroups >= 0.18 && < 0.19

80− , unordered-containers >= 0.2 && < 0.3

80+ , unordered-containers >= 0.2

81− , text >= 1.1 && < 1.3

81+ , text >= 1.1

82− , vector >= 0.10 && < 1.0

82+ , vector >= 0.10

83

84test-suite local

85 hs-source-dirs:

@@ -114,15 +114,14 @@ test-suite local

114 , hjsonschema

115 , profunctors

116 , protolude

117− , semigroups

118 , text

117 , text

119 , QuickCheck

118 , QuickCheck

120 , unordered-containers

119 , unordered-containers

121 , vector

120 , vector

122

121

123 -- directory-1.2.5 required for `listDirectory`:

122 -- directory-1.2.5 required for `listDirectory`:

124− , directory >= 1.2.5 && < 2.0

123+ , directory >= 1.2.5

125− , hspec >= 2.2 && < 3.0

124+ , hspec >= 2.2

126

125

127test-suite remote

126test-suite remote

128 hs-source-dirs:

127 hs-source-dirs:

@@ -153,7 +152,6 @@ test-suite remote

153 , hjsonschema

152 , hjsonschema

154 , profunctors

153 , profunctors

155 , protolude

154 , protolude

156− , semigroups

157 , text

155 , text

158 , unordered-containers

156 , unordered-containers

159 , vector

157 , vector

logo.jpgdeleted

Binary file not shown.

run-stack-haddockdeleted−1

@@ -1 +0,0 @@

1−../stack-haddock-upload/stack-haddock-upload hjsonschema # 1.2.0.1

shell.nix+1

@@ -8,6 +8,7 @@ haskell.lib.buildStackProject {

8 pcre

9

10 git # for `git:` references in stack.yml.

11+ ncurses # for intero

11 pkgconfig

12 pkgconfig

12 zlib

13 zlib

13 ];

14 ];

src/Import.hs+7−7

@@ -1,16 +1,16 @@

1

2module Import (module Export, fromJSONEither) where

3

4−import Protolude as Export

4+import Protolude as Export

5

6−import Data.Aeson as Export

6+import Data.Aeson as Export

7import Data.HashMap.Strict as Export (HashMap)

8−import Data.List.NonEmpty as Export (NonEmpty)

8+import Data.List.NonEmpty as Export (NonEmpty)

9−import Data.Vector as Export (Vector)

9+import Data.Vector as Export (Vector)

10−import Test.QuickCheck as Export hiding ((.&.), Failure,

10+import Test.QuickCheck as Export hiding (Failure, Result, Success,

11− Result, Success)

11+ (.&.))

12

13−import qualified Data.Text as T

13+import qualified Data.Text as T

14

15fromJSONEither :: FromJSON a => Value -> Either Text a

16fromJSONEither a =

src/JSONSchema/Draft4.hs+12−15

@@ -37,22 +37,19 @@ module JSONSchema.Draft4

37

38import Import

39

40−import qualified Data.ByteString as BS

40+import qualified Data.ByteString as BS

41−import Data.FileEmbed (embedFile,

41+import Data.FileEmbed (embedFile, makeRelativeToProject)

42− makeRelativeToProject)

43−import qualified Data.HashMap.Strict as HM

42+import qualified Data.HashMap.Strict as HM

44−import qualified Data.List.NonEmpty as NE

43+import qualified Data.List.NonEmpty as NE

45−import Data.Maybe (fromMaybe)

44+import Data.Maybe (fromMaybe)

46−

45+

47−import JSONSchema.Draft4.Failure (Invalid(..),

46+import JSONSchema.Draft4.Failure (Invalid(..), SchemaInvalid(..),

48− SchemaInvalid(..),

49 ValidatorFailure(..))

47 ValidatorFailure(..))

50−import JSONSchema.Draft4.Schema (Schema)

48+import JSONSchema.Draft4.Schema (Schema)

51−import qualified JSONSchema.Draft4.Schema as SC

49+import qualified JSONSchema.Draft4.Schema as SC

52−import qualified JSONSchema.Draft4.Spec as Spec

50+import qualified JSONSchema.Draft4.Spec as Spec

53−import JSONSchema.Fetch (SchemaWithURI(..),

51+import JSONSchema.Fetch (SchemaWithURI(..), URISchemaMap(..))

54− URISchemaMap(..))

55−import qualified JSONSchema.Fetch as FE

52+import qualified JSONSchema.Fetch as FE

56

53

57data HTTPValidationFailure

54data HTTPValidationFailure

58 = HVRequest FE.HTTPFailure

55 = HVRequest FE.HTTPFailure

src/JSONSchema/Draft4/Failure.hs+1−2

@@ -1,9 +1,8 @@

1−

2module JSONSchema.Draft4.Failure where

1module JSONSchema.Draft4.Failure where

3

2

4import Import

3import Import

5

4

6−import JSONSchema.Draft4.Schema (Schema)

5+import JSONSchema.Draft4.Schema (Schema)

7import qualified JSONSchema.Validator.Draft4 as VAL

6import qualified JSONSchema.Validator.Draft4 as VAL

8

7

9-- | Used to report an entire instance being invalidated, as opposed

8-- | Used to report an entire instance being invalidated, as opposed

src/JSONSchema/Draft4/Schema.hs+6−7

@@ -1,14 +1,13 @@

1−

2module JSONSchema.Draft4.Schema where

1module JSONSchema.Draft4.Schema where

3

2

4−import Import hiding (mapMaybe)

3+import Import hiding (mapMaybe)

5

4

6−import qualified Data.HashMap.Strict as HM

5+import qualified Data.HashMap.Strict as HM

7−import Data.List.NonEmpty (NonEmpty)

6+import Data.List.NonEmpty (NonEmpty)

8−import Data.Maybe (fromJust, isJust)

7+import Data.Maybe (fromJust, isJust)

9import Data.Scientific

8import Data.Scientific

10−import qualified Data.Set as Set

9+import qualified Data.Set as Set

11−import qualified Data.Text as T

10+import qualified Data.Text as T

12

11

13import qualified JSONSchema.Validator.Draft4 as D4

12import qualified JSONSchema.Validator.Draft4 as D4

14import JSONSchema.Validator.Utils

13import JSONSchema.Validator.Utils

src/JSONSchema/Draft4/Spec.hs+9−13

@@ -1,22 +1,18 @@

1−

2module JSONSchema.Draft4.Spec where

1module JSONSchema.Draft4.Spec where

3

2

4import Import

3import Import

5

4

6−import Data.Maybe (fromMaybe)

5+import Data.Maybe (fromMaybe)

7−import Data.Profunctor (Profunctor(..))

6+import Data.Profunctor (Profunctor(..))

8

7

9import JSONSchema.Draft4.Failure

8import JSONSchema.Draft4.Failure

10−import JSONSchema.Draft4.Schema (Schema(..),

9+import JSONSchema.Draft4.Schema (Schema(..), emptySchema)

11− emptySchema)

12−import JSONSchema.Fetch (SchemaWithURI(..),

10+import JSONSchema.Fetch (SchemaWithURI(..), URISchemaMap(..))

13− URISchemaMap(..))

14−import qualified JSONSchema.Fetch as FE

11+import qualified JSONSchema.Fetch as FE

15−import JSONSchema.Types (Spec(..))

12+import JSONSchema.Types (Spec(..))

16−import qualified JSONSchema.Types as JT

13+import qualified JSONSchema.Types as JT

17import JSONSchema.Validator.Draft4

14import JSONSchema.Validator.Draft4

18−import JSONSchema.Validator.Reference (BaseURI(..),

15+import JSONSchema.Validator.Reference (BaseURI(..), Scope(..),

19− Scope(..),

20 updateResolutionScope)

16 updateResolutionScope)

21

17

22-- | An implementation of 'JT.embedded'.

18-- | An implementation of 'JT.embedded'.

@@ -43,7 +39,7 @@ specValidate schemaMap sw =

43 (_schemaId (_swSchema sw))

39 (_schemaId (_swSchema sw))

44 }

40 }

45

41

46−validateSubschema

42+validateSubschema

47 :: URISchemaMap Schema

43 :: URISchemaMap Schema

48 -> VisitedSchemas

44 -> VisitedSchemas

49 -> Scope Schema

45 -> Scope Schema

src/JSONSchema/Fetch.hs+16−15

@@ -1,18 +1,18 @@

1−

2module JSONSchema.Fetch where

1module JSONSchema.Fetch where

3

2

4import Import

3import Import

5

4

6−import Control.Exception (IOException, catch)

5+import qualified Control.Exception.Safe as Safe

7−import Control.Monad (foldM)

6+import Control.Monad (foldM)

8−import qualified Data.ByteString as BS

7+import qualified Data.ByteString as BS

9−import qualified Data.ByteString.Lazy as LBS

8+import qualified Data.ByteString.Lazy as LBS

10−import qualified Data.HashMap.Strict as HM

9+import qualified Data.HashMap.Strict as HM

11−import qualified Data.Text as T

10+import qualified Data.Semigroup as S

11+import qualified Data.Text as T

12−import qualified Network.HTTP.Client as NC

12+import qualified Network.HTTP.Client as NC

13−

13+import qualified Network.HTTP.Client.TLS as NCTLS

14+

14−import JSONSchema.Validator.Reference (BaseURI(..),

15+import JSONSchema.Validator.Reference (BaseURI(..), resolveReference,

15− resolveReference,

16 updateResolutionScope)

17

18--------------------------------------------------

@@ -30,7 +30,7 @@ data FetchInfo schema = FetchInfo

30-- | Keys are URIs (without URI fragments).

31newtype URISchemaMap schema

32 = URISchemaMap { _unURISchemaMap :: HashMap Text schema }

33− deriving (Eq, Show, Monoid)

33+ deriving (Eq, Show, S.Semigroup, Monoid)

34

35-- | A top-level schema along with its location.

36data SchemaWithURI schema = SchemaWithURI

@@ -61,9 +61,9 @@ referencesViaHTTP'

61 -> SchemaWithURI schema

62 -> IO (Either HTTPFailure (URISchemaMap schema))

63referencesViaHTTP' info sw = do

64− manager <- NC.newManager NC.defaultManagerSettings

64+ manager <- NC.newManager NCTLS.tlsManagerSettings

65 let f = referencesMethodAgnostic (getURL manager) info sw

66− catch (first HTTPParseFailure <$> f) handler

66+ Safe.catch (first HTTPParseFailure <$> f) handler

67 where

68 getURL :: NC.Manager -> Text -> IO BS.ByteString

69 getURL man url = do

@@ -89,7 +89,8 @@ referencesViaFilesystem'

89 => FetchInfo schema

90 -> SchemaWithURI schema

91 -> IO (Either FilesystemFailure (URISchemaMap schema))

92+referencesViaFilesystem' info sw =

92−referencesViaFilesystem' info sw = catch (first FSParseFailure <$> f) handler

93+ Safe.catch (first FSParseFailure <$> f) handler

93 where

94 where

94 f :: IO (Either Text (URISchemaMap schema))

95 f :: IO (Either Text (URISchemaMap schema))

95 f = referencesMethodAgnostic (BS.readFile . T.unpack) info sw

96 f = referencesMethodAgnostic (BS.readFile . T.unpack) info sw

src/JSONSchema/Types.hs−1

@@ -1,4 +1,3 @@

1−

2module JSONSchema.Types where

1module JSONSchema.Types where

3

2

4import Import

3import Import

src/JSONSchema/Validator/Draft4.hs+7−8

@@ -2,7 +2,6 @@

2--

3-- This is frankly a lot of busywork. It can perhaps be moved into the

4-- validator modules themselves once we're sure this is the right design.

5−

6module JSONSchema.Validator.Draft4

5module JSONSchema.Validator.Draft4

7 ( module JSONSchema.Validator.Draft4

6 ( module JSONSchema.Validator.Draft4

8 , module Export

7 , module Export

@@ -10,16 +9,16 @@ module JSONSchema.Validator.Draft4

10

9

11import Import

10import Import

12

11

13−import qualified Data.HashMap.Strict as HM

12+import qualified Data.HashMap.Strict as HM

14−import qualified Data.List.NonEmpty as NE

13+import qualified Data.List.NonEmpty as NE

15

14

16−import JSONSchema.Validator.Draft4.Any as Export

15+import JSONSchema.Validator.Draft4.Any as Export

17−import JSONSchema.Validator.Draft4.Array as Export

16+import JSONSchema.Validator.Draft4.Array as Export

18import JSONSchema.Validator.Draft4.Number as Export

17import JSONSchema.Validator.Draft4.Number as Export

19import JSONSchema.Validator.Draft4.Object as Export

18import JSONSchema.Validator.Draft4.Object as Export

20import JSONSchema.Validator.Draft4.String as Export

19import JSONSchema.Validator.Draft4.String as Export

21−import JSONSchema.Validator.Reference (BaseURI(..), Scope(..))

20+import JSONSchema.Validator.Reference (BaseURI(..), Scope(..))

22−import JSONSchema.Validator.Types (Validator(..))

21+import JSONSchema.Validator.Types (Validator(..))

23

22

24-- | For internal use.

23-- | For internal use.

25--

24--

@@ -148,7 +147,7 @@ propertiesRelatedValidator f =

148 <> HM.elems (fromMaybe mempty (_propPattern a))

147 <> HM.elems (fromMaybe mempty (_propPattern a))

149 <> case _propAdditional a of

148 <> case _propAdditional a of

150 Just (AdditionalPropertiesObject b) -> [b]

149 Just (AdditionalPropertiesObject b) -> [b]

151− _ -> mempty

150+ _ -> mempty

152 ))

151 ))

153 (\a b -> case fromJSONEither b of

152 (\a b -> case fromJSONEither b of

154 Left _ -> mempty

153 Left _ -> mempty

src/JSONSchema/Validator/Draft4/Any.hs+46−24

@@ -1,25 +1,24 @@

1−

2module JSONSchema.Validator.Draft4.Any where

1module JSONSchema.Validator.Draft4.Any where

3

2

4−import Import hiding ((<>))

3+import Import hiding ((<>))

5

4

6−import Data.Aeson.TH (constructorTagModifier)

5+import Data.Aeson.TH (constructorTagModifier)

7−import Data.Char (toLower)

6+import Data.Char (toLower)

7+import qualified Data.HashMap.Strict as HM

8−import Data.List.NonEmpty (NonEmpty((:|)))

8+import Data.List.NonEmpty (NonEmpty((:|)))

9−import qualified Data.List.NonEmpty as NE

9+import qualified Data.List.NonEmpty as NE

10−import qualified Data.Scientific as SCI

10+import qualified Data.Scientific as SCI

11import Data.Semigroup

12−import Data.Set (Set)

12+import Data.Set (Set)

13−import qualified Data.Set as Set

13+import qualified Data.Set as Set

14−import Data.Text.Encoding.Error (UnicodeException)

14+import Data.Text.Encoding.Error (UnicodeException)

15−import qualified JSONPointer as JP

15+import qualified JSONPointer as JP

16−import Network.HTTP.Types.URI (urlDecode)

16+import Network.HTTP.Types.URI (urlDecode)

17−

17+

18−import qualified JSONSchema.Validator.Utils as UT

19−import JSONSchema.Validator.Reference (BaseURI(..),

18+import JSONSchema.Validator.Reference (BaseURI(..), Scope(..),

20− Scope(..),

21 URIAndFragment,

19 URIAndFragment,

22 resolveReference)

20 resolveReference)

21+import qualified JSONSchema.Validator.Utils as UT

23

22

24--------------------------------------------------

23--------------------------------------------------

25-- * $ref

24-- * $ref

@@ -135,7 +134,7 @@ data JSONPointerError

135 deriving (Eq, Show)

134 deriving (Eq, Show)

136

135

137resolveFragment

136resolveFragment

138− :: forall schema. (FromJSON schema, ToJSON schema)

137+ :: (FromJSON schema, ToJSON schema)

139 => (BaseURI -> schema -> BaseURI)

138 => (BaseURI -> schema -> BaseURI)

140 -> Scope schema

139 -> Scope schema

141 -> Text

140 -> Text

@@ -160,17 +159,40 @@ resolveFragment updateScope scope fragment = do

160 -- as property keys that aren't meant to change scope?

159 -- as property keys that aren't meant to change scope?

161 -- Perhaps this should be added to the language agnostic

160 -- Perhaps this should be added to the language agnostic

162 -- test suite as well.

161 -- test suite as well.

162+ --

163+ -- In the meantime 'newBaseURIFromFragment' drops all keys

164+ -- from JSON objects except "id", which at least prevents

165+ -- SubschemaDecodingError in a situation where one of the

166+ -- values we step through isn't a valid schema.

163 go :: (Value, BaseURI)

167 go :: (Value, BaseURI)

164 -> JP.Token

168 -> JP.Token

165 -> Either JSONPointerError (Value, BaseURI)

169 -> Either JSONPointerError (Value, BaseURI)

166− go (lastVal, uri) tok = do

170+ go (lastVal, baseURI) tok = do

167 v <- first ResolutionError (JP.resolveToken tok lastVal)

171 v <- first ResolutionError (JP.resolveToken tok lastVal)

168− case v of

172+ newBase <- newBaseURIFromFragment updateScope baseURI v

169− Array _ -> pure (v, uri)

173+ Right (v, newBase)

170− _ -> do

174+

171− -- PERFORMANCE: Avoid deserializing subschemas.

175+-- | Update the 'BaseURI' (the store of the current "id" value)

176+-- after resolving one token of a JSON Pointer and stepping into

177+-- a new 'Value'.

178+newBaseURIFromFragment

179+ :: FromJSON schema

180+ => (BaseURI -> schema -> BaseURI)

181+ -> BaseURI

182+ -> Value

183+ -> Either JSONPointerError BaseURI

184+newBaseURIFromFragment updateScope baseURI v =

185+ case v of

186+ Object hm -> do

187+ let hmWithOnlyId = case HM.lookup idKey hm of

188+ Nothing -> mempty

189+ Just idVal -> HM.singleton idKey idVal

172− schema <- first SubschemaDecodingError (fromJSONEither v)

190+ schema <- first SubschemaDecodingError (fromJSONEither (Object hmWithOnlyId))

173− pure (v, updateScope uri schema)

191+ Right (updateScope baseURI schema)

192+ _ -> Right baseURI

193+ where

194+ idKey :: Text

195+ idKey = "id"

174

196

175--------------------------------------------------

197--------------------------------------------------

176-- * enum

198-- * enum

src/JSONSchema/Validator/Draft4/Array.hs+7−6

@@ -1,11 +1,10 @@

1−

2module JSONSchema.Validator.Draft4.Array where

1module JSONSchema.Validator.Draft4.Array where

3

2

4import Import

3import Import

5

4

6−import qualified Data.List.NonEmpty as NE

5+import qualified Data.List.NonEmpty as NE

7−import qualified Data.Vector as V

6+import qualified Data.Vector as V

8−import qualified JSONPointer as JP

7+import qualified JSONPointer as JP

9

8

10import JSONSchema.Validator.Utils (allUniqueValues)

9import JSONSchema.Validator.Utils (allUniqueValues)

11

10

@@ -174,7 +173,8 @@ itemsVal f a xs =

174 :: schema

173 :: schema

175 -> (JP.Index, Value)

174 -> (JP.Index, Value)

176 -> Maybe (JP.Index, NonEmpty err)

175 -> Maybe (JP.Index, NonEmpty err)

177− validateElem schema (index,x) = (index,) <$> NE.nonEmpty (f schema x)

176+ validateElem schema (index,x) =

177+ (\v -> (index, v)) <$> NE.nonEmpty (f schema x)

178

179--------------------------------------------------

180-- * additionalItems

@@ -219,6 +219,7 @@ additionalItemsVal _ (AdditionalBool False) xs =

219 AdditionalItemsBoolInvalid <$> NE.nonEmpty xs

220additionalItemsVal f (AdditionalObject subSchema) xs =

221 let res = mapMaybe

222+ (\(index,x) -> (\v -> (index, v))

222− (\(index,x) -> (index,) <$> NE.nonEmpty (f subSchema x))

223+ <$> NE.nonEmpty (f subSchema x))

223 xs

224 xs

224 in AdditionalItemsObjectInvalid <$> NE.nonEmpty res

225 in AdditionalItemsObjectInvalid <$> NE.nonEmpty res

src/JSONSchema/Validator/Draft4/Number.hs+1−2

@@ -1,9 +1,8 @@

1−

2module JSONSchema.Validator.Draft4.Number where

1module JSONSchema.Validator.Draft4.Number where

3

2

4import Import

3import Import

5

4

6−import Data.Fixed (mod')

5+import Data.Fixed (mod')

7import Data.Scientific (Scientific)

6import Data.Scientific (Scientific)

8

7

9--------------------------------------------------

8--------------------------------------------------

src/JSONSchema/Validator/Draft4/Object.hs+5−6

@@ -1,4 +1,3 @@

1−

2module JSONSchema.Validator.Draft4.Object

1module JSONSchema.Validator.Draft4.Object

3 ( module JSONSchema.Validator.Draft4.Object

2 ( module JSONSchema.Validator.Draft4.Object

4 , module JSONSchema.Validator.Draft4.Object.Properties

3 , module JSONSchema.Validator.Draft4.Object.Properties

@@ -6,11 +5,11 @@ module JSONSchema.Validator.Draft4.Object

6

5

7import Import

6import Import

8

7

9−import qualified Data.HashMap.Strict as HM

8+import qualified Data.HashMap.Strict as HM

10−import qualified Data.List.NonEmpty as NE

9+import qualified Data.List.NonEmpty as NE

11−import Data.Set (Set)

10+import Data.Set (Set)

12−import qualified Data.Set as Set

11+import qualified Data.Set as Set

13−import qualified Data.Text as T

12+import qualified Data.Text as T

14

13

15import JSONSchema.Validator.Draft4.Object.Properties

14import JSONSchema.Validator.Draft4.Object.Properties

16import JSONSchema.Validator.Utils

15import JSONSchema.Validator.Utils

src/JSONSchema/Validator/Draft4/Object/Properties.hs+5−6

@@ -1,13 +1,12 @@

1−

2module JSONSchema.Validator.Draft4.Object.Properties where

1module JSONSchema.Validator.Draft4.Object.Properties where

3

2

4import Import

3import Import

5

4

6−import qualified Data.Hashable as HA

5+import qualified Data.Hashable as HA

7−import qualified Data.HashMap.Strict as HM

6+import qualified Data.HashMap.Strict as HM

8−import qualified Data.List.NonEmpty as NE

7+import qualified Data.List.NonEmpty as NE

9−import Data.Text.Encoding (encodeUtf8)

8+import Data.Text.Encoding (encodeUtf8)

10−import qualified JSONPointer as JP

9+import qualified JSONPointer as JP

11import qualified Text.Regex.PCRE.Heavy as RE

10import qualified Text.Regex.PCRE.Heavy as RE

12

11

13data PropertiesRelated schema = PropertiesRelated

12data PropertiesRelated schema = PropertiesRelated

src/JSONSchema/Validator/Draft4/String.hs+2−3

@@ -1,10 +1,9 @@

1−

2module JSONSchema.Validator.Draft4.String where

1module JSONSchema.Validator.Draft4.String where

3

2

4import Import

3import Import

5

4

6−import qualified Data.Text as T

5+import qualified Data.Text as T

7−import Data.Text.Encoding (encodeUtf8)

6+import Data.Text.Encoding (encodeUtf8)

8import qualified Text.Regex.PCRE.Heavy as RE

7import qualified Text.Regex.PCRE.Heavy as RE

9

8

10--------------------------------------------------

9--------------------------------------------------

src/JSONSchema/Validator/Reference.hs+7−7

@@ -3,15 +3,14 @@

3--

4-- And is extended for JSON Schema here:

5-- <http://json-schema.org/latest/json-schema-core.html#anchor26>

6−

7module JSONSchema.Validator.Reference where

6module JSONSchema.Validator.Reference where

8

7

9import Import

8import Import

10

9

11−import qualified Data.Text as T

10+import qualified Data.Text as T

12−import System.FilePath ((</>), dropFileName)

11+import System.FilePath (dropFileName, (</>))

13

12

14−data Scope schema = Scope

13+data Scope schema = Scope

15 { _topLevelDocument :: schema

14 { _topLevelDocument :: schema

16 , _documentURI :: Maybe Text

15 , _documentURI :: Maybe Text

17 , _currentBaseURI :: BaseURI

16 , _currentBaseURI :: BaseURI

@@ -25,9 +24,10 @@ newtype BaseURI

25type URIAndFragment = (Maybe Text, Maybe Text)

24type URIAndFragment = (Maybe Text, Maybe Text)

26

25

27updateResolutionScope :: BaseURI -> Maybe Text -> BaseURI

26updateResolutionScope :: BaseURI -> Maybe Text -> BaseURI

28−updateResolutionScope base idKeyword

27+updateResolutionScope base idKeyword =

28+ case idKeyword of

29− | Just t <- idKeyword = BaseURI . fst . baseAndFragment $ resolveScopeAgainst base t

29+ Just t -> BaseURI . fst . baseAndFragment $ resolveScopeAgainst base t

30− | otherwise = base

30+ Nothing -> base

31

32resolveReference :: BaseURI -> Text -> URIAndFragment

33resolveReference base t = baseAndFragment (resolveScopeAgainst base t)

src/JSONSchema/Validator/Types.hs−1

@@ -1,4 +1,3 @@

1−

2module JSONSchema.Validator.Types where

1module JSONSchema.Validator.Types where

3

2

4import Import

3import Import

src/JSONSchema/Validator/Utils.hs+7−8

@@ -1,16 +1,15 @@

1−

2module JSONSchema.Validator.Utils where

1module JSONSchema.Validator.Utils where

3

2

4import Import

3import Import

5

4

6−import Control.Monad (fail)

5+import Control.Monad (fail)

7import qualified Data.HashMap.Strict as HM

6import qualified Data.HashMap.Strict as HM

8−import qualified Data.List.NonEmpty as NE

7+import qualified Data.List.NonEmpty as NE

9−import Data.Scientific (Scientific, fromFloatDigits)

8+import Data.Scientific (Scientific, fromFloatDigits)

10−import Data.Set (Set)

9+import Data.Set (Set)

11−import qualified Data.Set as S

10+import qualified Data.Set as S

12−import qualified Data.Text as T

11+import qualified Data.Text as T

13−import qualified Data.Vector as V

12+import qualified Data.Vector as V

14

13

15--------------------------------------------------

14--------------------------------------------------

16-- * QuickCheck

15-- * QuickCheck

stack.yaml+2−7

@@ -1,7 +1,2 @@

1−resolver: nightly-2017-09-18

1+resolver: lts-10.8

2−# packages:

2+pvp-bounds: upper-revision

3−# - './'

4−# - location: '../hjsonpointer'

5−# extra-dep: true

6−extra-deps:

7− - hjsonpointer-1.3.0

test/Local.hs+7−10

@@ -1,19 +1,18 @@

1−

2module Main where

1module Main where

3

2

4import Protolude

3import Protolude

5

4

6import Data.Aeson

5import Data.Aeson

7import qualified Data.List.NonEmpty as NE

6import qualified Data.List.NonEmpty as NE

8−import qualified System.Timeout as TO

7+import qualified System.Timeout as TO

9import Test.Hspec

8import Test.Hspec

10−import Test.QuickCheck (property)

9+import Test.QuickCheck (property)

11

10

12−import qualified JSONSchema.Draft4 as D4

11+import qualified JSONSchema.Draft4 as D4

13−import qualified JSONSchema.Types as JT

12+import qualified JSONSchema.Types as JT

14import qualified Local.Failure

13import qualified Local.Failure

15−import qualified Local.Validation

16import qualified Local.Reference

14import qualified Local.Reference

15+import qualified Local.Validation

17import Shared

16import Shared

18

17

19-- Examples

18-- Examples

@@ -33,12 +32,10 @@ main = do

33 -- Language agnostic tests

32 -- Language agnostic tests

34 ts <- readSchemaTests

33 ts <- readSchemaTests

35 dir

34 dir

36− (\a -> not (isHTTPTest a || skipOptional a))

35+ (\a -> not (isHTTPTest a || skipTest a))

37

36

38 -- Custom supplements to the language agnostic tests

37 -- Custom supplements to the language agnostic tests

39− supplementTs <- readSchemaTests

38+ supplementTs <- readSchemaTests supplementDir (not . isHTTPTest)

40− supplementDir

41− (\a -> not (isHTTPTest a || skipOptional a))

42

39

43 hspec $ do

40 hspec $ do

44 describe "Examples" exampleTests

41 describe "Examples" exampleTests

test/Local/Failure.hs+3−4

@@ -1,15 +1,14 @@

1−

2module Local.Failure where

1module Local.Failure where

3

2

4import Protolude

3import Protolude

5

4

6import Data.Aeson

5import Data.Aeson

6+import qualified Data.Vector as V

7+import qualified JSONPointer as JP

7import Test.Hspec

8import Test.Hspec

8−import qualified Data.Vector as V

9−import qualified JSONPointer as JP

10

9

11import JSONSchema.Draft4

10import JSONSchema.Draft4

12−import qualified JSONSchema.Draft4.Spec as Spec

11+import qualified JSONSchema.Draft4.Spec as Spec

13import qualified JSONSchema.Validator.Draft4 as VAL

12import qualified JSONSchema.Validator.Draft4 as VAL

14

13

15spec :: Spec

14spec :: Spec

test/Local/Reference.hs−1

@@ -1,4 +1,3 @@

1−

2module Local.Reference where

1module Local.Reference where

3

2

4import Protolude

3import Protolude

test/Local/Validation.hs+4−5

@@ -1,17 +1,16 @@

1−

2module Local.Validation where

1module Local.Validation where

3

2

4import Protolude

3import Protolude

5

4

6import Data.Aeson

5import Data.Aeson

7−import qualified Data.Aeson as AE

6+import qualified Data.Aeson as AE

8import qualified Data.HashMap.Strict as HM

7import qualified Data.HashMap.Strict as HM

9−import Data.String (String)

8+import Data.String (String)

10import Test.Hspec

9import Test.Hspec

11

10

11+import qualified AlternateSchema as AS

12import JSONSchema.Draft4

13−import qualified JSONSchema.Types as JT

13+import qualified JSONSchema.Types as JT

14−import qualified AlternateSchema as AS

15

14

16spec :: Spec

15spec :: Spec

17spec = do

16spec = do

test/Remote.hs+6−7

@@ -1,17 +1,16 @@

1−

2module Main where

1module Main where

3

2

4import Protolude

3import Protolude

5

4

6−import Control.Concurrent.Async (withAsync)

5+import Control.Concurrent.Async (withAsync)

7−import qualified Data.List.NonEmpty as NE

6+import qualified Data.List.NonEmpty as NE

8import Network.Wai.Application.Static (defaultFileServerSettings,

7import Network.Wai.Application.Static (defaultFileServerSettings,

9 staticApp)

8 staticApp)

10−import Network.Wai.Handler.Warp (run)

9+import qualified Network.Wai.Handler.Warp as Warp

11import Test.Hspec

10import Test.Hspec

12

11

13−import qualified JSONSchema.Draft4 as D4

12+import qualified JSONSchema.Draft4 as D4

14−import qualified JSONSchema.Types as JT

13+import qualified JSONSchema.Types as JT

15import Shared

14import Shared

16

15

17-- Examples

16-- Examples

@@ -52,7 +51,7 @@ main = withAsync serve $ \_ -> do

52 assertResult sc failures

51 assertResult sc failures

53

52

54serve :: IO ()

53serve :: IO ()

55−serve = run 1234

54+serve = Warp.run 1234

56 . staticApp

55 . staticApp

57 . defaultFileServerSettings

56 . defaultFileServerSettings

58 $ "JSON-Schema-Test-Suite/remotes"

57 $ "JSON-Schema-Test-Suite/remotes"

test/Shared.hs+18−20

@@ -1,19 +1,29 @@

1−

2module Shared where

1module Shared where

3

2

4import Protolude

3import Protolude

5

4

6−import Control.Monad (fail)

5+import Control.Monad (fail)

7import Data.Aeson

6import Data.Aeson

8−import Data.Aeson.TH (fieldLabelModifier)

7+import Data.Aeson.TH (fieldLabelModifier)

9−import qualified Data.ByteString as BS

8+import qualified Data.ByteString as BS

10−import Data.Char (toLower)

9+import Data.Char (toLower)

11−import Data.List (stripPrefix, unlines)

10+import Data.List (stripPrefix, unlines)

12−import qualified Data.Text as T

11+import qualified Data.Text as T

13import qualified System.Directory as SD

12import qualified System.Directory as SD

14−import System.FilePath ((</>))

13+import System.FilePath ((</>))

15import Test.Hspec

14import Test.Hspec

16

15

16+skipTest :: FilePath -> Bool

17+skipTest file = (file == "optional/format.json") -- Optional

18+ || (file == "optional/zeroTerminatedFloats.json")

19+ || (file == "optional/ecmascript-regex.json")

20+

21+

22+isHTTPTest :: FilePath -> Bool

23+isHTTPTest file = (file == "definitions.json")

24+ || (file == "ref.json")

25+ || (file == "refRemote.json")

26+

17-- Recursively return the contents of a directory

27-- Recursively return the contents of a directory

18-- (or return itself if given a file as an argument).

28-- (or return itself if given a file as an argument).

19--

29--

@@ -37,18 +47,6 @@ listFilesFullPath path = do

37 fs <- fmap (path </>) <$> SD.listDirectory path

47 fs <- fmap (path </>) <$> SD.listDirectory path

38 concat <$> traverse listFilesFullPath fs

48 concat <$> traverse listFilesFullPath fs

39

49

40−isHTTPTest :: FilePath -> Bool

41−isHTTPTest file = (file == "definitions.json")

42− || (file == "ref.json")

43− || (file == "refRemote.json")

44−

45−-- | We may never support the @"format"@ keywords

46−-- and are currently failing the others listed here.

47−skipOptional :: FilePath -> Bool

48−skipOptional file = (file == "optional/format.json")

49− || (file == "optional/zeroTerminatedFloats.json")

50− || (file == "optional/ecmascript-regex.json")

51−

52data SchemaTest = SchemaTest

50data SchemaTest = SchemaTest

53 { _stDescription :: Text

51 { _stDescription :: Text

54 , _stSchema :: Value

52 , _stSchema :: Value