From e0726239c87f8f98568043c0548974c10d232bfa Mon Sep 17 00:00:00 2001
From: Avery <thecommunistduck@hotmail.co.uk>
Date: Wed, 16 Mar 2022 11:56:37 +0100
Subject: [PATCH 1/8] tests pass

---
 src/Data/OpenApi.hs                     |   1 +
 src/Data/OpenApi/Internal.hs            | 170 ++++++++++++++++++++----
 src/Data/OpenApi/Internal/AesonUtils.hs |  32 ++++-
 test/Data/OpenApiSpec.hs                |  68 +++++++---
 4 files changed, 216 insertions(+), 55 deletions(-)

diff --git a/src/Data/OpenApi.hs b/src/Data/OpenApi.hs
index e8c8ea6e..b264f21a 100644
--- a/src/Data/OpenApi.hs
+++ b/src/Data/OpenApi.hs
@@ -119,6 +119,7 @@ module Data.OpenApi (
   -- ** Miscellaneous
   MimeList(..),
   URL(..),
+  SpecificationExtensions (..),
 ) where
 
 import Data.OpenApi.Lens
diff --git a/src/Data/OpenApi/Internal.hs b/src/Data/OpenApi/Internal.hs
index 5395ff25..49b99cbb 100644
--- a/src/Data/OpenApi/Internal.hs
+++ b/src/Data/OpenApi/Internal.hs
@@ -56,6 +56,7 @@ import Data.OpenApi.Internal.AesonUtils (AesonDefaultValue (..), HasSwaggerAeson
                                          sopSwaggerGenericToJSON, sopSwaggerGenericToJSONWithOpts)
 import Data.OpenApi.Internal.Utils
 import Generics.SOP.TH                  (deriveGeneric)
+import Data.Maybe (catMaybes)
 
 -- $setup
 -- >>> :seti -XDataKinds
@@ -99,6 +100,8 @@ data OpenApi = OpenApi
 
     -- | Additional external documentation.
   , _openApiExternalDocs :: Maybe ExternalDocs
+    -- | Specification Extensions
+  , _openApiExtensions :: SpecificationExtensions
   } deriving (Eq, Show, Generic, Data, Typeable)
 
 -- | The object provides metadata about the API.
@@ -124,6 +127,9 @@ data Info = Info
     -- | The version of the OpenAPI document (which is distinct from the
     -- OpenAPI Specification version or the API implementation version).
   , _infoVersion :: Text
+
+    -- | Specification Extensions
+  , _infoExtensions :: SpecificationExtensions
   } deriving (Eq, Show, Generic, Data, Typeable)
 
 -- | Contact information for the exposed API.
@@ -136,6 +142,9 @@ data Contact = Contact
 
     -- | The email address of the contact person/organization.
   , _contactEmail :: Maybe Text
+
+    -- | Specification Extensions
+  , _contactExtensions :: SpecificationExtensions
   } deriving (Eq, Show, Generic, Data, Typeable)
 
 -- | License information for the exposed API.
@@ -145,10 +154,13 @@ data License = License
 
     -- | A URL to the license used for the API.
   , _licenseUrl :: Maybe URL
+
+    -- | Specification Extensions
+  , _licenseExtensions :: SpecificationExtensions
   } deriving (Eq, Show, Generic, Data, Typeable)
 
 instance IsString License where
-  fromString s = License (fromString s) Nothing
+  fromString s = License (fromString s) Nothing mempty
 
 -- | An object representing a Server.
 data Server = Server
@@ -165,6 +177,8 @@ data Server = Server
     -- | A map between a variable name and its value.
     -- The value is used for substitution in the server's URL template.
   , _serverVariables :: InsOrdHashMap Text ServerVariable
+    -- | Specification Extensions
+  , _serverExtensions :: SpecificationExtensions
   } deriving (Eq, Show, Generic, Data, Typeable)
 
 data ServerVariable = ServerVariable
@@ -181,10 +195,13 @@ data ServerVariable = ServerVariable
     -- | An optional description for the server variable.
     -- [CommonMark syntax](https://spec.commonmark.org/) MAY be used for rich text representation.
   , _serverVariableDescription :: Maybe Text
+
+    -- | Specification Extensions
+  , _serverVariableExtensions :: SpecificationExtensions
   } deriving (Eq, Show, Generic, Data, Typeable)
 
 instance IsString Server where
-  fromString s = Server (fromString s) Nothing mempty
+  fromString s = Server (fromString s) Nothing mempty mempty
 
 -- | Holds a set of reusable objects for different aspects of the OAS.
 -- All objects defined within the components object will have no effect on the API
@@ -245,6 +262,9 @@ data PathItem = PathItem
     -- The list MUST NOT include duplicated parameters.
     -- A unique parameter is defined by a combination of a name and location.
   , _pathItemParameters :: [Referenced Param]
+
+    -- | Specification Extensions
+  , _pathItemExtensions :: SpecificationExtensions
   } deriving (Eq, Show, Generic, Data, Typeable)
 
 -- | Describes a single API operation on a path.
@@ -310,6 +330,9 @@ data Operation = Operation
     -- If an alternative server object is specified at the 'PathItem' Object or Root level,
     -- it will be overridden by this value.
   , _operationServers :: [Server]
+
+    -- | Specification Extensions
+  , _operationExtensions :: SpecificationExtensions
   } deriving (Eq, Show, Generic, Data, Typeable)
 
 -- This instance should be in @http-media@.
@@ -343,6 +366,9 @@ data RequestBody = RequestBody
     -- | Determines if the request body is required in the request.
     -- Defaults to 'False'.
   , _requestBodyRequired :: Maybe Bool
+
+    -- | Specification Extensions
+  , _requestBodyExtensions :: SpecificationExtensions
   } deriving (Eq, Show, Generic, Data, Typeable)
 
 -- | Each Media Type Object provides schema and examples for the media type identified by its key.
@@ -362,6 +388,8 @@ data MediaTypeObject = MediaTypeObject
     -- The encoding object SHALL only apply to 'RequestBody' objects when the media type
     -- is @multipart@ or @application/x-www-form-urlencoded@.
   , _mediaTypeObjectEncoding :: InsOrdHashMap Text Encoding
+    -- | Specification Extensions
+  , _mediaTypeObjectExtensions :: SpecificationExtensions
   } deriving (Eq, Show, Generic, Data, Typeable)
 
 -- | In order to support common ways of serializing simple parameters, a set of style values are defined.
@@ -425,6 +453,8 @@ data Encoding = Encoding
     -- The default value is @false@. This property SHALL be ignored if the request body media type
     -- is not @application/x-www-form-urlencoded@.
   , _encodingAllowReserved :: Maybe Bool
+    -- | Specification Extensions
+  , _encodingExtensions :: SpecificationExtensions
   } deriving (Eq, Show, Generic, Data, Typeable)
 
 newtype MimeList = MimeList { getMimeList :: [MediaType] }
@@ -535,6 +565,9 @@ data Example = Example
     -- in JSON or YAML documents. The '_exampleValue' field
     -- and '_exampleExternalValue' field are mutually exclusive.
   , _exampleExternalValue :: Maybe URL
+
+    -- | Specification Extensions
+  , _exampleExtensions :: SpecificationExtensions
   } deriving (Eq, Show, Generic, Typeable, Data)
 
 data ExpressionOrValue
@@ -571,6 +604,9 @@ data Link = Link
 
     -- | A server object to be used by the target operation.
   , _linkServer :: Maybe Server
+
+    -- | Specification Extensions
+  , _linkExtensions :: SpecificationExtensions
   } deriving (Eq, Show, Generic, Typeable, Data)
 
 -- | Items for @'OpenApiArray'@ schemas.
@@ -660,6 +696,8 @@ data Schema = Schema
   , _schemaUniqueItems :: Maybe Bool
   , _schemaEnum :: Maybe [Value]
   , _schemaMultipleOf :: Maybe Scientific
+    -- | Specification Extensions
+  , _schemaExtensions :: SpecificationExtensions
   } deriving (Eq, Show, Generic, Data, Typeable)
 
 -- | Regex pattern for @string@ type.
@@ -706,6 +744,8 @@ data Xml = Xml
     -- Default value is @False@.
     -- The definition takes effect only when defined alongside type being array (outside the items).
   , _xmlWrapped :: Maybe Bool
+    -- | Specification Extensions
+  , _xmlExtensions :: SpecificationExtensions
   } deriving (Eq, Show, Generic, Data, Typeable)
 
 -- | A container for the expected responses of an operation.
@@ -721,6 +761,8 @@ data Responses = Responses
     -- | Any HTTP status code can be used as the property name (one property per HTTP status code).
     -- Describes the expected response for those HTTP status codes.
   , _responsesResponses :: InsOrdHashMap HttpStatusCode (Referenced Response)
