@@ -18,7 +18,7 @@ import Control.Lens
1818import Control.Monad.Reader
1919
2020import Data.Aeson
21−import Data.Foldable (traverse_)
21+import Data.Foldable (traverse_, for_)
2222import Data.HashMap.Strict (HashMap)
2323import qualified Data.HashMap.Strict as HashMap
2424import qualified "unordered-containers" Data.HashSet as HashSet
@@ -42,13 +42,18 @@ instance Applicative ValidationResult where
4242 ValidationFailed xs <*> _ = ValidationFailed xs
4343 _ <*> ValidationFailed ys = ValidationFailed ys
4444
45+instance Alternative ValidationResult where
46+ empty = ValidationFailed []
47+ ValidationPassed x <|> _ = ValidationPassed x
48+ _ <|> y = y
49+
4550instance Monad ValidationResult where
4651 return = pure
4752 ValidationPassed x >>= f = f x
4853 ValidationFailed msg >>= _ = ValidationFailed msg
4954
5055newtype Validation a = Validation { runValidation :: ReaderT (HashMap Text Schema) ValidationResult a }
51− deriving (Functor, Applicative, Monad, MonadReader (HashMap Text Schema))
56+ deriving (Functor, Applicative, Alternative, Monad, MonadReader (HashMap Text Schema))
5257
5358invalid :: String -> Validation a
5459invalid msg = Validation (ReaderT (const (ValidationFailed [msg])))
@@ -136,8 +141,26 @@ validateWithSchema schema value
136141 where
137142 allUnique = Vector.length xs == HashSet.size (HashSet.fromList (Vector.toList xs))
138143
139− validateObject o
140− = valid
144+ validateObject o = case schema ^. schemaDiscriminator of
145+ Just name -> validateWithSchemaRef (Ref (Reference name)) value
146+ Nothing ->
147+ when' (fromIntegral (HashMap.size o) >) schemaMaxProperties
148+ (\n -> invalid $ "object size exceeds maximum (total number of properties should be <=" ++ show n ++ "): " ++ show (encode o))
149+ *> when' (fromIntegral (HashMap.size o) <) schemaMaxProperties
150+ (\n -> invalid $ "object size is too small (total number of properties should be >=" ++ show n ++ "): " ++ show (encode o))
151+ *> validateRequired
152+ *> validateProps
153+ where
154+ validateRequired = traverse_ validateReq (schema ^. schemaRequired)
155+ validateReq name = when (not (HashMap.member name o))
156+ (invalid $ "property " ++ show name ++ " is required, but not found in " ++ show (encode o))
157+
158+ validateProps = for_ (HashMap.toList o) $ \(k, v) ->
159+ case HashMap.lookup k (schema ^. schemaProperties) of
160+ Nothing -> case schema ^. schemaAdditionalProperties of
161+ Nothing -> valid -- TODO: issue a warning
162+ Just s -> validateWithSchema s v
163+ Just s -> validateWithSchemaRef s v
141164
142165 validateEnum = case schema ^. enum_ of
143166 Nothing -> valid