Skip to content

Commit 4958ad7

Browse files
Fjolnir-Dvorakjonschoning
Fjolnir-Dvorak
authored and
jonschoning
committed
[FEATURE][Haskell] Add Middleware support for the haskell servant generator (#4056)
* updated the golden files for haskell to be able to generate against those * Added support for middlewares in the haskell servant generator. * Renamed runOpenAPIPetstoreServer to runOpenAPIPetstoreMiddlewareServer and added a backwards compability version runOpenAPIPetstoreServer using requestMiddlewareId as middleware.
1 parent 33f63d6 commit 4958ad7

8 files changed

Lines changed: 61 additions & 49 deletions

File tree

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

Lines changed: 16 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -19,6 +19,7 @@ module {{title}}.API
1919
, {{title}}Backend(..)
2020
, create{{title}}Client
2121
, run{{title}}Server
22+
, run{{title}}MiddlewareServer
2223
, run{{title}}Client
2324
, run{{title}}ClientWithManager
2425
, call{{title}}
@@ -51,6 +52,7 @@ import GHC.Generics (Generic)
5152
import Network.HTTP.Client (Manager, newManager)
5253
import Network.HTTP.Client.TLS (tlsManagerSettings)
5354
import Network.HTTP.Types.Method (methodOptions)
55+
import Network.Wai (Middleware)
5456
import qualified Network.Wai.Handler.Warp as Warp
5557
import Servant (ServerError, serve)
5658
import Servant.API
@@ -149,7 +151,7 @@ newtype {{title}}ClientError = {{title}}ClientError ClientError
149151
-- | Backend for {{title}}.
150152
-- The backend can be used both for the client and the server. The client generated from the {{title}} OpenAPI spec
151153
-- is a backend that executes actions by sending HTTP requests (see @create{{title}}Client@). Alternatively, provided
152-
-- a backend, the API can be served using @run{{title}}Server@.
154+
-- a backend, the API can be served using @run{{title}}MiddlewareServer@.
153155
data {{title}}Backend m = {{title}}Backend
154156
{ {{#apis}}{{#operations}}{{#operation}}{{operationId}} :: {{& vendorExtensions.x-clientType}}{- ^ {{& notes}} -}{{#hasMore}}
155157
, {{/hasMore}}{{/operation}}{{/operations}}{{#hasMore}}
@@ -207,17 +209,27 @@ call{{title}} env f = do
207209
Right response -> pure response
208210
{{/apiInfo}}
209211

212+
210213
{{#apiInfo}}
214+
requestMiddlewareId :: Application -> Application
215+
requestMiddlewareId a = a
216+
211217
-- | Run the {{title}} server at the provided host and port.
212218
run{{title}}Server
219+
:: (MonadIO m, MonadThrow m)
220+
=> Config -> {{title}}Backend (ExceptT ServerError IO) -> m ()
221+
run{{title}}Server config backend = run{{title}}MiddlewareServer config requestMiddlewareId backend
222+
223+
-- | Run the {{title}} server at the provided host and port.
224+
run{{title}}MiddlewareServer
213225
:: (MonadIO m, MonadThrow m)
214-
=> Config -> {{title}}Backend (ExceptT ServerError IO) -> m ()
215-
run{{title}}Server Config{..} backend = do
226+
=> Config -> Middleware -> {{title}}Backend (ExceptT ServerError IO) -> m ()
227+
run{{title}}MiddlewareServer Config{..} middleware backend = do
216228
url <- parseBaseUrl configUrl
217229
let warpSettings = Warp.defaultSettings
218230
& Warp.setPort (baseUrlPort url)
219231
& Warp.setHost (fromString $ baseUrlHost url)
220-
liftIO $ Warp.runSettings warpSettings $ serve (Proxy :: Proxy {{title}}API) (serverFromBackend backend)
232+
liftIO $ Warp.runSettings warpSettings $ middleware $ serve (Proxy :: Proxy {{title}}API) (serverFromBackend backend)
221233
where
222234
serverFromBackend {{title}}Backend{..} =
223235
({{#apis}}{{#operations}}{{#operation}}coerce {{operationId}}{{#hasMore}} :<|>

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

Lines changed: 12 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -58,22 +58,32 @@ main = do
5858

5959
## Creating a Server
6060

61-
In order to create a server, you must use the `run{{title}}Server` function. However, you unlike the client, in which case you *got* a `{{title}}Backend`
61+
In order to create a server, you must use the `run{{title}}MiddlewareServer` function. However, you unlike the client, in which case you *got* a `{{title}}Backend`
6262
from the library, you must instead *provide* a `{{title}}Backend`. For example, if you have defined handler functions for all the
6363
functions in `{{title}}.Handlers`, you can write:
6464

6565
```haskell
6666
{-# LANGUAGE RecordWildCards #-}
6767

6868
import {{title}}.API
69+
-- required dependency: wai
70+
import Network.Wai (Middleware)
71+
-- required dependency: wai-extra
72+
import Network.Wai.Middleware.RequestLogger (logStdout)
6973

7074
-- A module you wrote yourself, containing all handlers needed for the {{title}}Backend type.
7175
import {{title}}.Handlers
7276

77+
-- If you would like to not use any middlewares you could use run{{title}}Server instead
78+
79+
-- Combined middlewares
80+
requestMiddlewares :: Middleware
81+
requestMiddlewares = logStdout
82+
7383
-- Run a {{title}} server on localhost:8080
7484
main :: IO ()
7585
main = do
7686
let server = {{title}}Backend{..}
7787
config = Config "http://localhost:8080/"
78-
run{{title}}Server config server
88+
run{{title}}MiddlewareServer config requestMiddlewares server
7989
```

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

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -28,6 +28,7 @@ library
2828
, servant-client-core
2929
, servant-server
3030
, servant
31+
, wai
3132
, warp
3233
, transformers
3334
, mtl

‎samples/server/petstore/haskell-servant/.openapi-generator/VERSION‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1 +1 @@
1-
4.0.3-SNAPSHOT
1+
4.2.0-SNAPSHOT

‎samples/server/petstore/haskell-servant/README.md‎

Lines changed: 12 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -58,22 +58,32 @@ main = do
5858

5959
## Creating a Server
6060

61-
In order to create a server, you must use the `runOpenAPIPetstoreServer` function. However, you unlike the client, in which case you *got* a `OpenAPIPetstoreBackend`
61+
In order to create a server, you must use the `runOpenAPIPetstoreMiddlewareServer` function. However, you unlike the client, in which case you *got* a `OpenAPIPetstoreBackend`
6262
from the library, you must instead *provide* a `OpenAPIPetstoreBackend`. For example, if you have defined handler functions for all the
6363
functions in `OpenAPIPetstore.Handlers`, you can write:
6464

6565
```haskell
6666
{-# LANGUAGE RecordWildCards #-}
6767

6868
import OpenAPIPetstore.API
69+
-- required dependency: wai
70+
import Network.Wai (Middleware)
71+
-- required dependency: wai-extra
72+
import Network.Wai.Middleware.RequestLogger (logStdout)
6973

7074
-- A module you wrote yourself, containing all handlers needed for the OpenAPIPetstoreBackend type.
7175
import OpenAPIPetstore.Handlers
7276

77+
-- If you would like to not use any middlewares you could use runOpenAPIPetstoreServer instead
78+
79+
-- Combined middlewares
80+
requestMiddlewares :: Middleware
81+
requestMiddlewares = logStdout
82+
7383
-- Run a OpenAPIPetstore server on localhost:8080
7484
main :: IO ()
7585
main = do
7686
let server = OpenAPIPetstoreBackend{..}
7787
config = Config "http://localhost:8080/"
78-
runOpenAPIPetstoreServer config server
88+
runOpenAPIPetstoreMiddlewareServer config requestMiddlewares server
7989
```

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

Lines changed: 18 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -19,6 +19,7 @@ module OpenAPIPetstore.API
1919
, OpenAPIPetstoreBackend(..)
2020
, createOpenAPIPetstoreClient
2121
, runOpenAPIPetstoreServer
22+
, runOpenAPIPetstoreMiddlewareServer
2223
, runOpenAPIPetstoreClient
2324
, runOpenAPIPetstoreClientWithManager
2425
, callOpenAPIPetstore
@@ -51,6 +52,7 @@ import GHC.Generics (Generic)
5152
import Network.HTTP.Client (Manager, newManager)
5253
import Network.HTTP.Client.TLS (tlsManagerSettings)
5354
import Network.HTTP.Types.Method (methodOptions)
55+
import Network.Wai (Middleware)
5456
import qualified Network.Wai.Handler.Warp as Warp
5557
import Servant (ServerError, serve)
5658
import Servant.API
@@ -137,7 +139,7 @@ type OpenAPIPetstoreAPI
137139
= "pet" :> ReqBody '[JSON] Pet :> Verb 'POST 200 '[JSON] () -- 'addPet' route
138140
:<|> "pet" :> Capture "petId" Integer :> Header "api_key" Text :> Verb 'DELETE 200 '[JSON] () -- 'deletePet' route
139141
:<|> "pet" :> "findByStatus" :> QueryParam "status" (QueryList 'CommaSeparated (Text)) :> Verb 'GET 200 '[JSON] [Pet] -- 'findPetsByStatus' route
140-
:<|> "pet" :> "findByTags" :> QueryParam "tags" (QueryList 'CommaSeparated (Text)) :> QueryParam "maxCount" Int :> Verb 'GET 200 '[JSON] [Pet] -- 'findPetsByTags' route
142+
:<|> "pet" :> "findByTags" :> QueryParam "tags" (QueryList 'CommaSeparated (Text)) :> Verb 'GET 200 '[JSON] [Pet] -- 'findPetsByTags' route
141143
:<|> "pet" :> Capture "petId" Integer :> Verb 'GET 200 '[JSON] Pet -- 'getPetById' route
142144
:<|> "pet" :> ReqBody '[JSON] Pet :> Verb 'PUT 200 '[JSON] () -- 'updatePet' route
143145
:<|> "pet" :> Capture "petId" Integer :> ReqBody '[FormUrlEncoded] FormUpdatePetWithForm :> Verb 'POST 200 '[JSON] () -- 'updatePetWithForm' route
@@ -171,12 +173,12 @@ newtype OpenAPIPetstoreClientError = OpenAPIPetstoreClientError ClientError
171173
-- | Backend for OpenAPIPetstore.
172174
-- The backend can be used both for the client and the server. The client generated from the OpenAPIPetstore OpenAPI spec
173175
-- is a backend that executes actions by sending HTTP requests (see @createOpenAPIPetstoreClient@). Alternatively, provided
174-
-- a backend, the API can be served using @runOpenAPIPetstoreServer@.
176+
-- a backend, the API can be served using @runOpenAPIPetstoreMiddlewareServer@.
175177
data OpenAPIPetstoreBackend m = OpenAPIPetstoreBackend
176178
{ addPet :: Pet -> m (){- ^ -}
177179
, deletePet :: Integer -> Maybe Text -> m (){- ^ -}
178180
, findPetsByStatus :: Maybe [Text] -> m [Pet]{- ^ Multiple status values can be provided with comma separated strings -}
179-
, findPetsByTags :: Maybe [Text] -> Maybe Int -> m [Pet]{- ^ Multiple tags can be provided with comma separated strings. Use tag1, tag2, tag3 for testing. -}
181+
, findPetsByTags :: Maybe [Text] -> m [Pet]{- ^ Multiple tags can be provided with comma separated strings. Use tag1, tag2, tag3 for testing. -}
180182
, getPetById :: Integer -> m Pet{- ^ Returns a single pet -}
181183
, updatePet :: Pet -> m (){- ^ -}
182184
, updatePetWithForm :: Integer -> FormUpdatePetWithForm -> m (){- ^ -}
@@ -260,16 +262,26 @@ callOpenAPIPetstore env f = do
260262
Left err -> throwM (OpenAPIPetstoreClientError err)
261263
Right response -> pure response
262264

265+
266+
requestMiddlewareId :: Application -> Application
267+
requestMiddlewareId a = a
268+
263269
-- | Run the OpenAPIPetstore server at the provided host and port.
264270
runOpenAPIPetstoreServer
271+
:: (MonadIO m, MonadThrow m)
272+
=> Config -> OpenAPIPetstoreBackend (ExceptT ServerError IO) -> m ()
273+
runOpenAPIPetstoreServer config backend = runOpenAPIPetstoreMiddlewareServer config requestMiddlewareId backend
274+
275+
-- | Run the OpenAPIPetstore server at the provided host and port.
276+
runOpenAPIPetstoreMiddlewareServer
265277
:: (MonadIO m, MonadThrow m)
266-
=> Config -> OpenAPIPetstoreBackend (ExceptT ServerError IO) -> m ()
267-
runOpenAPIPetstoreServer Config{..} backend = do
278+
=> Config -> Middleware -> OpenAPIPetstoreBackend (ExceptT ServerError IO) -> m ()
279+
runOpenAPIPetstoreMiddlewareServer Config{..} middleware backend = do
268280
url <- parseBaseUrl configUrl
269281
let warpSettings = Warp.defaultSettings
270282
& Warp.setPort (baseUrlPort url)
271283
& Warp.setHost (fromString $ baseUrlHost url)
272-
liftIO $ Warp.runSettings warpSettings $ serve (Proxy :: Proxy OpenAPIPetstoreAPI) (serverFromBackend backend)
284+
liftIO $ Warp.runSettings warpSettings $ middleware $ serve (Proxy :: Proxy OpenAPIPetstoreAPI) (serverFromBackend backend)
273285
where
274286
serverFromBackend OpenAPIPetstoreBackend{..} =
275287
(coerce addPet :<|>

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

Lines changed: 0 additions & 34 deletions
Original file line numberDiff line numberDiff line change
@@ -6,8 +6,6 @@
66
module OpenAPIPetstore.Types (
77
ApiResponse (..),
88
Category (..),
9-
InlineObject (..),
10-
InlineObject1 (..),
119
Order (..),
1210
Pet (..),
1311
Tag (..),
@@ -65,38 +63,6 @@ instance ToSchema Category where
6563
$ removeFieldLabelPrefix False "category"
6664

6765

68-
-- |
69-
data InlineObject = InlineObject
70-
{ inlineObjectName :: Maybe Text -- ^ Updated name of the pet
71-
, inlineObjectStatus :: Maybe Text -- ^ Updated status of the pet
72-
} deriving (Show, Eq, Generic, Data)
73-
74-
instance FromJSON InlineObject where
75-
parseJSON = genericParseJSON (removeFieldLabelPrefix True "inlineObject")
76-
instance ToJSON InlineObject where
77-
toJSON = genericToJSON (removeFieldLabelPrefix False "inlineObject")
78-
instance ToSchema InlineObject where
79-
declareNamedSchema = Swagger.genericDeclareNamedSchema
80-
$ Swagger.fromAesonOptions
81-
$ removeFieldLabelPrefix False "inlineObject"
82-
83-
84-
-- |
85-
data InlineObject1 = InlineObject1
86-
{ inlineObject1AdditionalMetadata :: Maybe Text -- ^ Additional data to pass to server
87-
, inlineObject1File :: Maybe FilePath -- ^ file to upload
88-
} deriving (Show, Eq, Generic, Data)
89-
90-
instance FromJSON InlineObject1 where
91-
parseJSON = genericParseJSON (removeFieldLabelPrefix True "inlineObject1")
92-
instance ToJSON InlineObject1 where
93-
toJSON = genericToJSON (removeFieldLabelPrefix False "inlineObject1")
94-
instance ToSchema InlineObject1 where
95-
declareNamedSchema = Swagger.genericDeclareNamedSchema
96-
$ Swagger.fromAesonOptions
97-
$ removeFieldLabelPrefix False "inlineObject1"
98-
99-
10066
-- | An order for a pets from the pet store
10167
data Order = Order
10268
{ orderId :: Maybe Integer -- ^

‎samples/server/petstore/haskell-servant/openapi-petstore.cabal‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -28,6 +28,7 @@ library
2828
, servant-client-core
2929
, servant-server
3030
, servant
31+
, wai
3132
, warp
3233
, transformers
3334
, mtl

0 commit comments

Comments
 (0)