loafle/openapi-generator
3
0
Fork 0
forked from loafle/openapi-generator-original
Code Pull Requests Activity

Haskell: JSON Query parameters (#18047)

Browse Source 
* Allow json encoded query paramters

* Also fix haskell-http-client

* Regenerate haskell samples
This commit is contained in:
Timo von Holtz 2024-03-12 02:35:18 -05:00 committed by GitHub
parent 6251aa17ef
commit 5975e6c5b0
No known key found for this signature in database
GPG Key ID: B5690EEEBB952194
25 changed files with 2683 additions and 70 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
bin/configs/haskell-http-client.yaml
View File

@ -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: ''

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

@ -745,10 +745,15 @@ 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
// 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);

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

@ -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";

7
modules/openapi-generator/src/main/resources/haskell-http-client/Core.mustache vendored
View File

@ -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

1
modules/openapi-generator/src/main/resources/haskell-http-client/Model.mustache vendored
View File

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

2
modules/openapi-generator/src/main/resources/haskell-http-client/_queryColl.mustache vendored
View File

@ -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}}

13
modules/openapi-generator/src/main/resources/haskell-servant/API.mustache vendored
View File

@ -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}}.

1
modules/openapi-generator/src/main/resources/haskell-servant/Types.mustache vendored
View File

@ -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 (

2
modules/openapi-generator/src/main/resources/haskell-servant/stack.mustache vendored
View File

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

2200
modules/openapi-generator/src/test/resources/3_0/haskell-http-client/petstore-with-fake-endpoints-models-for-testing.yaml Normal file
View File

File diff suppressed because it is too large Load Diff

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

@ -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

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

@ -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 CommaSeparated ("ioutil", Just ioutil)
`addQuery` toQueryColl PipeSeparated ("pipe", Just pipe)
`addQuery` toQueryColl MultiParamArray ("ioutil", Just ioutil)
`addQuery` toQueryColl SpaceSeparated ("http", Just http)
`addQuery` toQueryColl CommaSeparated ("url", Just url)
`addQuery` toQueryColl MultiParamArray ("context", Just context)

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

@ -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@

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

@ -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

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

@ -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' .

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

@ -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

147
samples/client/petstore/haskell-http-client/openapi.yaml
View File

@ -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
- in: query
style: pipeDelimited
- 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"

28
samples/client/petstore/haskell-http-client/tests/Instances.hs
View File

@ -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

3
samples/client/petstore/haskell-http-client/tests/Test.hs
View File

@ -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)

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

@ -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 :<|>

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

@ -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

2
samples/server/petstore/haskell-servant/stack.yaml
View File

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

1
samples/server/petstore/haskell-yesod/config/routes.yesodroutes
View File

@ -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

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

@ -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

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

@ -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