Skip to content

[FEATURE][Haskell] Add Middleware support for the haskell servant generator #4056

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 3 commits into from
Oct 31, 2019
Merged

[FEATURE][Haskell] Add Middleware support for the haskell servant generator #4056

Show file tree
Hide file tree
Changes from 2 commits
Commits
Show all changes
3 commits
Select commit Hold shift + click to select a range
2b9c725
updated the golden files for haskell to be able to generate against t…
Fjolnir-Dvorak Oct 4, 2019
422c6a2
Added support for middlewares in the haskell servant generator.
Fjolnir-Dvorak Oct 4, 2019
a7cb7db
Renamed runOpenAPIPetstoreServer to runOpenAPIPetstoreMiddlewareServe…
Fjolnir-Dvorak Oct 5, 2019
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
7 changes: 4 additions & 3 deletions modules/openapi-generator/src/main/resources/haskell-servant/API.mustache
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -51,6 +51,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
Expand Down Expand Up @@ -211,13 +212,13 @@ call{{title}} env f = do
-- | 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 = do
=> Config -> Middleware -> {{title}}Backend (ExceptT ServerError IO) -> m ()
Copy link
Contributor

@f-f f-f Oct 5, 2019

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I'd say instead of changing the signature of this function we could add a run{{title}}ServerWithMiddleware function, and provide the default implementation of the middleware here

In this way we wouldn't have to document how to get a default middleware, since we'd have that already implemented

Copy link
Contributor Author

@Fjolnir-Dvorak Fjolnir-Dvorak Oct 5, 2019

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

That would be a good Idea to keep backwards-compability, though I would keep the documentation since I think that the call with middleware should be the preferred one since an ID-function does not add any runtime overhead.

Copy link
Contributor

@Drezil Drezil Oct 9, 2019

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

In this way we wouldn't have to document how to get a default middleware, since we'd have that already implemented

The 'default'-Middleware is literally just id and the example-server would have that as default.
I fear that if one adds wrappers for this it could start to set a precedence for every case where this could be extended.

Another "clean" solution could be to add a datatype:

data ServerConfig = ServerConfig { serverMiddleware :: Middleware }
  deriving (....)

defaultServerConfig = ServerConfig id
-- or with data-default
instance Default ServerConfig where
  def = ServerConfig id

and people using defaultServerConfig would not be affected if we change things in any way in the future. Especially if the use the Default-Pattern: http://hackage.haskell.org/package/data-default

let myConfig = defaultServerConfig { serverMiddleware = myMiddleware }
-- or with data-default
let myConfig = def { serverMiddleware = myMiddleware }

This way we would never have to update/break the type-signature of the implementation for all future versions.

run{{title}}Server 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}} :<|>
Expand Down
14 changes: 13 additions & 1 deletion modules/openapi-generator/src/main/resources/haskell-servant/README.mustache
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -66,14 +66,26 @@ functions in `{{title}}.Handlers`, you can write:
{-# 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 just create an id-middleware implementation
-- requestMiddlewareId :: Application -> Application
-- requestMiddlewareId a = a

-- 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}}Server config requestMiddlewares server
```
1 change: 1 addition & 0 deletions ...les/openapi-generator/src/main/resources/haskell-servant/haskell-servant-codegen.mustache
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -28,6 +28,7 @@ library
, servant-client-core
, servant-server
, servant
, wai
, warp
, transformers
, mtl
Expand Down
2 changes: 1 addition & 1 deletion samples/server/petstore/haskell-servant/.openapi-generator/VERSION
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1 +1 @@
4.0.3-SNAPSHOT
4.2.0-SNAPSHOT
14 changes: 13 additions & 1 deletion samples/server/petstore/haskell-servant/README.md
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -66,14 +66,26 @@ functions in `OpenAPIPetstore.Handlers`, you can write:
{-# 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 just create an id-middleware implementation
-- requestMiddlewareId :: Application -> Application
-- requestMiddlewareId a = a

-- Default Requestlogging middleware.
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
runOpenAPIPetstoreServer config requestMiddlewares server
```
11 changes: 6 additions & 5 deletions samples/server/petstore/haskell-servant/lib/OpenAPIPetstore/API.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -51,6 +51,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
Expand Down Expand Up @@ -137,7 +138,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
Expand Down Expand Up @@ -176,7 +177,7 @@ 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 (){- ^ -}
Expand Down Expand Up @@ -263,13 +264,13 @@ callOpenAPIPetstore env f = do
-- | Run the OpenAPIPetstore server at the provided host and port.
runOpenAPIPetstoreServer
:: (MonadIO m, MonadThrow m)
=> Config -> OpenAPIPetstoreBackend (ExceptT ServerError IO) -> m ()
runOpenAPIPetstoreServer Config{..} backend = do
=> Config -> Middleware -> OpenAPIPetstoreBackend (ExceptT ServerError IO) -> m ()
runOpenAPIPetstoreServer 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 :<|>
Expand Down
34 changes: 0 additions & 34 deletions samples/server/petstore/haskell-servant/lib/OpenAPIPetstore/Types.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -6,8 +6,6 @@
module OpenAPIPetstore.Types (
ApiResponse (..),
Category (..),
InlineObject (..),
InlineObject1 (..),
Order (..),
Pet (..),
Tag (..),
Expand Down Expand Up @@ -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 -- ^
Expand Down
1 change: 1 addition & 0 deletions samples/server/petstore/haskell-servant/openapi-petstore.cabal
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -28,6 +28,7 @@ library
, servant-client-core
, servant-server
, servant
, wai
, warp
, transformers
, mtl
Expand Down