+    -- | Specification Extensions
+  , _responsesExtensions :: SpecificationExtensions
   } deriving (Eq, Show, Generic, Data, Typeable)
 
 type HttpStatusCode = Int
@@ -744,10 +786,12 @@ data Response = Response
     -- The key of the map is a short name for the link, following the naming
     -- constraints of the names for 'Component' Objects.
   , _responseLinks :: InsOrdHashMap Text (Referenced Link)
+    -- | Specification Extensions
+  , _responseExtensions :: SpecificationExtensions
   } deriving (Eq, Show, Generic, Data, Typeable)
 
 instance IsString Response where
-  fromString s = Response (fromString s) mempty mempty mempty
+  fromString s = Response (fromString s) mempty mempty mempty mempty
 
 -- | A map of possible out-of band callbacks related to the parent operation.
 -- Each value in the map is a 'PathItem' Object that describes a set of requests that
@@ -824,6 +868,8 @@ data OAuth2Flow p = OAuth2Flow
     -- A map between the scope name and a short description for it.
     -- The map MAY be empty.
   , _oAuth2Scopes :: InsOrdHashMap Text Text
+    -- | Specification Extensions
+  , _oAuth2Extensions :: SpecificationExtensions
   } deriving (Eq, Show, Generic, Data, Typeable)
 
 data OAuth2Flows = OAuth2Flows
@@ -838,6 +884,8 @@ data OAuth2Flows = OAuth2Flows
 
     -- | Configuration for the OAuth Authorization Code flow
   , _oAuth2FlowsAuthorizationCode :: Maybe (OAuth2Flow OAuth2AuthorizationCodeFlow)
+    -- | Specification Extensions
+  , _oAuth2FlowsExtensions :: SpecificationExtensions
   } deriving (Eq, Show, Generic, Data, Typeable)
 
 type BearerFormat = Text
@@ -895,6 +943,9 @@ data SecurityScheme = SecurityScheme
 
     -- | A short description for security scheme.
   , _securitySchemeDescription :: Maybe Text
+
+   -- | Specification Extensions
+  , _securitySchemeExtensions :: SpecificationExtensions
   } deriving (Eq, Show, Generic, Data, Typeable)
 
 newtype SecurityDefinitions
@@ -923,12 +974,15 @@ data Tag = Tag
 
     -- | Additional external documentation for this tag.
   , _tagExternalDocs :: Maybe ExternalDocs
-  } deriving (Eq, Ord, Show, Generic, Data, Typeable)
+
+    -- | Specification Extensions
+  , _tagExtensions :: SpecificationExtensions
+  } deriving (Eq, Show, Generic, Data, Typeable)
 
 instance Hashable Tag
 
 instance IsString Tag where
-  fromString s = Tag (fromString s) Nothing Nothing
+  fromString s = Tag (fromString s) Nothing Nothing mempty
 
 -- | Allows referencing an external resource for extended documentation.
 data ExternalDocs = ExternalDocs
@@ -938,7 +992,10 @@ data ExternalDocs = ExternalDocs
 
     -- | The URL for the target documentation.
   , _externalDocsUrl :: URL
-  } deriving (Eq, Ord, Show, Generic, Data, Typeable)
+
+    -- | Specification Extensions
+  , _externalDocsExtensions :: SpecificationExtensions
+  } deriving (Eq, Show, Generic, Data, Typeable)
 
 instance Hashable ExternalDocs
 
@@ -955,13 +1012,17 @@ data Referenced a
 instance IsString a => IsString (Referenced a) where
   fromString = Inline . fromString
 
-newtype URL = URL { getUrl :: Text } deriving (Eq, Ord, Show, Hashable, ToJSON, FromJSON, Data, Typeable)
+newtype URL = URL { getUrl :: Text } 
+  deriving (Eq, Ord, Show, Hashable, ToJSON, FromJSON, Data, Typeable, AesonDefaultValue)
 
 data AdditionalProperties
   = AdditionalPropertiesAllowed Bool
   | AdditionalPropertiesSchema (Referenced Schema)
   deriving (Eq, Show, Data, Typeable)
 
+newtype SpecificationExtensions = SpecificationExtensions {getSpecificationExtensions :: Definitions Value}
+  deriving (Eq, Show, Hashable, Data, Typeable, Semigroup, Monoid, SwaggerMonoid, AesonDefaultValue)
+
 -------------------------------------------------------------------------------
 -- Generic instances
 -------------------------------------------------------------------------------
@@ -984,6 +1045,13 @@ deriveGeneric ''OpenApi
 deriveGeneric ''Example
 deriveGeneric ''Encoding
 deriveGeneric ''Link
+deriveGeneric ''Info
+deriveGeneric ''Contact
+deriveGeneric ''License
+deriveGeneric ''ServerVariable
+deriveGeneric ''Tag
+deriveGeneric ''Xml
+deriveGeneric ''ExternalDocs
 
 -- =======================================================================
 -- Monoid instances
@@ -1085,6 +1153,7 @@ instance Semigroup OAuth2Flows where
     , _oAuth2FlowsPassword = _oAuth2FlowsPassword l <> _oAuth2FlowsPassword r
     , _oAuth2FlowsClientCredentials = _oAuth2FlowsClientCredentials l <> _oAuth2FlowsClientCredentials r
     , _oAuth2FlowsAuthorizationCode = _oAuth2FlowsAuthorizationCode l <> _oAuth2FlowsAuthorizationCode r
+    , _oAuth2FlowsExtensions = _oAuth2FlowsExtensions l <> _oAuth2FlowsExtensions r
     }
 
 instance Monoid OAuth2Flows where
@@ -1092,9 +1161,9 @@ instance Monoid OAuth2Flows where
   mappend = (<>)
 
 instance Semigroup SecurityScheme where
-  SecurityScheme (SecuritySchemeOAuth2 lFlows) lDesc
-    <> SecurityScheme (SecuritySchemeOAuth2 rFlows) rDesc =
-      SecurityScheme (SecuritySchemeOAuth2 $ lFlows <> rFlows) (swaggerMappend lDesc rDesc)
+  SecurityScheme (SecuritySchemeOAuth2 lFlows) lDesc lExt
+    <> SecurityScheme (SecuritySchemeOAuth2 rFlows) rDesc rExt =
+      SecurityScheme (SecuritySchemeOAuth2 $ lFlows <> rFlows) (swaggerMappend lDesc rDesc) (lExt <> rExt)
   l <> _ = l
 
 instance Semigroup SecurityDefinitions where
@@ -1316,7 +1385,7 @@ instance ToJSON SecurityScheme where
 
 instance ToJSON Schema where
   toJSON = sopSwaggerGenericToJSONWithOpts $
-      mkSwaggerAesonOptions "schema" & saoSubObject ?~ "items"
+      mkSwaggerAesonOptions "schema" & saoSubObject .~ ["items", "extensions"]
 
 instance ToJSON Header where
   toJSON = sopSwaggerGenericToJSON
@@ -1418,6 +1487,11 @@ instance ToJSON ExpressionOrValue where
 instance ToJSON Callback where
   toJSON (Callback ps) = toJSON ps
 
+instance ToJSON SpecificationExtensions where
+  toJSON = toJSON . addExtPrefix . getSpecificationExtensions
+    where
+      addExtPrefix = InsOrdHashMap.mapKeys ("x-" <>)
+
 -- =======================================================================
 -- Manual FromJSON instances
 -- =======================================================================
@@ -1490,11 +1564,24 @@ instance FromJSON Param where
   parseJSON = sopSwaggerGenericParseJSON
 
 instance FromJSON Responses where
-  parseJSON (Object o) = Responses
-    <$> o .:? "default"
-    <*> parseJSON (Object (deleteKey "default" o))
+  parseJSON (Object o) = Responses 
+    <$> o .:? "default" 
+    <*> parseJSON 
+      ( Object 
+        ( HashMap.filterWithKey (\k _ -> not $ isExt k) 
+          $ HashMap.delete "default" o 
+        ) 
+      ) 
+    <*> case HashMap.filterWithKey (\k _ -> isExt k) o of
+        exts
+          | HashMap.null exts -> pure (SpecificationExtensions mempty)
+          | otherwise -> parseJSON (Object exts)
+    
   parseJSON _ = empty
 
+isExt :: Text -> Bool
+isExt = Text.isPrefixOf "x-"
+
 instance FromJSON Example where
   parseJSON = sopSwaggerGenericParseJSON
 
@@ -1563,6 +1650,12 @@ instance FromJSON ExpressionOrValue where
 instance FromJSON Callback where
   parseJSON = fmap Callback . parseJSON
 
