From d0f0823d8e870f874392401fe58882f978b86d29 Mon Sep 17 00:00:00 2001
From: Uladzimir Stsepchanka <st.uladzimir@protonmail.com>
Date: Sat, 6 May 2023 10:22:53 +0300
Subject: [PATCH 1/9] Derive defaultSchemaOptions from Aeson.defaultOptions

---
 src/Data/OpenApi/SchemaOptions.hs | 14 +++++---------
 1 file changed, 5 insertions(+), 9 deletions(-)

diff --git a/src/Data/OpenApi/SchemaOptions.hs b/src/Data/OpenApi/SchemaOptions.hs
index ed95881f..e7de05ff 100644
--- a/src/Data/OpenApi/SchemaOptions.hs
+++ b/src/Data/OpenApi/SchemaOptions.hs
@@ -39,14 +39,7 @@ data SchemaOptions = SchemaOptions
 -- }
 -- @
 defaultSchemaOptions :: SchemaOptions
-defaultSchemaOptions = SchemaOptions
-  { fieldLabelModifier = id
-  , constructorTagModifier = id
-  , datatypeNameModifier = id
-  , allNullaryToStringTag = True
-  , unwrapUnaryRecords = False
-  , sumEncoding = Aeson.defaultTaggedObject
-  }
+defaultSchemaOptions = fromAesonOptions Aeson.defaultOptions
 
 -- | Convert 'Aeson.Options' to 'SchemaOptions'.
 --
@@ -56,20 +49,23 @@ defaultSchemaOptions = SchemaOptions
 -- * 'constructorTagModifier'
 -- * 'allNullaryToStringTag'
 -- * 'unwrapUnaryRecords'
+-- * 'sumEncoding'
 --
 -- Note that these fields have no effect on `SchemaOptions`:
 --
 -- * 'Aeson.omitNothingFields'
 -- * 'Aeson.tagSingleConstructors'
+-- * 'Aeson.rejectUnknownFields'
 --
 -- The rest is defined as in 'defaultSchemaOptions'.
 --
 -- @since 2.2.1
 --
 fromAesonOptions :: Aeson.Options -> SchemaOptions
