Add bytestring package to dependencies of generated haskell code (#19101)

* Add bytestring package to dependencies of generated haskell code

This broke in https://github.com/OpenAPITools/openapi-generator/pull/18047
where tvh introduced an import of Data.ByteString.Lazy. The added
bytestring package was available in some but not all cases.

* update workflow to test haskell servant ping

* update samples

---------

Co-authored-by: Bastian Senst <senst@cp-med.com>
This commit is contained in:
William Cheng 2024-07-07 22:06:20 +08:00 committed by GitHub
parent 8f7cce716f
commit 0820edee5d
No known key found for this signature in database
GPG Key ID: B5690EEEBB952194
12 changed files with 488 additions and 4 deletions

View File

@ -5,11 +5,13 @@ on:
paths:
- samples/server/petstore/haskell-yesod/**
- samples/server/petstore/haskell-servant/**
- samples/server/others/haskell-servant-ping/**
- samples/client/petstore/haskell-http-client/**
pull_request:
paths:
- samples/server/petstore/haskell-yesod/**
- samples/server/petstore/haskell-servant/**
- samples/server/others/haskell-servant-ping/**
- samples/client/petstore/haskell-http-client/**
jobs:
build:
@ -22,6 +24,7 @@ jobs:
# servers
- samples/server/petstore/haskell-yesod/
- samples/server/petstore/haskell-servant/
- samples/server/others/haskell-servant-ping/
- samples/client/petstore/haskell-http-client/
steps:
- uses: actions/checkout@v4

View File

@ -0,0 +1,4 @@
generatorName: haskell
outputDir: samples/server/others/haskell-servant-ping
inputSpec: modules/openapi-generator/src/test/resources/3_0/ping.yaml
templateDir: modules/openapi-generator/src/main/resources/haskell-servant

View File

@ -38,12 +38,9 @@ library
, http-types
, swagger2
, uuid
, bytestring
{{#authMethods}}
{{#isApiKey}}
, bytestring
{{/isApiKey}}
{{#isBasicBearer}}
, bytestring
, wai-extra
{{/isBasicBearer}}
{{#isBasicBasic}}

View File

@ -0,0 +1,23 @@
# OpenAPI Generator Ignore
# Generated by openapi-generator https://github.com/openapitools/openapi-generator
# Use this file to prevent files from being overwritten by the generator.
# The patterns follow closely to .gitignore or .dockerignore.
# As an example, the C# client generator defines ApiClient.cs.
# You can make changes and tell OpenAPI Generator to ignore just this file by uncommenting the following line:
#ApiClient.cs
# You can match any string of characters against a directory, file or extension with a single asterisk (*):
#foo/*/qux
# The above matches foo/bar/qux and foo/baz/qux, but not foo/bar/baz/qux
# You can recursively match patterns against a directory, file or extension with a double asterisk (**):
#foo/**/qux
# This matches foo/bar/qux, foo/baz/qux, and foo/bar/baz/qux
# You can also negate patterns with an exclamation (!).
# For example, you can ignore all files in a docs folder with the file extension .md:
#docs/*.md
# Then explicitly reverse the ignore rule for a single file:
#!docs/README.md

View File

@ -0,0 +1,6 @@
README.md
Setup.hs
lib/PingTest/API.hs
lib/PingTest/Types.hs
ping-test.cabal
stack.yaml

View File

@ -0,0 +1 @@
7.8.0-SNAPSHOT

View File

@ -0,0 +1,128 @@
# Auto-Generated OpenAPI Bindings to `PingTest`
The library in `lib` provides auto-generated-from-OpenAPI bindings to the PingTest API.
## Installation
Installation follows the standard approach to installing Stack-based projects.
1. Install the [Haskell `stack` tool](http://docs.haskellstack.org/en/stable/README).
2. Run `stack install` to install this package.
Otherwise, if you already have a Stack project, you can include this package under the `packages` key in your `stack.yaml`:
```yaml
packages:
- location:
git: https://github.com/yourGitOrg/yourGitRepo
commit: somecommit
```
## Main Interface
The main interface to this library is in the `PingTest.API` module, which exports the PingTestBackend type. The PingTestBackend
type can be used to create and define servers and clients for the API.
## Creating a Client
A client can be created via the `createPingTestClient` function, which will generate a function for every endpoint of the API.
Then these functions can be invoked with `runPingTestClientWithManager` or more conveniently with `callPingTestClient`
(depending if you want an `Either` back or you want to catch) to access the API endpoint they refer to, if the API is served
at the `url` you specified.
For example, if `localhost:8080` is serving the PingTest API, you can write:
```haskell
{-# LANGUAGE RecordWildCards #-}
import PingTest.API as API
import Network.HTTP.Client (newManager)
import Network.HTTP.Client.TLS (tlsManagerSettings)
import Servant.Client (ClientEnv, mkClientEnv, parseBaseUrl)
main :: IO ()
main = do
-- Configure the BaseUrl for the client
url <- parseBaseUrl "http://localhost:8080/"
-- You probably want to reuse the Manager across calls, for performance reasons
manager <- newManager tlsManagerSettings
-- Create the client (all endpoint functions will be available)
let PingTestBackend{..} = API.createPingTestClient
-- Any PingTest API call can go here, e.g. here we call `getSomeEndpoint`
API.callPingTest (mkClientEnv manager url) getSomeEndpoint
```
## Creating a Server
In order to create a server, you must use the `runPingTestMiddlewareServer` function. However, you unlike the client, in which case you *got* a `PingTestBackend`
from the library, you must instead *provide* a `PingTestBackend`. For example, if you have defined handler functions for all the
functions in `PingTest.Handlers`, you can write:
```haskell
{-# LANGUAGE RecordWildCards #-}
import PingTest.API
-- required dependency: wai
import Network.Wai (Middleware)
-- required dependency: wai-extra
import Network.Wai.Middleware.RequestLogger (logStdout)
-- A module you wrote yourself, containing all handlers needed for the PingTestBackend type.
import PingTest.Handlers
-- If you would like to not use any middlewares you could use runPingTestServer instead
-- Combined middlewares
requestMiddlewares :: Middleware
requestMiddlewares = logStdout
-- Run a PingTest server on localhost:8080
main :: IO ()
main = do
let server = PingTestBackend{..}
config = Config "http://localhost:8080/"
runPingTestMiddlewareServer config requestMiddlewares server
```
## Authentication
Currently basic, bearer and API key authentication is supported. The API key must be provided
in the request header.
For clients authentication the function `clientAuth` is generated automatically. For basic
authentication the argument is of type `BasicAuthData` provided by `Servant.API.BasicAuth`.
For bearer and API key authentication the argument is the key/token and is of type `Text`.
Protected endpoints on the client will receive an extra argument. The value returned by
`clientAuth keyTokenOrBasic` can then be used to make authenticated requests.
For the server you are free to choose a custom data type. After you specified an instance of
`AuthServerData` it is automatically added as a first argument to protected endpoints:
```
newtype Account = Account {unAccount :: Text}
type instance AuthServerData Protected = Account
```
Additionally, you have to provide value for the `PingTestAuth` type provided by the
`PingTest.API` module:
```
auth :: PingTestAuth
auth =
PingTestAuth
{ lookupUser = lookupAccount,
authError = \request -> err401 {errBody = "Missing header"}
}
```
`lookupAccount` is a user defined function used to verify the key, token or basic auth data.
`authError` takes a `Request` and returns a `ServerError`. The value is used by the server
functions:
```
runPingTestMiddlewareServer config requestMiddlewares auth server
```

View File

@ -0,0 +1,2 @@
import Distribution.Simple
main = defaultMain

View File

@ -0,0 +1,245 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE ViewPatterns #-}
{-# OPTIONS_GHC
-fno-warn-unused-binds -fno-warn-unused-imports -freduction-depth=328 #-}
module PingTest.API
( -- * Client and Server
Config(..)
, PingTestBackend(..)
, createPingTestClient
, runPingTestServer
, runPingTestMiddlewareServer
, runPingTestClient
, runPingTestClientWithManager
, callPingTest
, PingTestClient
, PingTestClientError(..)
-- ** Servant
, PingTestAPI
-- ** Plain WAI Application
, serverWaiApplicationPingTest
) where
import PingTest.Types
import Control.Monad.Catch (Exception, MonadThrow, throwM)
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 qualified Data.ByteString.Lazy as BSL
import Data.Coerce (coerce)
import Data.Data (Data)
import Data.Function ((&))
import qualified Data.Map as Map
import Data.Monoid ((<>))
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 (..))
import GHC.Generics (Generic)
import Network.HTTP.Client (Manager, newManager)
import Network.HTTP.Client.TLS (tlsManagerSettings)
import Network.HTTP.Types.Method (methodOptions)
import Network.Wai (Middleware)
import qualified Network.Wai.Handler.Warp as Warp
import Servant (ServerError, serveWithContextT)
import Servant.API hiding (addHeader)
import Servant.API.Verbs (StdMethod (..), Verb)
import Servant.Client (ClientEnv, Scheme (Http), ClientError, client,
mkClientEnv, parseBaseUrl)
import Servant.Client.Core (baseUrlPort, baseUrlHost)
import Servant.Client.Internal.HttpClient (ClientM (..))
import Servant.Server (Handler (..), Application, Context (EmptyContext))
import Servant.Server.StaticFiles (serveDirectoryFileServer)
import Web.FormUrlEncoded
import Web.HttpApiData
-- | List of elements parsed from a query.
newtype QueryList (p :: CollectionFormat) a = QueryList
{ fromQueryList :: [a]
} deriving (Functor, Applicative, Monad, Foldable, Traversable)
-- | Formats in which a list can be encoded into a HTTP path.
data CollectionFormat
= CommaSeparated -- ^ CSV format for multiple parameters.
| SpaceSeparated -- ^ Also called "SSV"
| TabSeparated -- ^ Also called "TSV"
| PipeSeparated -- ^ `value1|value2|value2`
| MultiParamArray -- ^ Using multiple GET parameters, e.g. `foo=bar&foo=baz`. Only for GET params.
instance FromHttpApiData a => FromHttpApiData (QueryList 'CommaSeparated a) where
parseQueryParam = parseSeparatedQueryList ','
instance FromHttpApiData a => FromHttpApiData (QueryList 'TabSeparated a) where
parseQueryParam = parseSeparatedQueryList '\t'
instance FromHttpApiData a => FromHttpApiData (QueryList 'SpaceSeparated a) where
parseQueryParam = parseSeparatedQueryList ' '
instance FromHttpApiData a => FromHttpApiData (QueryList 'PipeSeparated a) where
parseQueryParam = parseSeparatedQueryList '|'
instance FromHttpApiData a => FromHttpApiData (QueryList 'MultiParamArray a) where
parseQueryParam = error "unimplemented FromHttpApiData for MultiParamArray collection format"
parseSeparatedQueryList :: FromHttpApiData a => Char -> Text -> Either Text (QueryList p a)
parseSeparatedQueryList char = fmap QueryList . mapM parseQueryParam . T.split (== char)
instance ToHttpApiData a => ToHttpApiData (QueryList 'CommaSeparated a) where
toQueryParam = formatSeparatedQueryList ','
instance ToHttpApiData a => ToHttpApiData (QueryList 'TabSeparated a) where
toQueryParam = formatSeparatedQueryList '\t'
instance ToHttpApiData a => ToHttpApiData (QueryList 'SpaceSeparated a) where
toQueryParam = formatSeparatedQueryList ' '
instance ToHttpApiData a => ToHttpApiData (QueryList 'PipeSeparated a) where
toQueryParam = formatSeparatedQueryList '|'
instance ToHttpApiData a => ToHttpApiData (QueryList 'MultiParamArray a) where
toQueryParam = error "unimplemented ToHttpApiData for MultiParamArray collection format"
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 PingTest.
type PingTestAPI
= "ping" :> Verb 'GET 201 '[JSON] NoContent -- 'pingGet' route
:<|> Raw
-- | Server or client configuration, specifying the host and port to query or serve on.
data Config = Config
{ configUrl :: String -- ^ scheme://hostname:port/path, e.g. "http://localhost:8080/"
} deriving (Eq, Ord, Show, Read)
-- | Custom exception type for our errors.
newtype PingTestClientError = PingTestClientError ClientError
deriving (Show, Exception)
-- | Configuration, specifying the full url of the service.
-- | Backend for PingTest.
-- The backend can be used both for the client and the server. The client generated from the PingTest OpenAPI spec
-- is a backend that executes actions by sending HTTP requests (see @createPingTestClient@). Alternatively, provided
-- a backend, the API can be served using @runPingTestMiddlewareServer@.
data PingTestBackend m = PingTestBackend
{ pingGet :: m NoContent{- ^ -}
}
newtype PingTestClient a = PingTestClient
{ runClient :: ClientEnv -> ExceptT ClientError IO a
} deriving Functor
instance Applicative PingTestClient where
pure x = PingTestClient (\_ -> pure x)
(PingTestClient f) <*> (PingTestClient x) =
PingTestClient (\env -> f env <*> x env)
instance Monad PingTestClient where
(PingTestClient a) >>= f =
PingTestClient (\env -> do
value <- a env
runClient (f value) env)
instance MonadIO PingTestClient where
liftIO io = PingTestClient (\_ -> liftIO io)
createPingTestClient :: PingTestBackend PingTestClient
createPingTestClient = PingTestBackend{..}
where
((coerce -> pingGet) :<|>
_) = client (Proxy :: Proxy PingTestAPI)
-- | Run requests in the PingTestClient monad.
runPingTestClient :: Config -> PingTestClient a -> ExceptT ClientError IO a
runPingTestClient clientConfig cl = do
manager <- liftIO $ newManager tlsManagerSettings
runPingTestClientWithManager manager clientConfig cl
-- | Run requests in the PingTestClient monad using a custom manager.
runPingTestClientWithManager :: Manager -> Config -> PingTestClient a -> ExceptT ClientError IO a
runPingTestClientWithManager manager Config{..} cl = do
url <- parseBaseUrl configUrl
runClient cl $ mkClientEnv manager url
-- | Like @runClient@, but returns the response or throws
-- a PingTestClientError
callPingTest
:: (MonadIO m, MonadThrow m)
=> ClientEnv -> PingTestClient a -> m a
callPingTest env f = do
res <- liftIO $ runExceptT $ runClient f env
case res of
Left err -> throwM (PingTestClientError err)
Right response -> pure response
requestMiddlewareId :: Application -> Application
requestMiddlewareId a = a
-- | Run the PingTest server at the provided host and port.
runPingTestServer
:: (MonadIO m, MonadThrow m)
=> Config -> PingTestBackend (ExceptT ServerError IO) -> m ()
runPingTestServer config backend = runPingTestMiddlewareServer config requestMiddlewareId backend
-- | Run the PingTest server at the provided host and port.
runPingTestMiddlewareServer
:: (MonadIO m, MonadThrow m)
=> Config -> Middleware -> PingTestBackend (ExceptT ServerError IO) -> m ()
runPingTestMiddlewareServer Config{..} middleware backend = do
url <- parseBaseUrl configUrl
let warpSettings = Warp.defaultSettings
& Warp.setPort (baseUrlPort url)
& Warp.setHost (fromString $ baseUrlHost url)
liftIO $ Warp.runSettings warpSettings $ middleware $ serverWaiApplicationPingTest backend
-- | Plain "Network.Wai" Application for the PingTest server.
--
-- Can be used to implement e.g. tests that call the API without a full webserver.
serverWaiApplicationPingTest :: PingTestBackend (ExceptT ServerError IO) -> Application
serverWaiApplicationPingTest backend = serveWithContextT (Proxy :: Proxy PingTestAPI) context id (serverFromBackend backend)
where
context = serverContext
serverFromBackend PingTestBackend{..} =
(coerce pingGet :<|>
serveDirectoryFileServer "static")
serverContext :: Context ('[])
serverContext = EmptyContext

View File

@ -0,0 +1,25 @@
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# OPTIONS_GHC -fno-warn-unused-binds -fno-warn-unused-imports #-}
module PingTest.Types (
) where
import Data.Data (Data)
import Data.UUID (UUID)
import Data.List (lookup)
import Data.Maybe (fromMaybe)
import Data.Aeson (Value, FromJSON(..), ToJSON(..), genericToJSON, genericParseJSON)
import Data.Aeson.Types (Options(..), defaultOptions)
import Data.Set (Set)
import Data.Text (Text)
import Data.Time
import Data.Swagger (ToSchema, declareNamedSchema)
import qualified Data.Swagger as Swagger
import qualified Data.Char as Char
import qualified Data.Text as T
import qualified Data.Map as Map
import GHC.Generics (Generic)

View File

@ -0,0 +1,42 @@
name: ping-test
version: 0.1.0.0
synopsis: Auto-generated API bindings for ping-test
description: Please see README.md
homepage: https://openapi-generator.tech
author: Author Name Here
maintainer: author.name@email.com
copyright: YEAR - AUTHOR
category: Web
build-type: Simple
cabal-version: >=1.10
library
hs-source-dirs: lib
exposed-modules: PingTest.API
, PingTest.Types
ghc-options: -Wall
build-depends: base
, aeson
, text
, containers
, exceptions
, network-uri
, servant
, http-api-data
, servant
, servant-client
, servant-client-core
, servant-server
, servant
, wai
, warp
, transformers
, mtl
, time
, http-client
, http-client-tls
, http-types
, swagger2
, uuid
, bytestring
default-language: Haskell2010

View File

@ -0,0 +1,8 @@
resolver: lts-22.12
extra-deps: []
packages:
- '.'
nix:
enable: false
packages:
- zlib