+instance FromJSON SpecificationExtensions where
+  parseJSON = withObject "SpecificationExtensions" extFieldsParser
+    where
+      extFieldsParser = pure . SpecificationExtensions . InsOrdHashMap.fromList . catMaybes . filterExtFields
+      filterExtFields = fmap (\(k, v) -> fmap (\k' -> (k', v)) $ Text.stripPrefix "x-" k) . HashMap.toList
+
 instance HasSwaggerAesonOptions Server where
   swaggerAesonOptions _ = mkSwaggerAesonOptions "server"
 instance HasSwaggerAesonOptions Components where
@@ -1570,37 +1663,58 @@ instance HasSwaggerAesonOptions Components where
 instance HasSwaggerAesonOptions Header where
   swaggerAesonOptions _ = mkSwaggerAesonOptions "header"
 instance AesonDefaultValue p => HasSwaggerAesonOptions (OAuth2Flow p) where
-  swaggerAesonOptions _ = mkSwaggerAesonOptions "oauth2" & saoSubObject ?~ "params"
+  swaggerAesonOptions _ = mkSwaggerAesonOptions "oauth2" & saoSubObject .~ ["params", "extensions"]
 instance HasSwaggerAesonOptions OAuth2Flows where
-  swaggerAesonOptions _ = mkSwaggerAesonOptions "oauth2Flows"
+  swaggerAesonOptions _ = mkSwaggerAesonOptions "oauth2Flows" & saoSubObject .~ ["extensions"]
 instance HasSwaggerAesonOptions Operation where
-  swaggerAesonOptions _ = mkSwaggerAesonOptions "operation"
+  swaggerAesonOptions _ = mkSwaggerAesonOptions "operation" & saoSubObject .~ ["extensions"]
 instance HasSwaggerAesonOptions Param where
   swaggerAesonOptions _ = mkSwaggerAesonOptions "param"
 instance HasSwaggerAesonOptions PathItem where
-  swaggerAesonOptions _ = mkSwaggerAesonOptions "pathItem"
+  swaggerAesonOptions _ = mkSwaggerAesonOptions "pathItem" & saoSubObject .~ ["extensions"]
 instance HasSwaggerAesonOptions Response where
-  swaggerAesonOptions _ = mkSwaggerAesonOptions "response"
+  swaggerAesonOptions _ = mkSwaggerAesonOptions "response" & saoSubObject .~ ["extensions"]
 instance HasSwaggerAesonOptions RequestBody where
-  swaggerAesonOptions _ = mkSwaggerAesonOptions "requestBody"
+  swaggerAesonOptions _ = mkSwaggerAesonOptions "requestBody" & saoSubObject .~ ["extensions"]
 instance HasSwaggerAesonOptions MediaTypeObject where
-  swaggerAesonOptions _ = mkSwaggerAesonOptions "mediaTypeObject"
+  swaggerAesonOptions _ = mkSwaggerAesonOptions "mediaTypeObject" & saoSubObject .~ ["extensions"]
 instance HasSwaggerAesonOptions Responses where
-  swaggerAesonOptions _ = mkSwaggerAesonOptions "responses" & saoSubObject ?~ "responses"
+  swaggerAesonOptions _ = mkSwaggerAesonOptions "responses" & saoSubObject .~ ["responses", "extensions"]
 instance HasSwaggerAesonOptions SecurityScheme where
-  swaggerAesonOptions _ = mkSwaggerAesonOptions "securityScheme" & saoSubObject ?~ "type"
+  swaggerAesonOptions _ = mkSwaggerAesonOptions "securityScheme" & saoSubObject .~ ["type", "extensions"]
 instance HasSwaggerAesonOptions Schema where
-  swaggerAesonOptions _ = mkSwaggerAesonOptions "schema" & saoSubObject ?~ "paramSchema"
+  swaggerAesonOptions _ = mkSwaggerAesonOptions "schema" & saoSubObject .~ ["paramSchema", "extensions"]
 instance HasSwaggerAesonOptions OpenApi where
-  swaggerAesonOptions _ = mkSwaggerAesonOptions "swagger" & saoAdditionalPairs .~ [("openapi", "3.0.0")]
+  swaggerAesonOptions _ = mkSwaggerAesonOptions "swagger" & saoAdditionalPairs .~ [("openapi", "3.0.0")] 
+    & saoSubObject .~ ["extensions"]
 instance HasSwaggerAesonOptions Example where
-  swaggerAesonOptions _ = mkSwaggerAesonOptions "example"
+  swaggerAesonOptions _ = mkSwaggerAesonOptions "example" & saoSubObject .~ ["extensions"]
 instance HasSwaggerAesonOptions Encoding where
-  swaggerAesonOptions _ = mkSwaggerAesonOptions "encoding"
+  swaggerAesonOptions _ = mkSwaggerAesonOptions "encoding" & saoSubObject .~ ["extensions"]
 
 instance HasSwaggerAesonOptions Link where
-  swaggerAesonOptions _ = mkSwaggerAesonOptions "link"
+  swaggerAesonOptions _ = mkSwaggerAesonOptions "link" & saoSubObject .~ ["extensions"]
+
+instance HasSwaggerAesonOptions Info where
+  swaggerAesonOptions _ = mkSwaggerAesonOptions "info" & saoSubObject .~ ["extensions"]
+
+instance HasSwaggerAesonOptions Contact where
+  swaggerAesonOptions _ = mkSwaggerAesonOptions "contact" & saoSubObject .~ ["extensions"]
+
+instance HasSwaggerAesonOptions License where
+  swaggerAesonOptions _ = mkSwaggerAesonOptions "license" & saoSubObject .~ ["extensions"]
+
+instance HasSwaggerAesonOptions ServerVariable where
+  swaggerAesonOptions _ = mkSwaggerAesonOptions "serverVariable" & saoSubObject .~ ["extensions"]
+
+instance HasSwaggerAesonOptions Tag where
+  swaggerAesonOptions _ = mkSwaggerAesonOptions "tag" & saoSubObject .~ ["extensions"]
+
+instance HasSwaggerAesonOptions Xml where
+  swaggerAesonOptions _ = mkSwaggerAesonOptions "xml" & saoSubObject .~ ["extensions"]
 
+instance HasSwaggerAesonOptions ExternalDocs where
+  swaggerAesonOptions _ = mkSwaggerAesonOptions "externalDocs" & saoSubObject .~ ["extensions"]
 instance AesonDefaultValue Server
 instance AesonDefaultValue Components
 instance AesonDefaultValue OAuth2ImplicitFlow
diff --git a/src/Data/OpenApi/Internal/AesonUtils.hs b/src/Data/OpenApi/Internal/AesonUtils.hs
index 3804ab32..91a27cf3 100644
--- a/src/Data/OpenApi/Internal/AesonUtils.hs
+++ b/src/Data/OpenApi/Internal/AesonUtils.hs
@@ -49,13 +49,13 @@ import Data.OpenApi.Aeson.Compat (keyToString, objectToList, stringToKey)
 data SwaggerAesonOptions = SwaggerAesonOptions
     { _saoPrefix          :: String
     , _saoAdditionalPairs :: [Pair]
-    , _saoSubObject       :: Maybe String
+    , _saoSubObject       :: [String]
     }
 
 mkSwaggerAesonOptions
     :: String  -- ^ prefix
     -> SwaggerAesonOptions
-mkSwaggerAesonOptions pfx = SwaggerAesonOptions pfx [] Nothing
+mkSwaggerAesonOptions pfx = SwaggerAesonOptions pfx [] []
 
 makeLenses ''SwaggerAesonOptions
 
@@ -154,7 +154,7 @@ sopSwaggerGenericToJSON'' (SwaggerAesonOptions prefix _ sub) = go
     go :: (All ToJSON ys, All Eq ys) => NP I ys -> NP FieldInfo ys -> NP Maybe ys -> [Pair]
     go  Nil Nil Nil = []
     go (I x :* xs) (FieldInfo name :* names) (def :* defs)
-        | Just name' == sub = case json of
+        | name' `elem` sub = case json of
               Object m -> objectToList m ++ rest
               Null     -> rest
               _        -> error $ "sopSwaggerGenericToJSON: subjson is not an object: " ++ show json
@@ -227,9 +227,9 @@ sopSwaggerGenericParseJSON'' (SwaggerAesonOptions prefix _ sub) obj = go
     go :: (All FromJSON ys, All Eq ys) => NP FieldInfo ys -> NP Maybe ys -> Parser (NP I ys)
     go  Nil Nil = pure Nil
     go (FieldInfo name :* names) (def :* defs)
-        | Just name' == sub =
+        | name' `elem` sub =
             -- Note: we might strip fields of outer structure.
-            cons <$> (withDef $ parseJSON $ Object obj) <*> rest
+            cons <$> withDef (parseJSON $ Object obj) <*> rest
         | otherwise = case def of
             Just def' -> cons <$> obj .:? stringToKey name' .!= def' <*> rest
             Nothing  ->  cons <$> obj .: stringToKey name' <*> rest
