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

Merge remote-tracking branch 'origin' into 2.3.0

Browse Source
This commit is contained in:
wing328 2017-03-18 15:39:10 +08:00
commit 1010ecc8d5
22 changed files with 243 additions and 747 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
CONTRIBUTING.md
View File

@ -34,6 +34,8 @@ Code change should conform to the programming style guide of the respective lang
- C#: https://msdn.microsoft.com/en-us/library/vstudio/ff926074.aspx
- C++: https://google.github.io/styleguide/cppguide.html
- Clojure: https://github.com/bbatsov/clojure-style-guide
- Elixir: https://github.com/christopheradams/elixir_style_guide
- Erlang: https://github.com/inaka/erlang_guidelines
- Haskell: https://github.com/tibbe/haskell-style-guide/blob/master/haskell-style.md
- Java: https://google.github.io/styleguide/javaguide.html
- JavaScript: https://github.com/airbnb/javascript/

2
README.md
View File

@ -838,7 +838,7 @@ Here are some companies/projects using Swagger Codegen in production. To add you
- [carpolo](http://www.carpolo.co/)
- [CloudBoost](https://www.CloudBoost.io/)
- [Conplement](http://www.conplement.de/)
- [Cummins] (http://www.cummins.com/)
- [Cummins](http://www.cummins.com/)
- [Cupix](http://www.cupix.com)
- [DBBest Technologies](https://www.dbbest.com)
- [DecentFoX](http://decentfox.com/)

6
modules/swagger-codegen/src/main/java/io/swagger/codegen/languages/HaskellServantCodegen.java
View File

@ -54,6 +54,12 @@ public class HaskellServantCodegen extends DefaultCodegen implements CodegenConf
specialCharReplacements.put(">", "GreaterThan");
specialCharReplacements.put("<", "LessThan");
// backslash and double quote need double the escapement for both Java and Haskell
specialCharReplacements.remove("\\");
specialCharReplacements.remove("\"");
specialCharReplacements.put("\\\\", "Back_Slash");
specialCharReplacements.put("\\\"", "Double_Quote");
// set the output folder here
outputFolder = "generated-code/haskell-servant";

5
modules/swagger-codegen/src/main/java/io/swagger/codegen/languages/Swift3Codegen.java
View File

@ -277,6 +277,11 @@ public class Swift3Codegen extends DefaultCodegen implements CodegenConfig {
return toModelName(type);
}
@Override
public boolean isDataTypeFile(String dataType) {
return dataType != null && dataType.equals("URL");
}
@Override
public boolean isDataTypeBinary(final String dataType) {
return dataType != null && dataType.equals("Data");

7
modules/swagger-codegen/src/main/java/io/swagger/codegen/languages/SwiftCodegen.java
View File

@ -276,9 +276,14 @@ public class SwiftCodegen extends DefaultCodegen implements CodegenConfig {
return toModelName(type);
}
@Override
public boolean isDataTypeFile(String dataType) {
return dataType != null && dataType.equals("NSURL");
}
@Override
public boolean isDataTypeBinary(final String dataType) {
return dataType != null && dataType.equals("NSData");
return dataType != null && dataType.equals("NSData");
}
/**

162
modules/swagger-codegen/src/main/resources/haskell-servant/API.mustache
View File

@ -1,65 +1,79 @@
{-# LANGUAGE DataKinds, TypeFamilies, TypeOperators, FlexibleInstances, OverloadedStrings, ViewPatterns #-}
{-# LANGUAGE RecordWildCards, GeneralizedNewtypeDeriving, DeriveTraversable, FlexibleContexts, DeriveGeneric #-}
{-# OPTIONS_GHC -fno-warn-unused-binds -fno-warn-unused-imports -fcontext-stack={{contextStackLimit}} #-}
module {{title}}.API (
{-# LANGUAGE DataKinds #-}
{-# 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 -fcontext-stack=328 #-}
module {{title}}.API
-- * Client and Server
ServerConfig(..),
{{title}}Backend,
create{{title}}Client,
run{{title}}Server,
run{{title}}Client,
run{{title}}ClientWithManager,
{{title}}Client,
( ServerConfig(..)
, {{title}}Backend
, create{{title}}Client
, run{{title}}Server
, run{{title}}Client
, run{{title}}ClientWithManager
, {{title}}Client
-- ** Servant
{{title}}API,
, {{title}}API
) where
import {{title}}.Types
import Control.Monad.Except (ExceptT)
import Control.Monad.IO.Class
import Data.Aeson (Value)
import Data.Coerce (coerce)
import Servant.API
import Servant (serve, ServantErr)
import Web.HttpApiData
import qualified Network.Wai.Handler.Warp as Warp
import qualified Data.Text as T
import Data.Text (Text)
import Servant.Common.BaseUrl(BaseUrl(..))
import Servant.Client (ServantError, client, Scheme(Http))
import Data.Proxy (Proxy(..))
import Control.Monad.IO.Class
import Data.Function ((&))
import GHC.Exts (IsString(..))
import qualified Data.Map as Map
import GHC.Generics (Generic)
import Data.Monoid ((<>))
import Servant.API.Verbs (Verb, StdMethod(..))
import Control.Monad.Except (ExceptT)
import Network.HTTP.Client (Manager, newManager, defaultManagerSettings)
import Data.Proxy (Proxy(..))
import Data.Text (Text)
import qualified Data.Text as T
import GHC.Exts (IsString(..))
import GHC.Generics (Generic)
import Network.HTTP.Client (Manager, defaultManagerSettings, newManager)
import Network.HTTP.Types.Method (methodOptions)
instance ReflectMethod 'OPTIONS where
reflectMethod _ = methodOptions
import qualified Network.Wai.Handler.Warp as Warp
import Servant (ServantErr, serve)
import Servant.API
import Servant.API.Verbs (StdMethod(..), Verb)
import Servant.Client (Scheme(Http), ServantError, client)
import Servant.Common.BaseUrl (BaseUrl(..))
import Web.HttpApiData
{{#apiInfo}}{{#apis}}{{#operations}}{{#operation}}{{#hasFormParams}}
data {{vendorExtensions.x-formName}} = {{vendorExtensions.x-formName}}
{ {{#formParams}}{{vendorExtensions.x-formPrefix}}{{vendorExtensions.x-formParamName}} :: {{dataType}}{{#hasMore}}
, {{/hasMore}}{{/formParams}}
} deriving (Show, Eq, Generic)
{ {{#formParams}}{{vendorExtensions.x-formPrefix}}{{vendorExtensions.x-formParamName}} :: {{dataType}}{{#hasMore}}
, {{/hasMore}}{{/formParams}}
} deriving (Show, Eq, Generic)
instance FromFormUrlEncoded {{vendorExtensions.x-formName}} where
fromFormUrlEncoded inputs = {{vendorExtensions.x-formName}} <$> {{#formParams}} lookupEither "{{baseName}}" inputs{{#hasMore}} <*> {{/hasMore}}{{/formParams}}
fromFormUrlEncoded inputs = {{vendorExtensions.x-formName}} <$> {{#formParams}}lookupEither "{{baseName}}" inputs{{#hasMore}} <*> {{/hasMore}}{{/formParams}}
instance ToFormUrlEncoded {{vendorExtensions.x-formName}} where
toFormUrlEncoded value = [{{#formParams}}("{{baseName}}", toQueryParam $ {{vendorExtensions.x-formPrefix}}{{vendorExtensions.x-formParamName}} value){{#hasMore}}, {{/hasMore}}{{/formParams}}]
{{/hasFormParams}}{{/operation}}{{/operations}}{{/apis}}{{/apiInfo}}
toFormUrlEncoded value =
[ {{#formParams}}("{{baseName}}", toQueryParam $ {{vendorExtensions.x-formPrefix}}{{vendorExtensions.x-formParamName}} value){{#hasMore}}
, {{/hasMore}}{{/formParams}}
]{{/hasFormParams}}{{/operation}}{{/operations}}{{/apis}}{{/apiInfo}}
-- For the form data code generation.
lookupEither :: FromHttpApiData b => Text -> [(Text, Text)] -> Either Text b
lookupEither :: FromHttpApiData b => Text -> [(Text, Text)] -> Either String b
lookupEither key assocs =
case lookup key assocs of
Nothing -> Left $ "Could not find parameter " <> key <> " in form data"
Just value -> parseQueryParam value
Nothing -> Left $ "Could not find parameter " <> (T.unpack key) <> " in form data"
Just value ->
case parseQueryParam value of
Left result -> Left $ T.unpack result
Right result -> Right $ result
{{#apiInfo}}
-- | Servant type-level API, generated from the Swagger spec for {{title}}.
@ -70,54 +84,56 @@ type {{title}}API
{{/apiInfo}}
-- | Server or client configuration, specifying the host and port to query or serve on.
data ServerConfig = ServerConfig {
configHost :: String, -- ^ Hostname to serve on, e.g. "127.0.0.1"
configPort :: Int -- ^ Port to serve on, e.g. 8080
data ServerConfig = ServerConfig
{ configHost :: String -- ^ Hostname to serve on, e.g. "127.0.0.1"
, configPort :: Int -- ^ Port to serve on, e.g. 8080
} deriving (Eq, Ord, Show, Read)
-- | List of elements parsed from a query.
newtype QueryList (p :: CollectionFormat) a = QueryList { fromQueryList :: [a] }
deriving (Functor, Applicative, Monad, Foldable, Traversable)
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.
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 ','
parseQueryParam = parseSeparatedQueryList ','
instance FromHttpApiData a => FromHttpApiData (QueryList 'TabSeparated a) where
parseQueryParam = parseSeparatedQueryList '\t'
parseQueryParam = parseSeparatedQueryList '\t'
instance FromHttpApiData a => FromHttpApiData (QueryList 'SpaceSeparated a) where
parseQueryParam = parseSeparatedQueryList ' '
parseQueryParam = parseSeparatedQueryList ' '
instance FromHttpApiData a => FromHttpApiData (QueryList 'PipeSeparated a) where
parseQueryParam = parseSeparatedQueryList '|'
parseQueryParam = parseSeparatedQueryList '|'
instance FromHttpApiData a => FromHttpApiData (QueryList 'MultiParamArray a) where
parseQueryParam = error "unimplemented FromHttpApiData for MultiParamArray collection format"
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 ','
toQueryParam = formatSeparatedQueryList ','
instance ToHttpApiData a => ToHttpApiData (QueryList 'TabSeparated a) where
toQueryParam = formatSeparatedQueryList '\t'
toQueryParam = formatSeparatedQueryList '\t'
instance ToHttpApiData a => ToHttpApiData (QueryList 'SpaceSeparated a) where
toQueryParam = formatSeparatedQueryList ' '
toQueryParam = formatSeparatedQueryList ' '
instance ToHttpApiData a => ToHttpApiData (QueryList 'PipeSeparated a) where
toQueryParam = formatSeparatedQueryList '|'
toQueryParam = formatSeparatedQueryList '|'
instance ToHttpApiData a => ToHttpApiData (QueryList 'MultiParamArray a) where
toQueryParam = error "unimplemented ToHttpApiData for MultiParamArray collection format"
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
@ -128,26 +144,29 @@ formatSeparatedQueryList char = T.intercalate (T.singleton char) . map toQueryPa
-- The backend can be used both for the client and the server. The client generated from the {{title}} Swagger 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@.
data {{title}}Backend m = {{title}}Backend {
{{#apis}}{{#operations}}{{#operation}}{{operationId}} :: {{& vendorExtensions.x-clientType}}{- ^ {{& notes}} -}{{#hasMore}},
{{/hasMore}}{{/operation}}{{/operations}}{{#hasMore}},
{{/hasMore}}{{/apis}}
data {{title}}Backend m = {{title}}Backend
{ {{#apis}}{{#operations}}{{#operation}}{{operationId}} :: {{& vendorExtensions.x-clientType}}{- ^ {{& notes}} -}{{#hasMore}}
, {{/hasMore}}{{/operation}}{{/operations}}{{#hasMore}}
, {{/hasMore}}{{/apis}}
}
newtype {{title}}Client a = {{title}}Client { runClient :: Manager -> BaseUrl -> ExceptT ServantError IO a }
deriving Functor
newtype {{title}}Client a = {{title}}Client
{ runClient :: Manager -> BaseUrl -> ExceptT ServantError IO a
} deriving Functor
instance Applicative {{title}}Client where
pure x = {{title}}Client (\_ _ -> pure x)
({{title}}Client f) <*> ({{title}}Client x) = {{title}}Client (\manager url -> f manager url <*> x manager url)
pure x = {{title}}Client (\_ _ -> pure x)
({{title}}Client f) <*> ({{title}}Client x) =
{{title}}Client (\manager url -> f manager url <*> x manager url)
instance Monad {{title}}Client where
({{title}}Client a) >>= f = {{title}}Client (\manager url -> do
value <- a manager url
runClient (f value) manager url)
({{title}}Client a) >>= f =
{{title}}Client (\manager url -> do
value <- a manager url
runClient (f value) manager url)
instance MonadIO {{title}}Client where
liftIO io = {{title}}Client (\_ _ -> liftIO io)
liftIO io = {{title}}Client (\_ _ -> liftIO io)
{{/apiInfo}}
{{#apiInfo}}
@ -175,7 +194,6 @@ run{{title}}ClientWithManager manager clientConfig cl =
run{{title}}Server :: MonadIO m => ServerConfig -> {{title}}Backend (ExceptT ServantErr IO) -> m ()
run{{title}}Server ServerConfig{..} backend =
liftIO $ Warp.runSettings warpSettings $ serve (Proxy :: Proxy {{title}}API) (serverFromBackend backend)
where
warpSettings = Warp.defaultSettings & Warp.setPort configPort & Warp.setHost (fromString configHost)
serverFromBackend {{title}}Backend{..} =

29
modules/swagger-codegen/src/main/resources/haskell-servant/Types.mustache
View File

@ -5,10 +5,10 @@
module {{title}}.Types (
{{#models}}
{{#model}}
{{classname}} (..),
{{classname}} (..),
{{/model}}
{{/models}}
) where
) where
import Data.List (stripPrefix)
import Data.Maybe (fromMaybe)
@ -29,14 +29,14 @@ import Data.Function ((&))
{{^vendorExtensions.x-customNewtype}}
{{^parent}}
{{vendorExtensions.x-data}} {{classname}} = {{classname}}
{ {{#vars}}{{& name}} :: {{datatype}} -- ^ {{& description}}{{#hasMore}}
, {{/hasMore}}{{/vars}}
} deriving (Show, Eq, Generic)
{ {{#vars}}{{& name}} :: {{datatype}} -- ^ {{& description}}{{#hasMore}}
, {{/hasMore}}{{/vars}}
} deriving (Show, Eq, Generic)
instance FromJSON {{classname}} where
parseJSON = genericParseJSON (removeFieldLabelPrefix True "{{vendorExtensions.x-prefix}}")
parseJSON = genericParseJSON (removeFieldLabelPrefix True "{{vendorExtensions.x-prefix}}")
instance ToJSON {{classname}} where
toJSON = genericToJSON (removeFieldLabelPrefix False "{{vendorExtensions.x-prefix}}")
toJSON = genericToJSON (removeFieldLabelPrefix False "{{vendorExtensions.x-prefix}}")
{{/parent}}
{{#parent}}
newtype {{classname}} = {{classname}} { un{{classname}} :: {{parent}} }
@ -54,12 +54,15 @@ newtype {{classname}} = {{classname}} {{vendorExtensions.x-customNewtype}} deriv
removeFieldLabelPrefix :: Bool -> String -> Options
removeFieldLabelPrefix forParsing prefix =
defaultOptions
{ fieldLabelModifier = fromMaybe (error ("did not find prefix " ++ prefix)) . stripPrefix prefix . replaceSpecialChars
}
{fieldLabelModifier = fromMaybe (error ("did not find prefix " ++ prefix)) . stripPrefix prefix . replaceSpecialChars}
where
replaceSpecialChars field = foldl (&) field (map mkCharReplacement specialChars)
specialChars = [{{#specialCharReplacements}}("{{&char}}", "{{&replacement}}"){{#hasMore}}, {{/hasMore}}{{/specialCharReplacements}}]
specialChars =
[ {{#specialCharReplacements}}("{{&char}}", "{{&replacement}}"){{#hasMore}}
, {{/hasMore}}{{/specialCharReplacements}}
]
mkCharReplacement (replaceStr, searchStr) = T.unpack . replacer (T.pack searchStr) (T.pack replaceStr) . T.pack
replacer = if forParsing then flip T.replace else T.replace
replacer =
if forParsing
then flip T.replace
else T.replace

5
modules/swagger-codegen/src/test/resources/2_0/wordnik.yaml
View File

@ -412,8 +412,6 @@ paths:
$ref: '#/definitions/ExampleSearchResults'
'400':
description: Invalid word supplied.
'400':
description: Invalid word supplied.
'/account.json/authenticate/{username}':
get:
tags:
@ -741,7 +739,6 @@ paths:
type: array
items:
$ref: '#/definitions/WordListWord'
$ref: '#/definitions/WordListWord'
'400':
description: Invalid ID supplied
'403':
@ -1640,4 +1637,4 @@ definitions:
format: double
mi:
type: number
format: double
format: double

35
samples/server/petstore/haskell-servant/client/Main.hs
View File

@ -1,35 +0,0 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TypeOperators #-}
module Main where
import Control.Monad (void)
import Control.Monad.Trans.Either
import Control.Monad.IO.Class
import Servant.API
import Servant.Client
import Data.List.Split (splitOn)
import Network.URI (URI (..), URIAuth (..), parseURI)
import Data.Maybe (fromMaybe)
import Test.QuickCheck
import Control.Monad
import Model.User
import Model.Category
import Model.Pet
import Model.Tag
import Model.Order
import Api.UserApi
import Api.PetApi
import Api.StoreApi
-- userClient :: IO ()
-- userClient = do
-- users <- sample' (arbitrary :: Gen String)
-- let user = last users
-- void . runEitherT $ do
-- getUserByName user >>= (liftIO . putStrLn . show)
main :: IO ()
main = putStrLn "Hello Server!"

64
samples/server/petstore/haskell-servant/haskell-servant-codegen.cabal
View File

@ -1,64 +0,0 @@
name: haskell-servant-codegen
version: 0.1.0.0
synopsis: Swagger-codegen example for Haskell servant
description: Please see README.md
homepage: https://github.com/swagger-api/swagger-codegen#readme
license: Apache-2.0
license-file: LICENSE
author: Masahiro Yamauchi
maintainer: sgt.yamauchi@gmail.com
copyright: 2015- Masahiro Yamauchi
category: Web
build-type: Simple
-- extra-source-files:
cabal-version: >=1.10
library
hs-source-dirs: lib
exposed-modules: Utils
, Model.User
, Model.Category
, Model.Pet
, Model.Tag
, Model.Order
, Api.UserApi
, Api.PetApi
, Api.StoreApi
, Apis
ghc-options: -Wall
build-depends: base
, aeson
, text
, split
, containers
, network-uri
, QuickCheck
, servant
, servant-client
default-language: Haskell2010
executable client
hs-source-dirs: client
main-is: Main.hs
ghc-options: -threaded -rtsopts -with-rtsopts=-N
build-depends: base
, either
, transformers
, split
, network-uri
, QuickCheck
, servant
, servant-client
, haskell-servant-codegen
default-language: Haskell2010
executable server
hs-source-dirs: server
main-is: Main.hs
ghc-options: -threaded -rtsopts -with-rtsopts=-N
build-depends: base
, warp
, servant-server
, servant-mock
, haskell-servant-codegen
default-language: Haskell2010

113
samples/server/petstore/haskell-servant/lib/Api/PetApi.hs
View File

@ -1,113 +0,0 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
module Api.PetApi (
updatePet
, addPet
, findPetsByStatus
, findPetsByTags
, getPetById
, updatePetWithForm
, deletePet
, uploadFile
, getPetByIdWithByteArray
, addPetUsingByteArray
, proxyPetApi
, PetApi
) where
import GHC.Generics
import Data.Proxy
import Servant.API
import Servant.Client
import Network.URI (URI (..), URIAuth (..), parseURI)
import Data.Maybe (fromMaybe)
import Servant.Common.Text
import Data.List (intercalate)
import qualified Data.Text as T
import Utils
import Test.QuickCheck
import Model.Pet
import Model.Binary
data Formnamestatus = Formnamestatus
{ name :: String
, status :: String
} deriving (Show, Eq, Generic)
instance FromFormUrlEncoded Formnamestatus where
fromFormUrlEncoded inputs = Formnamestatus <$> lkp inputs "name" <*> lkp inputs "status"
instance ToFormUrlEncoded Formnamestatus where
toFormUrlEncoded x = [((T.pack $ show $ Api.PetApi.name x), (T.pack $ show $ Api.PetApi.status x))]
instance Arbitrary Formnamestatus where
arbitrary = Formnamestatus <$> arbitrary <*> arbitrary
data FormadditionalMetadatafile = FormadditionalMetadatafile
{ additionalMetadata :: String
, file :: FilePath
} deriving (Show, Eq, Generic)
instance FromFormUrlEncoded FormadditionalMetadatafile where
fromFormUrlEncoded inputs = FormadditionalMetadatafile <$> lkp inputs "additionalMetadata" <*> lkp inputs "file"
instance ToFormUrlEncoded FormadditionalMetadatafile where
toFormUrlEncoded x = [((T.pack $ show $ Api.PetApi.additionalMetadata x), (T.pack $ show $ Api.PetApi.file x))]
instance Arbitrary FormadditionalMetadatafile where
arbitrary = FormadditionalMetadatafile <$> arbitrary <*> arbitrary
type PetApi = "pet" :> ReqBody '[JSON] Pet :> Put '[JSON] () -- updatePet
:<|> "pet" :> ReqBody '[JSON] Pet :> Post '[JSON] () -- addPet
:<|> "pet" :> "findByStatus" :> QueryParam "status" [String] :> Get '[JSON] [Pet] -- findPetsByStatus
:<|> "pet" :> "findByTags" :> QueryParam "tags" [String] :> Get '[JSON] [Pet] -- findPetsByTags
:<|> "pet" :> Capture "petId" Integer :> Get '[JSON] Pet -- getPetById
:<|> "pet" :> Capture "petId" String :> ReqBody '[FormUrlEncoded] Formnamestatus :> Post '[JSON] () -- updatePetWithForm
:<|> "pet" :> Capture "petId" Integer :> Header "api_key" String :> Delete '[JSON] () -- deletePet
:<|> "pet" :> Capture "petId" Integer :> "uploadImage" :> ReqBody '[FormUrlEncoded] FormadditionalMetadatafile :> Post '[JSON] () -- uploadFile
:<|> "pet" :> Capture "petId" Integer?testing_byte_array=true :> Get '[JSON] Binary -- getPetByIdWithByteArray
:<|> "pet?testing_byte_array=true" :> ReqBody '[JSON] Binary :> Post '[JSON] () -- addPetUsingByteArray
proxyPetApi :: Proxy PetApi
proxyPetApi = Proxy
serverPath :: String
serverPath = "http://petstore.swagger.io/v2"
parseHostPort :: String -> (String, Int)
parseHostPort path = (host,port)
where
authority = case parseURI path of
Just x -> uriAuthority x
_ -> Nothing
(host, port) = case authority of
Just y -> (uriRegName y, (getPort . uriPort) y)
_ -> ("localhost", 8080)
getPort p = case (length p) of
0 -> 80
_ -> (read . drop 1) p
(host, port) = parseHostPort serverPath
updatePet
:<|> addPet
:<|> findPetsByStatus
:<|> findPetsByTags
:<|> getPetById
:<|> updatePetWithForm
:<|> deletePet
:<|> uploadFile
:<|> getPetByIdWithByteArray
:<|> addPetUsingByteArray
= client proxyPetApi $ BaseUrl Http host port

67
samples/server/petstore/haskell-servant/lib/Api/StoreApi.hs
View File

@ -1,67 +0,0 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
module Api.StoreApi (
getInventory
, placeOrder
, getOrderById
, deleteOrder
, proxyStoreApi
, StoreApi
) where
import GHC.Generics
import Data.Proxy
import Servant.API
import Servant.Client
import Network.URI (URI (..), URIAuth (..), parseURI)
import Data.Maybe (fromMaybe)
import Servant.Common.Text
import Data.List (intercalate)
import qualified Data.Text as T
import Utils
import Test.QuickCheck
import qualified Data.Map as Map
import Model.Order
type StoreApi = "store" :> "inventory" :> Get '[JSON] (Map.Map String Integer) -- getInventory
:<|> "store" :> "order" :> ReqBody '[JSON] Order :> Post '[JSON] Order -- placeOrder
:<|> "store" :> "order" :> Capture "orderId" String :> Get '[JSON] Order -- getOrderById
:<|> "store" :> "order" :> Capture "orderId" String :> Delete '[JSON] () -- deleteOrder
proxyStoreApi :: Proxy StoreApi
proxyStoreApi = Proxy
serverPath :: String
serverPath = "http://petstore.swagger.io/v2"
parseHostPort :: String -> (String, Int)
parseHostPort path = (host,port)
where
authority = case parseURI path of
Just x -> uriAuthority x
_ -> Nothing
(host, port) = case authority of
Just y -> (uriRegName y, (getPort . uriPort) y)
_ -> ("localhost", 8080)
getPort p = case (length p) of
0 -> 80
_ -> (read . drop 1) p
(host, port) = parseHostPort serverPath
getInventory
:<|> placeOrder
:<|> getOrderById
:<|> deleteOrder
= client proxyStoreApi $ BaseUrl Http host port

82
samples/server/petstore/haskell-servant/lib/Api/UserApi.hs
View File

@ -1,82 +0,0 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
module Api.UserApi (
createUser
, createUsersWithArrayInput
, createUsersWithListInput
, loginUser
, logoutUser
, getUserByName
, updateUser
, deleteUser
, proxyUserApi
, UserApi
) where
import GHC.Generics
import Data.Proxy
import Servant.API
import Servant.Client
import Network.URI (URI (..), URIAuth (..), parseURI)
import Data.Maybe (fromMaybe)
import Servant.Common.Text
import Data.List (intercalate)
import qualified Data.Text as T
import Utils
import Test.QuickCheck
import Model.User
type UserApi = "user" :> ReqBody '[JSON] User :> Post '[JSON] () -- createUser
:<|> "user" :> "createWithArray" :> ReqBody '[JSON] [User] :> Post '[JSON] () -- createUsersWithArrayInput
:<|> "user" :> "createWithList" :> ReqBody '[JSON] [User] :> Post '[JSON] () -- createUsersWithListInput
:<|> "user" :> "login" :> QueryParam "username" String :> QueryParam "password" String :> Get '[JSON] String -- loginUser
:<|> "user" :> "logout" :> Get '[JSON] () -- logoutUser
:<|> "user" :> Capture "username" String :> Get '[JSON] User -- getUserByName
:<|> "user" :> Capture "username" String :> ReqBody '[JSON] User :> Put '[JSON] () -- updateUser
:<|> "user" :> Capture "username" String :> Delete '[JSON] () -- deleteUser
proxyUserApi :: Proxy UserApi
proxyUserApi = Proxy
serverPath :: String
serverPath = "http://petstore.swagger.io/v2"
parseHostPort :: String -> (String, Int)
parseHostPort path = (host,port)
where
authority = case parseURI path of
Just x -> uriAuthority x
_ -> Nothing
(host, port) = case authority of
Just y -> (uriRegName y, (getPort . uriPort) y)
_ -> ("localhost", 8080)
getPort p = case (length p) of
0 -> 80
_ -> (read . drop 1) p
(host, port) = parseHostPort serverPath
createUser
:<|> createUsersWithArrayInput
:<|> createUsersWithListInput
:<|> loginUser
:<|> logoutUser
:<|> getUserByName
:<|> updateUser
:<|> deleteUser
= client proxyUserApi $ BaseUrl Http host port

24
samples/server/petstore/haskell-servant/lib/Apis.hs
View File

@ -1,24 +0,0 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE FlexibleInstances #-}
module Apis (
api
, API
) where
import Api.UserApi (UserApi)
import Api.PetApi (PetApi)
import Api.StoreApi (StoreApi)
import Data.Proxy
import Servant.API
import Test.QuickCheck
import qualified Data.Map as Map
import Utils
type API = UserApi :<|> PetApi :<|> StoreApi
api :: Proxy API
api = Proxy

24
samples/server/petstore/haskell-servant/lib/Model/Category.hs
View File

@ -1,24 +0,0 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Model.Category
( Category (..)
) where
import Data.Aeson
import GHC.Generics
import Test.QuickCheck
data Category = Category
{ id_ :: Integer
, name :: String
} deriving (Show, Eq, Generic)
instance FromJSON Category
instance ToJSON Category
instance Arbitrary Category where
arbitrary = Category <$> arbitrary <*> arbitrary

28
samples/server/petstore/haskell-servant/lib/Model/Order.hs
View File

@ -1,28 +0,0 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Model.Order
( Order (..)
) where
import Data.Aeson
import GHC.Generics
import Test.QuickCheck
data Order = Order
{ id_ :: Integer
, petId :: Integer
, quantity :: Integer
, shipDate :: Integer
, status :: String
, complete :: Bool
} deriving (Show, Eq, Generic)
instance FromJSON Order
instance ToJSON Order
instance Arbitrary Order where
arbitrary = Order <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary

30
samples/server/petstore/haskell-servant/lib/Model/Pet.hs
View File

@ -1,30 +0,0 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Model.Pet
( Pet (..)
) where
import Data.Aeson
import GHC.Generics
import Test.QuickCheck
import Model.Category
import Model.Tag
data Pet = Pet
{ id_ :: Integer
, category :: Category
, name :: String
, photoUrls :: [String]
, tags :: [Tag]
, status :: String
} deriving (Show, Eq, Generic)
instance FromJSON Pet
instance ToJSON Pet
instance Arbitrary Pet where
arbitrary = Pet <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary

24
samples/server/petstore/haskell-servant/lib/Model/Tag.hs
View File

@ -1,24 +0,0 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Model.Tag
( Tag (..)
) where
import Data.Aeson
import GHC.Generics
import Test.QuickCheck
data Tag = Tag
{ id_ :: Integer
, name :: String
} deriving (Show, Eq, Generic)
instance FromJSON Tag
instance ToJSON Tag
instance Arbitrary Tag where
arbitrary = Tag <$> arbitrary <*> arbitrary

30
samples/server/petstore/haskell-servant/lib/Model/User.hs
View File

@ -1,30 +0,0 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Model.User
( User (..)
) where
import Data.Aeson
import GHC.Generics
import Test.QuickCheck
data User = User
{ id_ :: Integer
, username :: String
, firstName :: String
, lastName :: String
, email :: String
, password :: String
, phone :: String
, userStatus :: Integer
} deriving (Show, Eq, Generic)
instance FromJSON User
instance ToJSON User
instance Arbitrary User where
arbitrary = User <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary

211
samples/server/petstore/haskell-servant/lib/SwaggerPetstore/API.hs
View File

@ -1,75 +1,92 @@
{-# LANGUAGE DataKinds, TypeFamilies, TypeOperators, FlexibleInstances, OverloadedStrings, ViewPatterns #-}
{-# LANGUAGE RecordWildCards, GeneralizedNewtypeDeriving, DeriveTraversable, FlexibleContexts, DeriveGeneric #-}
{-# OPTIONS_GHC -fno-warn-unused-binds -fno-warn-unused-imports -fcontext-stack=328 #-}
module SwaggerPetstore.API (
{-# LANGUAGE DataKinds #-}
{-# 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 -fcontext-stack=328 #-}
module SwaggerPetstore.API
-- * Client and Server
ServerConfig(..),
SwaggerPetstoreBackend,
createSwaggerPetstoreClient,
runSwaggerPetstoreServer,
runSwaggerPetstoreClient,
runSwaggerPetstoreClientWithManager,
SwaggerPetstoreClient,
( ServerConfig(..)
, SwaggerPetstoreBackend
, createSwaggerPetstoreClient
, runSwaggerPetstoreServer
, runSwaggerPetstoreClient
, runSwaggerPetstoreClientWithManager
, SwaggerPetstoreClient
-- ** Servant
SwaggerPetstoreAPI,
, SwaggerPetstoreAPI
) where
import SwaggerPetstore.Types
import Control.Monad.Except (ExceptT)
import Control.Monad.IO.Class
import Data.Aeson (Value)
import Data.Coerce (coerce)
import Servant.API
import Servant (serve, ServantErr)
import Web.HttpApiData
import qualified Network.Wai.Handler.Warp as Warp
import qualified Data.Text as T
import Data.Text (Text)
import Servant.Common.BaseUrl(BaseUrl(..))
import Servant.Client (ServantError, client, Scheme(Http))
import Data.Proxy (Proxy(..))
import Control.Monad.IO.Class
import Data.Function ((&))
import GHC.Exts (IsString(..))
import qualified Data.Map as Map
import GHC.Generics (Generic)
import Data.Monoid ((<>))
import Servant.API.Verbs (Verb, StdMethod(..))
import Control.Monad.Except (ExceptT)
import Network.HTTP.Client (Manager, newManager, defaultManagerSettings)
import Data.Proxy (Proxy(..))
import Data.Text (Text)
import qualified Data.Text as T
import GHC.Exts (IsString(..))
import GHC.Generics (Generic)
import Network.HTTP.Client (Manager, defaultManagerSettings, newManager)
import Network.HTTP.Types.Method (methodOptions)
instance ReflectMethod 'OPTIONS where
reflectMethod _ = methodOptions
import qualified Network.Wai.Handler.Warp as Warp
import Servant (ServantErr, serve)
import Servant.API
import Servant.API.Verbs (StdMethod(..), Verb)
import Servant.Client (Scheme(Http), ServantError, client)
import Servant.Common.BaseUrl (BaseUrl(..))
import Web.HttpApiData
data FormUpdatePetWithForm = FormUpdatePetWithForm
{ updatePetWithFormName :: Text
, updatePetWithFormStatus :: Text
} deriving (Show, Eq, Generic)
{ updatePetWithFormName :: Text
, updatePetWithFormStatus :: Text
} deriving (Show, Eq, Generic)
instance FromFormUrlEncoded FormUpdatePetWithForm where
fromFormUrlEncoded inputs = FormUpdatePetWithForm <$> lookupEither "name" inputs <*> lookupEither "status" inputs
instance ToFormUrlEncoded FormUpdatePetWithForm where
toFormUrlEncoded value = [("name", toQueryParam $ updatePetWithFormName value), ("status", toQueryParam $ updatePetWithFormStatus value)]
fromFormUrlEncoded inputs = FormUpdatePetWithForm <$> lookupEither "name" inputs <*> lookupEither "status" inputs
instance ToFormUrlEncoded FormUpdatePetWithForm where
toFormUrlEncoded value =
[ ("name", toQueryParam $ updatePetWithFormName value)
, ("status", toQueryParam $ updatePetWithFormStatus value)
]
data FormUploadFile = FormUploadFile
{ uploadFileAdditionalMetadata :: Text
, uploadFileFile :: FilePath
} deriving (Show, Eq, Generic)
{ uploadFileAdditionalMetadata :: Text
, uploadFileFile :: FilePath
} deriving (Show, Eq, Generic)
instance FromFormUrlEncoded FormUploadFile where
fromFormUrlEncoded inputs = FormUploadFile <$> lookupEither "additionalMetadata" inputs <*> lookupEither "file" inputs
instance ToFormUrlEncoded FormUploadFile where
toFormUrlEncoded value = [("additionalMetadata", toQueryParam $ uploadFileAdditionalMetadata value), ("file", toQueryParam $ uploadFileFile value)]
fromFormUrlEncoded inputs = FormUploadFile <$> lookupEither "additionalMetadata" inputs <*> lookupEither "file" inputs
instance ToFormUrlEncoded FormUploadFile where
toFormUrlEncoded value =
[ ("additionalMetadata", toQueryParam $ uploadFileAdditionalMetadata value)
, ("file", toQueryParam $ uploadFileFile value)
]
-- For the form data code generation.
lookupEither :: FromHttpApiData b => Text -> [(Text, Text)] -> Either Text b
lookupEither :: FromHttpApiData b => Text -> [(Text, Text)] -> Either String b
lookupEither key assocs =
case lookup key assocs of
Nothing -> Left $ "Could not find parameter " <> key <> " in form data"
Just value -> parseQueryParam value
Nothing -> Left $ "Could not find parameter " <> (T.unpack key) <> " in form data"
Just value ->
case parseQueryParam value of
Left result -> Left $ T.unpack result
Right result -> Right $ result
-- | Servant type-level API, generated from the Swagger spec for SwaggerPetstore.
type SwaggerPetstoreAPI
@ -95,54 +112,56 @@ type SwaggerPetstoreAPI
:<|> "user" :> Capture "username" Text :> ReqBody '[JSON] User :> Verb 'PUT 200 '[JSON] () -- 'updateUser' route
-- | Server or client configuration, specifying the host and port to query or serve on.
data ServerConfig = ServerConfig {
configHost :: String, -- ^ Hostname to serve on, e.g. "127.0.0.1"
configPort :: Int -- ^ Port to serve on, e.g. 8080
data ServerConfig = ServerConfig
{ configHost :: String -- ^ Hostname to serve on, e.g. "127.0.0.1"
, configPort :: Int -- ^ Port to serve on, e.g. 8080
} deriving (Eq, Ord, Show, Read)
-- | List of elements parsed from a query.
newtype QueryList (p :: CollectionFormat) a = QueryList { fromQueryList :: [a] }
deriving (Functor, Applicative, Monad, Foldable, Traversable)
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.
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 ','
parseQueryParam = parseSeparatedQueryList ','
instance FromHttpApiData a => FromHttpApiData (QueryList 'TabSeparated a) where
parseQueryParam = parseSeparatedQueryList '\t'
parseQueryParam = parseSeparatedQueryList '\t'
instance FromHttpApiData a => FromHttpApiData (QueryList 'SpaceSeparated a) where
parseQueryParam = parseSeparatedQueryList ' '
parseQueryParam = parseSeparatedQueryList ' '
instance FromHttpApiData a => FromHttpApiData (QueryList 'PipeSeparated a) where
parseQueryParam = parseSeparatedQueryList '|'
parseQueryParam = parseSeparatedQueryList '|'
instance FromHttpApiData a => FromHttpApiData (QueryList 'MultiParamArray a) where
parseQueryParam = error "unimplemented FromHttpApiData for MultiParamArray collection format"
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 ','
toQueryParam = formatSeparatedQueryList ','
instance ToHttpApiData a => ToHttpApiData (QueryList 'TabSeparated a) where
toQueryParam = formatSeparatedQueryList '\t'
toQueryParam = formatSeparatedQueryList '\t'
instance ToHttpApiData a => ToHttpApiData (QueryList 'SpaceSeparated a) where
toQueryParam = formatSeparatedQueryList ' '
toQueryParam = formatSeparatedQueryList ' '
instance ToHttpApiData a => ToHttpApiData (QueryList 'PipeSeparated a) where
toQueryParam = formatSeparatedQueryList '|'
toQueryParam = formatSeparatedQueryList '|'
instance ToHttpApiData a => ToHttpApiData (QueryList 'MultiParamArray a) where
toQueryParam = error "unimplemented ToHttpApiData for MultiParamArray collection format"
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
@ -152,43 +171,46 @@ formatSeparatedQueryList char = T.intercalate (T.singleton char) . map toQueryPa
-- The backend can be used both for the client and the server. The client generated from the SwaggerPetstore Swagger spec
-- is a backend that executes actions by sending HTTP requests (see @createSwaggerPetstoreClient@). Alternatively, provided
-- a backend, the API can be served using @runSwaggerPetstoreServer@.
data SwaggerPetstoreBackend m = SwaggerPetstoreBackend {
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] -> 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 (){- ^ -},
uploadFile :: Integer -> FormUploadFile -> m ApiResponse{- ^ -},
deleteOrder :: Text -> m (){- ^ For valid response try integer IDs with value < 1000. Anything above 1000 or nonintegers will generate API errors -},
getInventory :: m (Map.Map String Int){- ^ Returns a map of status codes to quantities -},
getOrderById :: Integer -> m Order{- ^ For valid response try integer IDs with value <= 5 or > 10. Other values will generated exceptions -},
placeOrder :: Order -> m Order{- ^ -},
createUser :: User -> m (){- ^ This can only be done by the logged in user. -},
createUsersWithArrayInput :: [User] -> m (){- ^ -},
createUsersWithListInput :: [User] -> m (){- ^ -},
deleteUser :: Text -> m (){- ^ This can only be done by the logged in user. -},
getUserByName :: Text -> m User{- ^ -},
loginUser :: Maybe Text -> Maybe Text -> m Text{- ^ -},
logoutUser :: m (){- ^ -},
updateUser :: Text -> User -> m (){- ^ This can only be done by the logged in user. -}
data SwaggerPetstoreBackend m = SwaggerPetstoreBackend
{ 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] -> 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 (){- ^ -}
, uploadFile :: Integer -> FormUploadFile -> m ApiResponse{- ^ -}
, deleteOrder :: Text -> m (){- ^ For valid response try integer IDs with value < 1000. Anything above 1000 or nonintegers will generate API errors -}
, getInventory :: m (Map.Map String Int){- ^ Returns a map of status codes to quantities -}
, getOrderById :: Integer -> m Order{- ^ For valid response try integer IDs with value <= 5 or > 10. Other values will generated exceptions -}
, placeOrder :: Order -> m Order{- ^ -}
, createUser :: User -> m (){- ^ This can only be done by the logged in user. -}
, createUsersWithArrayInput :: [User] -> m (){- ^ -}
, createUsersWithListInput :: [User] -> m (){- ^ -}
, deleteUser :: Text -> m (){- ^ This can only be done by the logged in user. -}
, getUserByName :: Text -> m User{- ^ -}
, loginUser :: Maybe Text -> Maybe Text -> m Text{- ^ -}
, logoutUser :: m (){- ^ -}
, updateUser :: Text -> User -> m (){- ^ This can only be done by the logged in user. -}
}
newtype SwaggerPetstoreClient a = SwaggerPetstoreClient { runClient :: Manager -> BaseUrl -> ExceptT ServantError IO a }
deriving Functor
newtype SwaggerPetstoreClient a = SwaggerPetstoreClient
{ runClient :: Manager -> BaseUrl -> ExceptT ServantError IO a
} deriving Functor
instance Applicative SwaggerPetstoreClient where
pure x = SwaggerPetstoreClient (\_ _ -> pure x)
(SwaggerPetstoreClient f) <*> (SwaggerPetstoreClient x) = SwaggerPetstoreClient (\manager url -> f manager url <*> x manager url)
pure x = SwaggerPetstoreClient (\_ _ -> pure x)
(SwaggerPetstoreClient f) <*> (SwaggerPetstoreClient x) =
SwaggerPetstoreClient (\manager url -> f manager url <*> x manager url)
instance Monad SwaggerPetstoreClient where
(SwaggerPetstoreClient a) >>= f = SwaggerPetstoreClient (\manager url -> do
value <- a manager url
runClient (f value) manager url)
(SwaggerPetstoreClient a) >>= f =
SwaggerPetstoreClient (\manager url -> do
value <- a manager url
runClient (f value) manager url)
instance MonadIO SwaggerPetstoreClient where
liftIO io = SwaggerPetstoreClient (\_ _ -> liftIO io)
liftIO io = SwaggerPetstoreClient (\_ _ -> liftIO io)
createSwaggerPetstoreClient :: SwaggerPetstoreBackend SwaggerPetstoreClient
createSwaggerPetstoreClient = SwaggerPetstoreBackend{..}
@ -229,7 +251,6 @@ runSwaggerPetstoreClientWithManager manager clientConfig cl =
runSwaggerPetstoreServer :: MonadIO m => ServerConfig -> SwaggerPetstoreBackend (ExceptT ServantErr IO) -> m ()
runSwaggerPetstoreServer ServerConfig{..} backend =
liftIO $ Warp.runSettings warpSettings $ serve (Proxy :: Proxy SwaggerPetstoreAPI) (serverFromBackend backend)
where
warpSettings = Warp.defaultSettings & Warp.setPort configPort & Warp.setHost (fromString configHost)
serverFromBackend SwaggerPetstoreBackend{..} =

27
samples/server/petstore/haskell-servant/lib/Utils.hs
View File

@ -1,27 +0,0 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE FlexibleInstances #-}
module Utils where
import GHC.Generics
import Servant.API
import Data.List (intercalate)
import Data.List.Split (splitOn)
import qualified Data.Map as Map
import qualified Data.Text as T
import Test.QuickCheck
instance FromText [String] where
fromText = Just . splitOn "," . T.unpack
instance ToText [String] where
toText = T.pack . intercalate ","
lkp inputs l = case lookup l inputs of
Nothing -> Left $ "label " ++ T.unpack l ++ " not found"
Just v -> Right $ read (T.unpack v)
instance (Ord k, Arbitrary k, Arbitrary v) => Arbitrary (Map.Map k v) where
arbitrary = Map.fromList <$> arbitrary

13
samples/server/petstore/haskell-servant/server/Main.hs
View File

@ -1,13 +0,0 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TypeOperators #-}
module Main where
import Apis
import Servant
import Servant.Mock
import qualified Network.Wai.Handler.Warp as Warp
main :: IO ()
main = Warp.run 8080 $ serve api (mock api)