9aa51b3 · typeable/openapi3

git.iko.soy/typeable/openapi3

on master help sign in

Polish types

9aa51b3Maxim Koltsov6 years ago

src/Data/Swagger.hs+1

compare with master

unifiedsplit

@@ -84,6 +84,7 @@ module Data.Swagger (

84 Xml(..),

85 Pattern,

86 AdditionalProperties(..),

87+ Discriminator(..),

88 -- ** Responses

89 -- ** Responses

89 Responses(..),

90 Responses(..),

src/Data/Swagger/Internal.hs+18−2

@@ -681,11 +681,13 @@ data Schema = Schema

681 , _schemaProperties :: InsOrdHashMap Text (Referenced Schema)

682 , _schemaAdditionalProperties :: Maybe AdditionalProperties

683

684− , _schemaDiscriminator :: Maybe Text -- FIXME Discriminator object

684+ , _schemaDiscriminator :: Maybe Discriminator

685 , _schemaReadOnly :: Maybe Bool

686+ , _schemaWriteOnly :: Maybe Bool

686 , _schemaXml :: Maybe Xml

687 , _schemaXml :: Maybe Xml

687 , _schemaExternalDocs :: Maybe ExternalDocs

688 , _schemaExternalDocs :: Maybe ExternalDocs

688 , _schemaExample :: Maybe Value

689 , _schemaExample :: Maybe Value

690+ , _schemaDeprecated :: Maybe Bool

689

691

690 , _schemaMaxProperties :: Maybe Integer

692 , _schemaMaxProperties :: Maybe Integer

691 , _schemaMinProperties :: Maybe Integer

693 , _schemaMinProperties :: Maybe Integer

@@ -693,6 +695,14 @@ data Schema = Schema

693 , _schemaParamSchema :: ParamSchema 'SwaggerKindSchema

695 , _schemaParamSchema :: ParamSchema 'SwaggerKindSchema

694 } deriving (Eq, Show, Generic, Data, Typeable)

696 } deriving (Eq, Show, Generic, Data, Typeable)

695

697

698+data Discriminator = Discriminator

699+ { -- | The name of the property in the payload that will hold the discriminator value.

700+ _discriminatorPropertyName :: Text

701+

702+ -- | An object to hold mappings between payload values and schema names or references.

703+ , _discriminatorMapping :: InsOrdHashMap Text Text

704+ } deriving (Eq, Show, Generic, Data, Typeable)

705+

696-- | A @'Schema'@ with an optional name.

706-- | A @'Schema'@ with an optional name.

697-- This name can be used in references.

707-- This name can be used in references.

698data NamedSchema = NamedSchema

708data NamedSchema = NamedSchema

@@ -790,7 +800,7 @@ data Response = Response

790 , _responseContent :: InsOrdHashMap Text MediaTypeObject

800 , _responseContent :: InsOrdHashMap Text MediaTypeObject

791

801

792 -- | Maps a header name to its definition.

802 -- | Maps a header name to its definition.

793− , _responseHeaders :: InsOrdHashMap HeaderName Header -- FIXME Referenced

803+ , _responseHeaders :: InsOrdHashMap HeaderName (Referenced Header)

794

804

795 -- TODO links

805 -- TODO links

796 } deriving (Eq, Show, Generic, Data, Typeable)

806 } deriving (Eq, Show, Generic, Data, Typeable)

@@ -1152,6 +1162,9 @@ instance ToJSON ExternalDocs where

1152instance ToJSON Xml where

1162instance ToJSON Xml where

1153 toJSON = genericToJSON (jsonPrefix "Xml")

1163 toJSON = genericToJSON (jsonPrefix "Xml")

1154

1164

1165+instance ToJSON Discriminator where

1166+ toJSON = genericToJSON (jsonPrefix "Discriminator")

1167+

1155-- =======================================================================

1168-- =======================================================================

1156-- Simple Generic-based FromJSON instances

1169-- Simple Generic-based FromJSON instances

1157-- =======================================================================

1170-- =======================================================================

@@ -1189,6 +1202,9 @@ instance FromJSON Tag where

1189instance FromJSON ExternalDocs where

1202instance FromJSON ExternalDocs where

1190 parseJSON = genericParseJSON (jsonPrefix "ExternalDocs")

1203 parseJSON = genericParseJSON (jsonPrefix "ExternalDocs")

1191

1204

1205+instance FromJSON Discriminator where

1206+ parseJSON = genericParseJSON (jsonPrefix "Discriminator")

1207+

1192-- =======================================================================

1208-- =======================================================================

1193-- Manual ToJSON instances

1209-- Manual ToJSON instances

1194-- =======================================================================

1210-- =======================================================================

src/Data/Swagger/Internal/Schema/Validation.hs+6−2

@@ -37,6 +37,7 @@ import Data.HashMap.Strict (HashMap)

37import qualified Data.HashMap.Strict as HashMap

38import qualified Data.HashMap.Strict.InsOrd as InsOrdHashMap

39import qualified "unordered-containers" Data.HashSet as HashSet

40+import Data.Maybe (fromMaybe)

40import Data.Proxy

41import Data.Proxy

41import Data.Scientific (Scientific, isInteger)

42import Data.Scientific (Scientific, isInteger)

42import Data.Text (Text)

43import Data.Text (Text)

@@ -374,8 +375,11 @@ validateArray xs = do

374validateObject :: HashMap Text Value -> Validation Schema ()

375validateObject :: HashMap Text Value -> Validation Schema ()

375validateObject o = withSchema $ \sch ->

376validateObject o = withSchema $ \sch ->

376 case sch ^. discriminator of

377 case sch ^. discriminator of

377− Just pname -> case fromJSON <$> HashMap.lookup pname o of

378+ Just (Discriminator pname types) -> case fromJSON <$> HashMap.lookup pname o of

379+ Just (Success pvalue) ->

380+ let ref = fromMaybe pvalue $ InsOrdHashMap.lookup pvalue types

381+ -- TODO ref may be name or reference

378− Just (Success ref) -> validateWithSchemaRef ref (Object o)

382+ in validateWithSchemaRef (Ref (Reference ref)) (Object o)

379 Just (Error msg) -> invalid ("failed to parse discriminator property " ++ show pname ++ ": " ++ show msg)

383 Just (Error msg) -> invalid ("failed to parse discriminator property " ++ show pname ++ ": " ++ show msg)

380 Nothing -> invalid ("discriminator property " ++ show pname ++ "is missing")

384 Nothing -> invalid ("discriminator property " ++ show pname ++ "is missing")

381 Nothing -> do

385 Nothing -> do

src/Data/Swagger/Lens.hs+5

@@ -29,6 +29,8 @@ import Data.Text (Text)

29makeFields ''Swagger

30makeFields ''Components

31makeFields ''Server

32+-- conflict with enum of ParamSchema

33+--makeLensesWith swaggerFieldRules ''ServerVariable

32makeFields ''RequestBody

34makeFields ''RequestBody

33makeFields ''MediaTypeObject

35makeFields ''MediaTypeObject

34makeFields ''Host

36makeFields ''Host

@@ -51,6 +53,9 @@ makeLensesWith swaggerFieldRules ''SecurityScheme

51makeFields ''ApiKeyParams

53makeFields ''ApiKeyParams

52makeFields ''OAuth2Params

54makeFields ''OAuth2Params

53makeFields ''ExternalDocs

55makeFields ''ExternalDocs

56+makeFields ''Encoding

57+makeFields ''Example

58+makeFields ''Discriminator

55-- * Prisms

60-- * Prisms

56-- ** 'ParamAnySchema' prisms

61-- ** 'ParamAnySchema' prisms