@@ -269,7 +269,7 @@ sopSwaggerGenericToEncoding x =
     opts  = swaggerAesonOptions proxy
 
 pairsToSeries :: [Pair] -> Series
-pairsToSeries = foldMap (\(k, v) -> (k .= v))
+pairsToSeries = foldMap (uncurry (.=))
 
 sopSwaggerGenericToEncoding'
     :: (All2 ToJSON '[xs], All2 Eq '[xs])
@@ -294,7 +294,7 @@ sopSwaggerGenericToEncoding'' (SwaggerAesonOptions prefix _ sub) = go
     go :: (All ToJSON ys, All Eq ys) => NP I ys -> NP FieldInfo ys -> NP Maybe ys -> Series
     go  Nil Nil Nil = mempty
     go (I x :* xs) (FieldInfo name :* names) (def :* defs)
-        | Just name' == sub = case toJSON x of
+        | name' `elem` sub = case toJSON x of
               Object m -> pairsToSeries (objectToList m) <> rest
               Null     -> rest
               _        -> error $ "sopSwaggerGenericToJSON: subjson is not an object: " ++ show (toJSON x)
@@ -311,3 +311,21 @@ sopSwaggerGenericToEncoding'' (SwaggerAesonOptions prefix _ sub) = go
     modifier = lowerFirstUppers . drop (length prefix)
     lowerFirstUppers s = map toLower x ++ y
       where (x, y) = span isUpper s
+
+sopSwaggerGenericToEncodingWithOpts
+    :: forall a xs.
+        ( HasDatatypeInfo a
+        , HasSwaggerAesonOptions a
+        , All2 ToJSON (Code a)
+        , All2 Eq (Code a)
+        , Code a ~ '[xs]
+        )
+    => SwaggerAesonOptions
+    -> a
+    -> Encoding
+sopSwaggerGenericToEncodingWithOpts opts x =
+    let ps = sopSwaggerGenericToEncoding' opts (from x) (datatypeInfo proxy) defs
+    in pairs (pairsToSeries (opts ^. saoAdditionalPairs) <> ps)
+  where
+    proxy = Proxy :: Proxy a
+    defs = hcpure (Proxy :: Proxy AesonDefaultValue) defaultValue
diff --git a/test/Data/OpenApiSpec.hs b/test/Data/OpenApiSpec.hs
index eb31d267..83e77d6a 100644
--- a/test/Data/OpenApiSpec.hs
+++ b/test/Data/OpenApiSpec.hs
@@ -18,6 +18,8 @@ import Data.Text (Text)
 import Data.OpenApi
 import SpecCommon
 import Test.Hspec hiding (example)
+import qualified Data.HashMap.Strict.InsOrd as InsOrdHM
+import Data.OpenApi
 
 spec :: Spec
 spec = do
@@ -65,6 +67,7 @@ infoExample = mempty
   & contact        ?~ contactExample
   & license        ?~ licenseExample
   & version        .~ "1.0.1"
+  & extensions     .~ mempty
 
 infoExampleJSON :: Value
 infoExampleJSON = [aesonQQ|
@@ -75,13 +78,16 @@ infoExampleJSON = [aesonQQ|
   "contact": {
     "name": "API Support",
     "url": "http://www.swagger.io/support",
-    "email": "support@swagger.io"
+    "email": "support@swagger.io",
+    "extensions": {}
   },
   "license": {
     "name": "Apache 2.0",
-    "url": "http://www.apache.org/licenses/LICENSE-2.0.html"
+    "url": "http://www.apache.org/licenses/LICENSE-2.0.html",
+    "extensions": {}
   },
-  "version": "1.0.1"
+  "version": "1.0.1",
+  "extensions": {}
 }
 |]
 
@@ -94,13 +100,15 @@ contactExample = mempty
   & name  ?~ "API Support"
   & url   ?~ URL "http://www.swagger.io/support"
   & email ?~ "support@swagger.io"
+  & extensions .~ mempty
 
 contactExampleJSON :: Value
 contactExampleJSON = [aesonQQ|
 {
   "name": "API Support",
   "url": "http://www.swagger.io/support",
-  "email": "support@swagger.io"
+  "email": "support@swagger.io",
+  "extensions": {}
 }
 |]
 
@@ -111,12 +119,14 @@ contactExampleJSON = [aesonQQ|
 licenseExample :: License
 licenseExample = "Apache 2.0"
   & url ?~ URL "http://www.apache.org/licenses/LICENSE-2.0.html"
+  & extensions .~ mempty
 
 licenseExampleJSON :: Value
 licenseExampleJSON = [aesonQQ|
 {
   "name": "Apache 2.0",
-  "url": "http://www.apache.org/licenses/LICENSE-2.0.html"
+  "url": "http://www.apache.org/licenses/LICENSE-2.0.html",
+  "extensions": {}
 }
 |]
 
@@ -148,6 +158,7 @@ operationExample = mempty
   & at 200 ?~ "Pet updated."
   & at 405 ?~ "Invalid input"
   & security .~ [SecurityRequirement [("petstore_auth", ["write:pets", "read:pets"])]]
+  & extensions .~ SpecificationExtensions (InsOrdHM.fromList [("ext1", toJSON True)])
 
 operationExampleJSON :: Value
 operationExampleJSON = [aesonQQ|
@@ -202,7 +213,8 @@ operationExampleJSON = [aesonQQ|
         "read:pets"
       ]
     }
-  ]
+  ],
+ "x-ext1": true
 }
 |]
 
@@ -234,6 +246,7 @@ schemaSimpleModelExample = mempty
             & minimum_ ?~ 0
             & type_    ?~ OpenApiInteger
             & format   ?~ "int32" ) ]
+  & extensions .~ SpecificationExtensions (InsOrdHM.fromList [("ext1", toJSON True)])
 
 schemaSimpleModelExampleJSON :: Value
 schemaSimpleModelExampleJSON = [aesonQQ|
@@ -251,7 +264,8 @@ schemaSimpleModelExampleJSON = [aesonQQ|
       "type": "integer"
     }
   },
-  "type": "object"
+  "type": "object",
+  "x-ext1": true
 }
 |]
 
@@ -452,15 +466,18 @@ securityDefinitionsExample :: SecurityDefinitions
 securityDefinitionsExample = SecurityDefinitions
   [ ("api_key", SecurityScheme
       { _securitySchemeType = SecuritySchemeApiKey (ApiKeyParams "api_key" ApiKeyHeader)
-      , _securitySchemeDescription = Nothing })
+      , _securitySchemeDescription = Nothing
+      , _securitySchemeExtensions = mempty })
   , ("petstore_auth", SecurityScheme
       { _securitySchemeType = SecuritySchemeOAuth2 (mempty & implicit ?~ OAuth2Flow
             { _oAuth2Params = OAuth2ImplicitFlow "http://swagger.io/api/oauth/dialog"
             , _oAath2RefreshUrl = Nothing
             , _oAuth2Scopes =
                 [ ("write:pets",  "modify pets in your account")
-                , ("read:pets", "read your pets") ] } )
-      , _securitySchemeDescription = Nothing }) ]
+                , ("read:pets", "read your pets") ]
+            , _oAuth2Extensions = mempty  } )
+      , _securitySchemeDescription = Nothing
+      , _securitySchemeExtensions = SpecificationExtensions (InsOrdHM.fromList [("ext1", toJSON True)])})]
 
 securityDefinitionsExampleJSON :: Value
 securityDefinitionsExampleJSON = [aesonQQ|
@@ -480,7 +497,8 @@ securityDefinitionsExampleJSON = [aesonQQ|
         },
         "authorizationUrl": "http://swagger.io/api/oauth/dialog"
       }
-    }
+    },
+  "x-ext1": true
   }
 }
 
@@ -493,8 +511,10 @@ oAuth2SecurityDefinitionsReadExample = SecurityDefinitions
             { _oAuth2Params = OAuth2ImplicitFlow "http://swagger.io/api/oauth/dialog"
             , _oAath2RefreshUrl = Nothing
             , _oAuth2Scopes =
-              [ ("read:pets", "read your pets") ] } )
-      , _securitySchemeDescription = Nothing })
+              [ ("read:pets", "read your pets") ]
+            , _oAuth2Extensions = mempty } )
+      , _securitySchemeDescription = Nothing
+      , _securitySchemeExtensions = mempty })
   ]
 
 oAuth2SecurityDefinitionsWriteExample :: SecurityDefinitions
