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
parent d2adccbb95 98e8e55281
commit 1010ecc8d5
22 changed files with 243 additions and 747 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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