diff --git a/examples/hackage.hs b/examples/hackage.hs index c605f6a..9204621 100644 --- a/examples/hackage.hs +++ b/examples/hackage.hs @@ -27,7 +27,7 @@ instance ToSchema UserSummary where usernameSchema <- declareSchemaRef (Proxy :: Proxy Username) useridSchema <- declareSchemaRef (Proxy :: Proxy Int) return $ NamedSchema (Just "UserSummary") $ mempty - & type_ .~ SwaggerObject + & type_ ?~ SwaggerObject & properties .~ [ ("summaryUsername", usernameSchema ) , ("summaryUserid" , useridSchema ) diff --git a/src/Data/Swagger/Internal.hs b/src/Data/Swagger/Internal.hs index cd1b553..5589833 100644 --- a/src/Data/Swagger/Internal.hs +++ b/src/Data/Swagger/Internal.hs @@ -610,7 +610,7 @@ data ParamSchema (t :: SwaggerKind *) = ParamSchema , _paramSchemaMultipleOf :: Maybe Scientific } deriving (Eq, Show, Generic, Typeable) -deriving instance (Typeable k, Data (SwaggerType k), Data (SwaggerItems k)) => Data (ParamSchema k) +deriving instance (Typeable k, Data (Maybe (SwaggerType k)), Data (SwaggerItems k)) => Data (ParamSchema k) data Xml = Xml { -- | Replaces the name of the element/attribute used for the described schema property. diff --git a/src/Data/Swagger/Internal/Schema.hs b/src/Data/Swagger/Internal/Schema.hs index f127604..74a4060 100644 --- a/src/Data/Swagger/Internal/Schema.hs +++ b/src/Data/Swagger/Internal/Schema.hs @@ -335,7 +335,7 @@ sketchSchema = sketch . toJSON go Null = mempty & type_ ?~ SwaggerNull go (Bool _) = mempty & type_ ?~ SwaggerBoolean - go (String _) = mempty & type_ ?~ SwaggerString + go (String _) = mempty & type_ ?~ SwaggerString go (Number _) = mempty & type_ ?~ SwaggerNumber go (Array xs) = mempty & type_ ?~ SwaggerArray diff --git a/src/Data/Swagger/Internal/Schema/Validation.hs b/src/Data/Swagger/Internal/Schema/Validation.hs index e8986fd..7b0f3ed 100644 --- a/src/Data/Swagger/Internal/Schema/Validation.hs +++ b/src/Data/Swagger/Internal/Schema/Validation.hs @@ -382,45 +382,44 @@ inferParamSchemaTypes sch = concat validateSchemaType :: Value -> Validation Schema () validateSchemaType value = withSchema $ \sch -> - case sch ^. type_ of - Just explicitType -> validateSchemaTypeAs explicitType value - Nothing -> - case inferSchemaTypes sch of - [t] -> validateSchemaTypeAs t value - [] -> invalid $ "unable to infer type for schema, please provide type explicitly" - ts -> invalid $ "unable to infer type for schema, possible candidates: " ++ intercalate ", " (map show ts) - -validateSchemaTypeAs - :: SwaggerType 'SwaggerKindSchema -> Value -> Validation Schema () -validateSchemaTypeAs t value = - case (t, value) of - (SwaggerNull, Null) -> valid - (SwaggerBoolean, Bool _) -> valid - (SwaggerInteger, Number n) -> sub_ paramSchema (validateInteger n) - (SwaggerNumber, Number n) -> sub_ paramSchema (validateNumber n) - (SwaggerString, String s) -> sub_ paramSchema (validateString s) - (SwaggerArray, Array xs) -> sub_ paramSchema (validateArray xs) - (SwaggerObject, Object o) -> validateObject o - _ -> invalid $ "expected JSON value of type " ++ show t + case (sch ^. type_, value) of + (Just SwaggerNull, Null) -> valid + (Just SwaggerBoolean, Bool _) -> valid + (Just SwaggerInteger, Number n) -> sub_ paramSchema (validateInteger n) + (Just SwaggerNumber, Number n) -> sub_ paramSchema (validateNumber n) + (Just SwaggerString, String s) -> sub_ paramSchema (validateString s) + (Just SwaggerArray, Array xs) -> sub_ paramSchema (validateArray xs) + (Just SwaggerObject, Object o) -> validateObject o + (Nothing, Null) -> valid + (Nothing, Bool _) -> valid + -- Number by default + (Nothing, Number n) -> sub_ paramSchema (validateNumber n) + (Nothing, String s) -> sub_ paramSchema (validateString s) + (Nothing, Array xs) -> sub_ paramSchema (validateArray xs) + (Nothing, Object o) -> validateObject o + param@(t, _) -> invalid $ "expected JSON value of type " ++ showType param validateParamSchemaType :: Value -> Validation (ParamSchema t) () validateParamSchemaType value = withSchema $ \sch -> - case sch ^. type_ of - Just explicitType -> validateParamSchemaTypeAs explicitType value - Nothing -> - case inferParamSchemaTypes sch of - [t] -> validateParamSchemaTypeAs t value - [] -> invalid $ "unable to infer type for schema, please provide type explicitly" - ts -> invalid $ "unable to infer type for schema, possible candidates: " ++ intercalate ", " (map show ts) - -validateParamSchemaTypeAs - :: SwaggerType t -> Value -> Validation (ParamSchema t) () -validateParamSchemaTypeAs t value = - case (t, value) of - (SwaggerBoolean, Bool _) -> valid - (SwaggerInteger, Number n) -> validateInteger n - (SwaggerNumber, Number n) -> validateNumber n - (SwaggerString, String s) -> validateString s - (SwaggerArray, Array xs) -> validateArray xs - _ -> invalid $ "expected JSON value of type " ++ show t - + case (sch ^. type_, value) of + (Just SwaggerBoolean, Bool _) -> valid + (Just SwaggerInteger, Number n) -> validateInteger n + (Just SwaggerNumber, Number n) -> validateNumber n + (Just SwaggerString, String s) -> validateString s + (Just SwaggerArray, Array xs) -> validateArray xs + (Nothing, Bool _) -> valid + -- Number by default + (Nothing, Number n) -> validateNumber n + (Nothing, String s) -> validateString s + (Nothing, Array xs) -> validateArray xs + (t, _) -> invalid $ "expected JSON value of type " ++ show t + param@(t, _) -> invalid $ "expected JSON value of type " ++ showType param + +showType :: (Maybe (SwaggerType t), Value) -> String +showType (Just type_, _) = show type_ +showType (Nothing, Null) = "SwaggerNull" +showType (Nothing, Bool _) = "SwaggerBoolean" +showType (Nothing, Number _) = "SwaggerNumber" +showType (Nothing, String _) = "SwaggerString" +showType (Nothing, Array _) = "SwaggerArray" +showType (Nothing, Object _) = "SwaggerObject"