@@ -504,8 +524,10 @@ oAuth2SecurityDefinitionsWriteExample = SecurityDefinitions
             { _oAuth2Params = OAuth2ImplicitFlow "http://swagger.io/api/oauth/dialog"
             , _oAath2RefreshUrl = Nothing
             , _oAuth2Scopes =
-                [ ("write:pets", "modify pets in your account") ] } )
-      , _securitySchemeDescription = Nothing })
+                [ ("write:pets", "modify pets in your account") ]
+            , _oAuth2Extensions = mempty } )
+      , _securitySchemeDescription = Nothing
+      , _securitySchemeExtensions = mempty })
   ]
 
 oAuth2SecurityDefinitionsExample :: SecurityDefinitions
@@ -554,7 +576,7 @@ emptyPathsFieldExampleJSON :: Value
 emptyPathsFieldExampleJSON = [aesonQQ|
 {
   "openapi": "3.0.0",
-  "info": {"version": "", "title": ""},
+  "info": {"version": "", "title": "", "extensions": {}},
   "paths": {},
   "components": {}
 }
@@ -569,7 +591,9 @@ swaggerExample = mempty
       & title .~ "Todo API"
       & license ?~ "MIT"
       & license._Just.url ?~ URL "http://mit.com"
+      & license . _Just . extensions .~ mempty
       & description ?~ "This is an API that tests servant-swagger support for a Todo API")
