module Data.JsonSchema.Draft4.Spec where import Import import Data.Maybe (fromMaybe) import Data.Profunctor (Profunctor(..)) import Data.JsonSchema.Draft4.Failure import Data.JsonSchema.Draft4.Schema (Schema(..)) import Data.JsonSchema.Fetch (ReferencedSchemas(..), SchemaWithURI(..)) import qualified Data.JsonSchema.Fetch as FE import Data.JsonSchema.Types (Spec(..)) import qualified Data.JsonSchema.Types as JT import Data.Validator.Draft4 import Data.Validator.Reference (updateResolutionScope) embedded :: Schema -> ([Schema], [Schema]) embedded s = JT.embedded (d4Spec (ReferencedSchemas s mempty) mempty Nothing) s specValidate :: ReferencedSchemas Schema -> SchemaWithURI Schema -> Value -> [ValidatorFailure] specValidate rs = continueValidating rs (VisitedSchemas [(Nothing, Nothing)]) continueValidating :: ReferencedSchemas Schema -> VisitedSchemas -> SchemaWithURI Schema -> Value -> [ValidatorFailure] continueValidating referenced visited sw = JT.validate (d4Spec referenced visited currentScope) (_swSchema sw) where currentScope :: Maybe Text currentScope = updateResolutionScope (_swURI sw) (_schemaId (_swSchema sw)) d4Spec :: ReferencedSchemas Schema -> VisitedSchemas -> Maybe Text -> Spec Schema ValidatorFailure d4Spec referenced visited scope = Spec [ dimap (fmap MultipleOf . _schemaMultipleOf) FailureMultipleOf multipleOfValidator , dimap (\s -> Maximum (fromMaybe False (_schemaExclusiveMaximum s)) <$> _schemaMaximum s) FailureMaximum maximumValidator , dimap (\s -> Minimum (fromMaybe False (_schemaExclusiveMinimum s)) <$> _schemaMinimum s) FailureMinimum minimumValidator , dimap (fmap MaxLength . _schemaMaxLength) FailureMaxLength maxLengthValidator , dimap (fmap MinLength . _schemaMinLength) FailureMinLength minLengthValidator , dimap (fmap PatternValidator . _schemaPattern) FailurePattern patternValidator , dimap (fmap MaxItems . _schemaMaxItems) FailureMaxItems maxItemsValidator , dimap (fmap MinItems . _schemaMinItems) FailureMinItems minItemsValidator , dimap (fmap UniqueItems . _schemaUniqueItems) FailureUniqueItems uniqueItemsValidator , dimap (\s -> ItemsRelated { _irItems = _schemaItems s , _irAdditional = _schemaAdditionalItems s }) (\err -> case err of IRInvalidItems e -> FailureItems e IRInvalidAdditional e -> FailureAdditionalItems e) (itemsRelatedValidator descend) , lmap (fmap Definitions . _schemaDefinitions) definitionsEmbedded , dimap (fmap MaxProperties . _schemaMaxProperties) FailureMaxProperties maxPropertiesValidator , dimap (fmap MinProperties . _schemaMinProperties) FailureMinProperties minPropertiesValidator , dimap (fmap Required . _schemaRequired) FailureRequired requiredValidator , dimap (fmap DependenciesValidator . _schemaDependencies) FailureDependencies (dependenciesValidator descend) , dimap (\s -> PropertiesRelated { _propProperties = _schemaProperties s , _propPattern = _schemaPatternProperties s , _propAdditional = _schemaAdditionalProperties s }) FailurePropertiesRelated (propertiesRelatedValidator descend) , dimap (\s -> Ref <$> _schemaRef s) FailureRef (refValidator visited scope (FE.getReference referenced) getRef) , dimap (fmap EnumValidator . _schemaEnum) FailureEnum enumValidator , dimap (fmap TypeContext . _schemaType) FailureType typeValidator , dimap (fmap AllOf . _schemaAllOf) FailureAllOf (allOfValidator lateral) , dimap (fmap AnyOf . _schemaAnyOf) FailureAnyOf (anyOfValidator lateral) , dimap (fmap OneOf . _schemaOneOf) FailureOneOf (oneOfValidator lateral) , dimap (fmap NotValidator . _schemaNot) FailureNot (notValidator lateral) ] where getRef :: VisitedSchemas -> Maybe Text -> Schema -> Value -> [ValidatorFailure] getRef newVisited newScope schema = continueValidating referenced newVisited (SchemaWithURI schema newScope) descend :: Schema -> Value -> [ValidatorFailure] descend schema = continueValidating referenced mempty (SchemaWithURI schema scope) lateral :: Schema -> Value -> [ValidatorFailure] lateral schema = continueValidating referenced visited (SchemaWithURI schema scope)