Haskell: JSON Query parameters (#18047)

* Allow json encoded query paramters

* Also fix haskell-http-client

* Regenerate haskell samples

Author: tvh

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,10 +745,15 @@ public void addOperationToGroup(String tag, String resourcePath, Operation opera
             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
-                // 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));
+            } 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 CodegenOperation fromOperation(String resourcePath, String httpMethod, Op
         // 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 CodegenOperation fromOperation(String resourcePath, String httpMethod, Op
             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:
 - '.'