+      & extensions .~ mempty
   & paths.at "/todo/{id}" ?~ (mempty & get ?~ ((mempty :: Operation)
       & responses . at 200 ?~ Inline (mempty
           & description .~ "OK"
@@ -606,9 +630,11 @@ swaggerExampleJSON = [aesonQQ|
         "title": "Todo API",
         "license": {
             "url": "http://mit.com",
-            "name": "MIT"
+            "name": "MIT",
+            "extensions": {}
         },
-        "description": "This is an API that tests servant-swagger support for a Todo API"
+        "description": "This is an API that tests servant-swagger support for a Todo API",
+        "extensions": {}
     },
     "paths": {
         "/todo/{id}": {
@@ -668,8 +694,10 @@ petstoreExampleJSON = [aesonQQ|
     "version": "1.0.0",
     "title": "Swagger Petstore",
     "license": {
-      "name": "MIT"
-    }
+      "name": "MIT",
+      "extensions": {}
+    },
+    "extensions": {}
   },
   "servers": [
     {

From 32eb9da2d34a95f156216b35a356779d882b7648 Mon Sep 17 00:00:00 2001
From: Avery <thecommunistduck@hotmail.co.uk>
Date: Wed, 16 Mar 2022 14:20:16 +0100
Subject: [PATCH 2/8] add param extension field

---
 src/Data/OpenApi/Internal.hs | 4 +++-
 test/Data/OpenApiSpec.hs     | 6 ++++--
 2 files changed, 7 insertions(+), 3 deletions(-)

diff --git a/src/Data/OpenApi/Internal.hs b/src/Data/OpenApi/Internal.hs
index 49b99cbb..5fed247b 100644
--- a/src/Data/OpenApi/Internal.hs
+++ b/src/Data/OpenApi/Internal.hs
@@ -540,6 +540,8 @@ data Param = Param
     -- the examples value SHALL override the example provided by the schema.
   , _paramExamples :: InsOrdHashMap Text (Referenced Example)
 
+  , _paramExtensions :: SpecificationExtensions
+
     -- TODO
     -- _paramContent :: InsOrdHashMap MediaType MediaTypeObject
     -- should be singleton. mutually exclusive with _paramSchema.
@@ -1669,7 +1671,7 @@ instance HasSwaggerAesonOptions OAuth2Flows where
 instance HasSwaggerAesonOptions Operation where
   swaggerAesonOptions _ = mkSwaggerAesonOptions "operation" & saoSubObject .~ ["extensions"]
 instance HasSwaggerAesonOptions Param where
-  swaggerAesonOptions _ = mkSwaggerAesonOptions "param"
+  swaggerAesonOptions _ = mkSwaggerAesonOptions "param" & saoSubObject .~ ["extensions"]
 instance HasSwaggerAesonOptions PathItem where
   swaggerAesonOptions _ = mkSwaggerAesonOptions "pathItem" & saoSubObject .~ ["extensions"]
 instance HasSwaggerAesonOptions Response where
diff --git a/test/Data/OpenApiSpec.hs b/test/Data/OpenApiSpec.hs
index 83e77d6a..cdec33d4 100644
--- a/test/Data/OpenApiSpec.hs
+++ b/test/Data/OpenApiSpec.hs
@@ -146,7 +146,8 @@ operationExample = mempty
     & description ?~ "ID of pet that needs to be updated"
     & required ?~ True
     & in_ .~ ParamPath
-    & schema ?~ Inline (mempty & type_ ?~ OpenApiString))]
+    & schema ?~ Inline (mempty & type_ ?~ OpenApiString)
+    & extensions .~ SpecificationExtensions (InsOrdHM.fromList [("param-extension-here", "SomeString")]))]
   & requestBody ?~ Inline (
     mempty & content . at "application/x-www-form-urlencoded" ?~ (mempty & schema ?~ (Inline (mempty
       & properties . at "petId" ?~ Inline (mempty
@@ -177,7 +178,8 @@ operationExampleJSON = [aesonQQ|
       },
       "in": "path",
       "name": "petId",
-      "description": "ID of pet that needs to be updated"
+      "description": "ID of pet that needs to be updated",
+      "x-param-extension-here": "SomeString"
     }
   ],
   "requestBody": {

From 224b681dd9a2037ffd1773d9846737df38405a59 Mon Sep 17 00:00:00 2001
From: Avery <thecommunistduck@hotmail.co.uk>
Date: Wed, 16 Mar 2022 14:34:53 +0100
Subject: [PATCH 3/8] Add better extension lens support

---
 src/Data/OpenApi/Internal.hs |  4 +--
 src/Data/OpenApi/Lens.hs     |  6 +++++
 stack.yaml.lock              | 47 ++++++++++++++++++++++++++++++++++++
 test/Data/OpenApiSpec.hs     |  8 +++---
 4 files changed, 59 insertions(+), 6 deletions(-)
 create mode 100644 stack.yaml.lock

diff --git a/src/Data/OpenApi/Internal.hs b/src/Data/OpenApi/Internal.hs
index 5fed247b..40a5b1a4 100644
--- a/src/Data/OpenApi/Internal.hs
+++ b/src/Data/OpenApi/Internal.hs
@@ -1022,7 +1022,7 @@ data AdditionalProperties
   | AdditionalPropertiesSchema (Referenced Schema)
   deriving (Eq, Show, Data, Typeable)
 
-newtype SpecificationExtensions = SpecificationExtensions {getSpecificationExtensions :: Definitions Value}
+newtype SpecificationExtensions = SpecificationExtensions { _unDefs :: Definitions Value}
   deriving (Eq, Show, Hashable, Data, Typeable, Semigroup, Monoid, SwaggerMonoid, AesonDefaultValue)
 
 -------------------------------------------------------------------------------
@@ -1490,7 +1490,7 @@ instance ToJSON Callback where
   toJSON (Callback ps) = toJSON ps
 
 instance ToJSON SpecificationExtensions where
-  toJSON = toJSON . addExtPrefix . getSpecificationExtensions
+  toJSON = toJSON . addExtPrefix . _unDefs
     where
       addExtPrefix = InsOrdHashMap.mapKeys ("x-" <>)
 
diff --git a/src/Data/OpenApi/Lens.hs b/src/Data/OpenApi/Lens.hs
index b8e23101..a434ca06 100644
--- a/src/Data/OpenApi/Lens.hs
+++ b/src/Data/OpenApi/Lens.hs
@@ -57,6 +57,7 @@ makeFields ''Encoding
 makeFields ''Example
 makeFields ''Discriminator
 makeFields ''Link
+makeLenses ''SpecificationExtensions
 
 -- * Prisms
 -- ** 'SecuritySchemeType' prisms
@@ -89,9 +90,11 @@ _OpenApiItemsObject
 
 type instance Index Responses = HttpStatusCode
 type instance Index Operation = HttpStatusCode
+type instance Index SpecificationExtensions = Text
 
 type instance IxValue Responses = Referenced Response
 type instance IxValue Operation = Referenced Response
+type instance IxValue SpecificationExtensions = Value
 
 instance Ixed Responses where ix n = responses . ix n
 instance At   Responses where at n = responses . at n
@@ -99,6 +102,9 @@ instance At   Responses where at n = responses . at n
 instance Ixed Operation where ix n = responses . ix n
 instance At   Operation where at n = responses . at n
 
+instance Ixed SpecificationExtensions where ix n = unDefs . ix n
+instance At   SpecificationExtensions where at n = unDefs . at n
+
 instance HasType NamedSchema (Maybe OpenApiType) where type_ = schema.type_
 
 -- OVERLAPPABLE instances
diff --git a/stack.yaml.lock b/stack.yaml.lock
new file mode 100644
index 00000000..4cf8f146
--- /dev/null
+++ b/stack.yaml.lock
@@ -0,0 +1,47 @@
+# This file was autogenerated by Stack.
+# You should not edit this file by hand.
+# For more information, please see the documentation at:
+#   https://docs.haskellstack.org/en/stable/lock_files
+
+packages:
+- completed:
+    hackage: optics-core-0.3@sha256:0464583aaef715f8e48b8c9ce3fab9866345de93e740dae32d5c5e9a57097bf7,4532
+    pantry-tree:
+      size: 5030
+      sha256: d87366c3a2d4099a7a1d54df029a38e24b591ba8fb88d56fabf0c5c4bc345a51
+  original:
+    hackage: optics-core-0.3
+- completed:
+    hackage: optics-th-0.3@sha256:b4746b3d142feb2dc9dfcf76b49a11fd04321aa0ee9c1bcd297c5e8dc393803c,1965
+    pantry-tree:
+      size: 653
+      sha256: 24e990405793450726f6364034614c715537b0ed3f21fafc9ce0267979feb01b
+  original:
+    hackage: optics-th-0.3
+- completed:
+    hackage: optics-extra-0.3@sha256:99696d87a92025e5f8d02e418b7851115e30a3d1425fba4afb6d41a0445cddd5,3492
+    pantry-tree:
+      size: 1809
+      sha256: 4d07622a2f3f62882de4f431d7f600053a8b461d5aa372c7ae596b672efab644
+  original:
+    hackage: optics-extra-0.3
+- completed:
+    hackage: indexed-profunctors-0.1@sha256:ddf618d0d4c58319c1e735e746bc69a1021f13b6f475dc9614b80af03432e6d4,1016
+    pantry-tree:
+      size: 235
+      sha256: cfd66c0a53be1b45eae72df112ea1158614458bb7b1c9cbbe3410b04ab011ec6
+  original:
+    hackage: indexed-profunctors-0.1
+- completed:
+    hackage: insert-ordered-containers-0.2.3.1@sha256:003307d51ba47411ead1f79b8559569b220723aea7439341d16980213f7520e9,2324
+    pantry-tree:
+      size: 541
+      sha256: c5b7b2a76cb090a990e9abbc671cb8913859925f230cd37ab1691ddca301fe06
+  original:
+    hackage: insert-ordered-containers-0.2.3.1
+snapshots:
+- completed:
+    size: 534126
+    url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/16/31.yaml
+    sha256: 637fb77049b25560622a224845b7acfe81a09fdb6a96a3c75997a10b651667f6
+  original: lts-16.31
diff --git a/test/Data/OpenApiSpec.hs b/test/Data/OpenApiSpec.hs
index cdec33d4..85a73ed4 100644
--- a/test/Data/OpenApiSpec.hs
+++ b/test/Data/OpenApiSpec.hs
@@ -2,6 +2,7 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE LambdaCase #-}
 module Data.OpenApiSpec where
 
 import Prelude ()
@@ -15,7 +16,6 @@ import Data.HashMap.Strict (HashMap)
 import qualified Data.HashSet.InsOrd as InsOrdHS
 import Data.Text (Text)
 
-import Data.OpenApi
 import SpecCommon
 import Test.Hspec hiding (example)
 import qualified Data.HashMap.Strict.InsOrd as InsOrdHM
@@ -44,7 +44,7 @@ spec = do
     context "Todo Example" $ swaggerExample <=> swaggerExampleJSON
     context "PetStore Example" $ do
       it "decodes successfully" $ do
-        fromJSON petstoreExampleJSON `shouldSatisfy` (\x -> case x of Success (_ :: OpenApi) -> True; _ -> False)
+        fromJSON petstoreExampleJSON `shouldSatisfy` (\case Success (_ :: OpenApi) -> True; _ -> False)
       it "roundtrips: fmap toJSON . fromJSON" $ do
         (toJSON :: OpenApi -> Value) <$> fromJSON petstoreExampleJSON `shouldBe` Success petstoreExampleJSON
     context "Security schemes" $ do
@@ -149,13 +149,13 @@ operationExample = mempty
     & schema ?~ Inline (mempty & type_ ?~ OpenApiString)
     & extensions .~ SpecificationExtensions (InsOrdHM.fromList [("param-extension-here", "SomeString")]))]
   & requestBody ?~ Inline (
-    mempty & content . at "application/x-www-form-urlencoded" ?~ (mempty & schema ?~ (Inline (mempty
+    mempty & content . at "application/x-www-form-urlencoded" ?~ (mempty & schema ?~ Inline (mempty
       & properties . at "petId" ?~ Inline (mempty
         & description ?~ "Updated name of the pet"
         & type_ ?~ OpenApiString)
       & properties . at "status" ?~ Inline (mempty
         & description ?~ "Updated status of the pet"
-        & type_ ?~ OpenApiString)))))
+        & type_ ?~ OpenApiString))))
   & at 200 ?~ "Pet updated."
   & at 405 ?~ "Invalid input"
   & security .~ [SecurityRequirement [("petstore_auth", ["write:pets", "read:pets"])]]

From e6ab412344dd99b3e1ae25e50104641d3ab85a0e Mon Sep 17 00:00:00 2001
From: Avery <thecommunistduck@hotmail.co.uk>
Date: Wed, 16 Mar 2022 15:02:59 +0100
Subject: [PATCH 4/8] add header extensions and paramlocation ord

---
 src/Data/OpenApi/Internal.hs | 5 +++--
 1 file changed, 3 insertions(+), 2 deletions(-)

diff --git a/src/Data/OpenApi/Internal.hs b/src/Data/OpenApi/Internal.hs
index 40a5b1a4..dd75db70 100644
--- a/src/Data/OpenApi/Internal.hs
+++ b/src/Data/OpenApi/Internal.hs
@@ -646,7 +646,7 @@ data ParamLocation
   | ParamPath
     -- | Used to pass a specific cookie value to the API.
   | ParamCookie
-  deriving (Eq, Show, Generic, Data, Typeable)
+  deriving (Eq, Ord, Show, Generic, Data, Typeable)
 
 type Format = Text
 
@@ -820,6 +820,7 @@ data Header = Header
   , _headerExamples :: InsOrdHashMap Text (Referenced Example)
 
   , _headerSchema :: Maybe (Referenced Schema)
+  , _headerExtensions :: SpecificationExtensions
   } deriving (Eq, Show, Generic, Data, Typeable)
 
 -- | The location of the API key.
@@ -1663,7 +1664,7 @@ instance HasSwaggerAesonOptions Server where
 instance HasSwaggerAesonOptions Components where
   swaggerAesonOptions _ = mkSwaggerAesonOptions "components"
 instance HasSwaggerAesonOptions Header where
-  swaggerAesonOptions _ = mkSwaggerAesonOptions "header"
+  swaggerAesonOptions _ = mkSwaggerAesonOptions "header" & saoSubObject .~ ["extensions"]
 instance AesonDefaultValue p => HasSwaggerAesonOptions (OAuth2Flow p) where
   swaggerAesonOptions _ = mkSwaggerAesonOptions "oauth2" & saoSubObject .~ ["params", "extensions"]
 instance HasSwaggerAesonOptions OAuth2Flows where

From f2b49faef06179424e20032d1707ee9a305a2e8b Mon Sep 17 00:00:00 2001
From: Avery <thecommunistduck@hotmail.co.uk>
Date: Wed, 16 Mar 2022 15:11:48 +0100
Subject: [PATCH 5/8] add hashable instance

---
 src/Data/OpenApi/Internal.hs | 2 ++
 1 file changed, 2 insertions(+)

diff --git a/src/Data/OpenApi/Internal.hs b/src/Data/OpenApi/Internal.hs
index dd75db70..6c36f628 100644
--- a/src/Data/OpenApi/Internal.hs
+++ b/src/Data/OpenApi/Internal.hs
@@ -648,6 +648,8 @@ data ParamLocation
   | ParamCookie
   deriving (Eq, Ord, Show, Generic, Data, Typeable)
 
+instance Hashable ParamLocation 
+
 type Format = Text
 
 type ParamName = Text

From 8a7615d2613cc3dc62821b6e31d3cd286f6c4e9a Mon Sep 17 00:00:00 2001
From: PrettyPrincessKitty FS <thecommunistduck@hotmail.co.uk>
Date: Wed, 16 Mar 2022 16:02:27 +0100
Subject: [PATCH 6/8] Add better default value for extensions

---
 src/Data/OpenApi/Internal.hs | 5 ++++-
 1 file changed, 4 insertions(+), 1 deletion(-)

diff --git a/src/Data/OpenApi/Internal.hs b/src/Data/OpenApi/Internal.hs
index 6c36f628..7ad83931 100644
--- a/src/Data/OpenApi/Internal.hs
+++ b/src/Data/OpenApi/Internal.hs
@@ -1026,7 +1026,10 @@ data AdditionalProperties
   deriving (Eq, Show, Data, Typeable)
 
 newtype SpecificationExtensions = SpecificationExtensions { _unDefs :: Definitions Value}
-  deriving (Eq, Show, Hashable, Data, Typeable, Semigroup, Monoid, SwaggerMonoid, AesonDefaultValue)
+  deriving (Eq, Show, Hashable, Data, Typeable, Semigroup, Monoid, SwaggerMonoid)
+
+instance AesonDefaultValue SpecificationExtensions where
+  defaultValue = Just (SpecificationExtensions mempty)
 
 -------------------------------------------------------------------------------
 -- Generic instances

From 7b9e8069e1dcc3fe66d5c11b1a3d146f00711cce Mon Sep 17 00:00:00 2001
From: Avery <thecommunistduck@hotmail.co.uk>
Date: Wed, 16 Mar 2022 16:35:11 +0100
Subject: [PATCH 7/8] more gracefully handle optional extensions

---
 src/Data/OpenApi/Internal.hs            | 42 +++++++++++++------------
 src/Data/OpenApi/Internal/AesonUtils.hs | 32 ++++++++++++++++---
 test/Data/OpenApiSpec.hs                | 35 +++++++--------------
 3 files changed, 61 insertions(+), 48 deletions(-)

diff --git a/src/Data/OpenApi/Internal.hs b/src/Data/OpenApi/Internal.hs
index 6c36f628..c9a74a73 100644
--- a/src/Data/OpenApi/Internal.hs
+++ b/src/Data/OpenApi/Internal.hs
@@ -14,6 +14,7 @@
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE TupleSections #-}
 module Data.OpenApi.Internal where
 
 import Prelude ()
@@ -53,7 +54,7 @@ import Data.OpenApi.Aeson.Compat        (deleteKey)
 import Data.OpenApi.Internal.AesonUtils (AesonDefaultValue (..), HasSwaggerAesonOptions (..),
                                          mkSwaggerAesonOptions, saoAdditionalPairs, saoSubObject,
                                          sopSwaggerGenericParseJSON, sopSwaggerGenericToEncoding,
-                                         sopSwaggerGenericToJSON, sopSwaggerGenericToJSONWithOpts)
+                                         sopSwaggerGenericToJSON, sopSwaggerGenericToJSONWithOpts, sopSwaggerGenericParseJSONWithOpts)
 import Data.OpenApi.Internal.Utils
 import Generics.SOP.TH                  (deriveGeneric)
 import Data.Maybe (catMaybes)
