Fix anyOf schema validation

novainsilico · Feb 3, 2023 · 08d2f56 · 08d2f56
1 parent 970ee64
commit 08d2f56
Show file tree

Hide file tree

Showing 2 changed files with 24 additions and 7 deletions.
diff --git a/src/Data/OpenApi/Internal/Schema/Validation.hs b/src/Data/OpenApi/Internal/Schema/Validation.hs
@@ -28,14 +28,14 @@ import           Prelude                             ()
 import           Prelude.Compat
 
 import           Control.Applicative
-import           Control.Lens                        hiding (allOf)
+import           Control.Lens                        hiding (allOf, anyOf)
 import           Control.Monad                       (forM, forM_, when)
 
 import           Data.Aeson                          hiding (Result)
 #if MIN_VERSION_aeson(2,0,0)
 import qualified Data.Aeson.KeyMap as KeyMap
 #endif
-import           Data.Foldable                       (for_, sequenceA_,
+import           Data.Foldable                       (asum, for_, sequenceA_,
                                                       traverse_)
 #if !MIN_VERSION_aeson(2,0,0)
 import           Data.HashMap.Strict                 (HashMap)
@@ -490,6 +490,9 @@ validateSchemaType val = withSchema $ \sch ->
         0 -> invalid $ "Value not valid under any of 'oneOf' schemas: " ++ show val
         1 -> valid
         _ -> invalid $ "Value matches more than one of 'oneOf' schemas: " ++ show val
+    (view anyOf -> Just variants) -> do
+      (asum $ (\var -> validateWithSchemaRef var val) <$> variants)
+      <|> (invalid $ "Value not valid under any of 'anyOf' schemas: " ++ show val)
     (view allOf -> Just variants) -> do
       -- Default semantics for Validation Monad will abort when at least one
       -- variant does not match.

diff --git a/test/Data/OpenApi/Schema/ValidationSpec.hs b/test/Data/OpenApi/Schema/ValidationSpec.hs
@@ -92,6 +92,7 @@ spec = do
     prop "(Int, String, Double)" $ shouldValidate (Proxy :: Proxy (Int, String, Double))
     prop "(Int, String, Double, [Int])" $ shouldValidate (Proxy :: Proxy (Int, String, Double, [Int]))
     prop "(Int, String, Double, [Int], Int)" $ shouldValidate (Proxy :: Proxy (Int, String, Double, [Int], Int))
+    prop "(String, Paint)" $ shouldValidate (Proxy :: Proxy (String, Paint))
     prop "Person" $ shouldValidate (Proxy :: Proxy Person)
     prop "Color" $ shouldValidate (Proxy :: Proxy Color)
     prop "Paint" $ shouldValidate (Proxy :: Proxy Paint)
@@ -109,6 +110,8 @@ spec = do
     prop "invalidPaintToJSON"         $ shouldNotValidate invalidPaintToJSON
     prop "invalidLightToJSON"         $ shouldNotValidate invalidLightToJSON
     prop "invalidButtonImagesToJSON"  $ shouldNotValidate invalidButtonImagesToJSON
+    prop "invalidStringPersonToJSON"  $ shouldNotValidate $ \(s :: String, p) ->
+      toJSON (s, toInvalidPersonJSON p)
 
 main :: IO ()
 main = hspec spec
@@ -128,12 +131,23 @@ instance ToSchema Person
 instance Arbitrary Person where
   arbitrary = Person <$> arbitrary <*> arbitrary <*> arbitrary
 
+data InvalidPersonJSON = InvalidPersonJSON
+  { invalidName  :: String
+  , invalidPhone :: Integer
+  , invalidEmail :: Maybe String
+  } deriving (Show, Generic)
+
+instance ToJSON InvalidPersonJSON
+
+toInvalidPersonJSON :: Person -> InvalidPersonJSON
+toInvalidPersonJSON Person{..} = InvalidPersonJSON
+  { invalidName = name
+  , invalidPhone = phone
+  , invalidEmail = email
+  }
+
 invalidPersonToJSON :: Person -> Value
-invalidPersonToJSON Person{..} = object
-  [ stringToKey "personName"  .= toJSON name
-  , stringToKey "personPhone" .= toJSON phone
-  , stringToKey "personEmail" .= toJSON email
-  ]
+invalidPersonToJSON = toJSON . toInvalidPersonJSON
 
 -- ========================================================================
 -- Color (enum)