-fromAesonOptions opts = defaultSchemaOptions
+fromAesonOptions opts = SchemaOptions
   { fieldLabelModifier     = Aeson.fieldLabelModifier     opts
   , constructorTagModifier = Aeson.constructorTagModifier opts
+  , datatypeNameModifier   = id
   , allNullaryToStringTag  = Aeson.allNullaryToStringTag  opts
   , unwrapUnaryRecords     = Aeson.unwrapUnaryRecords     opts
   , sumEncoding            = Aeson.sumEncoding            opts

From f4ac4f5954ce6125944bab24422eb51d2579c033 Mon Sep 17 00:00:00 2001
From: Uladzimir Stsepchanka <st.uladzimir@protonmail.com>
Date: Sat, 30 Dec 2023 13:19:03 +0300
Subject: [PATCH 2/9] Exhaustive tests covering all possible combinations of
 options

---
 openapi3.cabal       |   1 +
 test/GenericsSpec.hs | 199 +++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 200 insertions(+)
 create mode 100644 test/GenericsSpec.hs

diff --git a/openapi3.cabal b/openapi3.cabal
index a841ad7f..df0e54da 100644
--- a/openapi3.cabal
+++ b/openapi3.cabal
@@ -136,6 +136,7 @@ test-suite spec
     hspec-discover:hspec-discover >=2.5.5 && <2.12
 
   other-modules:
+    GenericsSpec
     SpecCommon
     Data.OpenApiSpec
     Data.OpenApi.CommonTestTypes
diff --git a/test/GenericsSpec.hs b/test/GenericsSpec.hs
new file mode 100644
index 00000000..010a2363
--- /dev/null
+++ b/test/GenericsSpec.hs
@@ -0,0 +1,199 @@
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE TypeApplications #-}
+
+module GenericsSpec
+  ( spec
+  ) where
+
+import           Control.Monad
+import qualified Data.Aeson as Aeson
+import           Data.Aeson.Types
+import qualified Data.ByteString.Lazy.Char8 as LBS
+import qualified Data.List as List
+import           Data.Maybe
+import           Data.OpenApi
+import           Data.OpenApi.Declare
+import           Data.OpenApi.Internal.Schema
+import           Data.OpenApi.Internal.Schema.Validation
+import           Data.OpenApi.Schema
+import           Data.OpenApi.Schema.Generator
+import           Data.Proxy
+import           Data.Typeable
+import           GHC.Generics
+import           Test.Hspec
+import           Test.Hspec.QuickCheck
+import           Test.QuickCheck
+
+
+spec :: Spec
+spec = describe "genericDeclareNamedSchema" $ do
+  mkTests $ Proxy @Unit
+  mkTests $ Proxy @UnaryConstructor
+  mkTests $ Proxy @UnaryConstructorMaybe
+  mkTests $ Proxy @UnaryRecord
+  mkTests $ Proxy @UnaryRecordMaybe
+  mkTests $ Proxy @ProductType
+  mkTests $ Proxy @Record
+  mkTests $ Proxy @SumType
+  mkTests $ Proxy @()
+  mkTests $ Proxy @[Int]
+  mkTests $ Proxy @(Maybe Int)
+  mkTests $ Proxy @(Either Bool Int)
+  mkTests $ Proxy @(Char, Int)
+  mkTests $ Proxy @(Char, Int, Bool)
+
+mkTests
+  :: ( Generic a, GToSchema (Rep a), Arbitrary a, Typeable a, Show a
+     , Aeson.GFromJSON Zero (Rep a), Aeson.GToJSON' Value Zero (Rep a)
+     )
+  => Proxy a
+  -> Spec
+mkTests proxy = describe (show $ typeRep proxy) $ forM_ allOptsCombinations $ \opts ->
+  describe (showDiff opts) $ do
+    let (defs, NamedSchema _ sch) =
+          runDeclare (genericDeclareNamedSchema schemaOpts proxy) mempty
+        jsonOpts = toAesonOptions opts
+        schemaOpts = fromAesonOptions jsonOpts
+    prop "random value validates again schema" $ \val -> do
+      let jsonVal = genericToJSON jsonOpts $ val `asProxyTypeOf` proxy
+      case validateJSON defs sch jsonVal of
+        [] -> pure ()
+        errors -> expectationFailure $ unlines errors
+    prop "value generated from schema is parsed successfully" $
+      forAll (schemaGen defs sch) $ \val ->
+        case (`asProxyTypeOf` proxy) <$> parseEither (genericParseJSON jsonOpts) val of
+          Right _ -> pure ()
+          Left err -> expectationFailure err
+
+-- | Generate all possible variant of 'Aeson.Options'
+allOptsCombinations :: [Opts]
+allOptsCombinations = do
+  snakeField <- [True, False]
+  snakeConstructor <- [True, False]
+  allNullaryToStringTag <- [True, False]
+  omitNothingFields <- [True, False]
+  sumEncoding <-
+    [ Aeson.defaultTaggedObject
+    , Aeson.UntaggedValue
+    , Aeson.ObjectWithSingleField
+    , Aeson.TwoElemArray
+    ]
+  unwrapUnaryRecords <- [True, False]
+  tagSingleConstructors <- [True, False]
+  rejectUnknownFields <- [True, False]
+  pure Opts{..}
+
+toAesonOptions :: Opts -> Aeson.Options
+toAesonOptions Opts{..} = Aeson.defaultOptions
+  { Aeson.fieldLabelModifier = if snakeField then camelTo2 '_' else id
+  , Aeson.constructorTagModifier = if snakeConstructor then camelTo2 '_' else id
+  , Aeson.allNullaryToStringTag = allNullaryToStringTag
+  , Aeson.omitNothingFields = omitNothingFields
+  , Aeson.sumEncoding = sumEncoding
+  , Aeson.unwrapUnaryRecords = unwrapUnaryRecords
+  , Aeson.tagSingleConstructors = tagSingleConstructors
+  , Aeson.rejectUnknownFields = rejectUnknownFields
+  }
+
+data Opts = Opts
+  { snakeField :: Bool
+  , snakeConstructor :: Bool
+  , allNullaryToStringTag :: Bool
+  , omitNothingFields :: Bool
+  , sumEncoding :: Aeson.SumEncoding
+  , unwrapUnaryRecords :: Bool
+  , tagSingleConstructors :: Bool
+  , rejectUnknownFields :: Bool
+  } deriving stock (Generic)
+
+-- Show difference with default options
+showDiff :: Opts -> String
+showDiff Opts{..} = if null diff then "defaultOptions" else List.intercalate ", " diff
+  where
+    diff = catMaybes
+      [ guard snakeField >> Just "snakeField=True"
+      , guard snakeConstructor >> Just "snakeConstructor=True"
+      , do
+          guard $ allNullaryToStringTag /= Aeson.allNullaryToStringTag Aeson.defaultOptions
+          Just $ "allNullaryToStringTag=" <> show allNullaryToStringTag
+      , do
+          guard $ omitNothingFields /= Aeson.omitNothingFields Aeson.defaultOptions
+          Just $ "omitNothingFields=" <> show omitNothingFields
+      , do
+          guard $ sumEncoding /= Aeson.sumEncoding Aeson.defaultOptions
+          Just $ "sumEncoding=" <> show sumEncoding
+      , do
+          guard $ unwrapUnaryRecords /= Aeson.unwrapUnaryRecords Aeson.defaultOptions
+          Just $ "unwrapUnaryRecords=" <> show unwrapUnaryRecords
+      , do
+          guard $ tagSingleConstructors /= Aeson.tagSingleConstructors Aeson.defaultOptions
+          Just $ "tagSingleConstructors=" <> show tagSingleConstructors
+      , do
+          guard $ rejectUnknownFields /= Aeson.rejectUnknownFields Aeson.defaultOptions
+          Just $ "rejectUnknownFields=" <> show rejectUnknownFields
+      ]
+
+data Unit = Unit
+  deriving stock (Generic, Show)
+
+instance Arbitrary Unit where
+  arbitrary = pure Unit
+
+newtype UnaryConstructor = UnaryConstructor Int
+  deriving stock (Generic, Show)
+  deriving newtype Arbitrary
+
+newtype UnaryConstructorMaybe = UnaryConstructorMaybe (Maybe Int)
+  deriving stock (Generic, Show)
+  deriving newtype Arbitrary
+
+newtype UnaryRecord = UnaryRecord { unaryRecord :: Int }
+  deriving stock (Generic, Show)
+  deriving newtype Arbitrary
+
+newtype UnaryRecordMaybe = UnaryRecordMaybe { unaryRecordMaybe :: Maybe Int }
+  deriving stock (Generic, Show)
+  deriving newtype Arbitrary
+
+data ProductType = ProductType Int Bool
+  deriving stock (Generic, Show)
+
+instance Arbitrary ProductType where
+  arbitrary = ProductType <$> arbitrary <*> arbitrary
+
+data Record = Record
+  { fieldOne :: Int
+  , fieldTwo :: Char
+  , fieldMaybe :: Maybe Bool
+  } deriving stock (Generic, Show)
+
+instance Arbitrary Record where
+  arbitrary = do
+    fieldOne <- arbitrary
+    fieldTwo <- arbitrary
+    fieldMaybe <- arbitrary
+    pure Record{..}
+
+data SumType
+  = SumNullaryConstructor
+  | SumUnaryConstructor Int
+  | SumUnaryConstructorWithField { sumUnaryConstructorWithField :: Int }
+  | SumBinaryConstructor Int Char
+  | SumBinaryConstructorWithFields
+    { sumBinaryConstructorWithFields1 :: Int
+    , sumBinaryConstructorWithFields2 :: Maybe Bool
+    }
+  deriving stock (Generic, Show)
+
+instance Arbitrary SumType where
+  arbitrary = oneof
+    [ pure SumNullaryConstructor
+    , SumUnaryConstructor <$> arbitrary
+    , SumUnaryConstructorWithField <$> arbitrary
+    , SumBinaryConstructor <$> arbitrary <*> arbitrary
+    , SumBinaryConstructorWithFields <$> arbitrary <*> arbitrary
+    ]

From 565841f98d76fcffb851cf19f37c9dde0c47437f Mon Sep 17 00:00:00 2001
From: Uladzimir Stsepchanka <st.uladzimir@protonmail.com>
Date: Sun, 31 Dec 2023 12:42:14 +0300
Subject: [PATCH 3/9] Disable TwoElemArray

---
 test/GenericsSpec.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/test/GenericsSpec.hs b/test/GenericsSpec.hs
index 010a2363..852b71b4 100644
--- a/test/GenericsSpec.hs
+++ b/test/GenericsSpec.hs
@@ -80,7 +80,7 @@ allOptsCombinations = do
     [ Aeson.defaultTaggedObject
     , Aeson.UntaggedValue
     , Aeson.ObjectWithSingleField
-    , Aeson.TwoElemArray
+    -- , Aeson.TwoElemArray FIXME
     ]
   unwrapUnaryRecords <- [True, False]
   tagSingleConstructors <- [True, False]

From 7c1f2c6fffe80f18a39850e42b93597cb3fa1725 Mon Sep 17 00:00:00 2001
From: Uladzimir Stsepchanka <st.uladzimir@protonmail.com>
Date: Sun, 31 Dec 2023 08:17:26 +0300
Subject: [PATCH 4/9] 'tagSingleConstructors'

Refactors generic dispatching
---
 src/Data/OpenApi.hs                       |   2 +-
 src/Data/OpenApi/Internal/Schema.hs       | 317 +++++++++++++---------
 src/Data/OpenApi/SchemaOptions.hs         |   6 +-
 test/Data/OpenApi/CommonTestTypes.hs      |  57 +++-
 test/Data/OpenApi/ParamSchemaSpec.hs      |   2 +-
 test/Data/OpenApi/Schema/GeneratorSpec.hs |  22 ++
 test/Data/OpenApi/SchemaSpec.hs           |   1 +
 test/SpecCommon.hs                        |   9 +-
 8 files changed, 270 insertions(+), 146 deletions(-)

diff --git a/src/Data/OpenApi.hs b/src/Data/OpenApi.hs
index 3b1e775f..b82b7ca9 100644
--- a/src/Data/OpenApi.hs
+++ b/src/Data/OpenApi.hs
@@ -372,7 +372,7 @@ import Data.OpenApi.Internal
 -- >>> instance ToSchema Error
 -- >>> BSL.putStrLn $ encodePretty $ toSchema (Proxy :: Proxy Error)
 -- {
---     "oneOf": [
+--     "anyOf": [
 --         {
 --             "properties": {
 --                 "tag": {
diff --git a/src/Data/OpenApi/Internal/Schema.hs b/src/Data/OpenApi/Internal/Schema.hs
index 212b2a40..c7380ace 100644
--- a/src/Data/OpenApi/Internal/Schema.hs
+++ b/src/Data/OpenApi/Internal/Schema.hs
@@ -29,12 +29,11 @@ import Data.Data.Lens (template)
 
 import Control.Applicative ((<|>))
 import Control.Monad
-import Control.Monad.Writer hiding (First, Last)
 import Data.Aeson (Object (..), SumEncoding (..), ToJSON (..), ToJSONKey (..),
                    ToJSONKeyFunction (..), Value (..))
 import Data.Char
 import Data.Data (Data)
-import Data.Foldable (traverse_)
+import Data.Foldable (foldl', traverse_)
 import Data.HashMap.Strict (HashMap)
 import qualified Data.HashMap.Strict as HashMap
 import           "unordered-containers" Data.HashSet (HashSet)
@@ -65,7 +64,7 @@ import Numeric.Natural.Compat (Natural)
 import Data.Word
 import GHC.Generics
 import qualified Data.UUID.Types as UUID
-import Type.Reflection (Typeable, typeRep)
+import Type.Reflection (Typeable, typeRep, typeOf)
 
 import           Data.OpenApi.Aeson.Compat         (keyToText, objectKeys, toInsOrdHashMap)
 import           Data.OpenApi.Declare
@@ -589,7 +588,7 @@ sketchStrictSchema = go . toJSON
         names = objectKeys o
 
 class GToSchema (f :: Type -> Type) where
-  gdeclareNamedSchema :: SchemaOptions -> Proxy f -> Schema -> Declare (Definitions Schema) NamedSchema
+  gdeclareNamedSchema :: SchemaOptions -> Proxy f -> Declare (Definitions Schema) NamedSchema
 
 instance {-# OVERLAPPABLE #-} ToSchema a => ToSchema [a] where
   declareNamedSchema _ = do
@@ -633,8 +632,7 @@ instance (ToSchema a, ToSchema b) => ToSchema (Either a b) where
   -- To match Aeson instance
   declareNamedSchema = genericDeclareNamedSchema defaultSchemaOptions { sumEncoding = ObjectWithSingleField }
 
-instance ToSchema () where
-  declareNamedSchema _ = pure (NamedSchema Nothing nullarySchema)
+instance ToSchema ()
 
 -- | For 'ToJSON' instance, see <http://hackage.haskell.org/package/uuid-aeson uuid-aeson> package.
 instance ToSchema UUID.UUID where
@@ -892,7 +890,7 @@ genericDeclareSchema opts proxy = _namedSchemaSchema <$> genericDeclareNamedSche
 genericDeclareNamedSchema :: forall a. (Generic a, GToSchema (Rep a), Typeable a) =>
   SchemaOptions -> Proxy a -> Declare (Definitions Schema) NamedSchema
 genericDeclareNamedSchema opts _ =
-  rename (Just $ T.pack name) <$> gdeclareNamedSchema opts (Proxy :: Proxy (Rep a)) mempty
+  rename (Just $ T.pack name) <$> gdeclareNamedSchema opts (Proxy :: Proxy (Rep a))
   where
     unspace ' ' = '_'
     unspace x = x
@@ -929,44 +927,78 @@ nullarySchema = mempty
   & items ?~ OpenApiItemsArray []
 
 gtoNamedSchema :: GToSchema f => SchemaOptions -> Proxy f -> NamedSchema
-gtoNamedSchema opts proxy = undeclare $ gdeclareNamedSchema opts proxy mempty
+gtoNamedSchema opts proxy = undeclare $ gdeclareNamedSchema opts proxy
 
 gdeclareSchema :: GToSchema f => SchemaOptions -> Proxy f -> Declare (Definitions Schema) Schema
-gdeclareSchema opts proxy = _namedSchemaSchema <$> gdeclareNamedSchema opts proxy mempty
+gdeclareSchema opts proxy = _namedSchemaSchema <$> gdeclareNamedSchema opts proxy
+
+
+---------------------------
+---------------------------
+---------------------------
+-- TOP LEVEL DISPATCHING --
+---------------------------
+---------------------------
+---------------------------
+
+-- | Single constructor datatype.
+instance (AllNullaryConstructors (C1 c f), GSumToSchema (C1 c f), GToSchema f, GToSchema (C1 c f))
+  => GToSchema (D1 d (C1 c f)) where
+  gdeclareNamedSchema opts _
+    | tagSingleConstructors opts = gsumSchema opts $ Proxy @(C1 c f)
+    | otherwise = gdeclareNamedSchema opts $ Proxy @(C1 c f)
+
+-- | Sum datatype
+instance (AllNullaryConstructors (f :+: g), GSumToSchema (f :+: g))
+  => GToSchema (D1 d (f :+: g)) where
+  gdeclareNamedSchema opts _ = gsumSchema opts $ Proxy @(f :+: g)
+
+---------------------------
+---------------------------
+---------------------------
+
+gsumSchema
+  :: (AllNullaryConstructors f, GSumToSchema f)
+  => SchemaOptions -> Proxy f -> Declare (Definitions Schema) NamedSchema
+gsumSchema opts proxy
+    | allNullaryToStringTag opts || sumEncoding opts == UntaggedValue
+    , Just names <- nullaryConstructorsNames proxy
+    = pure $ unnamed mempty
+        & type_ ?~ OpenApiString
+        & enum_ ?~ map (String . T.pack . constructorTagModifier opts) names
+    | otherwise = do
+        schemas <- gsumToSchema opts proxy
+        case schemas of
+          [Inline single] -> pure $ unnamed single
+          _ -> pure $ unnamed $ mempty & oneOf ?~ schemas
+
+instance (GProductSchemas (f :*: g)) => GToSchema (C1 c (f :*: g)) where
+  gdeclareNamedSchema opts _ = gdeclareNamedSchema opts $ Proxy @(f :*: g)
+
+instance (GToSchema (S1 s f)) => GToSchema (C1 c (S1 s f)) where
+  gdeclareNamedSchema opts _ = gdeclareNamedSchema opts $ Proxy @(S1 s f)
+
+instance GToSchema (C1 c U1) where
+  gdeclareNamedSchema opts _ = gdeclareNamedSchema opts $ Proxy @U1
+
+instance (GProductSchemas (f :*: g)) => GToSchema (f :*: g) where
+  gdeclareNamedSchema opts _ = gproductSchema opts $ Proxy @(f :*: g)
+
+instance (GToSchema f) => GToSchema (S1 ('MetaSel 'Nothing src ss ds) f) where
+  gdeclareNamedSchema opts _ = gdeclareNamedSchema opts $ Proxy @f
+
+instance (GToSchema f, GProductSchemas (S1 ('MetaSel ('Just sel) src ss ds) f))
+  => GToSchema (S1 ('MetaSel ('Just sel) src ss ds) f) where
+  gdeclareNamedSchema opts _ =
+    if unwrapUnaryRecords opts
+    then gdeclareNamedSchema opts $ Proxy @f
+    else gproductSchema opts $ Proxy @(S1 ('MetaSel ('Just sel) src ss ds) f)
 
-instance (GToSchema f, GToSchema g) => GToSchema (f :*: g) where
-  gdeclareNamedSchema opts _ schema = do
-    NamedSchema _ gschema <- gdeclareNamedSchema opts (Proxy :: Proxy f) schema
-    gdeclareNamedSchema opts (Proxy :: Proxy g) gschema
+instance ToSchema c => GToSchema (K1 i c) where
+  gdeclareNamedSchema _ _ = declareNamedSchema (Proxy :: Proxy c)
 
-instance (Datatype d, GToSchema f) => GToSchema (D1 d f) where
-  gdeclareNamedSchema opts _ s = rename name <$> gdeclareNamedSchema opts (Proxy :: Proxy f) s
-    where
-      name = gdatatypeSchemaName opts (Proxy :: Proxy d)
-
-instance {-# OVERLAPPABLE #-} GToSchema f => GToSchema (C1 c f) where
-  gdeclareNamedSchema opts _ = gdeclareNamedSchema opts (Proxy :: Proxy f)
-
-instance {-# OVERLAPPING #-} Constructor c => GToSchema (C1 c U1) where
-  gdeclareNamedSchema = gdeclareNamedSumSchema
-
--- | Single field constructor.
-instance (Selector s, GToSchema f, GToSchema (S1 s f)) => GToSchema (C1 c (S1 s f)) where
-  gdeclareNamedSchema opts _ s
-    | unwrapUnaryRecords opts = fieldSchema
-    | otherwise =
-        case schema ^. items of
-          Just (OpenApiItemsArray [_]) -> fieldSchema
-          _ -> do
-            -- We have to run recordSchema instead of just using its defs,
-            -- since those can be recursive and will lead to infinite loop,
-            -- see https://github.com/biocad/openapi3/pull/37
-            NamedSchema _ schema' <- recordSchema
-            return (unnamed schema')
-    where
-      (_, NamedSchema _ schema) = runDeclare recordSchema mempty
-      recordSchema = gdeclareNamedSchema opts (Proxy :: Proxy (S1 s f)) s
-      fieldSchema  = gdeclareNamedSchema opts (Proxy :: Proxy f) s
+instance GToSchema U1 where
+  gdeclareNamedSchema _ _ = pure (NamedSchema Nothing nullarySchema)
 
 gdeclareSchemaRef :: GToSchema a => SchemaOptions -> Proxy a -> Declare (Definitions Schema) (Referenced Schema)
 gdeclareSchemaRef opts proxy = do
@@ -983,87 +1015,90 @@ gdeclareSchemaRef opts proxy = do
       known <- looks (InsOrdHashMap.member name)
       when (not known) $ do
         declare [(name, schema)]
-        void $ gdeclareNamedSchema opts proxy mempty
+        void $ gdeclareNamedSchema opts proxy
       return $ Ref (Reference name)
     _ -> Inline <$> gdeclareSchema opts proxy
 
-appendItem :: Referenced Schema -> Maybe OpenApiItems -> Maybe OpenApiItems
-appendItem x Nothing = Just (OpenApiItemsArray [x])
-appendItem x (Just (OpenApiItemsArray xs)) = Just (OpenApiItemsArray (xs ++ [x]))
-appendItem _ _ = error "GToSchema.appendItem: cannot append to OpenApiItemsObject"
-
-withFieldSchema :: forall proxy s f. (Selector s, GToSchema f) =>
-  SchemaOptions -> proxy s f -> Bool -> Schema -> Declare (Definitions Schema) Schema
-withFieldSchema opts _ isRequiredField schema = do
-  ref <- gdeclareSchemaRef opts (Proxy :: Proxy f)
-  return $
-    if T.null fname
-      then schema
-        & type_ ?~ OpenApiArray
-        & items %~ appendItem ref
-        & maxItems %~ Just . maybe 1 (+1)   -- increment maxItems
-        & minItems %~ Just . maybe 1 (+1)   -- increment minItems
-      else schema
-        & type_ ?~ OpenApiObject
-        & properties . at fname ?~ ref
-        & if isRequiredField
-            then required %~ (++ [fname])
-            else id
-  where
-    fname = T.pack (fieldLabelModifier opts (selName (Proxy3 :: Proxy3 s f p)))
-
--- | Optional record fields.
-instance {-# OVERLAPPING #-} (Selector s, ToSchema c) => GToSchema (S1 s (K1 i (Maybe c))) where
-  gdeclareNamedSchema opts _ = fmap unnamed . withFieldSchema opts (Proxy2 :: Proxy2 s (K1 i (Maybe c))) False
-
--- | Record fields.
-instance {-# OVERLAPPABLE #-} (Selector s, GToSchema f) => GToSchema (S1 s f) where
-  gdeclareNamedSchema opts _ = fmap unnamed . withFieldSchema opts (Proxy2 :: Proxy2 s f) True
-
-instance ToSchema c => GToSchema (K1 i c) where
-  gdeclareNamedSchema _ _ _ = declareNamedSchema (Proxy :: Proxy c)
-
-instance ( GSumToSchema f
-         , GSumToSchema g
-         ) => GToSchema (f :+: g)
-   where
-  -- Aeson does not unwrap unary record in sum types.
-  gdeclareNamedSchema opts = gdeclareNamedSumSchema (opts { unwrapUnaryRecords = False })
-
-gdeclareNamedSumSchema :: GSumToSchema f => SchemaOptions -> Proxy f -> Schema -> Declare (Definitions Schema) NamedSchema
-gdeclareNamedSumSchema opts proxy _
-  | allNullaryToStringTag opts && allNullary = pure $ unnamed $ mempty
-      & type_ ?~ OpenApiString
-      & enum_ ?~ map (String . fst) sumSchemas
-  | otherwise = do
-    (schemas, _) <- runWriterT declareSumSchema
-    return $ unnamed $ mempty
-      & oneOf ?~ (snd <$> schemas)
-  where
-    declareSumSchema = gsumToSchema opts proxy
-    (sumSchemas, All allNullary) = undeclare (runWriterT declareSumSchema)
-
-type AllNullary = All
-
-class GSumToSchema (f :: Type -> Type)  where
-  gsumToSchema :: SchemaOptions -> Proxy f -> WriterT AllNullary (Declare (Definitions Schema)) [(T.Text, Referenced Schema)]
-
-instance (GSumToSchema f, GSumToSchema g) => GSumToSchema (f :+: g) where
-  gsumToSchema opts _ =
-    (<>) <$> gsumToSchema opts (Proxy :: Proxy f) <*> gsumToSchema opts (Proxy :: Proxy g)
+-- * Helper machinery for products
+
+gproductSchema
+  :: (GProductSchemas f) => SchemaOptions -> Proxy f -> Declare (Definitions Schema) NamedSchema
+gproductSchema opts proxy = do
+  (recordFields, productFields) <- gproductSchemas opts proxy
+  let sz = toInteger $ length productFields
+      insProp (name, _, schema) = at name ?~ schema
+      requiredProps = do
+        (name, required, _) <- recordFields
+        guard required
+        pure name
+  pure $ unnamed $ case recordFields of
+    [] -> mempty
+      & type_ ?~ OpenApiArray
+      & items ?~ OpenApiItemsArray productFields
+      & maxItems ?~ sz
+      & minItems ?~ sz
+    _ -> mempty
+      & type_ ?~ OpenApiObject
+      & properties .~ foldl' (flip insProp) mempty recordFields
+      & required .~ requiredProps
+
+type RecordField = (T.Text, Bool, Referenced Schema)
+
+class GProductSchemas f where
+  -- | Collect fields names
+   gproductSchemas
+     :: SchemaOptions
+     -> Proxy f
+     -> Declare (Definitions Schema) ([RecordField], [Referenced Schema])
+
+instance (GProductSchemas f, GProductSchemas g) => GProductSchemas (f :*: g) where
+  gproductSchemas opts _ = do
+    l <- gproductSchemas opts (Proxy @f)
+    r <- gproductSchemas opts (Proxy @g)
+    pure (l <> r)
+
+instance (IsMaybe c, Selector s, ToSchema c) => GProductSchemas (S1 s (K1 i c)) where
+  gproductSchemas opts _ = do
+    schema <- declareSchemaRef (Proxy @c)
+    pure $ case selName $ Proxy3 @s @_ @_ of
+      "" -> ([], [schema])
+      name ->
+        ( [ ( T.pack $ fieldLabelModifier opts name
+            , not $ isMaybe $ Proxy @c
+            , schema
+            )
+          ]
+        , []
+        )
+
+instance (GProductSchemas f) => GProductSchemas (C1 c f) where
+  gproductSchemas opts _ = gproductSchemas opts $ Proxy @f
+
+instance GProductSchemas U1 where
+  gproductSchemas _ _ = pure ([], [Inline nullarySchema])
+
+-- This will go away with latest aeson
+class IsMaybe a where
+  isMaybe :: Proxy a -> Bool
+
+instance {-# OVERLAPPABLE #-} IsMaybe a where
+  isMaybe _ = False
+
+instance {-# OVERLAPPING #-} IsMaybe (Maybe a) where
+  isMaybe _ = True
+
+-- * Helper machinery for sums
 
 -- | Convert one component of the sum to schema, to be later combined with @oneOf@.
-gsumConToSchemaWith :: forall c f. (GToSchema (C1 c f), Constructor c) =>
-  Maybe (Referenced Schema) -> SchemaOptions -> Proxy (C1 c f) -> (T.Text, Referenced Schema)
-gsumConToSchemaWith ref opts _ = (tag, withTitle)
+gsumConToSchemaWith :: forall c f. (Constructor c) =>
+  Maybe (Referenced Schema) -> SchemaOptions -> Proxy (C1 c f) -> Referenced Schema
+gsumConToSchemaWith ref opts _ = case schema of
+  Inline sub -> Inline $ sub
+  -- Give sub-schemas @title@ attribute with constructor name, if none present.
+  -- This will look prettier in swagger-ui.
+    & title %~ (<|> Just (T.pack constructorName))
+  s -> s
   where
-    -- Give sub-schemas @title@ attribute with constructor name, if none present.
-    -- This will look prettier in swagger-ui.
-    withTitle = case schema of
-      Inline sub -> Inline $ sub
-        & title %~ (<|> Just (T.pack constructorName))
-      s -> s
-
     schema = case sumEncoding opts of
       TaggedObject tagField contentsField ->
         case ref of
@@ -1105,29 +1140,51 @@ gsumConToSchemaWith ref opts _ = (tag, withTitle)
     refOrNullary = fromMaybe (Inline nullarySchema) ref
     refOrEnum = fromMaybe (Inline $ mempty & type_ ?~ OpenApiString & enum_ ?~ [String tag]) ref
 
-gsumConToSchema :: (GToSchema (C1 c f), Constructor c) =>
-  SchemaOptions -> Proxy (C1 c f) -> Declare (Definitions Schema) [(T.Text, Referenced Schema)]
-gsumConToSchema opts proxy = do
-  ref <- gdeclareSchemaRef opts proxy
-  return [gsumConToSchemaWith (Just ref) opts proxy]
+class GSumToSchema (f :: Type -> Type) where
+  gsumToSchema :: SchemaOptions -> Proxy f -> Declare (Definitions Schema) [Referenced Schema]
+
+instance (GSumToSchema f, GSumToSchema g) => GSumToSchema (f :+: g) where
+  gsumToSchema opts _ = (<>)
+    <$> gsumToSchema opts (Proxy @f)
+    <*> gsumToSchema opts (Proxy @g)
 
 instance {-# OVERLAPPABLE #-} (Constructor c, GToSchema f) => GSumToSchema (C1 c f) where
   gsumToSchema opts proxy = do
-    tell (All False)
-    lift $ gsumConToSchema opts proxy
-
-instance (Constructor c, Selector s, GToSchema f) => GSumToSchema (C1 c (S1 s f)) where
+    let unwrap = case sumEncoding opts of
+          -- This is how "Aeson" behaves
+          TaggedObject{} -> False
+          _ -> unwrapUnaryRecords opts
+    ref <- gdeclareSchemaRef opts{unwrapUnaryRecords = unwrap} (Proxy @f)
+    return [gsumConToSchemaWith (Just ref) opts proxy]
+
+instance {-# OVERLAPPING #-} (Constructor c) => GSumToSchema (C1 c U1) where
   gsumToSchema opts proxy = do
-    tell (All False)
-    lift $ gsumConToSchema opts proxy
-
-instance Constructor c => GSumToSchema (C1 c U1) where
-  gsumToSchema opts proxy = pure $ (:[]) $ gsumConToSchemaWith Nothing opts proxy
+    return [gsumConToSchemaWith Nothing opts proxy]
 
 data Proxy2 a b = Proxy2
 
 data Proxy3 a b c = Proxy3
 
+proxy3 :: Proxy (f a b) -> Proxy3 f a b
+proxy3 _ = Proxy3
+
+class AllNullaryConstructors f where
+  -- | Collect constructors names if all of them are nullary
+  nullaryConstructorsNames :: Proxy f -> Maybe [String]
+
+instance (AllNullaryConstructors f, AllNullaryConstructors g)
+  => AllNullaryConstructors (f :+: g) where
+  nullaryConstructorsNames _ = do
+    l <- nullaryConstructorsNames (Proxy @f)
+    r <- nullaryConstructorsNames (Proxy @g)
+    Just (l <> r)
+
+instance {-# OVERLAPPABLE #-} AllNullaryConstructors (C1 c f) where
+  nullaryConstructorsNames _ = Nothing
+
+instance {-# OVERLAPPING #-} (Constructor c) => AllNullaryConstructors (C1 c U1) where
+  nullaryConstructorsNames _ = Just [conName $ Proxy3 @c @_ @_]
+
 {- $setup
 >>> import Data.OpenApi
 >>> import Data.Aeson (encode)
diff --git a/src/Data/OpenApi/SchemaOptions.hs b/src/Data/OpenApi/SchemaOptions.hs
index e7de05ff..fa469c18 100644
--- a/src/Data/OpenApi/SchemaOptions.hs
+++ b/src/Data/OpenApi/SchemaOptions.hs
@@ -24,6 +24,9 @@ data SchemaOptions = SchemaOptions
   , unwrapUnaryRecords :: Bool
     -- | Specifies how to encode constructors of a sum datatype.
   , sumEncoding :: Aeson.SumEncoding
+    -- | Encode types with a single constructor as sums,
+    -- so that `allNullaryToStringTag` and `sumEncoding` apply.
+  , tagSingleConstructors :: Bool
   }
 
 -- | Default encoding @'SchemaOptions'@.
@@ -50,11 +53,11 @@ defaultSchemaOptions = fromAesonOptions Aeson.defaultOptions
 -- * 'allNullaryToStringTag'
 -- * 'unwrapUnaryRecords'
 -- * 'sumEncoding'
+-- * 'tagSingleConstructors'
 --
 -- Note that these fields have no effect on `SchemaOptions`:
 --
 -- * 'Aeson.omitNothingFields'
--- * 'Aeson.tagSingleConstructors'
 -- * 'Aeson.rejectUnknownFields'
 --
 -- The rest is defined as in 'defaultSchemaOptions'.
@@ -69,4 +72,5 @@ fromAesonOptions opts = SchemaOptions
   , allNullaryToStringTag  = Aeson.allNullaryToStringTag  opts
   , unwrapUnaryRecords     = Aeson.unwrapUnaryRecords     opts
   , sumEncoding            = Aeson.sumEncoding            opts
+  , tagSingleConstructors  = Aeson.tagSingleConstructors  opts
   }
diff --git a/test/Data/OpenApi/CommonTestTypes.hs b/test/Data/OpenApi/CommonTestTypes.hs
index 65480041..970a716b 100644
--- a/test/Data/OpenApi/CommonTestTypes.hs
+++ b/test/Data/OpenApi/CommonTestTypes.hs
@@ -7,7 +7,9 @@ module Data.OpenApi.CommonTestTypes where
 import           Prelude               ()
 import           Prelude.Compat
 
-import           Data.Aeson            (ToJSON (..), ToJSONKey (..), Value)
+import           Data.Aeson            (FromJSON(..), ToJSON (..), ToJSONKey (..), Value)
+import qualified Data.Aeson            as Aeson
+import qualified Data.Aeson.Types      as Aeson
 import           Data.Aeson.QQ.Simple
 import           Data.Aeson.Types      (toJSONKeyText)
 import           Data.Char
@@ -28,14 +30,49 @@ data Unit = Unit deriving (Generic)
 instance ToParamSchema Unit
 instance ToSchema Unit
 
-unitSchemaJSON :: Value
-unitSchemaJSON = [aesonQQ|
+unitParamSchemaJSON :: Value
+unitParamSchemaJSON = [aesonQQ|
 {
   "type": "string",
   "enum": ["Unit"]
 }
 |]
 
+unitSchemaJSON :: Value
+unitSchemaJSON = [aesonQQ|
+{
+  "type": "array",
+  "items": {},
+  "maxItems": 0,
+  "example": []
+}
+|]
+
+data UnitTagged = UnitTagged
+  deriving (Generic)
+
+instance ToSchema UnitTagged where
+  declareNamedSchema = genericDeclareNamedSchema
+    defaultSchemaOptions{Data.OpenApi.tagSingleConstructors = True}
+
+instance FromJSON UnitTagged where
+  parseJSON = Aeson.genericParseJSON Aeson.defaultOptions{Aeson.tagSingleConstructors = True}
+
+instance ToJSON UnitTagged where
+  toJSON = Aeson.genericToJSON Aeson.defaultOptions{Aeson.tagSingleConstructors = True}
+
+unitTaggedSchemaJSON :: Value
+unitTaggedSchemaJSON = [aesonQQ|
+{
+  "enum":
+    [
+      "UnitTagged"
+    ],
+   "type": "string"
+}
+|]
+
+
 -- ========================================================================
 -- Color (enum)
 -- ========================================================================
@@ -278,7 +315,7 @@ instance ToSchema Character
 characterSchemaJSON :: Value
 characterSchemaJSON = [aesonQQ|
 {
-  "oneOf": [
+  "anyOf": [
     {
       "required": [
         "tag",
@@ -329,7 +366,7 @@ characterSchemaJSON = [aesonQQ|
 characterInlinedSchemaJSON :: Value
 characterInlinedSchemaJSON = [aesonQQ|
 {
-  "oneOf": [
+  "anyOf": [
     {
       "required": [
         "tag",
@@ -415,7 +452,7 @@ characterInlinedSchemaJSON = [aesonQQ|
 characterInlinedPlayerSchemaJSON :: Value
 characterInlinedPlayerSchemaJSON = [aesonQQ|
 {
-  "oneOf": [
+  "anyOf": [
     {
       "required": [
         "tag",
@@ -644,7 +681,7 @@ instance ToSchema Light where
 lightSchemaJSON :: Value
 lightSchemaJSON = [aesonQQ|
 {
-  "oneOf": [
+  "anyOf": [
     {
       "required": [
         "tag"
@@ -726,7 +763,7 @@ lightSchemaJSON = [aesonQQ|
 lightInlinedSchemaJSON :: Value
 lightInlinedSchemaJSON = [aesonQQ|
 {
-  "oneOf": [
+  "anyOf": [
     {
       "required": [
         "tag"
@@ -935,7 +972,7 @@ predicateSchemaDeclareJSON = [aesonQQ|
 [
   {
     "Predicate": {
-      "oneOf": [
+      "anyOf": [
         {
           "properties": {
             "contents": { "$ref": "#/components/schemas/Noun" },
@@ -976,7 +1013,7 @@ predicateSchemaDeclareJSON = [aesonQQ|
       "type": "object"
     },
     "Modifier": {
-      "oneOf": [
+      "anyOf": [
         {
           "properties": {
             "contents": { "$ref": "#/components/schemas/Noun" },
diff --git a/test/Data/OpenApi/ParamSchemaSpec.hs b/test/Data/OpenApi/ParamSchemaSpec.hs
index 38a6007b..5b52ffee 100644
--- a/test/Data/OpenApi/ParamSchemaSpec.hs
+++ b/test/Data/OpenApi/ParamSchemaSpec.hs
@@ -27,7 +27,7 @@ checkToParamSchema proxy js = (toParamSchema proxy :: Schema) <=> js
 spec :: Spec
 spec = do
   describe "Generic ToParamSchema" $ do
-    context "Unit" $ checkToParamSchema (Proxy :: Proxy Unit) unitSchemaJSON
+    context "Unit" $ checkToParamSchema (Proxy :: Proxy Unit) unitParamSchemaJSON
     context "Color (bounded enum)" $ checkToParamSchema (Proxy :: Proxy Color) colorSchemaJSON
     context "Status (constructorTagModifier)" $ checkToParamSchema (Proxy :: Proxy Status) statusSchemaJSON
     context "Unary records" $ do
diff --git a/test/Data/OpenApi/Schema/GeneratorSpec.hs b/test/Data/OpenApi/Schema/GeneratorSpec.hs
index 7b3891cb..8da8b758 100644
--- a/test/Data/OpenApi/Schema/GeneratorSpec.hs
+++ b/test/Data/OpenApi/Schema/GeneratorSpec.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE DeriveGeneric     #-}
 {-# LANGUAGE OverloadedLists   #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE PackageImports    #-}
@@ -90,6 +91,8 @@ spec = do
     prop "MissingRequired" $ shouldNotValidate (Proxy :: Proxy MissingRequired)
     prop "MissingProperty" $ shouldNotValidate (Proxy :: Proxy MissingProperty)
     prop "WrongPropType" $ shouldNotValidate (Proxy :: Proxy WrongPropType)
+    prop "SingleUnary" $ shouldValidate (Proxy :: Proxy (SingleUnary Int))
+    prop "SingleUnaryTagged" $ shouldValidate (Proxy :: Proxy (SingleUnaryTagged Int))
 
 -- =============================
 -- Data types and bunk instances
@@ -166,3 +169,22 @@ instance ToSchema WrongPropType where
         & type_ ?~ OpenApiObject
         & properties .~ [("propE", boolSchema)]
         & required .~ ["propE"]
+
+data SingleUnary a = SingleUnary a
+  deriving (Show, Generic)
+
+instance (FromJSON a) => FromJSON (SingleUnary a)
+instance (ToSchema a) => ToSchema (SingleUnary a)
+
+data SingleUnaryTagged a = SingleUnaryTagged a
+  deriving (Show, Generic)
+
+instance (FromJSON a) => FromJSON (SingleUnaryTagged a) where
+  parseJSON = genericParseJSON
+    defaultOptions{Data.Aeson.tagSingleConstructors = True}
+instance (ToJSON a) => ToJSON (SingleUnaryTagged a) where
+  toJSON = genericToJSON
+    defaultOptions{Data.Aeson.tagSingleConstructors = True}
+instance (ToSchema a) => ToSchema (SingleUnaryTagged a) where
+  declareNamedSchema = genericDeclareNamedSchema
+    defaultSchemaOptions{Data.OpenApi.tagSingleConstructors = True}
diff --git a/test/Data/OpenApi/SchemaSpec.hs b/test/Data/OpenApi/SchemaSpec.hs
index 0a3f96e7..a3a48d9a 100644
--- a/test/Data/OpenApi/SchemaSpec.hs
+++ b/test/Data/OpenApi/SchemaSpec.hs
@@ -66,6 +66,7 @@ spec :: Spec
 spec = do
   describe "Generic ToSchema" $ do
     context "Unit" $ checkToSchema (Proxy :: Proxy Unit) unitSchemaJSON
+    context "UnitTagged" $ checkToSchema (Proxy :: Proxy UnitTagged) unitTaggedSchemaJSON
     context "Person" $ checkToSchema (Proxy :: Proxy Person) personSchemaJSON
     context "ISPair" $ checkToSchema (Proxy :: Proxy ISPair) ispairSchemaJSON
     context "Point (fieldLabelModifier)" $ checkToSchema (Proxy :: Proxy Point) pointSchemaJSON
diff --git a/test/SpecCommon.hs b/test/SpecCommon.hs
index 11828fb8..0dd407aa 100644
--- a/test/SpecCommon.hs
+++ b/test/SpecCommon.hs
@@ -4,16 +4,19 @@ import Data.Aeson
 import Data.ByteString.Builder (toLazyByteString)
 import qualified Data.Foldable as F
 import qualified Data.HashMap.Strict as HashMap
+import Data.Typeable
 import qualified Data.Vector as Vector
 
+import Data.OpenApi.Internal.Utils
 import Test.Hspec
 
 (<=>) :: (Eq a, Show a, ToJSON a, FromJSON a, HasCallStack) => a -> Value -> Spec
 x <=> js = do
   it "encodes correctly" $ do
-    toJSON x `shouldBe` js
-  it "decodes correctly" $ do
-    fromJSON js `shouldBe` Success x
+    encodePretty x `shouldBe` encodePretty js
+  it "decodes correctly" $ case fromJSON js of
+    Success expected -> encodePretty x `shouldBe` encodePretty (expected `asTypeOf` x)
+    Error err -> expectationFailure err
   it "roundtrips: eitherDecode . encode" $ do
     eitherDecode (encode x) `shouldBe` Right x
   it "roundtrips with toJSON" $ do

From 2a857655e5180632de105699a850268eac847aed Mon Sep 17 00:00:00 2001
From: Uladzimir Stsepchanka <st.uladzimir@protonmail.com>
Date: Tue, 2 Jan 2024 09:04:52 +0300
Subject: [PATCH 5/9] Validate anyOf

---
 src/Data/OpenApi/Internal/Schema.hs            |  5 ++++-
 src/Data/OpenApi/Internal/Schema/Validation.hs | 14 +++++++++-----
 2 files changed, 13 insertions(+), 6 deletions(-)

diff --git a/src/Data/OpenApi/Internal/Schema.hs b/src/Data/OpenApi/Internal/Schema.hs
index c7380ace..e7d2f873 100644
--- a/src/Data/OpenApi/Internal/Schema.hs
+++ b/src/Data/OpenApi/Internal/Schema.hs
@@ -970,7 +970,10 @@ gsumSchema opts proxy
         schemas <- gsumToSchema opts proxy
         case schemas of
           [Inline single] -> pure $ unnamed single
-          _ -> pure $ unnamed $ mempty & oneOf ?~ schemas
+          -- We use laxer 'anyOf' property instead of 'oneOf'.
+          -- The latter does not work for, e.g. @data Foo = Foo | NotFoo String@
+          -- with sumEncoding=UntaggedValue, as both branches match.
+          _ -> pure $ unnamed $ mempty & anyOf ?~ schemas
 
 instance (GProductSchemas (f :*: g)) => GToSchema (C1 c (f :*: g)) where
   gdeclareNamedSchema opts _ = gdeclareNamedSchema opts $ Proxy @(f :*: g)
diff --git a/src/Data/OpenApi/Internal/Schema/Validation.hs b/src/Data/OpenApi/Internal/Schema/Validation.hs
index 5554ccf8..e5c77989 100644
--- a/src/Data/OpenApi/Internal/Schema/Validation.hs
+++ b/src/Data/OpenApi/Internal/Schema/Validation.hs
@@ -28,8 +28,8 @@ import           Prelude                             ()
 import           Prelude.Compat
 
 import           Control.Applicative
-import           Control.Lens                        hiding (allOf)
-import           Control.Monad                       (forM, forM_, when)
+import           Control.Lens                        hiding (allOf, anyOf)
+import           Control.Monad                       (foldM, forM, forM_, when)
 
 import           Data.Aeson                          hiding (Result)
 #if MIN_VERSION_aeson(2,0,0)
@@ -481,15 +481,19 @@ inferParamSchemaTypes sch = concat
   ]
 
 validateSchemaType :: Value -> Validation Schema ()
-validateSchemaType val = withSchema $ \sch ->
+validateSchemaType val = withSchema $ \sch -> do
+  let validateSub var = (True <$ validateWithSchemaRef var val) <|> (return False)
   case sch of
     (view oneOf -> Just variants) -> do
-      res <- forM variants $ \var ->
-        (True <$ validateWithSchemaRef var val) <|> (return False)
+      res <- forM variants validateSub
       case length $ filter id res of
         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
+      res <- foldM (\res var -> if res then pure res else validateSub var) False variants
+      if res then valid else
+        invalid $ "Value does not match 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.

From aa651db81541b91cb697a38629ef2e108d440104 Mon Sep 17 00:00:00 2001
From: Uladzimir Stsepchanka <st.uladzimir@protonmail.com>
Date: Tue, 2 Jan 2024 07:17:50 +0300
Subject: [PATCH 6/9] TwoElemArray

---
 src/Data/OpenApi/Internal/Schema.hs | 15 ++++++++++-----
 test/GenericsSpec.hs                |  2 +-
 2 files changed, 11 insertions(+), 6 deletions(-)

diff --git a/src/Data/OpenApi/Internal/Schema.hs b/src/Data/OpenApi/Internal/Schema.hs
index e7d2f873..83da75a7 100644
--- a/src/Data/OpenApi/Internal/Schema.hs
+++ b/src/Data/OpenApi/Internal/Schema.hs
@@ -1109,13 +1109,13 @@ gsumConToSchemaWith ref opts _ = case schema of
           -- to the record, as Aeson does it.
           Just (Inline sub) | sub ^. type_ == Just OpenApiObject && isRecord -> Inline $ sub
             & required <>~ [T.pack tagField]
-            & properties . at (T.pack tagField) ?~ Inline (mempty & type_ ?~ OpenApiString & enum_ ?~ [String tag])
+            & properties . at (T.pack tagField) ?~ tagString
 
           -- If it is not a record, we need to put subschema into "contents" field.
           _ | not isRecord -> Inline $ mempty
             & type_ ?~ OpenApiObject
             & required .~ [T.pack tagField]
-            & properties . at (T.pack tagField) ?~ Inline (mempty & type_ ?~ OpenApiString & enum_ ?~ [String tag])
+            & properties . at (T.pack tagField) ?~ tagString
               -- If constructor is nullary, there is no content.
             & case ref of
                 Just r -> (properties . at (T.pack contentsField) ?~ r) . (required <>~ [T.pack contentsField])
@@ -1126,7 +1126,7 @@ gsumConToSchemaWith ref opts _ = case schema of
             & allOf ?~ [Inline $ mempty
               & type_ ?~ OpenApiObject
               & required .~ (T.pack tagField : if isRecord then [] else [T.pack contentsField])
-              & properties . at (T.pack tagField) ?~ Inline (mempty & type_ ?~ OpenApiString & enum_ ?~ [String tag])]
+              & properties . at (T.pack tagField) ?~ tagString]
             & if isRecord
                  then allOf . _Just <>~ [refOrNullary]
                  else allOf . _Just <>~ [Inline $ mempty & type_ ?~ OpenApiObject & properties . at (T.pack contentsField) ?~ refOrNullary]
@@ -1135,13 +1135,18 @@ gsumConToSchemaWith ref opts _ = case schema of
         & type_ ?~ OpenApiObject
         & required .~ [tag]
         & properties . at tag ?~ refOrNullary
-      TwoElemArray -> error "unrepresentable in OpenAPI 3"
+      TwoElemArray -> Inline $ mempty
+        & type_ ?~ OpenApiArray
+        & items ?~ OpenApiItemsArray [tagString, fromMaybe (Inline nullarySchema) ref]
+        & minItems ?~ 2
+        & maxItems ?~ 2
 
     constructorName = conName (Proxy3 :: Proxy3 c f p)
     tag = T.pack (constructorTagModifier opts constructorName)
+    tagString = Inline $ mempty & type_ ?~ OpenApiString & enum_ ?~ [String tag]
     isRecord = conIsRecord (Proxy3 :: Proxy3 c f p)
     refOrNullary = fromMaybe (Inline nullarySchema) ref
-    refOrEnum = fromMaybe (Inline $ mempty & type_ ?~ OpenApiString & enum_ ?~ [String tag]) ref
+    refOrEnum = fromMaybe tagString ref
 
 class GSumToSchema (f :: Type -> Type) where
   gsumToSchema :: SchemaOptions -> Proxy f -> Declare (Definitions Schema) [Referenced Schema]
diff --git a/test/GenericsSpec.hs b/test/GenericsSpec.hs
index 852b71b4..010a2363 100644
--- a/test/GenericsSpec.hs
+++ b/test/GenericsSpec.hs
@@ -80,7 +80,7 @@ allOptsCombinations = do
     [ Aeson.defaultTaggedObject
     , Aeson.UntaggedValue
     , Aeson.ObjectWithSingleField
-    -- , Aeson.TwoElemArray FIXME
+    , Aeson.TwoElemArray
     ]
   unwrapUnaryRecords <- [True, False]
   tagSingleConstructors <- [True, False]

From ad823dc2655ed10e750738022f14fb0393597519 Mon Sep 17 00:00:00 2001
From: Uladzimir Stsepchanka <st.uladzimir@protonmail.com>
Date: Tue, 2 Jan 2024 10:44:51 +0300
Subject: [PATCH 7/9] Some redundant constraints

---
 src/Data/OpenApi/Internal/Schema.hs | 17 ++++++++---------
 1 file changed, 8 insertions(+), 9 deletions(-)

diff --git a/src/Data/OpenApi/Internal/Schema.hs b/src/Data/OpenApi/Internal/Schema.hs
index 83da75a7..04f8dc94 100644
--- a/src/Data/OpenApi/Internal/Schema.hs
+++ b/src/Data/OpenApi/Internal/Schema.hs
@@ -16,7 +16,6 @@
 {-# LANGUAGE TypeOperators #-}
 {-# LANGUAGE TypeSynonymInstances #-}
 {-# LANGUAGE UndecidableInstances #-}
-{-# OPTIONS_GHC -Wno-redundant-constraints #-}
 -- For TypeErrors
 {-# OPTIONS_GHC -Wno-unticked-promoted-constructors #-}
 module Data.OpenApi.Internal.Schema where
@@ -151,7 +150,7 @@ class Typeable a => ToSchema a where
   -- Note that the schema itself is included in definitions
   -- only if it is recursive (and thus needs its definition in scope).
   declareNamedSchema :: Proxy a -> Declare (Definitions Schema) NamedSchema
-  default declareNamedSchema :: (Generic a, GToSchema (Rep a)) =>
+  default declareNamedSchema :: (GToSchema (Rep a)) =>
     Proxy a -> Declare (Definitions Schema) NamedSchema
   declareNamedSchema = genericDeclareNamedSchema defaultSchemaOptions
 
@@ -772,14 +771,14 @@ toSchemaBoundedIntegral _ = mempty
 -- | Default generic named schema for @'Bounded'@, @'Integral'@ types.
 genericToNamedSchemaBoundedIntegral :: forall a d f.
   ( Bounded a, Integral a
-  , Generic a, Rep a ~ D1 d f, Datatype d)
+  , Rep a ~ D1 d f, Datatype d)
   => SchemaOptions -> Proxy a -> NamedSchema
 genericToNamedSchemaBoundedIntegral opts proxy
   = genericNameSchema opts proxy (toSchemaBoundedIntegral proxy)
 
 -- | Declare a named schema for a @newtype@ wrapper.
 genericDeclareNamedSchemaNewtype :: forall a d c s i inner.
-  (Generic a, Datatype d, Rep a ~ D1 d (C1 c (S1 s (K1 i inner))))
+  (Datatype d, Rep a ~ D1 d (C1 c (S1 s (K1 i inner))))
   => SchemaOptions                                          -- ^ How to derive the name.
   -> (Proxy inner -> Declare (Definitions Schema) Schema)   -- ^ How to create a schema for the wrapped type.
   -> Proxy a
@@ -871,7 +870,7 @@ toSchemaBoundedEnumKeyMapping :: forall map key value.
 toSchemaBoundedEnumKeyMapping = flip evalDeclare mempty . declareSchemaBoundedEnumKeyMapping
 
 -- | A configurable generic @'Schema'@ creator.
-genericDeclareSchema :: (Generic a, GToSchema (Rep a), Typeable a) =>
+genericDeclareSchema :: (GToSchema (Rep a), Typeable a) =>
   SchemaOptions -> Proxy a -> Declare (Definitions Schema) Schema
 genericDeclareSchema opts proxy = _namedSchemaSchema <$> genericDeclareNamedSchema opts proxy
 
@@ -887,7 +886,7 @@ genericDeclareSchema opts proxy = _namedSchemaSchema <$> genericDeclareNamedSche
 --
 -- >>> _namedSchemaName $ undeclare $ genericDeclareNamedSchema defaultSchemaOptions (Proxy :: Proxy (Either Int Bool))
 -- Just "Either_Int_Bool"
-genericDeclareNamedSchema :: forall a. (Generic a, GToSchema (Rep a), Typeable a) =>
+genericDeclareNamedSchema :: forall a. (GToSchema (Rep a), Typeable a) =>
   SchemaOptions -> Proxy a -> Declare (Definitions Schema) NamedSchema
 genericDeclareNamedSchema opts _ =
   rename (Just $ T.pack name) <$> gdeclareNamedSchema opts (Proxy :: Proxy (Rep a))
@@ -900,7 +899,7 @@ genericDeclareNamedSchema opts _ =
 
 -- | Derive a 'Generic'-based name for a datatype and assign it to a given 'Schema'.
 genericNameSchema :: forall a d f.
-  (Generic a, Rep a ~ D1 d f, Datatype d)
+  (Rep a ~ D1 d f, Datatype d)
   => SchemaOptions -> Proxy a -> Schema -> NamedSchema
 genericNameSchema opts _ = NamedSchema (gdatatypeSchemaName opts (Proxy :: Proxy d))
 
@@ -913,7 +912,7 @@ gdatatypeSchemaName opts _ = case orig of
     name = datatypeNameModifier opts orig
 
 -- | Construct 'NamedSchema' usinng 'ToParamSchema'.
-paramSchemaToNamedSchema :: (ToParamSchema a, Generic a, Rep a ~ D1 d f, Datatype d) =>
+paramSchemaToNamedSchema :: (ToParamSchema a, Rep a ~ D1 d f, Datatype d) =>
   SchemaOptions -> Proxy a -> NamedSchema
 paramSchemaToNamedSchema opts proxy = genericNameSchema opts proxy (paramSchemaToSchema proxy)
 
@@ -942,7 +941,7 @@ gdeclareSchema opts proxy = _namedSchemaSchema <$> gdeclareNamedSchema opts prox
 ---------------------------
 
 -- | Single constructor datatype.
-instance (AllNullaryConstructors (C1 c f), GSumToSchema (C1 c f), GToSchema f, GToSchema (C1 c f))
+instance (AllNullaryConstructors (C1 c f), GSumToSchema (C1 c f), GToSchema (C1 c f))
   => GToSchema (D1 d (C1 c f)) where
   gdeclareNamedSchema opts _
     | tagSingleConstructors opts = gsumSchema opts $ Proxy @(C1 c f)

From 5a175c54e411b48b01f15370fd841500112f68d4 Mon Sep 17 00:00:00 2001
From: Uladzimir Stsepchanka <st.uladzimir@protonmail.com>
Date: Tue, 2 Jan 2024 11:54:20 +0300
Subject: [PATCH 8/9] 'rejectUnknownFields'

---
 src/Data/OpenApi/Internal/Schema.hs           | 12 ++++
 .../OpenApi/Internal/Schema/Validation.hs     | 13 +---
 src/Data/OpenApi/SchemaOptions.hs             |  5 +-
 test/Data/OpenApi/CommonTestTypes.hs          | 66 +++++++++++++++++++
 test/Data/OpenApi/Schema/ValidationSpec.hs    | 31 +++++++--
 test/Data/OpenApi/SchemaSpec.hs               |  4 ++
 6 files changed, 115 insertions(+), 16 deletions(-)

diff --git a/src/Data/OpenApi/Internal/Schema.hs b/src/Data/OpenApi/Internal/Schema.hs
index 04f8dc94..7de909c6 100644
--- a/src/Data/OpenApi/Internal/Schema.hs
+++ b/src/Data/OpenApi/Internal/Schema.hs
@@ -1041,6 +1041,7 @@ gproductSchema opts proxy = do
       & minItems ?~ sz
     _ -> mempty
       & type_ ?~ OpenApiObject
+      & additionalProperties .~ noAdditionalProperties opts
       & properties .~ foldl' (flip insProp) mempty recordFields
       & required .~ requiredProps
 
@@ -1113,6 +1114,7 @@ gsumConToSchemaWith ref opts _ = case schema of
           -- If it is not a record, we need to put subschema into "contents" field.
           _ | not isRecord -> Inline $ mempty
             & type_ ?~ OpenApiObject
+            & additionalProperties .~ noAdditionalProperties opts
             & required .~ [T.pack tagField]
             & properties . at (T.pack tagField) ?~ tagString
               -- If constructor is nullary, there is no content.
@@ -1124,6 +1126,7 @@ gsumConToSchemaWith ref opts _ = case schema of
           _ -> Inline $ mempty
             & allOf ?~ [Inline $ mempty
               & type_ ?~ OpenApiObject
+              & additionalProperties .~ noAdditionalProperties opts
               & required .~ (T.pack tagField : if isRecord then [] else [T.pack contentsField])
               & properties . at (T.pack tagField) ?~ tagString]
             & if isRecord
@@ -1132,6 +1135,8 @@ gsumConToSchemaWith ref opts _ = case schema of
       UntaggedValue -> refOrEnum -- Aeson encodes nullary constructors as strings in this case.
       ObjectWithSingleField -> Inline $ mempty
         & type_ ?~ OpenApiObject
+        -- This is how "aeson" behaves
+        & additionalProperties ?~ AdditionalPropertiesAllowed False
         & required .~ [tag]
         & properties . at tag ?~ refOrNullary
       TwoElemArray -> Inline $ mempty
@@ -1192,6 +1197,13 @@ instance {-# OVERLAPPABLE #-} AllNullaryConstructors (C1 c f) where
 instance {-# OVERLAPPING #-} (Constructor c) => AllNullaryConstructors (C1 c U1) where
   nullaryConstructorsNames _ = Just [conName $ Proxy3 @c @_ @_]
 
+noAdditionalProperties :: SchemaOptions -> Maybe AdditionalProperties
+noAdditionalProperties opts = do
+  -- Missing 'additionalProperties' serve as set to 'true',
+  -- so we set this only when 'rejectUnknownFields' is 'false'.
+  guard $ rejectUnknownFields opts
+  Just $ AdditionalPropertiesAllowed False
+
 {- $setup
 >>> import Data.OpenApi
 >>> import Data.Aeson (encode)
diff --git a/src/Data/OpenApi/Internal/Schema/Validation.hs b/src/Data/OpenApi/Internal/Schema/Validation.hs
index e5c77989..9f8f3681 100644
--- a/src/Data/OpenApi/Internal/Schema/Validation.hs
+++ b/src/Data/OpenApi/Internal/Schema/Validation.hs
@@ -412,21 +412,14 @@ validateObject o = withSchema $ \sch ->
 
     validateProps = withSchema $ \sch -> do
       for_ (objectToList o) $ \(keyToText -> k, v) ->
-        case v of
-          Null | not (k `elem` (sch ^. required)) -> valid  -- null is fine for non-required property
-          _ ->
-            case InsOrdHashMap.lookup k (sch ^. properties) of
-              Nothing -> checkMissing (unknownProperty k) additionalProperties $ validateAdditional k v
-              Just s  -> validateWithSchemaRef s v
+        case InsOrdHashMap.lookup k (sch ^. properties) of
+          Nothing -> checkMissing valid additionalProperties $ validateAdditional k v
+          Just s  -> validateWithSchemaRef s v
 
     validateAdditional _ _ (AdditionalPropertiesAllowed True) = valid
     validateAdditional k _ (AdditionalPropertiesAllowed False) = invalid $ "additionalProperties=false but extra property " <> show k <> " found"
     validateAdditional _ v (AdditionalPropertiesSchema s) = validateWithSchemaRef s v
 
-    unknownProperty :: Text -> Validation s a
-    unknownProperty pname = invalid $
-      "property " <> show pname <> " is found in JSON value, but it is not mentioned in Swagger schema"
-
 validateEnum :: Value -> Validation Schema ()
 validateEnum val = do
   check enum_ $ \xs ->
diff --git a/src/Data/OpenApi/SchemaOptions.hs b/src/Data/OpenApi/SchemaOptions.hs
index fa469c18..381c5325 100644
--- a/src/Data/OpenApi/SchemaOptions.hs
+++ b/src/Data/OpenApi/SchemaOptions.hs
@@ -27,6 +27,7 @@ data SchemaOptions = SchemaOptions
     -- | Encode types with a single constructor as sums,
     -- so that `allNullaryToStringTag` and `sumEncoding` apply.
   , tagSingleConstructors :: Bool
+  , rejectUnknownFields :: Bool
   }
 
 -- | Default encoding @'SchemaOptions'@.
@@ -54,11 +55,12 @@ defaultSchemaOptions = fromAesonOptions Aeson.defaultOptions
 -- * 'unwrapUnaryRecords'
 -- * 'sumEncoding'
 -- * 'tagSingleConstructors'
+-- * 'rejectUnknownFields'
 --
 -- Note that these fields have no effect on `SchemaOptions`:
 --
 -- * 'Aeson.omitNothingFields'
--- * 'Aeson.rejectUnknownFields'
+-- * 'Aeson.allowOmittedFields' (introduced in @aeson-2.2@)
 --
 -- The rest is defined as in 'defaultSchemaOptions'.
 --
@@ -73,4 +75,5 @@ fromAesonOptions opts = SchemaOptions
   , unwrapUnaryRecords     = Aeson.unwrapUnaryRecords     opts
   , sumEncoding            = Aeson.sumEncoding            opts
   , tagSingleConstructors  = Aeson.tagSingleConstructors  opts
+  , rejectUnknownFields    = Aeson.rejectUnknownFields    opts
   }
diff --git a/test/Data/OpenApi/CommonTestTypes.hs b/test/Data/OpenApi/CommonTestTypes.hs
index 970a716b..0e3178bb 100644
--- a/test/Data/OpenApi/CommonTestTypes.hs
+++ b/test/Data/OpenApi/CommonTestTypes.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE DeriveGeneric       #-}
+{-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE QuasiQuotes         #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 
@@ -1102,3 +1103,68 @@ unsignedIntsSchemaJSON = [aesonQQ|
   "required": ["uint32", "uint64"]
 }
 |]
+
+-- ========================================================================
+-- AdditionalProperties
+-- ========================================================================
+
+data AdditionalPropertiesYes = AdditionalPropertiesYes
+  { prop1 :: Bool
+  , prop2 :: Int
+  } deriving (Generic)
+instance ToSchema AdditionalPropertiesYes
+
+additionalPropYesSchema :: Value
+additionalPropYesSchema = [aesonQQ|
+{
+    "type": "object",
+    "properties": {
+        "prop1": {
+            "type": "boolean"
+        },
+        "prop2": {
+            "maximum": 9223372036854775807,
+            "minimum": -9223372036854775808,
+            "type": "integer"
+        }
+    },
+    "required": [
+        "prop1",
+        "prop2"
+    ]
+}
+|]
+
+data AdditionalPropertiesNo = AdditionalPropertiesNo
+  { prop1 :: Bool
+  , prop2 :: Int
+  } deriving (Generic)
+instance ToSchema AdditionalPropertiesNo where
+  declareNamedSchema = genericDeclareNamedSchema
+    defaultSchemaOptions{Data.OpenApi.rejectUnknownFields = True}
+
+additionalPropNoSchema :: Value
+additionalPropNoSchema = [aesonQQ|
+{
+    "type": "object",
+    "properties": {
+        "prop1": {
+            "type": "boolean"
+        },
+        "prop2": {
+            "maximum": 9223372036854775807,
+            "minimum": -9223372036854775808,
+            "type": "integer"
+        }
+    },
+    "required": [
+        "prop1",
+        "prop2"
+    ],
+    "additionalProperties": false
+}
+|]
+
+--------------------------
+--------------------------
+--------------------------
diff --git a/test/Data/OpenApi/Schema/ValidationSpec.hs b/test/Data/OpenApi/Schema/ValidationSpec.hs
index 981e6ced..f0818661 100644
--- a/test/Data/OpenApi/Schema/ValidationSpec.hs
+++ b/test/Data/OpenApi/Schema/ValidationSpec.hs
@@ -4,6 +4,7 @@
 {-# LANGUAGE QuasiQuotes         #-}
 {-# LANGUAGE RecordWildCards     #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 module Data.OpenApi.Schema.ValidationSpec where
 
@@ -40,6 +41,8 @@ import           Data.OpenApi
 import           Data.OpenApi.Declare
 import           Data.OpenApi.Aeson.Compat (stringToKey)
 
+import           Data.OpenApi.CommonTestTypes
+  (AdditionalPropertiesYes, AdditionalPropertiesNo)
 import           Test.Hspec
 import           Test.Hspec.QuickCheck
 import           Test.QuickCheck
@@ -49,11 +52,17 @@ shouldValidate :: (ToJSON a, ToSchema a) => Proxy a -> a -> Bool
 shouldValidate _ x = validateToJSON x == []
 
 shouldValidateValue :: (ToSchema a) => Proxy a -> Value -> Expectation
-shouldValidateValue px val = do
+shouldValidateValue px val = case validateValue px val of
+  [] -> pure ()
+  errors -> expectationFailure $ unlines errors
+
+shouldNotValidateValue :: (ToSchema a) => Proxy a -> Value -> [String] -> Expectation
+shouldNotValidateValue px val = shouldMatchList (validateValue px val)
+
+validateValue :: (ToSchema a) => Proxy a -> Value -> [String]
+validateValue px val =
   let (defs, sch) = runDeclare (declareSchema px) mempty
-  case validateJSON defs sch val of
-    [] -> pure ()
-    errors -> expectationFailure $ unlines errors
+  in validateJSON defs sch val
 
 shouldNotValidate :: forall a. ToSchema a => (a -> Value) -> a -> Bool
 shouldNotValidate f = not . null . validateJSON defs sch . f
@@ -123,7 +132,19 @@ spec = do
     prop "invalidColorToJSON"         $ shouldNotValidate invalidColorToJSON
     prop "invalidPaintToJSON"         $ shouldNotValidate invalidPaintToJSON
     prop "invalidLightToJSON"         $ shouldNotValidate invalidLightToJSON
-    prop "invalidButtonImagesToJSON"  $ shouldNotValidate invalidButtonImagesToJSON
+    describe "rejectUnknownFields" $ do
+      let val = [aesonQQ|
+        {
+          "prop1" : true,
+          "prop2" : 1,
+          "prop3" : null
+        }
+        |]
+      it "disabled" $
+        shouldValidateValue (Proxy @AdditionalPropertiesYes) val
+      it "enabled" $
+        shouldNotValidateValue (Proxy @AdditionalPropertiesNo) val
+          ["additionalProperties=false but extra property \"prop3\" found"]
 
 main :: IO ()
 main = hspec spec
diff --git a/test/Data/OpenApi/SchemaSpec.hs b/test/Data/OpenApi/SchemaSpec.hs
index a3a48d9a..7bb43f1f 100644
--- a/test/Data/OpenApi/SchemaSpec.hs
+++ b/test/Data/OpenApi/SchemaSpec.hs
@@ -1,6 +1,7 @@
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE QuasiQuotes #-}
 module Data.OpenApi.SchemaSpec where
 
@@ -115,6 +116,9 @@ spec = do
   describe "Bounded Enum key mapping" $ do
     context "ButtonImages" $ checkToSchema (Proxy :: Proxy ButtonImages) buttonImagesSchemaJSON
     context "TimeOfDay" $ checkToSchema (Proxy :: Proxy Data.Time.LocalTime.TimeOfDay) timeOfDaySchemaJSON
+  describe "rejectUnknownFields" $ do
+    describe "disabled" $ checkToSchema (Proxy @AdditionalPropertiesYes) additionalPropYesSchema
+    describe "enabled" $ checkToSchema (Proxy @AdditionalPropertiesNo) additionalPropNoSchema
 
 main :: IO ()
 main = hspec spec

From 19a25a12f35d83212f1d1b647f0ea355950b6027 Mon Sep 17 00:00:00 2001
From: Uladzimir Stsepchanka <st.uladzimir@protonmail.com>
Date: Sun, 4 Feb 2024 12:25:50 +0300
Subject: [PATCH 9/9] Oops

---
 src/Data/OpenApi/Internal/Schema.hs | 8 ++++----
 1 file changed, 4 insertions(+), 4 deletions(-)

diff --git a/src/Data/OpenApi/Internal/Schema.hs b/src/Data/OpenApi/Internal/Schema.hs
index 7de909c6..d968e7a6 100644
--- a/src/Data/OpenApi/Internal/Schema.hs
+++ b/src/Data/OpenApi/Internal/Schema.hs
@@ -1049,10 +1049,10 @@ type RecordField = (T.Text, Bool, Referenced Schema)
 
 class GProductSchemas f where
   -- | Collect fields names
-   gproductSchemas
-     :: SchemaOptions
-     -> Proxy f
-     -> Declare (Definitions Schema) ([RecordField], [Referenced Schema])
+  gproductSchemas
+    :: SchemaOptions
+    -> Proxy f
+    -> Declare (Definitions Schema) ([RecordField], [Referenced Schema])
 
 instance (GProductSchemas f, GProductSchemas g) => GProductSchemas (f :*: g) where
   gproductSchemas opts _ = do