@@ -1234,15 +1235,6 @@ instance ToJSON OpenApiType where
 instance ToJSON ParamLocation where
   toJSON = genericToJSON (jsonPrefix "Param")
 
-instance ToJSON Info where
-  toJSON = genericToJSON (jsonPrefix "Info")
-
-instance ToJSON Contact where
-  toJSON = genericToJSON (jsonPrefix "Contact")
-
-instance ToJSON License where
-  toJSON = genericToJSON (jsonPrefix "License")
-
 instance ToJSON ServerVariable where
   toJSON = genericToJSON (jsonPrefix "ServerVariable")
 
@@ -1289,15 +1281,6 @@ instance FromJSON OpenApiType where
 instance FromJSON ParamLocation where
   parseJSON = genericParseJSON (jsonPrefix "Param")
 
-instance FromJSON Info where
-  parseJSON = genericParseJSON (jsonPrefix "Info")
-
-instance FromJSON Contact where
-  parseJSON = genericParseJSON (jsonPrefix "Contact")
-
-instance FromJSON License where
-  parseJSON = genericParseJSON (jsonPrefix "License")
-
 instance FromJSON ServerVariable where
   parseJSON = genericParseJSON (jsonPrefix "ServerVariable")
 
@@ -1497,6 +1480,15 @@ instance ToJSON SpecificationExtensions where
     where
       addExtPrefix = InsOrdHashMap.mapKeys ("x-" <>)
 
+instance ToJSON Info where
+  toJSON = sopSwaggerGenericToJSONWithOpts (mkSwaggerAesonOptions "Info")
+
+instance ToJSON Contact where
+  toJSON = sopSwaggerGenericToJSONWithOpts (mkSwaggerAesonOptions "Contact")
+
+instance ToJSON License where
+  toJSON = sopSwaggerGenericToJSONWithOpts (mkSwaggerAesonOptions "License")
+
 -- =======================================================================
 -- Manual FromJSON instances
 -- =======================================================================
@@ -1659,7 +1651,17 @@ instance FromJSON SpecificationExtensions where
   parseJSON = withObject "SpecificationExtensions" extFieldsParser
     where
       extFieldsParser = pure . SpecificationExtensions . InsOrdHashMap.fromList . catMaybes . filterExtFields
-      filterExtFields = fmap (\(k, v) -> fmap (\k' -> (k', v)) $ Text.stripPrefix "x-" k) . HashMap.toList
+      filterExtFields = fmap (\(k, v) -> (, v) <$> Text.stripPrefix "x-" k) . HashMap.toList
+
+
+instance FromJSON Info where
+  parseJSON = sopSwaggerGenericParseJSONWithOpts (mkSwaggerAesonOptions "Info")
+
+instance FromJSON Contact where
+  parseJSON = sopSwaggerGenericParseJSONWithOpts (mkSwaggerAesonOptions "Contact")
+
+instance FromJSON License where
+  parseJSON = sopSwaggerGenericParseJSONWithOpts (mkSwaggerAesonOptions "License")
 
 instance HasSwaggerAesonOptions Server where
   swaggerAesonOptions _ = mkSwaggerAesonOptions "server"
