git.iko.soy/typeable/swagger2
on 6724b8a help sign in
.ghci−1
since splitsnapshots
unifiedsplit
@@ -1,2 +1 @@
1:set -itest -isrc -optP-include -optP.stack-work/dist/x86_64-linux/Cabal-1.24.2.0/build/autogen/cabal_macros.h -optP-I -optPinclude
1:set -itest -isrc -optP-include -optP.stack-work/dist/x86_64-linux/Cabal-1.24.2.0/build/autogen/cabal_macros.h -optP-I -optPinclude
2−:set -hide-package base-compat-0.10.4
.travis.yml+21−25
@@ -4,7 +4,7 @@
4#
4#
5# For more information, see https://github.com/haskell-CI/haskell-ci
5# For more information, see https://github.com/haskell-CI/haskell-ci
6#
6#
7−# version: 0.5.20191020
7+# version: 0.5.20190908
8#
8#
9language: c
9language: c
10dist: xenial
10dist: xenial
@@ -39,6 +39,10 @@ matrix:
39 addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.2.2","cabal-install-3.0"]}}
39 addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.2.2","cabal-install-3.0"]}}
40 - compiler: ghc-8.0.2
40 - compiler: ghc-8.0.2
41 addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.0.2","cabal-install-3.0"]}}
41 addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.0.2","cabal-install-3.0"]}}
42+ - compiler: ghc-7.10.3
43+ addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-7.10.3","cabal-install-3.0"]}}
44+ - compiler: ghc-7.8.4
45+ addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-7.8.4","cabal-install-3.0"]}}
42before_install:
46before_install:
43 - HC=$(echo "/opt/$CC/bin/ghc" | sed 's/-/\//')
47 - HC=$(echo "/opt/$CC/bin/ghc" | sed 's/-/\//')
44 - WITHCOMPILER="-w $HC"
48 - WITHCOMPILER="-w $HC"
@@ -79,29 +83,21 @@ install:
79 - HEADHACKAGE=false
83 - HEADHACKAGE=false
80 - rm -f $CABALHOME/config
84 - rm -f $CABALHOME/config
81 - |
85 - |
82− echo "verbose: normal +nowrap +markoutput" >> $CABALHOME/config
86+ echo "verbose: normal +nowrap +markoutput" >> $CABALHOME/config
83− echo "remote-build-reporting: anonymous" >> $CABALHOME/config
87+ echo "remote-build-reporting: anonymous" >> $CABALHOME/config
84− echo "write-ghc-environment-files: always" >> $CABALHOME/config
88+ echo "write-ghc-environment-files: always" >> $CABALHOME/config
85− echo "remote-repo-cache: $CABALHOME/packages" >> $CABALHOME/config
89+ echo "remote-repo-cache: $CABALHOME/packages" >> $CABALHOME/config
86− echo "logs-dir: $CABALHOME/logs" >> $CABALHOME/config
90+ echo "logs-dir: $CABALHOME/logs" >> $CABALHOME/config
87− echo "world-file: $CABALHOME/world" >> $CABALHOME/config
91+ echo "world-file: $CABALHOME/world" >> $CABALHOME/config
88− echo "extra-prog-path: $CABALHOME/bin" >> $CABALHOME/config
92+ echo "extra-prog-path: $CABALHOME/bin" >> $CABALHOME/config
89− echo "symlink-bindir: $CABALHOME/bin" >> $CABALHOME/config
93+ echo "symlink-bindir: $CABALHOME/bin" >> $CABALHOME/config
90− echo "installdir: $CABALHOME/bin" >> $CABALHOME/config
94+ echo "installdir: $CABALHOME/bin" >> $CABALHOME/config
91− echo "build-summary: $CABALHOME/logs/build.log" >> $CABALHOME/config
95+ echo "build-summary: $CABALHOME/logs/build.log" >> $CABALHOME/config
92− echo "store-dir: $CABALHOME/store" >> $CABALHOME/config
96+ echo "store-dir: $CABALHOME/store" >> $CABALHOME/config
93− echo "install-dirs user" >> $CABALHOME/config
97+ echo "install-dirs user" >> $CABALHOME/config
94− echo " prefix: $CABALHOME" >> $CABALHOME/config
98+ echo " prefix: $CABALHOME" >> $CABALHOME/config
95− echo "repository hackage.haskell.org" >> $CABALHOME/config
99+ echo "repository hackage.haskell.org" >> $CABALHOME/config
96− echo " url: http://hackage.haskell.org/" >> $CABALHOME/config
100+ echo " url: http://hackage.haskell.org/" >> $CABALHOME/config
97− echo " secure: True" >> $CABALHOME/config
98− echo " key-threshold: 3" >> $CABALHOME/config
99− echo " root-keys:" >> $CABALHOME/config
100− echo " fe331502606802feac15e514d9b9ea83fee8b6ffef71335479a2e68d84adc6b0" >> $CABALHOME/config
101− echo " 1ea9ba32c526d1cc91ab5e5bd364ec5e9e8cb67179a471872f6e26f0ae773d42" >> $CABALHOME/config
102− echo " 2c6c3627bd6c982990239487f1abd02e08a02e6cf16edb105a8012d444d870c3" >> $CABALHOME/config
103− echo " 0a5c7ea47cd1b15f01f5f51a33adda7e655bc0f0b0615baa8e271f4c3351e21d" >> $CABALHOME/config
104− echo " 51f0161b906011b52c6613376b1ae937670da69322113a246a09f807c62f6921" >> $CABALHOME/config
105 - |
101 - |
106 echo "program-default-options" >> $CABALHOME/config
102 echo "program-default-options" >> $CABALHOME/config
107 echo " ghc-options: $GHCJOBS +RTS -M6G -RTS" >> $CABALHOME/config
103 echo " ghc-options: $GHCJOBS +RTS -M6G -RTS" >> $CABALHOME/config
@@ -158,5 +154,5 @@ script:
158 - rm -f cabal.project.local
154 - rm -f cabal.project.local
159 - ${CABAL} v2-build $WITHCOMPILER --disable-tests --disable-benchmarks all | color_cabal_output
155 - ${CABAL} v2-build $WITHCOMPILER --disable-tests --disable-benchmarks all | color_cabal_output
160
156
161−# REGENDATA ("0.5.20191020",["--branches","master","--haddock-jobs=>=8.4","--output",".travis.yml","swagger2.cabal"])
157+# REGENDATA ["--branches","master","--haddock-jobs=>=8.4","--output",".travis.yml","swagger2.cabal"]
162# EOF
158# EOF
CHANGELOG.md−13
@@ -1,16 +1,3 @@
1−2.5
2−---
3−
4−Highlights:
5−- Add instance for `TimeOfDay` (see [#196]( https://github.com/GetShopTV/swagger2/pull/196 ));
6−- Add support for [`optics`](https://hackage.haskell.org/package/optics) (see [#200]( https://github.com/GetShopTV/swagger2/pull/200 ));
7−- Slightly better validation errors (see [#195]( https://github.com/GetShopTV/swagger2/pull/195 ));
8−
9−Fixes and minor changes:
10−- Minor cleanup (see [#194]( https://github.com/GetShopTV/swagger2/pull/194 ));
11−- Allow base-4.13 and other GHC-8.8 related stuff (see [#198]( https://github.com/GetShopTV/swagger2/pull/198 ));
12−- Fix `stack.yaml` (see [#201]( https://github.com/GetShopTV/swagger2/pull/201 ));
13−
142.4
12.4
15---
2---
16
3
src/Data/Swagger.hs+1−6
@@ -31,7 +31,6 @@ module Data.Swagger (
31
31
32 -- * Re-exports
32 -- * Re-exports
33 module Data.Swagger.Lens,
33 module Data.Swagger.Lens,
34− module Data.Swagger.Optics,
35 module Data.Swagger.Operation,
34 module Data.Swagger.Operation,
36 module Data.Swagger.ParamSchema,
35 module Data.Swagger.ParamSchema,
37 module Data.Swagger.Schema,
36 module Data.Swagger.Schema,
@@ -89,7 +88,6 @@ module Data.Swagger (
89 SecurityScheme(..),
88 SecurityScheme(..),
90 SecuritySchemeType(..),
89 SecuritySchemeType(..),
91 SecurityRequirement(..),
90 SecurityRequirement(..),
92− SecurityDefinitions(..),
93
91
94 -- *** API key
92 -- *** API key
95 ApiKeyParams(..),
93 ApiKeyParams(..),
@@ -114,7 +112,6 @@ module Data.Swagger (
114) where
112) where
115
113
116import Data.Swagger.Lens
114import Data.Swagger.Lens
117−import Data.Swagger.Optics ()
118import Data.Swagger.Operation
115import Data.Swagger.Operation
119import Data.Swagger.ParamSchema
116import Data.Swagger.ParamSchema
120import Data.Swagger.Schema
117import Data.Swagger.Schema
@@ -178,8 +175,6 @@ import Data.Swagger.Internal
178
175
179-- $lens
176-- $lens
180--
177--
181−-- Note: if you're working with the <https://hackage.haskell.org/package/optics optics> library, take a look at "Data.Swagger.Optics".
182−--
183-- Since @'Swagger'@ has a fairly complex structure, lenses and prisms are used
178-- Since @'Swagger'@ has a fairly complex structure, lenses and prisms are used
184-- to work comfortably with it. In combination with @'Monoid'@ instances, lenses
179-- to work comfortably with it. In combination with @'Monoid'@ instances, lenses
185-- make it fairly simple to construct/modify any part of the specification:
180-- make it fairly simple to construct/modify any part of the specification:
@@ -280,7 +275,7 @@ import Data.Swagger.Internal
280-- >>> encode $ toSchema (Proxy :: Proxy Person)
275-- >>> encode $ toSchema (Proxy :: Proxy Person)
281-- "{\"required\":[\"name\",\"age\"],\"properties\":{\"name\":{\"type\":\"string\"},\"age\":{\"type\":\"integer\"}},\"type\":\"object\"}"
276-- "{\"required\":[\"name\",\"age\"],\"properties\":{\"name\":{\"type\":\"string\"},\"age\":{\"type\":\"integer\"}},\"type\":\"object\"}"
282--
277--
283−-- Please note that not all valid Haskell data types will have a proper swagger schema. For example while we can derive a
278+-- Please note that not all valid Haskell data types will have a proper swagger schema. For example while we can derive a
284-- schema for basic enums like
279-- schema for basic enums like
285--
280--
286-- >>> data SampleEnum = ChoiceOne | ChoiceTwo deriving Generic
281-- >>> data SampleEnum = ChoiceOne | ChoiceTwo deriving Generic
src/Data/Swagger/Internal.hs+1−36
@@ -117,7 +117,7 @@ data Swagger = Swagger
117 , _swaggerResponses :: Definitions Response
117 , _swaggerResponses :: Definitions Response
118
118
119 -- | Security scheme definitions that can be used across the specification.
119 -- | Security scheme definitions that can be used across the specification.
120− , _swaggerSecurityDefinitions :: SecurityDefinitions
120+ , _swaggerSecurityDefinitions :: Definitions SecurityScheme
121
121
122 -- | A declaration of which security schemes are applied for the API as a whole.
122 -- | A declaration of which security schemes are applied for the API as a whole.
123 -- The list of values describes alternative security schemes that can be used
123 -- The list of values describes alternative security schemes that can be used
@@ -755,22 +755,6 @@ data SecurityScheme = SecurityScheme
755 , _securitySchemeDescription :: Maybe Text
755 , _securitySchemeDescription :: Maybe Text
756 } deriving (Eq, Show, Generic, Data, Typeable)
756 } deriving (Eq, Show, Generic, Data, Typeable)
757
757
758−
759−-- | merge scopes of two OAuth2 security schemes when their flows are identical.
760−-- In other case returns first security scheme
761−mergeSecurityScheme :: SecurityScheme -> SecurityScheme -> SecurityScheme
762−mergeSecurityScheme s1@(SecurityScheme (SecuritySchemeOAuth2 (OAuth2Params flow1 scopes1)) desc)
763− s2@(SecurityScheme (SecuritySchemeOAuth2 (OAuth2Params flow2 scopes2)) _)
764− = if flow1 == flow2 then
765− SecurityScheme (SecuritySchemeOAuth2 (OAuth2Params flow1 (scopes1 <> scopes2))) desc
766− else
767− s1
768−mergeSecurityScheme s1 _ = s1
769−
770−newtype SecurityDefinitions
771− = SecurityDefinitions (Definitions SecurityScheme)
772− deriving (Eq, Show, Generic, Data, Typeable)
773−
774-- | Lists the required security schemes to execute this operation.
758-- | Lists the required security schemes to execute this operation.
775-- The object can have multiple security schemes declared in it which are all required
759-- The object can have multiple security schemes declared in it which are all required
776-- (that is, there is a logical AND between the schemes).
760-- (that is, there is a logical AND between the schemes).
@@ -920,17 +904,6 @@ instance Monoid Example where
920 mempty = genericMempty
904 mempty = genericMempty
921 mappend = (<>)
905 mappend = (<>)
922
906
923−instance Semigroup SecurityScheme where
924− (<>) = mergeSecurityScheme
925−
926−instance Semigroup SecurityDefinitions where
927− (SecurityDefinitions sd1) <> (SecurityDefinitions sd2) =
928− SecurityDefinitions $ InsOrdHashMap.unionWith (<>) sd1 sd2
929−
930−instance Monoid SecurityDefinitions where
931− mempty = SecurityDefinitions $ InsOrdHashMap.empty
932− mappend = (<>)
933−
934-- =======================================================================
907-- =======================================================================
935-- SwaggerMonoid helper instances
908-- SwaggerMonoid helper instances
936-- =======================================================================
909-- =======================================================================
@@ -945,7 +918,6 @@ instance SwaggerMonoid Responses
945instance SwaggerMonoid Response
918instance SwaggerMonoid Response
946instance SwaggerMonoid ExternalDocs
919instance SwaggerMonoid ExternalDocs
947instance SwaggerMonoid Operation
920instance SwaggerMonoid Operation
948−instance SwaggerMonoid SecurityDefinitions
949instance (Eq a, Hashable a) => SwaggerMonoid (InsOrdHashSet a)
921instance (Eq a, Hashable a) => SwaggerMonoid (InsOrdHashSet a)
950
922
951instance SwaggerMonoid MimeList
923instance SwaggerMonoid MimeList
@@ -1146,9 +1118,6 @@ instance ToJSON PathItem where
1146instance ToJSON Example where
1118instance ToJSON Example where
1147 toJSON = toJSON . Map.mapKeys show . getExample
1119 toJSON = toJSON . Map.mapKeys show . getExample
1148
1120
1149−instance ToJSON SecurityDefinitions where
1150− toJSON (SecurityDefinitions sd) = toJSON sd
1151−
1152instance ToJSON Reference where
1121instance ToJSON Reference where
1153 toJSON (Reference ref) = object [ "$ref" .= ref ]
1122 toJSON (Reference ref) = object [ "$ref" .= ref ]
1154
1123
@@ -1310,9 +1279,6 @@ instance FromJSON Operation where
1310instance FromJSON PathItem where
1279instance FromJSON PathItem where
1311 parseJSON = sopSwaggerGenericParseJSON
1280 parseJSON = sopSwaggerGenericParseJSON
1312
1281
1313−instance FromJSON SecurityDefinitions where
1314− parseJSON js = SecurityDefinitions <$> parseJSON js
1315−
1316instance FromJSON Reference where
1282instance FromJSON Reference where
1317 parseJSON (Object o) = Reference <$> o .: "$ref"
1283 parseJSON (Object o) = Reference <$> o .: "$ref"
1318 parseJSON _ = empty
1284 parseJSON _ = empty
@@ -1424,4 +1390,3 @@ instance AesonDefaultValue (SwaggerType a)
1424instance AesonDefaultValue MimeList where defaultValue = Just mempty
1390instance AesonDefaultValue MimeList where defaultValue = Just mempty
1425instance AesonDefaultValue Info
1391instance AesonDefaultValue Info
1426instance AesonDefaultValue ParamLocation
1392instance AesonDefaultValue ParamLocation
1427−instance AesonDefaultValue SecurityDefinitions where defaultValue = Just $ SecurityDefinitions mempty
src/Data/Swagger/Internal/ParamSchema.hs−6
@@ -193,12 +193,6 @@ timeParamSchema fmt = mempty
193instance ToParamSchema Day where
193instance ToParamSchema Day where
194 toParamSchema _ = timeParamSchema "date"
194 toParamSchema _ = timeParamSchema "date"
195
195
196−-- |
197−-- >>> toParamSchema (Proxy :: Proxy TimeOfDay) ^. format
198−-- Just "hh:MM:ss"
199−instance ToParamSchema TimeOfDay where
200− toParamSchema _ = timeParamSchema "hh:MM:ss"
201−
202-- |
196-- |
203-- >>> toParamSchema (Proxy :: Proxy LocalTime) ^. format
197-- >>> toParamSchema (Proxy :: Proxy LocalTime) ^. format
204-- Just "yyyy-mm-ddThh:MM:ss"
198-- Just "yyyy-mm-ddThh:MM:ss"
src/Data/Swagger/Internal/Schema.hs−4
@@ -147,10 +147,6 @@ class ToSchema a where
147 Proxy a -> Declare (Definitions Schema) NamedSchema
147 Proxy a -> Declare (Definitions Schema) NamedSchema
148 declareNamedSchema = genericDeclareNamedSchema defaultSchemaOptions
148 declareNamedSchema = genericDeclareNamedSchema defaultSchemaOptions
149
149
150−instance ToSchema TimeOfDay where
151− declareNamedSchema _ = pure $ named "TimeOfDay" $ timeSchema "hh:MM:ss"
152− & example ?~ toJSON (TimeOfDay 12 33 15)
153−
154-- | Convert a type into a schema and declare all used schema definitions.
150-- | Convert a type into a schema and declare all used schema definitions.
155declareSchema :: ToSchema a => Proxy a -> Declare (Definitions Schema) Schema
151declareSchema :: ToSchema a => Proxy a -> Declare (Definitions Schema) Schema
156declareSchema = fmap _namedSchemaSchema . declareNamedSchema
152declareSchema = fmap _namedSchemaSchema . declareNamedSchema
src/Data/Swagger/Internal/Schema/Validation.hs+6−92
@@ -22,27 +22,23 @@
22-- Validate JSON values with Swagger Schema.
22-- Validate JSON values with Swagger Schema.
23module Data.Swagger.Internal.Schema.Validation where
23module Data.Swagger.Internal.Schema.Validation where
24
24
25−import Prelude ()
26−import Prelude.Compat
27−
28import Control.Applicative
25import Control.Applicative
29import Control.Lens
26import Control.Lens
30import Control.Monad (when)
27import Control.Monad (when)
31
28
32import Data.Aeson hiding (Result)
29import Data.Aeson hiding (Result)
33−import Data.Aeson.Encode.Pretty (encodePretty)
34import Data.Foldable (for_, sequenceA_,
30import Data.Foldable (for_, sequenceA_,
35 traverse_)
31 traverse_)
36import Data.HashMap.Strict (HashMap)
32import Data.HashMap.Strict (HashMap)
37import qualified Data.HashMap.Strict as HashMap
33import qualified Data.HashMap.Strict as HashMap
38import qualified Data.HashMap.Strict.InsOrd as InsOrdHashMap
34import qualified Data.HashMap.Strict.InsOrd as InsOrdHashMap
39import qualified "unordered-containers" Data.HashSet as HashSet
35import qualified "unordered-containers" Data.HashSet as HashSet
36+import Data.List (intercalate)
37+import Data.Monoid
40import Data.Proxy
38import Data.Proxy
41import Data.Scientific (Scientific, isInteger)
39import Data.Scientific (Scientific, isInteger)
42import Data.Text (Text)
40import Data.Text (Text)
43import qualified Data.Text as Text
41import qualified Data.Text as Text
44−import qualified Data.Text.Lazy as TL
45−import qualified Data.Text.Lazy.Encoding as TL
46import Data.Vector (Vector)
42import Data.Vector (Vector)
47import qualified Data.Vector as Vector
43import qualified Data.Vector as Vector
48
44
@@ -58,101 +54,18 @@ import Data.Swagger.Lens
58--
54--
59-- /NOTE:/ @'validateToJSON'@ does not perform string pattern validation.
55-- /NOTE:/ @'validateToJSON'@ does not perform string pattern validation.
60-- See @'validateToJSONWithPatternChecker'@.
56-- See @'validateToJSONWithPatternChecker'@.
61−--
62−-- See 'renderValidationErrors' on how the output is structured.
63−validatePrettyToJSON :: forall a. (ToJSON a, ToSchema a) => a -> Maybe String
64−validatePrettyToJSON = renderValidationErrors validateToJSON
65−
66−-- | Variant of 'validatePrettyToJSON' with typed output.
67validateToJSON :: forall a. (ToJSON a, ToSchema a) => a -> [ValidationError]
57validateToJSON :: forall a. (ToJSON a, ToSchema a) => a -> [ValidationError]
68validateToJSON = validateToJSONWithPatternChecker (\_pattern _str -> True)
58validateToJSON = validateToJSONWithPatternChecker (\_pattern _str -> True)
69
59
70-- | Validate @'ToJSON'@ instance matches @'ToSchema'@ for a given value and pattern checker.
60-- | Validate @'ToJSON'@ instance matches @'ToSchema'@ for a given value and pattern checker.
71-- This can be used with QuickCheck to ensure those instances are coherent.
61-- This can be used with QuickCheck to ensure those instances are coherent.
72--
62--
73−-- For validation without patterns see @'validateToJSON'@. See also:
63+-- For validation without patterns see @'validateToJSON'@.
74−-- 'renderValidationErrors'.
75validateToJSONWithPatternChecker :: forall a. (ToJSON a, ToSchema a) => (Pattern -> Text -> Bool) -> a -> [ValidationError]
64validateToJSONWithPatternChecker :: forall a. (ToJSON a, ToSchema a) => (Pattern -> Text -> Bool) -> a -> [ValidationError]
76validateToJSONWithPatternChecker checker = validateJSONWithPatternChecker checker defs sch . toJSON
65validateToJSONWithPatternChecker checker = validateJSONWithPatternChecker checker defs sch . toJSON
77 where
66 where
78 (defs, sch) = runDeclare (declareSchema (Proxy :: Proxy a)) mempty
67 (defs, sch) = runDeclare (declareSchema (Proxy :: Proxy a)) mempty
79
68
80−-- | Pretty print validation errors
81−-- together with actual JSON and Swagger Schema
82−-- (using 'encodePretty').
83−--
84−-- >>> import Data.Aeson as Aeson
85−-- >>> import Data.Foldable (traverse_)
86−-- >>> import GHC.Generics
87−-- >>> data Phone = Phone { value :: String } deriving (Generic)
88−-- >>> data Person = Person { name :: String, phone :: Phone } deriving (Generic)
89−-- >>> instance ToJSON Person where toJSON p = object [ "name" Aeson..= name p ]
90−-- >>> instance ToSchema Phone
91−-- >>> instance ToSchema Person
92−-- >>> let person = Person { name = "John", phone = Phone "123456" }
93−-- >>> traverse_ putStrLn $ renderValidationErrors validateToJSON person
94−-- Validation against the schema fails:
95−-- * property "phone" is required, but not found in "{\"name\":\"John\"}"
96−-- <BLANKLINE>
97−-- JSON value:
98−-- {
99−-- "name": "John"
100−-- }
101−-- <BLANKLINE>
102−-- Swagger Schema:
103−-- {
104−-- "required": [
105−-- "name",
106−-- "phone"
107−-- ],
108−-- "type": "object",
109−-- "properties": {
110−-- "phone": {
111−-- "$ref": "#/definitions/Phone"
112−-- },
113−-- "name": {
114−-- "type": "string"
115−-- }
116−-- }
117−-- }
118−-- <BLANKLINE>
119−-- Swagger Description Context:
120−-- {
121−-- "Phone": {
122−-- "required": [
123−-- "value"
124−-- ],
125−-- "type": "object",
126−-- "properties": {
127−-- "value": {
128−-- "type": "string"
129−-- }
130−-- }
131−-- }
132−-- }
133−-- <BLANKLINE>
134−renderValidationErrors
135− :: forall a. (ToJSON a, ToSchema a)
136− => (a -> [ValidationError]) -> a -> Maybe String
137−renderValidationErrors f x =
138− case f x of
139− [] -> Nothing
140− errors -> Just $ unlines
141− [ "Validation against the schema fails:"
142− , unlines (map (" * " ++) errors)
143− , "JSON value:"
144− , ppJSONString (toJSON x)
145− , ""
146− , "Swagger Schema:"
147− , ppJSONString (toJSON schema_)
148− , ""
149− , "Swagger Description Context:"
150− , ppJSONString (toJSON refs_)
151− ]
152− where
153− ppJSONString = TL.unpack . TL.decodeUtf8 . encodePretty
154− (refs_, schema_) = runDeclare (declareSchema (Proxy :: Proxy a)) mempty
155−
156-- | Validate JSON @'Value'@ against Swagger @'Schema'@.
69-- | Validate JSON @'Value'@ against Swagger @'Schema'@.
157--
70--
158-- prop> validateJSON mempty (toSchema (Proxy :: Proxy Int)) (toJSON (x :: Int)) == []
71-- prop> validateJSON mempty (toSchema (Proxy :: Proxy Int)) (toJSON (x :: Int)) == []
@@ -484,7 +397,7 @@ validateSchemaType value = withSchema $ \sch ->
484 (Nothing, String s) -> sub_ paramSchema (validateString s)
397 (Nothing, String s) -> sub_ paramSchema (validateString s)
485 (Nothing, Array xs) -> sub_ paramSchema (validateArray xs)
398 (Nothing, Array xs) -> sub_ paramSchema (validateArray xs)
486 (Nothing, Object o) -> validateObject o
399 (Nothing, Object o) -> validateObject o
487− bad -> invalid $ "expected JSON value of type " ++ showType bad
400+ param@(t, _) -> invalid $ "expected JSON value of type " ++ showType param
488
401
489validateParamSchemaType :: Value -> Validation (ParamSchema t) ()
402validateParamSchemaType :: Value -> Validation (ParamSchema t) ()
490validateParamSchemaType value = withSchema $ \sch ->
403validateParamSchemaType value = withSchema $ \sch ->
@@ -499,7 +412,8 @@ validateParamSchemaType value = withSchema $ \sch ->
499 (Nothing, Number n) -> validateNumber n
412 (Nothing, Number n) -> validateNumber n
500 (Nothing, String s) -> validateString s
413 (Nothing, String s) -> validateString s
501 (Nothing, Array xs) -> validateArray xs
414 (Nothing, Array xs) -> validateArray xs
415+ (t, _) -> invalid $ "expected JSON value of type " ++ show t
502− bad -> invalid $ "expected JSON value of type " ++ showType bad
416+ param@(t, _) -> invalid $ "expected JSON value of type " ++ showType param
503
417
504showType :: (Maybe (SwaggerType t), Value) -> String
418showType :: (Maybe (SwaggerType t), Value) -> String
505showType (Just type_, _) = show type_
419showType (Just type_, _) = show type_
src/Data/Swagger/Lens.hs−6
@@ -96,12 +96,6 @@ instance At Responses where at n = responses . at n
96instance Ixed Operation where ix n = responses . ix n
96instance Ixed Operation where ix n = responses . ix n
97instance At Operation where at n = responses . at n
97instance At Operation where at n = responses . at n
98
98
99−type instance Index SecurityDefinitions = Text
100−type instance IxValue SecurityDefinitions = SecurityScheme
101−
102−instance Ixed SecurityDefinitions where ix n = (coerced :: Lens' SecurityDefinitions (Definitions SecurityScheme)). ix n
103−instance At SecurityDefinitions where at n = (coerced :: Lens' SecurityDefinitions (Definitions SecurityScheme)). at n
104−
105instance HasParamSchema NamedSchema (ParamSchema 'SwaggerKindSchema) where paramSchema = schema.paramSchema
99instance HasParamSchema NamedSchema (ParamSchema 'SwaggerKindSchema) where paramSchema = schema.paramSchema
106
100
107-- HasType instances
101-- HasType instances
src/Data/Swagger/Optics.hsdeleted−597
@@ -1,597 +0,0 @@
1−{-# LANGUAGE DataKinds #-}
2−{-# LANGUAGE FlexibleInstances #-}
3−{-# LANGUAGE MultiParamTypeClasses #-}
4−{-# LANGUAGE OverloadedLabels #-}
5−{-# LANGUAGE TemplateHaskell #-}
6−{-# LANGUAGE TypeFamilies #-}
7−{-# LANGUAGE UndecidableInstances #-}
8−{-# OPTIONS_GHC -fno-warn-orphans #-}
9−-- |
10−-- Module: Data.Swagger.Optics
11−-- Maintainer: Andrzej Rybczak <andrzej@rybczak.net>
12−-- Stability: experimental
13−--
14−-- Lenses and prisms for the <https://hackage.haskell.org/package/optics optics>
15−-- library.
16−--
17−-- >>> import Data.Aeson
18−-- >>> import Optics.Core
19−-- >>> :set -XOverloadedLabels
20−--
21−-- Example from the "Data.Swagger" module using @optics@:
22−--
23−-- >>> :{
24−-- encode $ (mempty :: Swagger)
25−-- & #definitions .~ [ ("User", mempty & #type ?~ SwaggerString) ]
26−-- & #paths .~
27−-- [ ("/user", mempty & #get ?~ (mempty
28−-- & #produces ?~ MimeList ["application/json"]
29−-- & at 200 ?~ ("OK" & #_Inline % #schema ?~ Ref (Reference "User"))
30−-- & at 404 ?~ "User info not found")) ]
31−-- :}
32−-- "{\"swagger\":\"2.0\",\"info\":{\"version\":\"\",\"title\":\"\"},\"paths\":{\"/user\":{\"get\":{\"produces\":[\"application/json\"],\"responses\":{\"404\":{\"description\":\"User info not found\"},\"200\":{\"schema\":{\"$ref\":\"#/definitions/User\"},\"description\":\"OK\"}}}}},\"definitions\":{\"User\":{\"type\":\"string\"}}}"
33−--
34−-- For convenience optics are defined as /labels/. It means that field accessor
35−-- names can be overloaded for different types. One such common field is
36−-- @#description@. Many components of a Swagger specification can have
37−-- descriptions, and you can use the same name for them:
38−--
39−-- >>> encode $ (mempty :: Response) & #description .~ "No content"
40−-- "{\"description\":\"No content\"}"
41−-- >>> :{
42−-- encode $ (mempty :: Schema)
43−-- & #type ?~ SwaggerBoolean
44−-- & #description ?~ "To be or not to be"
45−-- :}
46−-- "{\"description\":\"To be or not to be\",\"type\":\"boolean\"}"
47−--
48−-- @'ParamSchema'@ is basically the /base schema specification/ and many types
49−-- contain it. So for convenience, all @'ParamSchema'@ fields are transitively
50−-- made fields of the type that has it. For example, you can use @#type@ to
51−-- access @'SwaggerType'@ of @'Header'@ schema without having to use
52−-- @#paramSchema@:
53−--
54−-- >>> encode $ (mempty :: Header) & #type ?~ SwaggerNumber
55−-- "{\"type\":\"number\"}"
56−--
57−-- Additionally, to simplify working with @'Response'@, both @'Operation'@ and
58−-- @'Responses'@ have direct access to it via @'Optics.Core.At.at'@. Example:
59−--
60−-- >>> :{
61−-- encode $ (mempty :: Operation)
62−-- & at 404 ?~ "Not found"
63−-- :}
64−-- "{\"responses\":{\"404\":{\"description\":\"Not found\"}}}"
65−--
66−module Data.Swagger.Optics () where
67−
68−import Data.Aeson (Value)
69−import Data.Scientific (Scientific)
70−import Data.Swagger.Internal
71−import Data.Text (Text)
72−import Optics.Core
73−import Optics.TH
74−
75−-- Lenses
76−
77−makeFieldLabels ''Swagger
78−makeFieldLabels ''Host
79−makeFieldLabels ''Info
80−makeFieldLabels ''Contact
81−makeFieldLabels ''License
82−makeFieldLabels ''PathItem
83−makeFieldLabels ''Tag
84−makeFieldLabels ''Operation
85−makeFieldLabels ''Param
86−makeFieldLabels ''ParamOtherSchema
87−makeFieldLabels ''Header
88−makeFieldLabels ''Schema
89−makeFieldLabels ''NamedSchema
90−makeFieldLabels ''ParamSchema
91−makeFieldLabels ''Xml
92−makeFieldLabels ''Responses
93−makeFieldLabels ''Response
94−makeFieldLabels ''SecurityScheme
95−makeFieldLabels ''ApiKeyParams
96−makeFieldLabels ''OAuth2Params
97−makeFieldLabels ''ExternalDocs
98−
99−-- Prisms
100−
101−makePrismLabels ''ParamAnySchema
102−makePrismLabels ''SecuritySchemeType
103−makePrismLabels ''Referenced
104−
105−-- SwaggerItems prisms
106−
107−instance
108− ( a ~ [Referenced Schema]
109− , b ~ [Referenced Schema]
110− ) => LabelOptic "_SwaggerItemsArray"
111− A_Review
112− (SwaggerItems 'SwaggerKindSchema)
113− (SwaggerItems 'SwaggerKindSchema)
114− a
115− b where
116− labelOptic = unto (\x -> SwaggerItemsArray x)
117− {-# INLINE labelOptic #-}
118−
119−instance
120− ( a ~ Referenced Schema
121− , b ~ Referenced Schema
122− ) => LabelOptic "_SwaggerItemsObject"
123− A_Review
124− (SwaggerItems 'SwaggerKindSchema)
125− (SwaggerItems 'SwaggerKindSchema)
126− a
127− b where
128− labelOptic = unto (\x -> SwaggerItemsObject x)
129− {-# INLINE labelOptic #-}
130−
131−instance
132− ( a ~ (Maybe (CollectionFormat t), ParamSchema t)
133− , b ~ (Maybe (CollectionFormat t), ParamSchema t)
134− ) => LabelOptic "_SwaggerItemsPrimitive"
135− A_Review
136− (SwaggerItems t)
137− (SwaggerItems t)
138− a
139− b where
140− labelOptic = unto (\(c, p) -> SwaggerItemsPrimitive c p)
141− {-# INLINE labelOptic #-}
142−
143−-- =============================================================
144−-- More helpful instances for easier access to schema properties
145−
146−type instance Index Responses = HttpStatusCode
147−type instance Index Operation = HttpStatusCode
148−
149−type instance IxValue Responses = Referenced Response
150−type instance IxValue Operation = Referenced Response
151−
152−instance Ixed Responses where
153− ix n = #responses % ix n
154− {-# INLINE ix #-}
155−instance At Responses where
156− at n = #responses % at n
157− {-# INLINE at #-}
158−
159−instance Ixed Operation where
160− ix n = #responses % ix n
161− {-# INLINE ix #-}
162−instance At Operation where
163− at n = #responses % at n
164− {-# INLINE at #-}
165−
166−-- #paramSchema
167−
168−instance
169− ( a ~ ParamSchema 'SwaggerKindSchema
170− , b ~ ParamSchema 'SwaggerKindSchema
171− ) => LabelOptic "paramSchema" A_Lens NamedSchema NamedSchema a b where
172− labelOptic = #schema % #paramSchema
173− {-# INLINE labelOptic #-}
174−
175−-- #type
176−
177−instance
178− ( a ~ Maybe (SwaggerType ('SwaggerKindNormal Header))
179− , b ~ Maybe (SwaggerType ('SwaggerKindNormal Header))
180− ) => LabelOptic "type" A_Lens Header Header a b where
181− labelOptic = #paramSchema % #type
182− {-# INLINE labelOptic #-}
183−
184−instance
185− ( a ~ Maybe (SwaggerType 'SwaggerKindSchema)
186− , b ~ Maybe (SwaggerType 'SwaggerKindSchema)
187− ) => LabelOptic "type" A_Lens Schema Schema a b where
188− labelOptic = #paramSchema % #type
189− {-# INLINE labelOptic #-}
190−
191−instance
192− ( a ~ Maybe (SwaggerType 'SwaggerKindSchema)
193− , b ~ Maybe (SwaggerType 'SwaggerKindSchema)
194− ) => LabelOptic "type" A_Lens NamedSchema NamedSchema a b where
195− labelOptic = #paramSchema % #type
196− {-# INLINE labelOptic #-}
197−
198−instance
199− ( a ~ Maybe (SwaggerType 'SwaggerKindParamOtherSchema)
200− , b ~ Maybe (SwaggerType 'SwaggerKindParamOtherSchema)
201− ) => LabelOptic "type" A_Lens ParamOtherSchema ParamOtherSchema a b where
202− labelOptic = #paramSchema % #type
203− {-# INLINE labelOptic #-}
204−
205−-- #default
206−
207−instance
208− ( a ~ Maybe Value, b ~ Maybe Value
209− ) => LabelOptic "default" A_Lens Header Header a b where
210− labelOptic = #paramSchema % #default
211− {-# INLINE labelOptic #-}
212−
213−instance
214− ( a ~ Maybe Value, b ~ Maybe Value
215− ) => LabelOptic "default" A_Lens Schema Schema a b where
216− labelOptic = #paramSchema % #default
217− {-# INLINE labelOptic #-}
218−
219−instance
220− ( a ~ Maybe Value, b ~ Maybe Value
221− ) => LabelOptic "default" A_Lens NamedSchema NamedSchema a b where
222− labelOptic = #paramSchema % #default
223− {-# INLINE labelOptic #-}
224−
225−instance
226− ( a ~ Maybe Value, b ~ Maybe Value
227− ) => LabelOptic "default" A_Lens ParamOtherSchema ParamOtherSchema a b where
228− labelOptic = #paramSchema % #default
229− {-# INLINE labelOptic #-}
230−
231−-- #format
232−
233−instance
234− ( a ~ Maybe Format, b ~ Maybe Format
235− ) => LabelOptic "format" A_Lens Header Header a b where
236− labelOptic = #paramSchema % #format
237− {-# INLINE labelOptic #-}
238−
239−instance
240− ( a ~ Maybe Format, b ~ Maybe Format
241− ) => LabelOptic "format" A_Lens Schema Schema a b where
242− labelOptic = #paramSchema % #format
243− {-# INLINE labelOptic #-}
244−
245−instance
246− ( a ~ Maybe Format, b ~ Maybe Format
247− ) => LabelOptic "format" A_Lens NamedSchema NamedSchema a b where
248− labelOptic = #paramSchema % #format
249− {-# INLINE labelOptic #-}
250−
251−instance
252− ( a ~ Maybe Format, b ~ Maybe Format
253− ) => LabelOptic "format" A_Lens ParamOtherSchema ParamOtherSchema a b where
254− labelOptic = #paramSchema % #format
255− {-# INLINE labelOptic #-}
256−
257−-- #items
258−
259−instance
260− ( a ~ Maybe (SwaggerItems ('SwaggerKindNormal Header))
261− , b ~ Maybe (SwaggerItems ('SwaggerKindNormal Header))
262− ) => LabelOptic "items" A_Lens Header Header a b where
263− labelOptic = #paramSchema % #items
264− {-# INLINE labelOptic #-}
265−
266−instance
267− ( a ~ Maybe (SwaggerItems 'SwaggerKindSchema)
268− , b ~ Maybe (SwaggerItems 'SwaggerKindSchema)
269− ) => LabelOptic "items" A_Lens Schema Schema a b where
270− labelOptic = #paramSchema % #items
271− {-# INLINE labelOptic #-}
272−
273−instance
274− ( a ~ Maybe (SwaggerItems 'SwaggerKindSchema)
275− , b ~ Maybe (SwaggerItems 'SwaggerKindSchema)
276− ) => LabelOptic "items" A_Lens NamedSchema NamedSchema a b where
277− labelOptic = #paramSchema % #items
278− {-# INLINE labelOptic #-}
279−
280−instance
281− ( a ~ Maybe (SwaggerItems 'SwaggerKindParamOtherSchema)
282− , b ~ Maybe (SwaggerItems 'SwaggerKindParamOtherSchema)
283− ) => LabelOptic "items" A_Lens ParamOtherSchema ParamOtherSchema a b where
284− labelOptic = #paramSchema % #items
285− {-# INLINE labelOptic #-}
286−
287−-- #maximum
288−
289−instance
290− ( a ~ Maybe Scientific, b ~ Maybe Scientific
291− ) => LabelOptic "maximum" A_Lens Header Header a b where
292− labelOptic = #paramSchema % #maximum
293− {-# INLINE labelOptic #-}
294−
295−instance
296− ( a ~ Maybe Scientific, b ~ Maybe Scientific
297− ) => LabelOptic "maximum" A_Lens Schema Schema a b where
298− labelOptic = #paramSchema % #maximum
299− {-# INLINE labelOptic #-}
300−
301−instance
302− ( a ~ Maybe Scientific, b ~ Maybe Scientific
303− ) => LabelOptic "maximum" A_Lens NamedSchema NamedSchema a b where
304− labelOptic = #paramSchema % #maximum
305− {-# INLINE labelOptic #-}
306−
307−instance
308− ( a ~ Maybe Scientific, b ~ Maybe Scientific
309− ) => LabelOptic "maximum" A_Lens ParamOtherSchema ParamOtherSchema a b where
310− labelOptic = #paramSchema % #maximum
311− {-# INLINE labelOptic #-}
312−
313−-- #exclusiveMaximum
314−
315−instance
316− ( a ~ Maybe Bool, b ~ Maybe Bool
317− ) => LabelOptic "exclusiveMaximum" A_Lens Header Header a b where
318− labelOptic = #paramSchema % #exclusiveMaximum
319− {-# INLINE labelOptic #-}
320−
321−instance
322− ( a ~ Maybe Bool, b ~ Maybe Bool
323− ) => LabelOptic "exclusiveMaximum" A_Lens Schema Schema a b where
324− labelOptic = #paramSchema % #exclusiveMaximum
325− {-# INLINE labelOptic #-}
326−
327−instance
328− ( a ~ Maybe Bool, b ~ Maybe Bool
329− ) => LabelOptic "exclusiveMaximum" A_Lens NamedSchema NamedSchema a b where
330− labelOptic = #paramSchema % #exclusiveMaximum
331− {-# INLINE labelOptic #-}
332−
333−instance
334− ( a ~ Maybe Bool, b ~ Maybe Bool
335− ) => LabelOptic "exclusiveMaximum" A_Lens ParamOtherSchema ParamOtherSchema a b where
336− labelOptic = #paramSchema % #exclusiveMaximum
337− {-# INLINE labelOptic #-}
338−
339−-- #minimum
340−
341−instance
342− ( a ~ Maybe Scientific, b ~ Maybe Scientific
343− ) => LabelOptic "minimum" A_Lens Header Header a b where
344− labelOptic = #paramSchema % #minimum
345− {-# INLINE labelOptic #-}
346−
347−instance
348− ( a ~ Maybe Scientific, b ~ Maybe Scientific
349− ) => LabelOptic "minimum" A_Lens Schema Schema a b where
350− labelOptic = #paramSchema % #minimum
351− {-# INLINE labelOptic #-}
352−
353−instance
354− ( a ~ Maybe Scientific, b ~ Maybe Scientific
355− ) => LabelOptic "minimum" A_Lens NamedSchema NamedSchema a b where
356− labelOptic = #paramSchema % #minimum
357− {-# INLINE labelOptic #-}
358−
359−instance
360− ( a ~ Maybe Scientific, b ~ Maybe Scientific
361− ) => LabelOptic "minimum" A_Lens ParamOtherSchema ParamOtherSchema a b where
362− labelOptic = #paramSchema % #minimum
363− {-# INLINE labelOptic #-}
364−
365−-- #exclusiveMinimum
366−
367−instance
368− ( a ~ Maybe Bool, b ~ Maybe Bool
369− ) => LabelOptic "exclusiveMinimum" A_Lens Header Header a b where
370− labelOptic = #paramSchema % #exclusiveMinimum
371− {-# INLINE labelOptic #-}
372−
373−instance
374− ( a ~ Maybe Bool, b ~ Maybe Bool
375− ) => LabelOptic "exclusiveMinimum" A_Lens Schema Schema a b where
376− labelOptic = #paramSchema % #exclusiveMinimum
377− {-# INLINE labelOptic #-}
378−
379−instance
380− ( a ~ Maybe Bool, b ~ Maybe Bool
381− ) => LabelOptic "exclusiveMinimum" A_Lens NamedSchema NamedSchema a b where
382− labelOptic = #paramSchema % #exclusiveMinimum
383− {-# INLINE labelOptic #-}
384−
385−instance
386− ( a ~ Maybe Bool, b ~ Maybe Bool
387− ) => LabelOptic "exclusiveMinimum" A_Lens ParamOtherSchema ParamOtherSchema a b where
388− labelOptic = #paramSchema % #exclusiveMinimum
389− {-# INLINE labelOptic #-}
390−
391−-- #maxLength
392−
393−instance
394− ( a ~ Maybe Integer, b ~ Maybe Integer
395− ) => LabelOptic "maxLength" A_Lens Header Header a b where
396− labelOptic = #paramSchema % #maxLength
397− {-# INLINE labelOptic #-}
398−
399−instance
400− ( a ~ Maybe Integer, b ~ Maybe Integer
401− ) => LabelOptic "maxLength" A_Lens Schema Schema a b where
402− labelOptic = #paramSchema % #maxLength
403− {-# INLINE labelOptic #-}
404−
405−instance
406− ( a ~ Maybe Integer, b ~ Maybe Integer
407− ) => LabelOptic "maxLength" A_Lens NamedSchema NamedSchema a b where
408− labelOptic = #paramSchema % #maxLength
409− {-# INLINE labelOptic #-}
410−
411−instance
412− ( a ~ Maybe Integer, b ~ Maybe Integer
413− ) => LabelOptic "maxLength" A_Lens ParamOtherSchema ParamOtherSchema a b where
414− labelOptic = #paramSchema % #maxLength
415− {-# INLINE labelOptic #-}
416−
417−-- #minLength
418−
419−instance
420− ( a ~ Maybe Integer, b ~ Maybe Integer
421− ) => LabelOptic "minLength" A_Lens Header Header a b where
422− labelOptic = #paramSchema % #minLength
423− {-# INLINE labelOptic #-}
424−
425−instance
426− ( a ~ Maybe Integer, b ~ Maybe Integer
427− ) => LabelOptic "minLength" A_Lens Schema Schema a b where
428− labelOptic = #paramSchema % #minLength
429− {-# INLINE labelOptic #-}
430−
431−instance
432− ( a ~ Maybe Integer, b ~ Maybe Integer
433− ) => LabelOptic "minLength" A_Lens NamedSchema NamedSchema a b where
434− labelOptic = #paramSchema % #minLength
435− {-# INLINE labelOptic #-}
436−
437−instance
438− ( a ~ Maybe Integer, b ~ Maybe Integer
439− ) => LabelOptic "minLength" A_Lens ParamOtherSchema ParamOtherSchema a b where
440− labelOptic = #paramSchema % #minLength
441− {-# INLINE labelOptic #-}
442−
443−-- #pattern
444−
445−instance
446− ( a ~ Maybe Text, b ~ Maybe Text
447− ) => LabelOptic "pattern" A_Lens Header Header a b where
448− labelOptic = #paramSchema % #pattern
449− {-# INLINE labelOptic #-}
450−
451−instance
452− ( a ~ Maybe Text, b ~ Maybe Text
453− ) => LabelOptic "pattern" A_Lens Schema Schema a b where
454− labelOptic = #paramSchema % #pattern
455− {-# INLINE labelOptic #-}
456−
457−instance
458− ( a ~ Maybe Text, b ~ Maybe Text
459− ) => LabelOptic "pattern" A_Lens NamedSchema NamedSchema a b where
460− labelOptic = #paramSchema % #pattern
461− {-# INLINE labelOptic #-}
462−
463−instance
464− ( a ~ Maybe Text, b ~ Maybe Text
465− ) => LabelOptic "pattern" A_Lens ParamOtherSchema ParamOtherSchema a b where
466− labelOptic = #paramSchema % #pattern
467− {-# INLINE labelOptic #-}
468−
469−-- #maxItems
470−
471−instance
472− ( a ~ Maybe Integer, b ~ Maybe Integer
473− ) => LabelOptic "maxItems" A_Lens Header Header a b where
474− labelOptic = #paramSchema % #maxItems
475− {-# INLINE labelOptic #-}
476−
477−instance
478− ( a ~ Maybe Integer, b ~ Maybe Integer
479− ) => LabelOptic "maxItems" A_Lens Schema Schema a b where
480− labelOptic = #paramSchema % #maxItems
481− {-# INLINE labelOptic #-}
482−
483−instance
484− ( a ~ Maybe Integer, b ~ Maybe Integer
485− ) => LabelOptic "maxItems" A_Lens NamedSchema NamedSchema a b where
486− labelOptic = #paramSchema % #maxItems
487− {-# INLINE labelOptic #-}
488−
489−instance
490− ( a ~ Maybe Integer, b ~ Maybe Integer
491− ) => LabelOptic "maxItems" A_Lens ParamOtherSchema ParamOtherSchema a b where
492− labelOptic = #paramSchema % #maxItems
493− {-# INLINE labelOptic #-}
494−
495−-- #minItems
496−
497−instance
498− ( a ~ Maybe Integer, b ~ Maybe Integer
499− ) => LabelOptic "minItems" A_Lens Header Header a b where
500− labelOptic = #paramSchema % #minItems
501− {-# INLINE labelOptic #-}
502−
503−instance
504− ( a ~ Maybe Integer, b ~ Maybe Integer
505− ) => LabelOptic "minItems" A_Lens Schema Schema a b where
506− labelOptic = #paramSchema % #minItems
507− {-# INLINE labelOptic #-}
508−
509−instance
510− ( a ~ Maybe Integer, b ~ Maybe Integer
511− ) => LabelOptic "minItems" A_Lens NamedSchema NamedSchema a b where
512− labelOptic = #paramSchema % #minItems
513− {-# INLINE labelOptic #-}
514−
515−instance
516− ( a ~ Maybe Integer, b ~ Maybe Integer
517− ) => LabelOptic "minItems" A_Lens ParamOtherSchema ParamOtherSchema a b where
518− labelOptic = #paramSchema % #minItems
519− {-# INLINE labelOptic #-}
520−
521−-- #uniqueItems
522−
523−instance
524− ( a ~ Maybe Bool, b ~ Maybe Bool
525− ) => LabelOptic "uniqueItems" A_Lens Header Header a b where
526− labelOptic = #paramSchema % #uniqueItems
527− {-# INLINE labelOptic #-}
528−
529−instance
530− ( a ~ Maybe Bool, b ~ Maybe Bool
531− ) => LabelOptic "uniqueItems" A_Lens Schema Schema a b where
532− labelOptic = #paramSchema % #uniqueItems
533− {-# INLINE labelOptic #-}
534−
535−instance
536− ( a ~ Maybe Bool, b ~ Maybe Bool
537− ) => LabelOptic "uniqueItems" A_Lens NamedSchema NamedSchema a b where
538− labelOptic = #paramSchema % #uniqueItems
539− {-# INLINE labelOptic #-}
540−
541−instance
542− ( a ~ Maybe Bool, b ~ Maybe Bool
543− ) => LabelOptic "uniqueItems" A_Lens ParamOtherSchema ParamOtherSchema a b where
544− labelOptic = #paramSchema % #uniqueItems
545− {-# INLINE labelOptic #-}
546−
547−-- #enum
548−
549−instance
550− ( a ~ Maybe [Value], b ~ Maybe [Value]
551− ) => LabelOptic "enum" A_Lens Header Header a b where
552− labelOptic = #paramSchema % #enum
553− {-# INLINE labelOptic #-}
554−
555−instance
556− ( a ~ Maybe [Value], b ~ Maybe [Value]
557− ) => LabelOptic "enum" A_Lens Schema Schema a b where
558− labelOptic = #paramSchema % #enum
559− {-# INLINE labelOptic #-}
560−
561−instance
562− ( a ~ Maybe [Value], b ~ Maybe [Value]
563− ) => LabelOptic "enum" A_Lens NamedSchema NamedSchema a b where
564− labelOptic = #paramSchema % #enum
565− {-# INLINE labelOptic #-}
566−
567−instance
568− ( a ~ Maybe [Value], b ~ Maybe [Value]
569− ) => LabelOptic "enum" A_Lens ParamOtherSchema ParamOtherSchema a b where
570− labelOptic = #paramSchema % #enum
571− {-# INLINE labelOptic #-}
572−
573−-- #multipleOf
574−
575−instance
576− ( a ~ Maybe Scientific, b ~ Maybe Scientific
577− ) => LabelOptic "multipleOf" A_Lens Header Header a b where
578− labelOptic = #paramSchema % #multipleOf
579− {-# INLINE labelOptic #-}
580−
581−instance
582− ( a ~ Maybe Scientific, b ~ Maybe Scientific
583− ) => LabelOptic "multipleOf" A_Lens Schema Schema a b where
584− labelOptic = #paramSchema % #multipleOf
585− {-# INLINE labelOptic #-}
586−
587−instance
588− ( a ~ Maybe Scientific, b ~ Maybe Scientific
589− ) => LabelOptic "multipleOf" A_Lens NamedSchema NamedSchema a b where
590− labelOptic = #paramSchema % #multipleOf
591− {-# INLINE labelOptic #-}
592−
593−instance
594− ( a ~ Maybe Scientific, b ~ Maybe Scientific
595− ) => LabelOptic "multipleOf" A_Lens ParamOtherSchema ParamOtherSchema a b where
596− labelOptic = #paramSchema % #multipleOf
597− {-# INLINE labelOptic #-}
src/Data/Swagger/Schema/Validation.hs−2
@@ -19,10 +19,8 @@ module Data.Swagger.Schema.Validation (
19 ValidationError,
19 ValidationError,
20
20
21 -- ** Using 'ToJSON' and 'ToSchema'
21 -- ** Using 'ToJSON' and 'ToSchema'
22− validatePrettyToJSON,
23 validateToJSON,
22 validateToJSON,
24 validateToJSONWithPatternChecker,
23 validateToJSONWithPatternChecker,
25− renderValidationErrors,
26
24
27 -- ** Using 'Value' and 'Schema'
25 -- ** Using 'Value' and 'Schema'
28 validateJSON,
26 validateJSON,
stack.yaml+5−6
@@ -1,9 +1,8 @@
1−resolver: lts-14.3
1+resolver: lts-12.10
2packages:
2packages:
3- '.'
3- '.'
4extra-deps:
4extra-deps:
5−- optics-core-0.2
5+- aeson-1.4.2.0
6−- optics-th-0.2
6+- base-compat-batteries-0.10.4
7−- optics-extra-0.2
7+- contravariant-1.5
8−- indexed-profunctors-0.1
9−- insert-ordered-containers-0.2.3
8+- insert-ordered-containers-0.2.2
swagger2.cabal+7−8
@@ -1,6 +1,7 @@
1cabal-version: >=1.10
1cabal-version: >=1.10
2name: swagger2
2name: swagger2
3−version: 2.5
3+version: 2.4
4+x-revision: 1
4
5
5synopsis: Swagger 2.0 data model
6synopsis: Swagger 2.0 data model
6category: Web, Swagger
7category: Web, Swagger
@@ -24,7 +25,9 @@ extra-source-files:
24 , examples/*.hs
25 , examples/*.hs
25 , include/overlapping-compat.h
26 , include/overlapping-compat.h
26tested-with:
27tested-with:
28+ GHC ==7.8.4
29+ || ==7.10.3
27− GHC ==8.0.2
30+ || ==8.0.2
28 || ==8.2.2
31 || ==8.2.2
29 || ==8.4.4
32 || ==8.4.4
30 || ==8.6.5
33 || ==8.6.5
@@ -42,7 +45,6 @@ library
42 Data.Swagger.Declare
45 Data.Swagger.Declare
43 Data.Swagger.Lens
46 Data.Swagger.Lens
44 Data.Swagger.Operation
47 Data.Swagger.Operation
45− Data.Swagger.Optics
46 Data.Swagger.ParamSchema
48 Data.Swagger.ParamSchema
47 Data.Swagger.Schema
49 Data.Swagger.Schema
48 Data.Swagger.Schema.Generator
50 Data.Swagger.Schema.Generator
@@ -60,8 +62,7 @@ library
60
62
61 -- GHC boot libraries
63 -- GHC boot libraries
62 build-depends:
64 build-depends:
63− base >=4.9 && <4.14
65+ base >=4.7 && <4.14
64− , aeson-pretty >=0.8.7 && <0.9
65 , bytestring >=0.10.4.0 && <0.11
66 , bytestring >=0.10.4.0 && <0.11
66 , containers >=0.5.5.1 && <0.7
67 , containers >=0.5.5.1 && <0.7
67 , template-haskell >=2.9.0.0 && <2.16
68 , template-haskell >=2.9.0.0 && <2.16
@@ -81,11 +82,9 @@ library
81 , generics-sop >=0.3.2.0 && <0.6
82 , generics-sop >=0.3.2.0 && <0.6
82 , hashable >=1.2.7.0 && <1.4
83 , hashable >=1.2.7.0 && <1.4
83 , http-media >=0.7.1.2 && <0.9
84 , http-media >=0.7.1.2 && <0.9
84− , insert-ordered-containers >=0.2.3 && <0.3
85+ , insert-ordered-containers >=0.2.2 && <0.3
85 , lens >=4.16.1 && <4.19
86 , lens >=4.16.1 && <4.19
86 , network >=2.6.3.5 && <3.2
87 , network >=2.6.3.5 && <3.2
87− , optics-core >=0.2 && <0.3
88− , optics-th >=0.2 && <0.3
89 , scientific >=0.3.6.2 && <0.4
88 , scientific >=0.3.6.2 && <0.4
90 , transformers-compat >=0.3 && <0.7
89 , transformers-compat >=0.3 && <0.7
91 , unordered-containers >=0.2.9.0 && <0.3
90 , unordered-containers >=0.2.9.0 && <0.3
test/Data/Swagger/CommonTestTypes.hs+2−29
@@ -18,6 +18,8 @@ import qualified Data.Text as Text
18import GHC.Generics
18import GHC.Generics
19
19
20import Data.Swagger
20import Data.Swagger
21+import Data.Swagger.Declare
22+import Data.Swagger.Internal (SwaggerKind (..))
21
23
22-- ========================================================================
24-- ========================================================================
23-- Unit type
25-- Unit type
@@ -648,32 +650,3 @@ singleMaybeFieldSchemaJSON = [aesonQQ|
648 }
650 }
649}
651}
650|]
652|]
651−
652−
653−-- ========================================================================
654−-- TimeOfDay
655−-- ========================================================================
656−data TimeOfDay
657− = Int
658− | Pico
659− deriving (Generic)
660−instance ToSchema TimeOfDay
661−instance ToParamSchema TimeOfDay
662−
663−
664−timeOfDaySchemaJSON :: Value
665−timeOfDaySchemaJSON = [aesonQQ|
666−{
667− "example": "12:33:15",
668− "type": "string",
669− "format": "hh:MM:ss"
670−}
671−|]
672−
673−timeOfDayParamSchemaJSON :: Value
674−timeOfDayParamSchemaJSON = [aesonQQ|
675−{
676− "type": "string",
677− "format": "hh:MM:ss"
678−}
679−|]
test/Data/Swagger/ParamSchemaSpec.hs+1−6
@@ -3,10 +3,9 @@
3{-# LANGUAGE ScopedTypeVariables #-}
3{-# LANGUAGE ScopedTypeVariables #-}
4{-# LANGUAGE TemplateHaskell #-}
4{-# LANGUAGE TemplateHaskell #-}
5{-# LANGUAGE QuasiQuotes #-}
5{-# LANGUAGE QuasiQuotes #-}
6−{-# LANGUAGE OverloadedStrings #-}
7module Data.Swagger.ParamSchemaSpec where
6module Data.Swagger.ParamSchemaSpec where
8
7
9−import Data.Aeson
8+import Data.Aeson (Value)
10import Data.Aeson.QQ.Simple
9import Data.Aeson.QQ.Simple
11import Data.Char
10import Data.Char
12import Data.Proxy
11import Data.Proxy
@@ -18,9 +17,6 @@ import Data.Swagger.Internal (SwaggerKind(..))
18import Data.Swagger.CommonTestTypes
17import Data.Swagger.CommonTestTypes
19import SpecCommon
18import SpecCommon
20import Test.Hspec
19import Test.Hspec
21−import Data.Time.LocalTime
22−
23−import qualified Data.HashMap.Strict as HM
24
20
25checkToParamSchema :: ToParamSchema a => Proxy a -> Value -> Spec
21checkToParamSchema :: ToParamSchema a => Proxy a -> Value -> Spec
26checkToParamSchema proxy js = (toParamSchema proxy :: ParamSchema ('SwaggerKindNormal Param)) <=> js
22checkToParamSchema proxy js = (toParamSchema proxy :: ParamSchema ('SwaggerKindNormal Param)) <=> js
@@ -34,7 +30,6 @@ spec = do
34 context "Unary records" $ do
30 context "Unary records" $ do
35 context "Email (unary record)" $ checkToParamSchema (Proxy :: Proxy Email) emailSchemaJSON
31 context "Email (unary record)" $ checkToParamSchema (Proxy :: Proxy Email) emailSchemaJSON
36 context "UserId (non-record newtype)" $ checkToParamSchema (Proxy :: Proxy UserId) userIdSchemaJSON
32 context "UserId (non-record newtype)" $ checkToParamSchema (Proxy :: Proxy UserId) userIdSchemaJSON
37− context "TimeOfDay" $ checkToParamSchema (Proxy :: Proxy Data.Time.LocalTime.TimeOfDay) timeOfDayParamSchemaJSON
38
33
39main :: IO ()
34main :: IO ()
40main = hspec spec
35main = hspec spec
test/Data/Swagger/SchemaSpec.hs+6−5
@@ -8,11 +8,16 @@ import Prelude ()
8import Prelude.Compat
8import Prelude.Compat
9
9
10import Control.Lens ((^.))
10import Control.Lens ((^.))
11−import Data.Aeson (Value)
11+import Data.Aeson (Value, ToJSON(..), ToJSONKey(..))
12+import Data.Aeson.Types (toJSONKeyText)
13+import Data.Aeson.QQ.Simple
14+import Data.Char
12import qualified Data.HashMap.Strict.InsOrd as InsOrdHashMap
15import qualified Data.HashMap.Strict.InsOrd as InsOrdHashMap
13import Data.Proxy
16import Data.Proxy
14import Data.Set (Set)
17import Data.Set (Set)
18+import Data.Map (Map)
15import qualified Data.Text as Text
19import qualified Data.Text as Text
20+import GHC.Generics
16
21
17import Data.Swagger
22import Data.Swagger
18import Data.Swagger.Declare
23import Data.Swagger.Declare
@@ -21,9 +26,6 @@ import Data.Swagger.CommonTestTypes
21import SpecCommon
26import SpecCommon
22import Test.Hspec
27import Test.Hspec
23
28
24−import qualified Data.HashMap.Strict as HM
25−import Data.Time.LocalTime
26−
27checkToSchema :: ToSchema a => Proxy a -> Value -> Spec
29checkToSchema :: ToSchema a => Proxy a -> Value -> Spec
28checkToSchema proxy js = toSchema proxy <=> js
30checkToSchema proxy js = toSchema proxy <=> js
29
31
@@ -108,7 +110,6 @@ spec = do
108 context "MyRoseTree' (inlineNonRecursiveSchemas)" $ checkInlinedRecSchema (Proxy :: Proxy MyRoseTree') myRoseTreeSchemaJSON'
110 context "MyRoseTree' (inlineNonRecursiveSchemas)" $ checkInlinedRecSchema (Proxy :: Proxy MyRoseTree') myRoseTreeSchemaJSON'
109 describe "Bounded Enum key mapping" $ do
111 describe "Bounded Enum key mapping" $ do
110 context "ButtonImages" $ checkToSchema (Proxy :: Proxy ButtonImages) buttonImagesSchemaJSON
112 context "ButtonImages" $ checkToSchema (Proxy :: Proxy ButtonImages) buttonImagesSchemaJSON
111− context "TimeOfDay" $ checkToSchema (Proxy :: Proxy Data.Time.LocalTime.TimeOfDay) timeOfDaySchemaJSON
112
113
113main :: IO ()
114main :: IO ()
114main = hspec spec
115main = hspec spec
test/Data/SwaggerSpec.hs+2−43
@@ -43,7 +43,6 @@ spec = do
43 describe "Parameters Definition Object" $ paramsDefinitionExample <=> paramsDefinitionExampleJSON
43 describe "Parameters Definition Object" $ paramsDefinitionExample <=> paramsDefinitionExampleJSON
44 describe "Responses Definition Object" $ responsesDefinitionExample <=> responsesDefinitionExampleJSON
44 describe "Responses Definition Object" $ responsesDefinitionExample <=> responsesDefinitionExampleJSON
45 describe "Security Definitions Object" $ securityDefinitionsExample <=> securityDefinitionsExampleJSON
45 describe "Security Definitions Object" $ securityDefinitionsExample <=> securityDefinitionsExampleJSON
46− describe "OAuth2 Security Definitions with merged Scope" $ oAuth2SecurityDefinitionsExample <=> oAuth2SecurityDefinitionsExampleJSON
47 describe "Composition Schema Example" $ compositionSchemaExample <=> compositionSchemaExampleJSON
46 describe "Composition Schema Example" $ compositionSchemaExample <=> compositionSchemaExampleJSON
48 describe "Swagger Object" $ do
47 describe "Swagger Object" $ do
49 context "Todo Example" $ swaggerExample <=> swaggerExampleJSON
48 context "Todo Example" $ swaggerExample <=> swaggerExampleJSON
@@ -460,8 +459,8 @@ responsesDefinitionExampleJSON = [aesonQQ|
460-- Responses Definition object
459-- Responses Definition object
461-- =======================================================================
460-- =======================================================================
462
461
463−securityDefinitionsExample :: SecurityDefinitions
462+securityDefinitionsExample :: HashMap Text SecurityScheme
464−securityDefinitionsExample = SecurityDefinitions
463+securityDefinitionsExample =
465 [ ("api_key", SecurityScheme
464 [ ("api_key", SecurityScheme
466 { _securitySchemeType = SecuritySchemeApiKey (ApiKeyParams "api_key" ApiKeyHeader)
465 { _securitySchemeType = SecuritySchemeApiKey (ApiKeyParams "api_key" ApiKeyHeader)
467 , _securitySchemeDescription = Nothing })
466 , _securitySchemeDescription = Nothing })
@@ -493,46 +492,6 @@ securityDefinitionsExampleJSON = [aesonQQ|
493}
492}
494|]
493|]
495
494
496−oAuth2SecurityDefinitionsReadExample :: SecurityDefinitions
497−oAuth2SecurityDefinitionsReadExample = SecurityDefinitions
498− [ ("petstore_auth", SecurityScheme
499− { _securitySchemeType = SecuritySchemeOAuth2 (OAuth2Params
500− { _oauth2Flow = OAuth2Implicit "http://swagger.io/api/oauth/dialog"
501− , _oauth2Scopes =
502− [ ("read:pets", "read your pets") ] } )
503− , _securitySchemeDescription = Nothing })
504− ]
505−
506−oAuth2SecurityDefinitionsWriteExample :: SecurityDefinitions
507−oAuth2SecurityDefinitionsWriteExample = SecurityDefinitions
508− [ ("petstore_auth", SecurityScheme
509− { _securitySchemeType = SecuritySchemeOAuth2 (OAuth2Params
510− { _oauth2Flow = OAuth2Implicit "http://swagger.io/api/oauth/dialog"
511− , _oauth2Scopes =
512− [ ("write:pets", "modify pets in your account") ] } )
513− , _securitySchemeDescription = Nothing })
514− ]
515−
516−oAuth2SecurityDefinitionsExample :: SecurityDefinitions
517−oAuth2SecurityDefinitionsExample =
518− oAuth2SecurityDefinitionsWriteExample <>
519− oAuth2SecurityDefinitionsReadExample
520−
521−oAuth2SecurityDefinitionsExampleJSON :: Value
522−oAuth2SecurityDefinitionsExampleJSON = [aesonQQ|
523−{
524− "petstore_auth": {
525− "type": "oauth2",
526− "authorizationUrl": "http://swagger.io/api/oauth/dialog",
527− "flow": "implicit",
528− "scopes": {
529− "write:pets": "modify pets in your account",
530− "read:pets": "read your pets"
531− }
532− }
533−}
534−|]
535−
536-- =======================================================================
495-- =======================================================================
537-- Swagger object
496-- Swagger object
538-- =======================================================================
497-- =======================================================================