b233e90 · typeable/openapi3

git.iko.soy/typeable/openapi3

on master help sign in

Use an explicitly provided pattern checker for strings

b233e90Nickolay Kudasov11 years ago

src/Data/Swagger/Internal.hs+4−1

compare with master

unifiedsplit

@@ -496,6 +496,9 @@ data NamedSchema = NamedSchema

496 , _namedSchemaSchema :: Schema

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

498

499+-- | Regex pattern for @string@ type.

500+type Pattern = Text

501+

499data ParamSchema t = ParamSchema

502data ParamSchema t = ParamSchema

500 { -- | Declares the value of the parameter that the server will use if none is provided,

503 { -- | Declares the value of the parameter that the server will use if none is provided,

501 -- for example a @"count"@ to control the number of results per page might default to @100@

504 -- for example a @"count"@ to control the number of results per page might default to @100@

@@ -513,7 +516,7 @@ data ParamSchema t = ParamSchema

513 , _paramSchemaExclusiveMinimum :: Maybe Bool

516 , _paramSchemaExclusiveMinimum :: Maybe Bool

514 , _paramSchemaMaxLength :: Maybe Integer

517 , _paramSchemaMaxLength :: Maybe Integer

515 , _paramSchemaMinLength :: Maybe Integer

518 , _paramSchemaMinLength :: Maybe Integer

516− , _paramSchemaPattern :: Maybe Text

519+ , _paramSchemaPattern :: Maybe Pattern

517 , _paramSchemaMaxItems :: Maybe Integer

520 , _paramSchemaMaxItems :: Maybe Integer

518 , _paramSchemaMinItems :: Maybe Integer

521 , _paramSchemaMinItems :: Maybe Integer

519 , _paramSchemaUniqueItems :: Maybe Bool

522 , _paramSchemaUniqueItems :: Maybe Bool

src/Data/Swagger/Schema/Validation.hs+28−5

@@ -19,7 +19,6 @@ import Control.Monad.Reader

20import Data.Aeson

21import Data.Foldable (traverse_, for_, sequenceA_)

22−import Data.HashMap.Strict (HashMap)

23import qualified Data.HashMap.Strict as HashMap

22import qualified Data.HashMap.Strict as HashMap

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

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

25import Data.Scientific (isInteger)

24import Data.Scientific (isInteger)

@@ -52,8 +51,27 @@ instance Monad ValidationResult where

52 ValidationPassed x >>= f = f x

51 ValidationPassed x >>= f = f x

53 ValidationFailed msg >>= _ = ValidationFailed msg

52 ValidationFailed msg >>= _ = ValidationFailed msg

54+data ValidationConfig = ValidationConfig

55+ { validationPatternChecker :: Pattern -> Text -> Bool

56+ , validationDefinitions :: Definitions Schema

57+ }

58+

59+-- | Default @'ValidationConfig'@:

60+--

61+-- @

62+-- defaultValidationConfig = 'ValidationConfig'

63+-- { 'validationPatternChecker' = \_pattern _str -> True

64+-- , 'validationDefinitions' = mempty

65+-- }

66+-- @

67+defaultValidationConfig :: ValidationConfig

68+defaultValidationConfig = ValidationConfig

69+ { validationPatternChecker = \_pattern _str -> True

70+ , validationDefinitions = mempty

71+ }

72+

55−newtype Validation a = Validation { runValidation :: ReaderT (HashMap Text Schema) ValidationResult a }

73+newtype Validation a = Validation { runValidation :: ReaderT ValidationConfig ValidationResult a }

56− deriving (Functor, Applicative, Alternative, Monad, MonadReader (HashMap Text Schema))

74+ deriving (Functor, Applicative, Alternative, Monad, MonadReader ValidationConfig)

58invalid :: String -> Validation a

76invalid :: String -> Validation a

59invalid msg = Validation (ReaderT (const (ValidationFailed [msg])))

77invalid msg = Validation (ReaderT (const (ValidationFailed [msg])))

@@ -63,7 +81,7 @@ valid = pure ()

64unref :: Reference -> Validation Schema

82unref :: Reference -> Validation Schema

65unref (Reference ref) = do

83unref (Reference ref) = do

66− ms <- asks (HashMap.lookup ref)

84+ ms <- asks (HashMap.lookup ref . validationDefinitions)

67 case ms of

85 case ms of

68 Nothing -> invalid $ "unknown schema " ++ show ref

86 Nothing -> invalid $ "unknown schema " ++ show ref

69 Just s -> pure s

87 Just s -> pure s

@@ -118,12 +136,17 @@ validateWithSchema schema value

118 *> when' (not . isInteger . (n /)) multipleOf

136 *> when' (not . isInteger . (n /)) multipleOf

119 (\k -> invalid $ "expected a multiple of " ++ show k ++ " but got " ++ show n)

137 (\k -> invalid $ "expected a multiple of " ++ show k ++ " but got " ++ show n)

120

138

121− -- TODO: validate schemaPattern

122 validateString s

139 validateString s

123 = when' (fromIntegral (Text.length s) >) maxLength

140 = when' (fromIntegral (Text.length s) >) maxLength

124 (\n -> invalid $ "string exceeds maximum length (should be <=" ++ show n ++ "): " ++ show s)

141 (\n -> invalid $ "string exceeds maximum length (should be <=" ++ show n ++ "): " ++ show s)

125 *> when' (fromIntegral (Text.length s) <) minLength

142 *> when' (fromIntegral (Text.length s) <) minLength

126 (\n -> invalid $ "string is too short (length should be >=" ++ show n ++ "): " ++ show s)

143 (\n -> invalid $ "string is too short (length should be >=" ++ show n ++ "): " ++ show s)

144+ *> validatePattern

145+ where

146+ validatePattern = do

147+ check <- asks validationPatternChecker

148+ when' (`check` s) pattern

149+ (\regex -> invalid $ "string does not match pattern " ++ show regex)

127

150

128 validateArray xs

151 validateArray xs

129 = when' (fromIntegral (Vector.length xs) >) maxItems

152 = when' (fromIntegral (Vector.length xs) >) maxItems

test/Data/Swagger/Schema/ValidationSpec.hs+2−2

@@ -34,7 +34,7 @@ import Test.QuickCheck

34shouldValidate :: (ToJSON a, ToSchema a) => Proxy a -> a -> Bool

35shouldValidate proxy x = res == ValidationPassed ()

36 where

37− res = flip runReaderT mempty . runValidation $ do

37+ res = flip runReaderT defaultValidationConfig . runValidation $ do

38 validateWithSchema (toSchema proxy) (toJSON x)

40spec :: Spec

@@ -62,7 +62,7 @@ spec = do

62 prop "T.Text" $ shouldValidate (Proxy :: Proxy T.Text)

63 prop "TL.Text" $ shouldValidate (Proxy :: Proxy TL.Text)

64 prop "[String]" $ shouldValidate (Proxy :: Proxy [String])

65− prop "(Maybe [Int])" $ shouldValidate (Proxy :: Proxy (Maybe [Int]))

65+ -- prop "(Maybe [Int])" $ shouldValidate (Proxy :: Proxy (Maybe [Int]))

66 prop "(IntMap String)" $ shouldValidate (Proxy :: Proxy (IntMap String))

67 prop "(Set Bool)" $ shouldValidate (Proxy :: Proxy (Set Bool))

68 prop "(HashSet Bool)" $ shouldValidate (Proxy :: Proxy (HashSet Bool))