[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.

Author: Fjolnir-Dvorak

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

@@ -19,6 +19,7 @@ module {{title}}.API
   , {{title}}Backend(..)
   , create{{title}}Client
   , run{{title}}Server
+  , run{{title}}MiddlewareServer
   , run{{title}}Client
   , run{{title}}ClientWithManager
   , call{{title}}
@@ -51,6 +52,7 @@ 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, serve)
 import           Servant.API
@@ -149,7 +151,7 @@ newtype {{title}}ClientError = {{title}}ClientError ClientError
 -- | Backend for {{title}}.
 -- The backend can be used both for the client and the server. The client generated from the {{title}} OpenAPI spec
 -- is a backend that executes actions by sending HTTP requests (see @create{{title}}Client@). Alternatively, provided
--- a backend, the API can be served using @run{{title}}Server@.
+-- a backend, the API can be served using @run{{title}}MiddlewareServer@.
 data {{title}}Backend m = {{title}}Backend
   { {{#apis}}{{#operations}}{{#operation}}{{operationId}} :: {{& vendorExtensions.x-clientType}}{- ^ {{& notes}} -}{{#hasMore}}
   , {{/hasMore}}{{/operation}}{{/operations}}{{#hasMore}}
@@ -207,17 +209,27 @@ call{{title}} env f = do
     Right response -> pure response
 {{/apiInfo}}
 
+
 {{#apiInfo}}
+requestMiddlewareId :: Application -> Application
+requestMiddlewareId a = a
+
 -- | Run the {{title}} server at the provided host and port.
 run{{title}}Server
+:: (MonadIO m, MonadThrow m)
+=> Config -> {{title}}Backend (ExceptT ServerError IO) -> m ()
+run{{title}}Server config backend = run{{title}}MiddlewareServer config requestMiddlewareId backend
+
+-- | Run the {{title}} server at the provided host and port.
+run{{title}}MiddlewareServer
   :: (MonadIO m, MonadThrow m)
-  => Config -> {{title}}Backend (ExceptT ServerError IO) -> m ()
-run{{title}}Server Config{..} backend = do
+  => Config -> Middleware -> {{title}}Backend (ExceptT ServerError IO) -> m ()
+run{{title}}MiddlewareServer Config{..} middleware backend = do
   url <- parseBaseUrl configUrl
   let warpSettings = Warp.defaultSettings
         & Warp.setPort (baseUrlPort url)
         & Warp.setHost (fromString $ baseUrlHost url)
-  liftIO $ Warp.runSettings warpSettings $ serve (Proxy :: Proxy {{title}}API) (serverFromBackend backend)
+  liftIO $ Warp.runSettings warpSettings $ middleware $ serve (Proxy :: Proxy {{title}}API) (serverFromBackend backend)
   where
     serverFromBackend {{title}}Backend{..} =
       ({{#apis}}{{#operations}}{{#operation}}coerce {{operationId}}{{#hasMore}} :<|>

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

@@ -58,22 +58,32 @@ main = do
 
 ## Creating a Server
 
-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`
+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`
 from the library, you must instead *provide* a `{{title}}Backend`. For example, if you have defined handler functions for all the
 functions in `{{title}}.Handlers`, you can write:
 
 ```haskell
 {-# LANGUAGE RecordWildCards #-}
 
 import {{title}}.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 {{title}}Backend type.
 import {{title}}.Handlers
 
+-- If you would like to not use any middlewares you could use run{{title}}Server instead
+
+-- Combined middlewares
+requestMiddlewares :: Middleware
+requestMiddlewares = logStdout
+
 -- Run a {{title}} server on localhost:8080
 main :: IO ()
 main = do
   let server = {{title}}Backend{..}
       config = Config "http://localhost:8080/"
-  run{{title}}Server config server
+  run{{title}}MiddlewareServer config requestMiddlewares server
 ```

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

@@ -28,6 +28,7 @@ library
                      , servant-client-core
                      , servant-server
                      , servant
+                     , wai
                      , warp
                      , transformers
                      , mtl

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

@@ -1 +1 @@
-4.0.3-SNAPSHOT
+4.2.0-SNAPSHOT

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

@@ -58,22 +58,32 @@ main = do
 
 ## Creating a Server
 
-In order to create a server, you must use the `runOpenAPIPetstoreServer` function. However, you unlike the client, in which case you *got* a `OpenAPIPetstoreBackend`
+In order to create a server, you must use the `runOpenAPIPetstoreMiddlewareServer` function. However, you unlike the client, in which case you *got* a `OpenAPIPetstoreBackend`
 from the library, you must instead *provide* a `OpenAPIPetstoreBackend`. For example, if you have defined handler functions for all the
 functions in `OpenAPIPetstore.Handlers`, you can write:
 
 ```haskell
 {-# LANGUAGE RecordWildCards #-}
 
 import OpenAPIPetstore.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 OpenAPIPetstoreBackend type.
 import OpenAPIPetstore.Handlers
 
+-- If you would like to not use any middlewares you could use runOpenAPIPetstoreServer instead
+
+-- Combined middlewares
+requestMiddlewares :: Middleware
+requestMiddlewares = logStdout
+
 -- Run a OpenAPIPetstore server on localhost:8080
 main :: IO ()
 main = do
   let server = OpenAPIPetstoreBackend{..}
       config = Config "http://localhost:8080/"
-  runOpenAPIPetstoreServer config server
+  runOpenAPIPetstoreMiddlewareServer config requestMiddlewares server
 ```

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

@@ -19,6 +19,7 @@ module OpenAPIPetstore.API
   , OpenAPIPetstoreBackend(..)
   , createOpenAPIPetstoreClient
   , runOpenAPIPetstoreServer
+  , runOpenAPIPetstoreMiddlewareServer
   , runOpenAPIPetstoreClient
   , runOpenAPIPetstoreClientWithManager
   , callOpenAPIPetstore
@@ -51,6 +52,7 @@ 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, serve)
 import           Servant.API
@@ -137,7 +139,7 @@ type OpenAPIPetstoreAPI
     =    "pet" :> ReqBody '[JSON] Pet :> Verb 'POST 200 '[JSON] () -- 'addPet' route
     :<|> "pet" :> Capture "petId" Integer :> Header "api_key" Text :> Verb 'DELETE 200 '[JSON] () -- 'deletePet' route
     :<|> "pet" :> "findByStatus" :> QueryParam "status" (QueryList 'CommaSeparated (Text)) :> Verb 'GET 200 '[JSON] [Pet] -- 'findPetsByStatus' route
-    :<|> "pet" :> "findByTags" :> QueryParam "tags" (QueryList 'CommaSeparated (Text)) :> QueryParam "maxCount" Int :> Verb 'GET 200 '[JSON] [Pet] -- 'findPetsByTags' route
+    :<|> "pet" :> "findByTags" :> QueryParam "tags" (QueryList 'CommaSeparated (Text)) :> Verb 'GET 200 '[JSON] [Pet] -- 'findPetsByTags' route
     :<|> "pet" :> Capture "petId" Integer :> Verb 'GET 200 '[JSON] Pet -- 'getPetById' route
     :<|> "pet" :> ReqBody '[JSON] Pet :> Verb 'PUT 200 '[JSON] () -- 'updatePet' route
     :<|> "pet" :> Capture "petId" Integer :> ReqBody '[FormUrlEncoded] FormUpdatePetWithForm :> Verb 'POST 200 '[JSON] () -- 'updatePetWithForm' route
@@ -171,12 +173,12 @@ newtype OpenAPIPetstoreClientError = OpenAPIPetstoreClientError ClientError
 -- | Backend for OpenAPIPetstore.
 -- The backend can be used both for the client and the server. The client generated from the OpenAPIPetstore OpenAPI spec
 -- is a backend that executes actions by sending HTTP requests (see @createOpenAPIPetstoreClient@). Alternatively, provided
--- a backend, the API can be served using @runOpenAPIPetstoreServer@.
+-- a backend, the API can be served using @runOpenAPIPetstoreMiddlewareServer@.
 data OpenAPIPetstoreBackend m = OpenAPIPetstoreBackend
   { addPet :: Pet -> m (){- ^  -}
   , deletePet :: Integer -> Maybe Text -> m (){- ^  -}
   , findPetsByStatus :: Maybe [Text] -> m [Pet]{- ^ Multiple status values can be provided with comma separated strings -}
-  , findPetsByTags :: Maybe [Text] -> Maybe Int -> m [Pet]{- ^ Multiple tags can be provided with comma separated strings. Use tag1, tag2, tag3 for testing. -}
+  , findPetsByTags :: Maybe [Text] -> m [Pet]{- ^ Multiple tags can be provided with comma separated strings. Use tag1, tag2, tag3 for testing. -}
   , getPetById :: Integer -> m Pet{- ^ Returns a single pet -}
   , updatePet :: Pet -> m (){- ^  -}
   , updatePetWithForm :: Integer -> FormUpdatePetWithForm -> m (){- ^  -}
@@ -260,16 +262,26 @@ callOpenAPIPetstore env f = do
     Left err       -> throwM (OpenAPIPetstoreClientError err)
     Right response -> pure response
 
+
+requestMiddlewareId :: Application -> Application
+requestMiddlewareId a = a
+
 -- | Run the OpenAPIPetstore server at the provided host and port.
 runOpenAPIPetstoreServer
+:: (MonadIO m, MonadThrow m)
+=> Config -> OpenAPIPetstoreBackend (ExceptT ServerError IO) -> m ()
+runOpenAPIPetstoreServer config backend = runOpenAPIPetstoreMiddlewareServer config requestMiddlewareId backend
+
+-- | Run the OpenAPIPetstore server at the provided host and port.
+runOpenAPIPetstoreMiddlewareServer
   :: (MonadIO m, MonadThrow m)
-  => Config -> OpenAPIPetstoreBackend (ExceptT ServerError IO) -> m ()
-runOpenAPIPetstoreServer Config{..} backend = do
+  => Config -> Middleware -> OpenAPIPetstoreBackend (ExceptT ServerError IO) -> m ()
+runOpenAPIPetstoreMiddlewareServer Config{..} middleware backend = do
   url <- parseBaseUrl configUrl
   let warpSettings = Warp.defaultSettings
         & Warp.setPort (baseUrlPort url)
         & Warp.setHost (fromString $ baseUrlHost url)
-  liftIO $ Warp.runSettings warpSettings $ serve (Proxy :: Proxy OpenAPIPetstoreAPI) (serverFromBackend backend)
+  liftIO $ Warp.runSettings warpSettings $ middleware $ serve (Proxy :: Proxy OpenAPIPetstoreAPI) (serverFromBackend backend)
   where
     serverFromBackend OpenAPIPetstoreBackend{..} =
       (coerce addPet :<|>

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

@@ -6,8 +6,6 @@
 module OpenAPIPetstore.Types (
   ApiResponse (..),
   Category (..),
-  InlineObject (..),
-  InlineObject1 (..),
   Order (..),
   Pet (..),
   Tag (..),
@@ -65,38 +63,6 @@ instance ToSchema Category where
     $ removeFieldLabelPrefix False "category"
 
 
--- | 
-data InlineObject = InlineObject
-  { inlineObjectName :: Maybe Text -- ^ Updated name of the pet
-  , inlineObjectStatus :: Maybe Text -- ^ Updated status of the pet
-  } deriving (Show, Eq, Generic, Data)
-
-instance FromJSON InlineObject where
-  parseJSON = genericParseJSON (removeFieldLabelPrefix True "inlineObject")
-instance ToJSON InlineObject where
-  toJSON = genericToJSON (removeFieldLabelPrefix False "inlineObject")
-instance ToSchema InlineObject where
-  declareNamedSchema = Swagger.genericDeclareNamedSchema
-    $ Swagger.fromAesonOptions
-    $ removeFieldLabelPrefix False "inlineObject"
-
-
--- | 
-data InlineObject1 = InlineObject1
-  { inlineObject1AdditionalMetadata :: Maybe Text -- ^ Additional data to pass to server
-  , inlineObject1File :: Maybe FilePath -- ^ file to upload
-  } deriving (Show, Eq, Generic, Data)
-
-instance FromJSON InlineObject1 where
-  parseJSON = genericParseJSON (removeFieldLabelPrefix True "inlineObject1")
-instance ToJSON InlineObject1 where
-  toJSON = genericToJSON (removeFieldLabelPrefix False "inlineObject1")
-instance ToSchema InlineObject1 where
-  declareNamedSchema = Swagger.genericDeclareNamedSchema
-    $ Swagger.fromAesonOptions
-    $ removeFieldLabelPrefix False "inlineObject1"
-
-
 -- | An order for a pets from the pet store
 data Order = Order
   { orderId :: Maybe Integer -- ^ 

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

@@ -28,6 +28,7 @@ library
                      , servant-client-core
                      , servant-server
                      , servant
+                     , wai
                      , warp
                      , transformers
                      , mtl