Haskell: JSON Query parameters (#18047)

* Allow json encoded query paramters

* Also fix haskell-http-client

* Regenerate haskell samples

bin/configs/haskell-http-client.yaml

@@ -1,6 +1,6 @@
 generatorName: haskell-http-client
 outputDir: samples/client/petstore/haskell-http-client
-inputSpec: modules/openapi-generator/src/test/resources/2_0/petstore-with-fake-endpoints-models-for-testing.yaml
+inputSpec: modules/openapi-generator/src/test/resources/3_0/haskell-http-client/petstore-with-fake-endpoints-models-for-testing.yaml
 templateDir: modules/openapi-generator/src/main/resources/haskell-http-client
 additionalProperties:
     queryExtraUnreserved: ''

modules/openapi-generator/src/main/java/org/openapitools/codegen/languages/HaskellHttpClientCodegen.java

@@ -745,11 +745,16 @@ public class HaskellHttpClientCodegen extends DefaultCodegen implements CodegenC
             param.vendorExtensions.put(VENDOR_EXTENSION_X_IS_BODY_OR_FORM_PARAM, param.isBodyParam || param.isFormParam);
             if (!StringUtils.isBlank(param.collectionFormat)) {
                 param.vendorExtensions.put(VENDOR_EXTENSION_X_COLLECTION_FORMAT, mapCollectionFormat(param.collectionFormat));
-            } else if (!param.isBodyParam && (param.isArray || param.dataType.startsWith("["))) { // param.isArray is sometimes false for list types
+            } else if (!param.isBodyParam) {
+                if (param.isArray || param.dataType.startsWith("[")) { // param.isArray is sometimes false for list types
                     // defaulting due to https://github.com/wing328/openapi-generator/issues/72
                     param.collectionFormat = "csv";
                     param.vendorExtensions.put(VENDOR_EXTENSION_X_COLLECTION_FORMAT, mapCollectionFormat(param.collectionFormat));
                 }
+            }
+            if (param.isQueryParam && (isJsonMimeType(param.contentType) || ContainsJsonMimeType(param.contentType))) {
+                param.vendorExtensions.put(X_MEDIA_IS_JSON, "true");
+            }
             if (!param.required) {
                 op.vendorExtensions.put(VENDOR_EXTENSION_X_HAS_OPTIONAL_PARAMS, true);
             }

modules/openapi-generator/src/main/java/org/openapitools/codegen/languages/HaskellServantCodegen.java

@@ -514,6 +514,13 @@ public class HaskellServantCodegen extends DefaultCodegen implements CodegenConf
         // Query parameters appended to routes
         for (CodegenParameter param : op.queryParams) {
             String paramType = param.dataType;
+            if (param.contentType == "application/json") {
+                if (param.isArray) {
+                    paramType = "[JSONQueryParam " + paramType.substring(1, paramType.length() - 1) + "]";
+                } else {
+                    paramType = "(JSONQueryParam " + paramType + ")";
+                }
+            }
             if (param.isArray) {
                 if (StringUtils.isEmpty(param.collectionFormat)) {
                     param.collectionFormat = "csv";
@@ -549,6 +556,13 @@ public class HaskellServantCodegen extends DefaultCodegen implements CodegenConf
             path.add("Header \"" + param.baseName + "\" " + param.dataType);
 
             String paramType = param.dataType;
+            if (param.contentType == "application/json") {
+                if (param.isArray) {
+                    paramType = "(JSONQueryParam " + paramType.substring(1, paramType.length() - 1) + ")";
+                } else {
+                    paramType = "(JSONQueryParam " + paramType + ")";
+                }
+            }
             if (param.isArray) {
                 if (StringUtils.isEmpty(param.collectionFormat)) {
                     param.collectionFormat = "csv";

modules/openapi-generator/src/main/resources/haskell-http-client/Core.mustache

@@ -41,6 +41,7 @@ import qualified Data.Maybe as P
 import qualified Data.Proxy as P (Proxy(..))
 import qualified Data.Text as T
 import qualified Data.Text.Encoding as T
+import qualified Data.Text.Lazy.Encoding as TL
 import qualified Data.Time as TI
 import qualified Data.Time.ISO8601 as TI
 import qualified GHC.Base as P (Alternative)
@@ -330,6 +331,9 @@ toQuery :: WH.ToHttpApiData a => (BC.ByteString, Maybe a) -> [NH.QueryItem]
 toQuery x = [(fmap . fmap) toQueryParam x]
   where toQueryParam = T.encodeUtf8 . WH.toQueryParam
 
+toJsonQuery :: A.ToJSON a => (BC.ByteString, Maybe a) -> [NH.QueryItem]
+toJsonQuery = toQuery . (fmap . fmap) (TL.decodeUtf8 . A.encode)
+
 toPartialEscapeQuery :: B.ByteString -> NH.Query -> NH.PartialEscapeQuery
 toPartialEscapeQuery extraUnreserved query = fmap (\(k, v) -> (k, maybe [] go v)) query
   where go :: B.ByteString -> [NH.EscapeItem]
@@ -362,6 +366,9 @@ toFormColl c xs = WH.toForm $ fmap unpack $ _toColl c toHeader $ pack xs
 toQueryColl :: WH.ToHttpApiData a => CollectionFormat -> (BC.ByteString, Maybe [a]) -> NH.Query
 toQueryColl c xs = _toCollA c toQuery xs
 
+toJsonQueryColl :: A.ToJSON a => CollectionFormat -> (BC.ByteString, Maybe [a]) -> NH.Query
+toJsonQueryColl c xs = _toCollA c toJsonQuery xs
+
 _toColl :: P.Traversable f => CollectionFormat -> (f a -> [(b, BC.ByteString)]) -> f [a] -> [(b, BC.ByteString)]
 _toColl c encode xs = fmap (fmap P.fromJust) (_toCollA' c fencode BC.singleton (fmap Just xs))
   where fencode = fmap (fmap Just) . encode . fmap P.fromJust

modules/openapi-generator/src/main/resources/haskell-http-client/Model.mustache

@@ -7,6 +7,7 @@ Module : {{baseModule}}.Model
 {-# LANGUAGE DeriveFoldable #-}
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DeriveTraversable #-}
+{-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE MultiParamTypeClasses #-}

modules/openapi-generator/src/main/resources/haskell-http-client/_queryColl.mustache

@@ -1 +1 @@
-toQuery{{#collectionFormat}}Coll {{vendorExtensions.x-collection-format}}{{/collectionFormat}}
+to{{#vendorExtensions.x-mediaIsJson}}Json{{/vendorExtensions.x-mediaIsJson}}Query{{#collectionFormat}}Coll {{vendorExtensions.x-collection-format}}{{/collectionFormat}}

modules/openapi-generator/src/main/resources/haskell-servant/API.mustache

@@ -47,6 +47,7 @@ import           Control.Monad.Except               (ExceptT, runExceptT)
 import           Control.Monad.IO.Class
 import           Control.Monad.Trans.Reader         (ReaderT (..))
 import           Data.Aeson                         (Value)
+import qualified Data.Aeson                         as Aeson
 {{#authMethods}}
 {{#isApiKey}}
 import           Data.ByteString                    (ByteString)
@@ -55,6 +56,7 @@ import           Data.ByteString                    (ByteString)
 import           Data.ByteString                    (ByteString)
 {{/isBasicBearer}}
 {{/authMethods}}
+import qualified Data.ByteString.Lazy               as BSL
 import           Data.Coerce                        (coerce)
 import           Data.Data                          (Data)
 import           Data.Function                      ((&))
@@ -64,6 +66,7 @@ import           Data.Proxy                         (Proxy (..))
 import           Data.Set                           (Set)
 import           Data.Text                          (Text)
 import qualified Data.Text                          as T
+import qualified Data.Text.Encoding                 as T
 import           Data.Time
 import           Data.UUID                          (UUID)
 import           GHC.Exts                           (IsString (..))
@@ -166,6 +169,16 @@ instance ToHttpApiData a => ToHttpApiData (QueryList 'MultiParamArray a) where
 formatSeparatedQueryList :: ToHttpApiData a => Char ->  QueryList p a -> Text
 formatSeparatedQueryList char = T.intercalate (T.singleton char) . map toQueryParam . fromQueryList
 
+newtype JSONQueryParam a = JSONQueryParam
+  { fromJsonQueryParam :: a
+  } deriving (Functor, Foldable, Traversable)
+
+instance Aeson.ToJSON a => ToHttpApiData (JSONQueryParam a) where
+  toQueryParam = T.decodeUtf8 . BSL.toStrict . Aeson.encode . fromJsonQueryParam
+
+instance Aeson.FromJSON a => FromHttpApiData (JSONQueryParam a) where
+  parseQueryParam = either (Left . T.pack) (Right . JSONQueryParam) . Aeson.eitherDecodeStrict . T.encodeUtf8
+
 
 {{#apiInfo}}
 -- | Servant type-level API, generated from the OpenAPI spec for {{title}}.

modules/openapi-generator/src/main/resources/haskell-servant/Types.mustache

@@ -1,6 +1,7 @@
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE DeriveDataTypeable         #-}
 {-# LANGUAGE DeriveGeneric              #-}
+{-# LANGUAGE DuplicateRecordFields      #-}
 {-# OPTIONS_GHC -fno-warn-unused-binds -fno-warn-unused-imports #-}
 
 module {{title}}.Types (

modules/openapi-generator/src/main/resources/haskell-servant/stack.mustache

@@ -1,4 +1,4 @@
-resolver: lts-19.2
+resolver: lts-22.12
 extra-deps: []
 packages:
 - '.'

modules/openapi-generator/src/test/resources/3_0/haskell/petstore.yaml

@@ -157,6 +157,40 @@ paths:
         - petstore_auth:
             - 'read:pets'
       deprecated: true
+  /pet/find:
+    get:
+      tags:
+        - pet
+      summary: Finds Pets
+      operationId: findPets
+      parameters:
+        - name: filter
+          in: query
+          required: false
+          content:
+            application/json:
+              schema:
+                $ref: '#/components/schemas/PetFilter'
+
+      responses:
+        '200':
+          description: successful operation
+          content:
+            application/xml:
+              schema:
+                type: array
+                items:
+                  $ref: '#/components/schemas/Pet'
+            application/json:
+              schema:
+                type: array
+                items:
+                  $ref: '#/components/schemas/Pet'
+        '400':
+          description: Invalid status value
+      security:
+        - petstore_auth:
+            - 'read:pets'
   '/pet/{petId}':
     get:
       tags:
@@ -752,3 +786,14 @@ components:
         - "\""
         - "\\"
       description: description
+    PetFilter:
+      type: object
+      properties:
+        tags:
+          type: array
+          items:
+            type: string
+        status:
+          type: array
+          items:
+            type: string

samples/client/petstore/haskell-http-client/lib/OpenAPIPetstore/API/Fake.hs

@@ -520,8 +520,8 @@ testQueryParameterCollectionFormat
   -> OpenAPIPetstoreRequest TestQueryParameterCollectionFormat MimeNoContent NoContent MimeNoContent
 testQueryParameterCollectionFormat (Pipe pipe) (Ioutil ioutil) (Http http) (Url url) (Context context) =
   _mkRequest "PUT" ["/fake/test-query-parameters"]
-    `addQuery` toQueryColl CommaSeparated ("pipe", Just pipe)
+    `addQuery` toQueryColl PipeSeparated ("pipe", Just pipe)
-    `addQuery` toQueryColl CommaSeparated ("ioutil", Just ioutil)
+    `addQuery` toQueryColl MultiParamArray ("ioutil", Just ioutil)
     `addQuery` toQueryColl SpaceSeparated ("http", Just http)
     `addQuery` toQueryColl CommaSeparated ("url", Just url)
     `addQuery` toQueryColl MultiParamArray ("context", Just context)

samples/client/petstore/haskell-http-client/lib/OpenAPIPetstore/API/Pet.hs

@@ -110,6 +110,34 @@ instance HasOptionalParam DeletePet ApiKey where
 instance Produces DeletePet MimeNoContent
 
 
+-- *** findPets
+
+-- | @GET \/pet\/find@
+-- 
+-- Finds Pets
+-- 
+-- AuthMethod: 'AuthOAuthPetstoreAuth'
+-- 
+findPets
+  :: Accept accept -- ^ request accept ('MimeType')
+  -> OpenAPIPetstoreRequest FindPets MimeNoContent [Pet] accept
+findPets  _ =
+  _mkRequest "GET" ["/pet/find"]
+    `_hasAuthType` (P.Proxy :: P.Proxy AuthOAuthPetstoreAuth)
+
+data FindPets  
+instance HasOptionalParam FindPets Filter where
+  applyOptionalParam req (Filter xs) =
+    req `addQuery` toJsonQuery ("filter", Just xs)
+instance HasOptionalParam FindPets OrderBy where
+  applyOptionalParam req (OrderBy xs) =
+    req `addQuery` toJsonQueryColl CommaSeparated ("order_by", Just xs)
+-- | @application/xml@
+instance Produces FindPets MimeXML
+-- | @application/json@
+instance Produces FindPets MimeJSON
+
+
 -- *** findPetsByStatus
 
 -- | @GET \/pet\/findByStatus@

samples/client/petstore/haskell-http-client/lib/OpenAPIPetstore/Core.hs

@@ -50,6 +50,7 @@ import qualified Data.Maybe as P
 import qualified Data.Proxy as P (Proxy(..))
 import qualified Data.Text as T
 import qualified Data.Text.Encoding as T
+import qualified Data.Text.Lazy.Encoding as TL
 import qualified Data.Time as TI
 import qualified Data.Time.ISO8601 as TI
 import qualified GHC.Base as P (Alternative)
@@ -339,6 +340,9 @@ toQuery :: WH.ToHttpApiData a => (BC.ByteString, Maybe a) -> [NH.QueryItem]
 toQuery x = [(fmap . fmap) toQueryParam x]
   where toQueryParam = T.encodeUtf8 . WH.toQueryParam
 
+toJsonQuery :: A.ToJSON a => (BC.ByteString, Maybe a) -> [NH.QueryItem]
+toJsonQuery = toQuery . (fmap . fmap) (TL.decodeUtf8 . A.encode)
+
 toPartialEscapeQuery :: B.ByteString -> NH.Query -> NH.PartialEscapeQuery
 toPartialEscapeQuery extraUnreserved query = fmap (\(k, v) -> (k, maybe [] go v)) query
   where go :: B.ByteString -> [NH.EscapeItem]
@@ -371,6 +375,9 @@ toFormColl c xs = WH.toForm $ fmap unpack $ _toColl c toHeader $ pack xs
 toQueryColl :: WH.ToHttpApiData a => CollectionFormat -> (BC.ByteString, Maybe [a]) -> NH.Query
 toQueryColl c xs = _toCollA c toQuery xs
 
+toJsonQueryColl :: A.ToJSON a => CollectionFormat -> (BC.ByteString, Maybe [a]) -> NH.Query
+toJsonQueryColl c xs = _toCollA c toJsonQuery xs
+
 _toColl :: P.Traversable f => CollectionFormat -> (f a -> [(b, BC.ByteString)]) -> f [a] -> [(b, BC.ByteString)]
 _toColl c encode xs = fmap (fmap P.fromJust) (_toCollA' c fencode BC.singleton (fmap Just xs))
   where fencode = fmap (fmap Just) . encode . fmap P.fromJust

samples/client/petstore/haskell-http-client/lib/OpenAPIPetstore/Model.hs

@@ -16,6 +16,7 @@ Module : OpenAPIPetstore.Model
 {-# LANGUAGE DeriveFoldable #-}
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DeriveTraversable #-}
+{-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
@@ -123,6 +124,9 @@ newtype EnumQueryStringArray = EnumQueryStringArray { unEnumQueryStringArray ::
 -- ** File2
 newtype File2 = File2 { unFile2 :: FilePath } deriving (P.Eq, P.Show)
 
+-- ** Filter
+newtype Filter = Filter { unFilter :: PetFilter } deriving (P.Eq, P.Show)
+
 -- ** Http
 newtype Http = Http { unHttp :: [Text] } deriving (P.Eq, P.Show)
 
@@ -144,6 +148,9 @@ newtype Name2 = Name2 { unName2 :: Text } deriving (P.Eq, P.Show)
 -- ** Number
 newtype Number = Number { unNumber :: Double } deriving (P.Eq, P.Show)
 
+-- ** OrderBy
+newtype OrderBy = OrderBy { unOrderBy :: [PetOrder] } deriving (P.Eq, P.Show)
+
 -- ** OrderId
 newtype OrderId = OrderId { unOrderId :: Integer } deriving (P.Eq, P.Show)
 
@@ -1533,6 +1540,66 @@ mkPet petName petPhotoUrls =
   , petStatus = Nothing
   }
 
+-- ** PetFilter
+-- | PetFilter
+data PetFilter = PetFilter
+  { petFilterTags :: !(Maybe [Text]) -- ^ "tags"
+  , petFilterStatus :: !(Maybe [Text]) -- ^ "status"
+  } deriving (P.Show, P.Eq, P.Typeable)
+
+-- | FromJSON PetFilter
+instance A.FromJSON PetFilter where
+  parseJSON = A.withObject "PetFilter" $ \o ->
+    PetFilter
+      <$> (o .:? "tags")
+      <*> (o .:? "status")
+
+-- | ToJSON PetFilter
+instance A.ToJSON PetFilter where
+  toJSON PetFilter {..} =
+   _omitNulls
+      [ "tags" .= petFilterTags
+      , "status" .= petFilterStatus
+      ]
+
+
+-- | Construct a value of type 'PetFilter' (by applying it's required fields, if any)
+mkPetFilter
+  :: PetFilter
+mkPetFilter =
+  PetFilter
+  { petFilterTags = Nothing
+  , petFilterStatus = Nothing
+  }
+
+-- ** PetOrder
+-- | PetOrder
+data PetOrder = PetOrder
+  { petOrderName :: !(Maybe E'Name) -- ^ "name"
+  } deriving (P.Show, P.Eq, P.Typeable)
+
+-- | FromJSON PetOrder
+instance A.FromJSON PetOrder where
+  parseJSON = A.withObject "PetOrder" $ \o ->
+    PetOrder
+      <$> (o .:? "name")
+
+-- | ToJSON PetOrder
+instance A.ToJSON PetOrder where
+  toJSON PetOrder {..} =
+   _omitNulls
+      [ "name" .= petOrderName
+      ]
+
+
+-- | Construct a value of type 'PetOrder' (by applying it's required fields, if any)
+mkPetOrder
+  :: PetOrder
+mkPetOrder =
+  PetOrder
+  { petOrderName = Nothing
+  }
+
 -- ** ReadOnlyFirst
 -- | ReadOnlyFirst
 data ReadOnlyFirst = ReadOnlyFirst
@@ -1565,34 +1632,6 @@ mkReadOnlyFirst =
   , readOnlyFirstBaz = Nothing
   }
 
--- ** SpecialModelName
--- | SpecialModelName
-data SpecialModelName = SpecialModelName
-  { specialModelNameSpecialPropertyName :: !(Maybe Integer) -- ^ "$special[property.name]"
-  } deriving (P.Show, P.Eq, P.Typeable)
-
--- | FromJSON SpecialModelName
-instance A.FromJSON SpecialModelName where
-  parseJSON = A.withObject "SpecialModelName" $ \o ->
-    SpecialModelName
-      <$> (o .:? "$special[property.name]")
-
--- | ToJSON SpecialModelName
-instance A.ToJSON SpecialModelName where
-  toJSON SpecialModelName {..} =
-   _omitNulls
-      [ "$special[property.name]" .= specialModelNameSpecialPropertyName
-      ]
-
-
--- | Construct a value of type 'SpecialModelName' (by applying it's required fields, if any)
-mkSpecialModelName
-  :: SpecialModelName
-mkSpecialModelName =
-  SpecialModelName
-  { specialModelNameSpecialPropertyName = Nothing
-  }
-
 -- ** Tag
 -- | Tag
 data Tag = Tag
@@ -2221,6 +2260,34 @@ toE'Kind = \case
   s -> P.Left $ "toE'Kind: enum parse failure: " P.++ P.show s
 
 
+-- ** E'Name
+
+-- | Enum of 'Text'
+data E'Name
+  = E'Name'Asc -- ^ @"asc"@
+  | E'Name'Desc -- ^ @"desc"@
+  deriving (P.Show, P.Eq, P.Typeable, P.Ord, P.Bounded, P.Enum)
+
+instance A.ToJSON E'Name where toJSON = A.toJSON . fromE'Name
+instance A.FromJSON E'Name where parseJSON o = P.either P.fail (pure . P.id) . toE'Name =<< A.parseJSON o
+instance WH.ToHttpApiData E'Name where toQueryParam = WH.toQueryParam . fromE'Name
+instance WH.FromHttpApiData E'Name where parseQueryParam o = WH.parseQueryParam o >>= P.left T.pack . toE'Name
+instance MimeRender MimeMultipartFormData E'Name where mimeRender _ = mimeRenderDefaultMultipartFormData
+
+-- | unwrap 'E'Name' enum
+fromE'Name :: E'Name -> Text
+fromE'Name = \case
+  E'Name'Asc -> "asc"
+  E'Name'Desc -> "desc"
+
+-- | parse 'E'Name' enum
+toE'Name :: Text -> P.Either String E'Name
+toE'Name = \case
+  "asc" -> P.Right E'Name'Asc
+  "desc" -> P.Right E'Name'Desc
+  s -> P.Left $ "toE'Name: enum parse failure: " P.++ P.show s
+
+
 -- ** E'Status
 
 -- | Enum of 'Text' .

samples/client/petstore/haskell-http-client/lib/OpenAPIPetstore/ModelLens.hs

@@ -713,6 +713,29 @@ petStatusL f Pet{..} = (\petStatus -> Pet { petStatus, ..} ) <$> f petStatus
 
 
 
+-- * PetFilter
+
+-- | 'petFilterTags' Lens
+petFilterTagsL :: Lens_' PetFilter (Maybe [Text])
+petFilterTagsL f PetFilter{..} = (\petFilterTags -> PetFilter { petFilterTags, ..} ) <$> f petFilterTags
+{-# INLINE petFilterTagsL #-}
+
+-- | 'petFilterStatus' Lens
+petFilterStatusL :: Lens_' PetFilter (Maybe [Text])
+petFilterStatusL f PetFilter{..} = (\petFilterStatus -> PetFilter { petFilterStatus, ..} ) <$> f petFilterStatus
+{-# INLINE petFilterStatusL #-}
+
+
+
+-- * PetOrder
+
+-- | 'petOrderName' Lens
+petOrderNameL :: Lens_' PetOrder (Maybe E'Name)
+petOrderNameL f PetOrder{..} = (\petOrderName -> PetOrder { petOrderName, ..} ) <$> f petOrderName
+{-# INLINE petOrderNameL #-}
+
+
+
 -- * ReadOnlyFirst
 
 -- | 'readOnlyFirstBar' Lens
@@ -727,15 +750,6 @@ readOnlyFirstBazL f ReadOnlyFirst{..} = (\readOnlyFirstBaz -> ReadOnlyFirst { re
 
 
 
--- * SpecialModelName
-
--- | 'specialModelNameSpecialPropertyName' Lens
-specialModelNameSpecialPropertyNameL :: Lens_' SpecialModelName (Maybe Integer)
-specialModelNameSpecialPropertyNameL f SpecialModelName{..} = (\specialModelNameSpecialPropertyName -> SpecialModelName { specialModelNameSpecialPropertyName, ..} ) <$> f specialModelNameSpecialPropertyName
-{-# INLINE specialModelNameSpecialPropertyNameL #-}
-
-
-
 -- * Tag
 
 -- | 'tagId' Lens

samples/client/petstore/haskell-http-client/openapi.yaml

@@ -167,21 +167,68 @@ paths:
       summary: Finds Pets by tags
       tags:
       - pet
+  /pet/find:
+    get:
+      operationId: findPets
+      parameters:
+      - content:
+          application/json:
+            schema:
+              $ref: '#/components/schemas/PetFilter'
+        in: query
+        name: filter
+        required: false
+      - content:
+          application/json:
+            schema:
+              items:
+                $ref: '#/components/schemas/PetOrder'
+              type: array
+        in: query
+        name: order_by
+        required: false
+      responses:
+        "200":
+          content:
+            application/xml:
+              schema:
+                items:
+                  $ref: '#/components/schemas/Pet'
+                type: array
+            application/json:
+              schema:
+                items:
+                  $ref: '#/components/schemas/Pet'
+                type: array
+          description: successful operation
+        "400":
+          description: Invalid status value
+      security:
+      - petstore_auth:
+        - read:pets
+      summary: Finds Pets
+      tags:
+      - pet
   /pet/{petId}:
     delete:
       operationId: deletePet
       parameters:
-      - in: header
+      - explode: false
+        in: header
         name: api_key
+        required: false
         schema:
           type: string
+        style: simple
       - description: Pet id to delete
+        explode: false
         in: path
         name: petId
         required: true
         schema:
           format: int64
           type: integer
+        style: simple
       responses:
         "200":
           content: {}
@@ -201,12 +248,14 @@ paths:
       operationId: getPetById
       parameters:
       - description: ID of pet to return
+        explode: false
         in: path
         name: petId
         required: true
         schema:
           format: int64
           type: integer
+        style: simple
       responses:
         "200":
           content:
@@ -232,12 +281,14 @@ paths:
       operationId: updatePetWithForm
       parameters:
       - description: ID of pet that needs to be updated
+        explode: false
         in: path
         name: petId
         required: true
         schema:
           format: int64
           type: integer
+        style: simple
       requestBody:
         content:
           application/x-www-form-urlencoded:
@@ -259,12 +310,14 @@ paths:
       operationId: uploadFile
       parameters:
       - description: ID of pet to update
+        explode: false
         in: path
         name: petId
         required: true
         schema:
           format: int64
           type: integer
+        style: simple
       requestBody:
         content:
           multipart/form-data:
@@ -337,11 +390,13 @@ paths:
       operationId: deleteOrder
       parameters:
       - description: ID of the order that needs to be deleted
+        explode: false
         in: path
         name: order_id
         required: true
         schema:
           type: string
+        style: simple
       responses:
         "400":
           content: {}
@@ -358,6 +413,7 @@ paths:
       operationId: getOrderById
       parameters:
       - description: ID of pet that needs to be fetched
+        explode: false
         in: path
         name: order_id
         required: true
@@ -366,6 +422,7 @@ paths:
           maximum: 5
           minimum: 1
           type: integer
+        style: simple
       responses:
         "200":
           content:
@@ -449,17 +506,21 @@ paths:
       operationId: loginUser
       parameters:
       - description: The user name for login
+        explode: true
         in: query
         name: username
         required: true
         schema:
           type: string
+        style: form
       - description: The password for login in clear text
+        explode: true
         in: query
         name: password
         required: true
         schema:
           type: string
+        style: form
       responses:
         "200":
           content:
@@ -473,14 +534,18 @@ paths:
           headers:
             X-Rate-Limit:
               description: calls per hour allowed by the user
+              explode: false
               schema:
                 format: int32
                 type: integer
+              style: simple
             X-Expires-After:
               description: date in UTC when token expires
+              explode: false
               schema:
                 format: date-time
                 type: string
+              style: simple
         "400":
           content: {}
           description: Invalid username/password supplied
@@ -503,11 +568,13 @@ paths:
       operationId: deleteUser
       parameters:
       - description: The name that needs to be deleted
+        explode: false
         in: path
         name: username
         required: true
         schema:
           type: string
+        style: simple
       responses:
         "400":
           content: {}
@@ -522,11 +589,13 @@ paths:
       operationId: getUserByName
       parameters:
       - description: The name that needs to be fetched. Use user1 for testing.
+        explode: false
         in: path
         name: username
         required: true
         schema:
           type: string
+        style: simple
       responses:
         "200":
           content:
@@ -551,11 +620,13 @@ paths:
       operationId: updateUser
       parameters:
       - description: name that need to be deleted
+        explode: false
         in: path
         name: username
         required: true
         schema:
           type: string
+        style: simple
       requestBody:
         content:
           '*/*':
@@ -604,40 +675,55 @@ paths:
       operationId: testGroupParameters
       parameters:
       - description: Required String in group parameters
+        explode: true
         in: query
         name: required_string_group
         required: true
         schema:
           type: integer
+        style: form
       - description: Required Boolean in group parameters
+        explode: false
         in: header
         name: required_boolean_group
         required: true
         schema:
           type: boolean
+        style: simple
       - description: Required Integer in group parameters
+        explode: true
         in: query
         name: required_int64_group
         required: true
         schema:
           format: int64
           type: integer
+        style: form
       - description: String in group parameters
+        explode: true
         in: query
         name: string_group
+        required: false
         schema:
           type: integer
+        style: form
       - description: Boolean in group parameters
+        explode: false
         in: header
         name: boolean_group
+        required: false
         schema:
           type: boolean
+        style: simple
       - description: Integer in group parameters
+        explode: true
         in: query
         name: int64_group
+        required: false
         schema:
           format: int64
           type: integer
+        style: form
       responses:
         "400":
           content: {}
@@ -654,6 +740,7 @@ paths:
         explode: false
         in: header
         name: enum_header_string_array
+        required: false
         schema:
           items:
             default: $
@@ -664,8 +751,10 @@ paths:
           type: array
         style: simple
       - description: Header parameter enum test (string)
+        explode: false
         in: header
         name: enum_header_string
+        required: false
         schema:
           default: -efg
           enum:
@@ -673,10 +762,12 @@ paths:
           - -efg
           - (xyz)
           type: string
+        style: simple
       - description: Query parameter enum test (string array)
         explode: false
         in: query
         name: enum_query_string_array
+        required: false
         schema:
           items:
             default: $
@@ -687,8 +778,10 @@ paths:
           type: array
         style: form
       - description: Query parameter enum test (string)
+        explode: true
         in: query
         name: enum_query_string
+        required: false
         schema:
           default: -efg
           enum:
@@ -696,24 +789,31 @@ paths:
           - -efg
           - (xyz)
           type: string
+        style: form
       - description: Query parameter enum test (double)
+        explode: true
         in: query
         name: enum_query_integer
+        required: false
         schema:
           enum:
           - 1
           - -2
           format: int32
           type: integer
+        style: form
       - description: Query parameter enum test (double)
+        explode: true
         in: query
         name: enum_query_double
+        required: false
         schema:
           enum:
           - 1.1
           - -1.2
           format: double
           type: number
+        style: form
       requestBody:
         content:
           application/x-www-form-urlencoded:
@@ -903,11 +1003,13 @@ paths:
     put:
       operationId: testBodyWithQueryParams
       parameters:
-      - in: query
+      - explode: true
+        in: query
         name: query
         required: true
         schema:
           type: string
+        style: form
       requestBody:
         content:
           application/json:
@@ -961,12 +1063,14 @@ paths:
       operationId: 123_test_@#$%_special_tags
       parameters:
       - description: to test uuid example value
+        explode: false
         in: header
         name: uuid_test
         required: true
         schema:
           format: uuid
           type: string
+        style: simple
       requestBody:
         content:
           application/json:
@@ -1016,15 +1120,18 @@ paths:
           items:
             type: string
           type: array
-        style: form
+        style: pipeDelimited
-      - in: query
+      - explode: true
+        in: query
         name: ioutil
         required: true
         schema:
           items:
             type: string
           type: array
-      - in: query
+        style: form
+      - explode: false
+        in: query
         name: http
         required: true
         schema:
@@ -1061,12 +1168,14 @@ paths:
       operationId: uploadFileWithRequiredFile
       parameters:
       - description: ID of pet to update
+        explode: false
         in: path
         name: petId
         required: true
         schema:
           format: int64
           type: integer
+        style: simple
       requestBody:
         content:
           multipart/form-data:
@@ -1240,6 +1349,25 @@ components:
       type: object
       xml:
         name: Pet
+    PetFilter:
+      properties:
+        tags:
+          items:
+            type: string
+          type: array
+        status:
+          items:
+            type: string
+          type: array
+      type: object
+    PetOrder:
+      properties:
+        name:
+          enum:
+          - asc
+          - desc
+          type: string
+      type: object
     ApiResponse:
       example:
         code: 0
@@ -1254,14 +1382,6 @@ components:
         message:
           type: string
       type: object
-    $special[model.name]:
-      properties:
-        $special[property.name]:
-          format: int64
-          type: integer
-      type: object
-      xml:
-        name: "$special[model.name]"
     Return:
       description: Model for testing reserved words
       properties:
@@ -2146,4 +2266,3 @@ components:
     http_basic_test:
       scheme: basic
       type: http
-x-original-swagger-version: "2.0"

samples/client/petstore/haskell-http-client/tests/Instances.hs

@@ -470,6 +470,23 @@ genPet n =
     <*> arbitraryReducedMaybe n -- petTags :: Maybe [Tag]
     <*> arbitraryReducedMaybe n -- petStatus :: Maybe E'Status2
   
+instance Arbitrary PetFilter where
+  arbitrary = sized genPetFilter
+
+genPetFilter :: Int -> Gen PetFilter
+genPetFilter n =
+  PetFilter
+    <$> arbitraryReducedMaybe n -- petFilterTags :: Maybe [Text]
+    <*> arbitraryReducedMaybe n -- petFilterStatus :: Maybe [Text]
+  
+instance Arbitrary PetOrder where
+  arbitrary = sized genPetOrder
+
+genPetOrder :: Int -> Gen PetOrder
+genPetOrder n =
+  PetOrder
+    <$> arbitraryReducedMaybe n -- petOrderName :: Maybe E'Name
+  
 instance Arbitrary ReadOnlyFirst where
   arbitrary = sized genReadOnlyFirst
 
@@ -479,14 +496,6 @@ genReadOnlyFirst n =
     <$> arbitraryReducedMaybe n -- readOnlyFirstBar :: Maybe Text
     <*> arbitraryReducedMaybe n -- readOnlyFirstBaz :: Maybe Text
   
-instance Arbitrary SpecialModelName where
-  arbitrary = sized genSpecialModelName
-
-genSpecialModelName :: Int -> Gen SpecialModelName
-genSpecialModelName n =
-  SpecialModelName
-    <$> arbitraryReducedMaybe n -- specialModelNameSpecialPropertyName :: Maybe Integer
-  
 instance Arbitrary Tag where
   arbitrary = sized genTag
 
@@ -605,6 +614,9 @@ instance Arbitrary E'JustSymbol where
 instance Arbitrary E'Kind where
   arbitrary = arbitraryBoundedEnum
 
+instance Arbitrary E'Name where
+  arbitrary = arbitraryBoundedEnum
+
 instance Arbitrary E'Status where
   arbitrary = arbitraryBoundedEnum
 

samples/client/petstore/haskell-http-client/tests/Test.hs

@@ -58,8 +58,9 @@ main =
       propMimeEq MimeJSON (Proxy :: Proxy OuterComposite)
       propMimeEq MimeJSON (Proxy :: Proxy OuterEnum)
       propMimeEq MimeJSON (Proxy :: Proxy Pet)
+      propMimeEq MimeJSON (Proxy :: Proxy PetFilter)
+      propMimeEq MimeJSON (Proxy :: Proxy PetOrder)
       propMimeEq MimeJSON (Proxy :: Proxy ReadOnlyFirst)
-      propMimeEq MimeJSON (Proxy :: Proxy SpecialModelName)
       propMimeEq MimeJSON (Proxy :: Proxy Tag)
       propMimeEq MimeJSON (Proxy :: Proxy TypeHolderDefault)
       propMimeEq MimeJSON (Proxy :: Proxy TypeHolderExample)

samples/server/petstore/haskell-servant/lib/OpenAPIPetstore/API.hs

@@ -42,7 +42,9 @@ import           Control.Monad.Except               (ExceptT, runExceptT)
 import           Control.Monad.IO.Class
 import           Control.Monad.Trans.Reader         (ReaderT (..))
 import           Data.Aeson                         (Value)
+import qualified Data.Aeson                         as Aeson
 import           Data.ByteString                    (ByteString)
+import qualified Data.ByteString.Lazy               as BSL
 import           Data.Coerce                        (coerce)
 import           Data.Data                          (Data)
 import           Data.Function                      ((&))
@@ -52,6 +54,7 @@ import           Data.Proxy                         (Proxy (..))
 import           Data.Set                           (Set)
 import           Data.Text                          (Text)
 import qualified Data.Text                          as T
+import qualified Data.Text.Encoding                 as T
 import           Data.Time
 import           Data.UUID                          (UUID)
 import           GHC.Exts                           (IsString (..))
@@ -143,11 +146,22 @@ instance ToHttpApiData a => ToHttpApiData (QueryList 'MultiParamArray a) where
 formatSeparatedQueryList :: ToHttpApiData a => Char ->  QueryList p a -> Text
 formatSeparatedQueryList char = T.intercalate (T.singleton char) . map toQueryParam . fromQueryList
 
+newtype JSONQueryParam a = JSONQueryParam
+  { fromJsonQueryParam :: a
+  } deriving (Functor, Foldable, Traversable)
+
+instance Aeson.ToJSON a => ToHttpApiData (JSONQueryParam a) where
+  toQueryParam = T.decodeUtf8 . BSL.toStrict . Aeson.encode . fromJsonQueryParam
+
+instance Aeson.FromJSON a => FromHttpApiData (JSONQueryParam a) where
+  parseQueryParam = either (Left . T.pack) (Right . JSONQueryParam) . Aeson.eitherDecodeStrict . T.encodeUtf8
+
 
 -- | Servant type-level API, generated from the OpenAPI spec for OpenAPIPetstore.
 type OpenAPIPetstoreAPI
     =    Protected :> "pet" :> ReqBody '[JSON] Pet :> Verb 'POST 200 '[JSON] Pet -- 'addPet' route
     :<|> Protected :> "pet" :> Capture "petId" Integer :> Header "api_key" Text :> Verb 'DELETE 200 '[JSON] NoContent -- 'deletePet' route
+    :<|> Protected :> "pet" :> "find" :> QueryParam "filter" (JSONQueryParam PetFilter) :> Verb 'GET 200 '[JSON] [Pet] -- 'findPets' route
     :<|> Protected :> "pet" :> "findByStatus" :> QueryParam "status" (QueryList 'CommaSeparated (Text)) :> Verb 'GET 200 '[JSON] [Pet] -- 'findPetsByStatus' route
     :<|> Protected :> "pet" :> "findByTags" :> QueryParam "tags" (QueryList 'CommaSeparated (Text)) :> Verb 'GET 200 '[JSON] [Pet] -- 'findPetsByTags' route
     :<|> Protected :> "pet" :> Capture "petId" Integer :> Verb 'GET 200 '[JSON] Pet -- 'getPetById' route
@@ -188,6 +202,7 @@ newtype OpenAPIPetstoreClientError = OpenAPIPetstoreClientError ClientError
 data OpenAPIPetstoreBackend a m = OpenAPIPetstoreBackend
   { addPet :: a -> Pet -> m Pet{- ^  -}
   , deletePet :: a -> Integer -> Maybe Text -> m NoContent{- ^  -}
+  , findPets :: a -> Maybe PetFilter -> m [Pet]{- ^  -}
   , findPetsByStatus :: a -> Maybe [Text] -> m [Pet]{- ^ Multiple status values can be provided with comma separated strings -}
   , findPetsByTags :: a -> Maybe [Text] -> m [Pet]{- ^ Multiple tags can be provided with comma separated strings. Use tag1, tag2, tag3 for testing. -}
   , getPetById :: a -> Integer -> m Pet{- ^ Returns a single pet -}
@@ -240,6 +255,7 @@ createOpenAPIPetstoreClient = OpenAPIPetstoreBackend{..}
   where
     ((coerce -> addPet) :<|>
      (coerce -> deletePet) :<|>
+     (coerce -> findPets) :<|>
      (coerce -> findPetsByStatus) :<|>
      (coerce -> findPetsByTags) :<|>
      (coerce -> getPetById) :<|>
@@ -314,6 +330,7 @@ serverWaiApplicationOpenAPIPetstore auth backend = serveWithContextT (Proxy :: P
     serverFromBackend OpenAPIPetstoreBackend{..} =
       (coerce addPet :<|>
        coerce deletePet :<|>
+       coerce findPets :<|>
        coerce findPetsByStatus :<|>
        coerce findPetsByTags :<|>
        coerce getPetById :<|>

samples/server/petstore/haskell-servant/lib/OpenAPIPetstore/Types.hs

@@ -1,6 +1,7 @@
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE DeriveDataTypeable         #-}
 {-# LANGUAGE DeriveGeneric              #-}
+{-# LANGUAGE DuplicateRecordFields      #-}
 {-# OPTIONS_GHC -fno-warn-unused-binds -fno-warn-unused-imports #-}
 
 module OpenAPIPetstore.Types (
@@ -8,6 +9,7 @@ module OpenAPIPetstore.Types (
   Category (..),
   Order (..),
   Pet (..),
+  PetFilter (..),
   SpecialCharacters (..),
   Tag (..),
   User (..),
@@ -160,6 +162,34 @@ optionsPet =
       ]
 
 
+-- | 
+data PetFilter = PetFilter
+  { petFilterTags :: Maybe [Text] -- ^ 
+  , petFilterStatus :: Maybe [Text] -- ^ 
+  } deriving (Show, Eq, Generic, Data)
+
+instance FromJSON PetFilter where
+  parseJSON = genericParseJSON optionsPetFilter
+instance ToJSON PetFilter where
+  toJSON = genericToJSON optionsPetFilter
+instance ToSchema PetFilter where
+  declareNamedSchema = Swagger.genericDeclareNamedSchema
+    $ Swagger.fromAesonOptions
+    $ optionsPetFilter
+
+optionsPetFilter :: Options
+optionsPetFilter =
+  defaultOptions
+    { omitNothingFields  = True
+    , fieldLabelModifier = \s -> fromMaybe ("did not find JSON field name for " ++ show s) $ lookup s table
+    }
+  where
+    table =
+      [ ("petFilterTags", "tags")
+      , ("petFilterStatus", "status")
+      ]
+
+
 -- | description
 data SpecialCharacters = SpecialCharacters
   { specialCharactersDoubleQuote :: Text -- ^ double quote

samples/server/petstore/haskell-servant/stack.yaml

@@ -1,4 +1,4 @@
-resolver: lts-19.2
+resolver: lts-22.12
 extra-deps: []
 packages:
 - '.'

samples/server/petstore/haskell-yesod/config/routes.yesodroutes

@@ -6,6 +6,7 @@
 /pet PetR PUT POST
 /pet/findByStatus PetFindByStatusR GET
 /pet/findByTags PetFindByTagsR GET
+/pet/find PetFindR GET
 !/pet/#Int64 PetByInt64R GET POST DELETE
 /pet/#Int64/uploadImage PetByInt64UploadImageR POST
 /store/inventory StoreInventoryR GET

samples/server/petstore/haskell-yesod/src/Handler/Pet.hs

@@ -20,6 +20,12 @@ deletePetByInt64R :: Int64 -- ^ Pet id to delete
                   -> Handler Value
 deletePetByInt64R petId = notImplemented
 
+-- | Finds Pets
+--
+-- operationId: findPets
+getPetFindR :: Handler Value
+getPetFindR = notImplemented
+
 -- | Finds Pets by status
 --
 -- Multiple status values can be provided with comma separated strings

samples/server/petstore/haskell-yesod/src/OpenAPIPetstore/Types.hs

@@ -8,6 +8,7 @@ module OpenAPIPetstore.Types (
   Category (..),
   Order (..),
   Pet (..),
+  PetFilter (..),
   SpecialCharacters (..),
   Tag (..),
   User (..),
@@ -139,6 +140,30 @@ optionsPet =
       ]
 
 
+-- | 
+data PetFilter = PetFilter
+  { petFilterTags :: Maybe [Text] -- ^ 
+  , petFilterStatus :: Maybe [Text] -- ^ 
+  } deriving (Show, Eq, Generic)
+
+instance FromJSON PetFilter where
+  parseJSON = genericParseJSON optionsPetFilter
+instance ToJSON PetFilter where
+  toJSON = genericToJSON optionsPetFilter
+
+optionsPetFilter :: Options
+optionsPetFilter =
+  defaultOptions
+    { omitNothingFields  = True
+    , fieldLabelModifier = \s -> fromMaybe ("did not find JSON field name for " ++ show s) $ List.lookup s table
+    }
+  where
+    table =
+      [ ("petFilterTags", "tags")
+      , ("petFilterStatus", "status")
+      ]
+
+
 -- | description
 data SpecialCharacters = SpecialCharacters
   { specialCharactersDoubleQuote :: Text -- ^ double quote