diff --git a/src/Data/OpenApi/Internal/AesonUtils.hs b/src/Data/OpenApi/Internal/AesonUtils.hs
index 91a27cf3..70e9cc34 100644
--- a/src/Data/OpenApi/Internal/AesonUtils.hs
+++ b/src/Data/OpenApi/Internal/AesonUtils.hs
@@ -12,6 +12,7 @@ module Data.OpenApi.Internal.AesonUtils (
     sopSwaggerGenericToEncoding,
     sopSwaggerGenericToJSONWithOpts,
     sopSwaggerGenericParseJSON,
+    sopSwaggerGenericParseJSONWithOpts,
     -- * Options
     HasSwaggerAesonOptions(..),
     SwaggerAesonOptions,
@@ -176,8 +177,7 @@ sopSwaggerGenericToJSON'' (SwaggerAesonOptions prefix _ sub) = go
 -------------------------------------------------------------------------------
 -- FromJSON
 -------------------------------------------------------------------------------
-
-sopSwaggerGenericParseJSON
+sopSwaggerGenericParseJSONWithOpts
     :: forall a xs.
         ( HasDatatypeInfo a
         , HasSwaggerAesonOptions a
@@ -185,13 +185,37 @@ sopSwaggerGenericParseJSON
         , All2 Eq (Code a)
         , Code a ~ '[xs]
         )
-    => Value
+    => SwaggerAesonOptions
+    -> Value
     -> Parser a
-sopSwaggerGenericParseJSON = withObject "Swagger Record Object" $ \obj ->
+sopSwaggerGenericParseJSONWithOpts opts = withObject "Swagger Record Object" $ \obj ->
     let ps = sopSwaggerGenericParseJSON' opts obj (datatypeInfo proxy) (aesonDefaults proxy)
     in do
         traverse_ (parseAdditionalField obj) (opts ^. saoAdditionalPairs)
         to <$> ps
+  where
+    proxy = Proxy :: Proxy a
+
+    parseAdditionalField :: Object -> Pair -> Parser ()
+    parseAdditionalField obj (k, v) = do
+        v' <- obj .: k
+        unless (v == v') $ fail $
+            "Additonal field don't match for key " ++ keyToString k
+            ++ ": " ++ show v
+            ++ " /= " ++ show v'
+
+
+sopSwaggerGenericParseJSON
+    :: forall a xs.
+        ( HasDatatypeInfo a
+        , HasSwaggerAesonOptions a
+        , All2 FromJSON (Code a)
+        , All2 Eq (Code a)
+        , Code a ~ '[xs]
+        )
+    => Value
+    -> Parser a
+sopSwaggerGenericParseJSON = sopSwaggerGenericParseJSONWithOpts opts
   where
     proxy = Proxy :: Proxy a
     opts  = swaggerAesonOptions proxy
diff --git a/test/Data/OpenApiSpec.hs b/test/Data/OpenApiSpec.hs
index 85a73ed4..78cd1b52 100644
--- a/test/Data/OpenApiSpec.hs
+++ b/test/Data/OpenApiSpec.hs
@@ -67,7 +67,6 @@ infoExample = mempty
   & contact        ?~ contactExample
   & license        ?~ licenseExample
   & version        .~ "1.0.1"
-  & extensions     .~ mempty
 
 infoExampleJSON :: Value
 infoExampleJSON = [aesonQQ|
@@ -78,16 +77,13 @@ infoExampleJSON = [aesonQQ|
   "contact": {
     "name": "API Support",
     "url": "http://www.swagger.io/support",
-    "email": "support@swagger.io",
-    "extensions": {}
+    "email": "support@swagger.io"
   },
   "license": {
     "name": "Apache 2.0",
-    "url": "http://www.apache.org/licenses/LICENSE-2.0.html",
-    "extensions": {}
+    "url": "http://www.apache.org/licenses/LICENSE-2.0.html"
   },
-  "version": "1.0.1",
-  "extensions": {}
+  "version": "1.0.1"
 }
 |]
 
@@ -100,15 +96,13 @@ contactExample = mempty
   & name  ?~ "API Support"
   & url   ?~ URL "http://www.swagger.io/support"
   & email ?~ "support@swagger.io"
-  & extensions .~ mempty
 
 contactExampleJSON :: Value
 contactExampleJSON = [aesonQQ|
 {
   "name": "API Support",
   "url": "http://www.swagger.io/support",
-  "email": "support@swagger.io",
-  "extensions": {}
+  "email": "support@swagger.io"
 }
 |]
 
@@ -119,14 +113,12 @@ contactExampleJSON = [aesonQQ|
 licenseExample :: License
 licenseExample = "Apache 2.0"
   & url ?~ URL "http://www.apache.org/licenses/LICENSE-2.0.html"
-  & extensions .~ mempty
 
 licenseExampleJSON :: Value
 licenseExampleJSON = [aesonQQ|
 {
   "name": "Apache 2.0",
-  "url": "http://www.apache.org/licenses/LICENSE-2.0.html",
-  "extensions": {}
+  "url": "http://www.apache.org/licenses/LICENSE-2.0.html"
 }
 |]
 
@@ -578,7 +570,7 @@ emptyPathsFieldExampleJSON :: Value
 emptyPathsFieldExampleJSON = [aesonQQ|
 {
   "openapi": "3.0.0",
-  "info": {"version": "", "title": "", "extensions": {}},
+  "info": {"version": "", "title": ""},
   "paths": {},
   "components": {}
 }
@@ -593,9 +585,8 @@ swaggerExample = mempty
       & title .~ "Todo API"
       & license ?~ "MIT"
       & license._Just.url ?~ URL "http://mit.com"
-      & license . _Just . extensions .~ mempty
       & description ?~ "This is an API that tests servant-swagger support for a Todo API")
-      & extensions .~ mempty
+
   & paths.at "/todo/{id}" ?~ (mempty & get ?~ ((mempty :: Operation)
       & responses . at 200 ?~ Inline (mempty
           & description .~ "OK"
@@ -632,11 +623,9 @@ swaggerExampleJSON = [aesonQQ|
         "title": "Todo API",
         "license": {
             "url": "http://mit.com",
-            "name": "MIT",
-            "extensions": {}
+            "name": "MIT"
         },
-        "description": "This is an API that tests servant-swagger support for a Todo API",
-        "extensions": {}
+        "description": "This is an API that tests servant-swagger support for a Todo API"
     },
     "paths": {
         "/todo/{id}": {
@@ -696,10 +685,8 @@ petstoreExampleJSON = [aesonQQ|
     "version": "1.0.0",
     "title": "Swagger Petstore",
     "license": {
-      "name": "MIT",
-      "extensions": {}
-    },
-    "extensions": {}
+      "name": "MIT"
+    }
   },
   "servers": [
     {

From 3fc3da84303c0191f4846dbde5a09564dfd0342e Mon Sep 17 00:00:00 2001
From: Avery <thecommunistduck@hotmail.co.uk>
Date: Wed, 16 Mar 2022 16:49:59 +0100
Subject: [PATCH 8/8] Oops, forgot some instances

---
 src/Data/OpenApi/Internal.hs | 48 ++++++++++++++++++------------------
 1 file changed, 24 insertions(+), 24 deletions(-)

diff --git a/src/Data/OpenApi/Internal.hs b/src/Data/OpenApi/Internal.hs
index caa72abc..a008ed6b 100644
--- a/src/Data/OpenApi/Internal.hs
+++ b/src/Data/OpenApi/Internal.hs
@@ -1238,24 +1238,12 @@ instance ToJSON OpenApiType where
 instance ToJSON ParamLocation where
   toJSON = genericToJSON (jsonPrefix "Param")
 
-instance ToJSON ServerVariable where
-  toJSON = genericToJSON (jsonPrefix "ServerVariable")
-
 instance ToJSON ApiKeyLocation where
   toJSON = genericToJSON (jsonPrefix "ApiKey")
 
 instance ToJSON ApiKeyParams where
   toJSON = genericToJSON (jsonPrefix "apiKey")
 
-instance ToJSON Tag where
-  toJSON = genericToJSON (jsonPrefix "Tag")
-
-instance ToJSON ExternalDocs where
-  toJSON = genericToJSON (jsonPrefix "ExternalDocs")
-
-instance ToJSON Xml where
-  toJSON = genericToJSON (jsonPrefix "Xml")
-
 instance ToJSON Discriminator where
   toJSON = genericToJSON (jsonPrefix "Discriminator")
 
@@ -1284,21 +1272,12 @@ instance FromJSON OpenApiType where
 instance FromJSON ParamLocation where
   parseJSON = genericParseJSON (jsonPrefix "Param")
 
-instance FromJSON ServerVariable where
-  parseJSON = genericParseJSON (jsonPrefix "ServerVariable")
-
 instance FromJSON ApiKeyLocation where
   parseJSON = genericParseJSON (jsonPrefix "ApiKey")
 
 instance FromJSON ApiKeyParams where
   parseJSON = genericParseJSON (jsonPrefix "apiKey")
 
-instance FromJSON Tag where
-  parseJSON = genericParseJSON (jsonPrefix "Tag")
-
-instance FromJSON ExternalDocs where
-  parseJSON = genericParseJSON (jsonPrefix "ExternalDocs")
-
 instance FromJSON Discriminator where
   parseJSON = genericParseJSON (jsonPrefix "Discriminator")
 
@@ -1492,6 +1471,18 @@ instance ToJSON Contact where
 instance ToJSON License where
   toJSON = sopSwaggerGenericToJSONWithOpts (mkSwaggerAesonOptions "License")
 
+instance ToJSON ServerVariable where
+  toJSON = sopSwaggerGenericToJSONWithOpts (mkSwaggerAesonOptions "ServerVariable")
+
+instance ToJSON Tag where
+  toJSON = sopSwaggerGenericToJSONWithOpts (mkSwaggerAesonOptions "Tag")
+
+instance ToJSON ExternalDocs where
+  toJSON = sopSwaggerGenericToJSONWithOpts (mkSwaggerAesonOptions "ExternalDocs")
+
+instance ToJSON Xml where
+  toJSON = sopSwaggerGenericToJSONWithOpts (mkSwaggerAesonOptions "Xml")
+
 -- =======================================================================
 -- Manual FromJSON instances
 -- =======================================================================
@@ -1635,9 +1626,6 @@ instance FromJSON (Referenced Header)   where parseJSON = referencedParseJSON "#
 instance FromJSON (Referenced Link)     where parseJSON = referencedParseJSON "#/components/links/"
 instance FromJSON (Referenced Callback) where parseJSON = referencedParseJSON "#/components/callbacks/"
 
-instance FromJSON Xml where
-  parseJSON = genericParseJSON (jsonPrefix "xml")
-
 instance FromJSON AdditionalProperties where
   parseJSON (Bool b) = pure $ AdditionalPropertiesAllowed b
   parseJSON js = AdditionalPropertiesSchema <$> parseJSON js
@@ -1666,6 +1654,18 @@ instance FromJSON Contact where
 instance FromJSON License where
   parseJSON = sopSwaggerGenericParseJSONWithOpts (mkSwaggerAesonOptions "License")
 
+instance FromJSON ServerVariable where
+  parseJSON = sopSwaggerGenericParseJSONWithOpts (mkSwaggerAesonOptions "ServerVariable")
+
+instance FromJSON Tag where
+  parseJSON = sopSwaggerGenericParseJSONWithOpts (mkSwaggerAesonOptions "Tag")
+
+instance FromJSON ExternalDocs where
+  parseJSON = sopSwaggerGenericParseJSONWithOpts (mkSwaggerAesonOptions "ExternalDocs")
+
+instance FromJSON Xml where
+  parseJSON = sopSwaggerGenericParseJSONWithOpts (mkSwaggerAesonOptions "xml")
+
 instance HasSwaggerAesonOptions Server where
   swaggerAesonOptions _ = mkSwaggerAesonOptions "server"
 instance HasSwaggerAesonOptions Components where