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

[haskell-http-client] handle Alias models + refactoring. (#6712)

Browse Source 
* handle Alias models with newtypes

* add inlineConsumesContentTypes cli option

* generate swagger.yaml instead of swagger.json

* check for/validate unhandled authMethods

* refactoring
This commit is contained in:
Jon Schoning
2017-10-17 21:47:56 -05:00
committed by wing328
parent 1ac04ae13a
commit 5219035b3a
77 changed files with 7058 additions and 7204 deletions
Download Patch File Download Diff File Expand all files Collapse all files

348
samples/client/petstore/haskell-http-client/lib/SwaggerPetstore/API.hs
View File

@@ -14,6 +14,7 @@ Module : SwaggerPetstore.API
-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
@@ -23,49 +24,38 @@ Module : SwaggerPetstore.API
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# OPTIONS_GHC -fno-warn-name-shadowing -fno-warn-unused-binds -fno-warn-unused-imports #-}
module SwaggerPetstore.API where
import SwaggerPetstore.Model as M
import SwaggerPetstore.Core
import SwaggerPetstore.MimeTypes
import SwaggerPetstore.Lens
import SwaggerPetstore.Model as M
import qualified Data.Aeson as A
import qualified Data.Time as TI
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as BL
import qualified Data.ByteString.Builder as BB
import qualified Data.ByteString.Char8 as BC
import qualified Data.ByteString.Lazy.Char8 as BCL
import qualified Data.ByteString.Base64 as B64
import qualified Network.HTTP.Client.MultipartFormData as NH
import qualified Network.HTTP.Media as ME
import qualified Network.HTTP.Types as NH
import qualified Web.HttpApiData as WH
import qualified Web.FormUrlEncoded as WH
import qualified Data.CaseInsensitive as CI
import qualified Data.ByteString.Char8 as BC
import qualified Data.ByteString.Lazy as BL
import qualified Data.Data as P (Typeable, TypeRep, typeOf, typeRep)
import qualified Data.Foldable as P
import qualified Data.Map as Map
import qualified Data.Set as Set
import qualified Data.Maybe as P
import qualified Data.Proxy as P (Proxy(..))
import qualified Data.Set as Set
import qualified Data.String as P
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.Encoding as TL
import qualified Data.Time as TI
import qualified GHC.Base as P (Alternative)
import qualified Control.Arrow as P (left)
import qualified Lens.Micro as L
import qualified Network.HTTP.Client.MultipartFormData as NH
import qualified Network.HTTP.Media as ME
import qualified Network.HTTP.Types as NH
import qualified Web.FormUrlEncoded as WH
import qualified Web.HttpApiData as WH
import Data.Monoid ((<>))
import Data.Function ((&))
@@ -993,240 +983,46 @@ instance Produces UpdateUser MimeJSON
-- * HasBodyParam
-- * Parameter newtypes
-- | Designates the body parameter of a request
class HasBodyParam req param where
setBodyParam :: forall contentType res. (Consumes req contentType, MimeRender contentType param) => SwaggerPetstoreRequest req contentType res -> param -> SwaggerPetstoreRequest req contentType res
setBodyParam req xs =
req `_setBodyLBS` mimeRender (P.Proxy :: P.Proxy contentType) xs & _setContentTypeHeader
newtype AdditionalMetadata = AdditionalMetadata { unAdditionalMetadata :: Text } deriving (P.Eq, P.Show)
newtype ApiKey = ApiKey { unApiKey :: Text } deriving (P.Eq, P.Show)
newtype Body = Body { unBody :: [User] } deriving (P.Eq, P.Show, A.ToJSON)
newtype Byte = Byte { unByte :: ByteArray } deriving (P.Eq, P.Show)
newtype Callback = Callback { unCallback :: Text } deriving (P.Eq, P.Show)
newtype EnumFormString = EnumFormString { unEnumFormString :: Text } deriving (P.Eq, P.Show)
newtype EnumFormStringArray = EnumFormStringArray { unEnumFormStringArray :: [Text] } deriving (P.Eq, P.Show)
newtype EnumHeaderString = EnumHeaderString { unEnumHeaderString :: Text } deriving (P.Eq, P.Show)
newtype EnumHeaderStringArray = EnumHeaderStringArray { unEnumHeaderStringArray :: [Text] } deriving (P.Eq, P.Show)
newtype EnumQueryDouble = EnumQueryDouble { unEnumQueryDouble :: Double } deriving (P.Eq, P.Show)
newtype EnumQueryInteger = EnumQueryInteger { unEnumQueryInteger :: Int } deriving (P.Eq, P.Show)
newtype EnumQueryString = EnumQueryString { unEnumQueryString :: Text } deriving (P.Eq, P.Show)
newtype EnumQueryStringArray = EnumQueryStringArray { unEnumQueryStringArray :: [Text] } deriving (P.Eq, P.Show)
newtype File = File { unFile :: FilePath } deriving (P.Eq, P.Show)
newtype Int32 = Int32 { unInt32 :: Int } deriving (P.Eq, P.Show)
newtype Int64 = Int64 { unInt64 :: Integer } deriving (P.Eq, P.Show)
newtype Name2 = Name2 { unName2 :: Text } deriving (P.Eq, P.Show)
newtype Number = Number { unNumber :: Double } deriving (P.Eq, P.Show)
newtype OrderId = OrderId { unOrderId :: Integer } deriving (P.Eq, P.Show)
newtype OrderIdText = OrderIdText { unOrderIdText :: Text } deriving (P.Eq, P.Show)
newtype Param = Param { unParam :: Text } deriving (P.Eq, P.Show)
newtype Param2 = Param2 { unParam2 :: Text } deriving (P.Eq, P.Show)
newtype ParamBinary = ParamBinary { unParamBinary :: Binary } deriving (P.Eq, P.Show)
newtype ParamDate = ParamDate { unParamDate :: Date } deriving (P.Eq, P.Show)
newtype ParamDateTime = ParamDateTime { unParamDateTime :: DateTime } deriving (P.Eq, P.Show)
newtype ParamDouble = ParamDouble { unParamDouble :: Double } deriving (P.Eq, P.Show)
newtype ParamFloat = ParamFloat { unParamFloat :: Float } deriving (P.Eq, P.Show)
newtype ParamInteger = ParamInteger { unParamInteger :: Int } deriving (P.Eq, P.Show)
newtype ParamString = ParamString { unParamString :: Text } deriving (P.Eq, P.Show)
newtype Password = Password { unPassword :: Text } deriving (P.Eq, P.Show)
newtype PatternWithoutDelimiter = PatternWithoutDelimiter { unPatternWithoutDelimiter :: Text } deriving (P.Eq, P.Show)
newtype PetId = PetId { unPetId :: Integer } deriving (P.Eq, P.Show)
newtype Status = Status { unStatus :: [Text] } deriving (P.Eq, P.Show)
newtype StatusText = StatusText { unStatusText :: Text } deriving (P.Eq, P.Show)
newtype Tags = Tags { unTags :: [Text] } deriving (P.Eq, P.Show)
newtype Username = Username { unUsername :: Text } deriving (P.Eq, P.Show)
-- * HasOptionalParam
-- | Designates the optional parameters of a request
class HasOptionalParam req param where
{-# MINIMAL applyOptionalParam | (-&-) #-}
-- | Apply an optional parameter to a request
applyOptionalParam :: SwaggerPetstoreRequest req contentType res -> param -> SwaggerPetstoreRequest req contentType res
applyOptionalParam = (-&-)
{-# INLINE applyOptionalParam #-}
-- | infix operator \/ alias for 'addOptionalParam'
(-&-) :: SwaggerPetstoreRequest req contentType res -> param -> SwaggerPetstoreRequest req contentType res
(-&-) = applyOptionalParam
{-# INLINE (-&-) #-}
infixl 2 -&-
-- * SwaggerPetstoreRequest
-- | Represents a request. The "req" type variable is the request type. The "res" type variable is the response type.
data SwaggerPetstoreRequest req contentType res = SwaggerPetstoreRequest
{ rMethod :: NH.Method -- ^ Method of SwaggerPetstoreRequest
, rUrlPath :: [BCL.ByteString] -- ^ Endpoint of SwaggerPetstoreRequest
, rParams :: Params -- ^ params of SwaggerPetstoreRequest
, rAuthTypes :: [P.TypeRep] -- ^ types of auth methods
}
deriving (P.Show)
-- | 'rMethod' Lens
rMethodL :: Lens_' (SwaggerPetstoreRequest req contentType res) NH.Method
rMethodL f SwaggerPetstoreRequest{..} = (\rMethod -> SwaggerPetstoreRequest { rMethod, ..} ) <$> f rMethod
{-# INLINE rMethodL #-}
-- | 'rUrlPath' Lens
rUrlPathL :: Lens_' (SwaggerPetstoreRequest req contentType res) [BCL.ByteString]
rUrlPathL f SwaggerPetstoreRequest{..} = (\rUrlPath -> SwaggerPetstoreRequest { rUrlPath, ..} ) <$> f rUrlPath
{-# INLINE rUrlPathL #-}
-- | 'rParams' Lens
rParamsL :: Lens_' (SwaggerPetstoreRequest req contentType res) Params
rParamsL f SwaggerPetstoreRequest{..} = (\rParams -> SwaggerPetstoreRequest { rParams, ..} ) <$> f rParams
{-# INLINE rParamsL #-}
-- | 'rParams' Lens
rAuthTypesL :: Lens_' (SwaggerPetstoreRequest req contentType res) [P.TypeRep]
rAuthTypesL f SwaggerPetstoreRequest{..} = (\rAuthTypes -> SwaggerPetstoreRequest { rAuthTypes, ..} ) <$> f rAuthTypes
{-# INLINE rAuthTypesL #-}
-- | Request Params
data Params = Params
{ paramsQuery :: NH.Query
, paramsHeaders :: NH.RequestHeaders
, paramsBody :: ParamBody
}
deriving (P.Show)
-- | 'paramsQuery' Lens
paramsQueryL :: Lens_' Params NH.Query
paramsQueryL f Params{..} = (\paramsQuery -> Params { paramsQuery, ..} ) <$> f paramsQuery
{-# INLINE paramsQueryL #-}
-- | 'paramsHeaders' Lens
paramsHeadersL :: Lens_' Params NH.RequestHeaders
paramsHeadersL f Params{..} = (\paramsHeaders -> Params { paramsHeaders, ..} ) <$> f paramsHeaders
{-# INLINE paramsHeadersL #-}
-- | 'paramsBody' Lens
paramsBodyL :: Lens_' Params ParamBody
paramsBodyL f Params{..} = (\paramsBody -> Params { paramsBody, ..} ) <$> f paramsBody
{-# INLINE paramsBodyL #-}
-- | Request Body
data ParamBody
= ParamBodyNone
| ParamBodyB B.ByteString
| ParamBodyBL BL.ByteString
| ParamBodyFormUrlEncoded WH.Form
| ParamBodyMultipartFormData [NH.Part]
deriving (P.Show)
-- ** SwaggerPetstoreRequest Utils
_mkRequest :: NH.Method -- ^ Method
-> [BCL.ByteString] -- ^ Endpoint
-> SwaggerPetstoreRequest req contentType res -- ^ req: Request Type, res: Response Type
_mkRequest m u = SwaggerPetstoreRequest m u _mkParams []
_mkParams :: Params
_mkParams = Params [] [] ParamBodyNone
setHeader :: SwaggerPetstoreRequest req contentType res -> [NH.Header] -> SwaggerPetstoreRequest req contentType res
setHeader req header =
req `removeHeader` P.fmap P.fst header &
L.over (rParamsL . paramsHeadersL) (header P.++)
removeHeader :: SwaggerPetstoreRequest req contentType res -> [NH.HeaderName] -> SwaggerPetstoreRequest req contentType res
removeHeader req header =
req &
L.over
(rParamsL . paramsHeadersL)
(P.filter (\h -> cifst h `P.notElem` P.fmap CI.mk header))
where
cifst = CI.mk . P.fst
_setContentTypeHeader :: forall req contentType res. MimeType contentType => SwaggerPetstoreRequest req contentType res -> SwaggerPetstoreRequest req contentType res
_setContentTypeHeader req =
case mimeType (P.Proxy :: P.Proxy contentType) of
Just m -> req `setHeader` [("content-type", BC.pack $ P.show m)]
Nothing -> req `removeHeader` ["content-type"]
_setAcceptHeader :: forall req contentType res accept. MimeType accept => SwaggerPetstoreRequest req contentType res -> accept -> SwaggerPetstoreRequest req contentType res
_setAcceptHeader req accept =
case mimeType' accept of
Just m -> req `setHeader` [("accept", BC.pack $ P.show m)]
Nothing -> req `removeHeader` ["accept"]
setQuery :: SwaggerPetstoreRequest req contentType res -> [NH.QueryItem] -> SwaggerPetstoreRequest req contentType res
setQuery req query =
req &
L.over
(rParamsL . paramsQueryL)
((query P.++) . P.filter (\q -> cifst q `P.notElem` P.fmap cifst query))
where
cifst = CI.mk . P.fst
addForm :: SwaggerPetstoreRequest req contentType res -> WH.Form -> SwaggerPetstoreRequest req contentType res
addForm req newform =
let form = case paramsBody (rParams req) of
ParamBodyFormUrlEncoded _form -> _form
_ -> mempty
in req & L.set (rParamsL . paramsBodyL) (ParamBodyFormUrlEncoded (newform <> form))
_addMultiFormPart :: SwaggerPetstoreRequest req contentType res -> NH.Part -> SwaggerPetstoreRequest req contentType res
_addMultiFormPart req newpart =
let parts = case paramsBody (rParams req) of
ParamBodyMultipartFormData _parts -> _parts
_ -> []
in req & L.set (rParamsL . paramsBodyL) (ParamBodyMultipartFormData (newpart : parts))
_setBodyBS :: SwaggerPetstoreRequest req contentType res -> B.ByteString -> SwaggerPetstoreRequest req contentType res
_setBodyBS req body =
req & L.set (rParamsL . paramsBodyL) (ParamBodyB body)
_setBodyLBS :: SwaggerPetstoreRequest req contentType res -> BL.ByteString -> SwaggerPetstoreRequest req contentType res
_setBodyLBS req body =
req & L.set (rParamsL . paramsBodyL) (ParamBodyBL body)
_hasAuthType :: AuthMethod authMethod => SwaggerPetstoreRequest req contentType res -> P.Proxy authMethod -> SwaggerPetstoreRequest req contentType res
_hasAuthType req proxy =
req & L.over rAuthTypesL (P.typeRep proxy :)
-- ** Params Utils
toPath
:: WH.ToHttpApiData a
=> a -> BCL.ByteString
toPath = BB.toLazyByteString . WH.toEncodedUrlPiece
toHeader :: WH.ToHttpApiData a => (NH.HeaderName, a) -> [NH.Header]
toHeader x = [fmap WH.toHeader x]
toForm :: WH.ToHttpApiData v => (BC.ByteString, v) -> WH.Form
toForm (k,v) = WH.toForm [(BC.unpack k,v)]
toQuery :: WH.ToHttpApiData a => (BC.ByteString, Maybe a) -> [NH.QueryItem]
toQuery x = [(fmap . fmap) toQueryParam x]
where toQueryParam = T.encodeUtf8 . WH.toQueryParam
-- *** Swagger `CollectionFormat` Utils
-- | Determines the format of the array if type array is used.
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`. This is valid only for parameters in "query" ('NH.Query') or "formData" ('WH.Form')
toHeaderColl :: WH.ToHttpApiData a => CollectionFormat -> (NH.HeaderName, [a]) -> [NH.Header]
toHeaderColl c xs = _toColl c toHeader xs
toFormColl :: WH.ToHttpApiData v => CollectionFormat -> (BC.ByteString, [v]) -> WH.Form
toFormColl c xs = WH.toForm $ fmap unpack $ _toColl c toHeader $ pack xs
where
pack (k,v) = (CI.mk k, v)
unpack (k,v) = (BC.unpack (CI.original k), BC.unpack v)
toQueryColl :: WH.ToHttpApiData a => CollectionFormat -> (BC.ByteString, Maybe [a]) -> NH.Query
toQueryColl c xs = _toCollA c toQuery xs
_toColl :: P.Traversable f => CollectionFormat -> (f a -> [(b, BC.ByteString)]) -> f [a] -> [(b, BC.ByteString)]
_toColl c encode xs = fmap (fmap P.fromJust) (_toCollA' c fencode BC.singleton (fmap Just xs))
where fencode = fmap (fmap Just) . encode . fmap P.fromJust
{-# INLINE fencode #-}
_toCollA :: (P.Traversable f, P.Traversable t, P.Alternative t) => CollectionFormat -> (f (t a) -> [(b, t BC.ByteString)]) -> f (t [a]) -> [(b, t BC.ByteString)]
_toCollA c encode xs = _toCollA' c encode BC.singleton xs
_toCollA' :: (P.Monoid c, P.Traversable f, P.Traversable t, P.Alternative t) => CollectionFormat -> (f (t a) -> [(b, t c)]) -> (Char -> c) -> f (t [a]) -> [(b, t c)]
_toCollA' c encode one xs = case c of
CommaSeparated -> go (one ',')
SpaceSeparated -> go (one ' ')
TabSeparated -> go (one '\t')
PipeSeparated -> go (one '|')
MultiParamArray -> expandList
where
go sep =
[P.foldl1 (\(sk, sv) (_, v) -> (sk, (combine sep <$> sv <*> v) <|> sv <|> v)) expandList]
combine sep x y = x <> sep <> y
expandList = (P.concatMap encode . (P.traverse . P.traverse) P.toList) xs
{-# INLINE go #-}
{-# INLINE expandList #-}
{-# INLINE combine #-}
-- * AuthMethods
-- | Provides a method to apply auth methods to requests
class P.Typeable a => AuthMethod a where
applyAuthMethod :: SwaggerPetstoreRequest req contentType res -> a -> SwaggerPetstoreRequest req contentType res
-- | An existential wrapper for any AuthMethod
data AnyAuthMethod = forall a. AuthMethod a => AnyAuthMethod a deriving (P.Typeable)
instance AuthMethod AnyAuthMethod where applyAuthMethod req (AnyAuthMethod a) = applyAuthMethod req a
-- * Auth Methods
-- ** AuthApiKeyApiKey
data AuthApiKeyApiKey =
@@ -1234,9 +1030,11 @@ data AuthApiKeyApiKey =
deriving (P.Eq, P.Show, P.Typeable)
instance AuthMethod AuthApiKeyApiKey where
applyAuthMethod req a@(AuthApiKeyApiKey secret) =
applyAuthMethod _ a@(AuthApiKeyApiKey secret) req =
P.pure $
if (P.typeOf a `P.elem` rAuthTypes req)
then req `setHeader` toHeader ("api_key", secret)
& L.over rAuthTypesL (P.filter (/= P.typeOf a))
else req
-- ** AuthApiKeyApiKeyQuery
@@ -1245,9 +1043,11 @@ data AuthApiKeyApiKeyQuery =
deriving (P.Eq, P.Show, P.Typeable)
instance AuthMethod AuthApiKeyApiKeyQuery where
applyAuthMethod req a@(AuthApiKeyApiKeyQuery secret) =
applyAuthMethod _ a@(AuthApiKeyApiKeyQuery secret) req =
P.pure $
if (P.typeOf a `P.elem` rAuthTypes req)
then req `setQuery` toQuery ("api_key_query", Just secret)
& L.over rAuthTypesL (P.filter (/= P.typeOf a))
else req
-- ** AuthBasicHttpBasicTest
@@ -1256,9 +1056,11 @@ data AuthBasicHttpBasicTest =
deriving (P.Eq, P.Show, P.Typeable)
instance AuthMethod AuthBasicHttpBasicTest where
applyAuthMethod req a@(AuthBasicHttpBasicTest user pw) =
applyAuthMethod _ a@(AuthBasicHttpBasicTest user pw) req =
P.pure $
if (P.typeOf a `P.elem` rAuthTypes req)
then req `setHeader` toHeader ("Authorization", T.decodeUtf8 cred)
& L.over rAuthTypesL (P.filter (/= P.typeOf a))
else req
where cred = BC.append "Basic " (B64.encode $ BC.concat [ user, ":", pw ])
@@ -1268,9 +1070,37 @@ data AuthOAuthPetstoreAuth =
deriving (P.Eq, P.Show, P.Typeable)
instance AuthMethod AuthOAuthPetstoreAuth where
applyAuthMethod req a@(AuthOAuthPetstoreAuth secret) =
applyAuthMethod _ a@(AuthOAuthPetstoreAuth secret) req =
P.pure $
if (P.typeOf a `P.elem` rAuthTypes req)
then req `setHeader` toHeader ("Authorization", "Bearer " <> secret)
& L.over rAuthTypesL (P.filter (/= P.typeOf a))
else req
-- * Custom Mime Types
-- ** MimeJsonCharsetutf8
data MimeJsonCharsetutf8 = MimeJsonCharsetutf8 deriving (P.Typeable)
-- | @application/json; charset=utf-8@
instance MimeType MimeJsonCharsetutf8 where
mimeType _ = Just $ P.fromString "application/json; charset=utf-8"
instance A.ToJSON a => MimeRender MimeJsonCharsetutf8 a where mimeRender _ = A.encode
instance A.FromJSON a => MimeUnrender MimeJsonCharsetutf8 a where mimeUnrender _ = A.eitherDecode
-- instance MimeRender MimeJsonCharsetutf8 T.Text where mimeRender _ = undefined
-- instance MimeUnrender MimeJsonCharsetutf8 T.Text where mimeUnrender _ = undefined
-- ** MimeXmlCharsetutf8
data MimeXmlCharsetutf8 = MimeXmlCharsetutf8 deriving (P.Typeable)
-- | @application/xml; charset=utf-8@
instance MimeType MimeXmlCharsetutf8 where
mimeType _ = Just $ P.fromString "application/xml; charset=utf-8"
-- instance MimeRender MimeXmlCharsetutf8 T.Text where mimeRender _ = undefined
-- instance MimeUnrender MimeXmlCharsetutf8 T.Text where mimeUnrender _ = undefined

151
samples/client/petstore/haskell-http-client/lib/SwaggerPetstore/Client.hs
View File

@@ -25,102 +25,30 @@ Module : SwaggerPetstore.Client
module SwaggerPetstore.Client where
import SwaggerPetstore.Model
import SwaggerPetstore.API
import SwaggerPetstore.MimeTypes
import SwaggerPetstore.Core
import SwaggerPetstore.Logging
import SwaggerPetstore.MimeTypes
import qualified Control.Exception.Safe as E
import qualified Control.Monad.IO.Class as P
import qualified Data.Aeson as A
import qualified Control.Monad as P
import qualified Data.Aeson.Types as A
import qualified Data.ByteString.Char8 as BC
import qualified Data.ByteString.Lazy as BL
import qualified Data.ByteString.Lazy.Char8 as BCL
import qualified Data.Proxy as P (Proxy(..))
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import qualified Network.HTTP.Client as NH
import qualified Network.HTTP.Client.MultipartFormData as NH
import qualified Network.HTTP.Types as NH
import qualified Web.FormUrlEncoded as WH
import qualified Web.HttpApiData as WH
import Data.Function ((&))
import Data.Monoid ((<>))
import Data.Text (Text)
import GHC.Exts (IsString(..))
import Web.FormUrlEncoded as WH
import Web.HttpApiData as WH
import Control.Monad.Catch (MonadThrow)
import qualified Data.Time as TI
import qualified Data.Map as Map
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import qualified Text.Printf as T
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as BL
import qualified Data.ByteString.Char8 as BC
import qualified Data.ByteString.Lazy.Char8 as BCL
import qualified Data.ByteString.Builder as BB
import qualified Network.HTTP.Client as NH
import qualified Network.HTTP.Client.TLS as NH
import qualified Network.HTTP.Client.MultipartFormData as NH
import qualified Network.HTTP.Types.Method as NH
import qualified Network.HTTP.Types as NH
import qualified Network.HTTP.Types.URI as NH
import qualified Control.Exception.Safe as E
-- * Config
-- |
data SwaggerPetstoreConfig = SwaggerPetstoreConfig
{ configHost :: BCL.ByteString -- ^ host supplied in the Request
, configUserAgent :: Text -- ^ user-agent supplied in the Request
, configLogExecWithContext :: LogExecWithContext -- ^ Run a block using a Logger instance
, configLogContext :: LogContext -- ^ Configures the logger
, configAuthMethods :: [AnyAuthMethod] -- ^ List of configured auth methods
}
-- | display the config
instance Show SwaggerPetstoreConfig where
show c =
T.printf
"{ configHost = %v, configUserAgent = %v, ..}"
(show (configHost c))
(show (configUserAgent c))
-- | constructs a default SwaggerPetstoreConfig
--
-- configHost:
--
-- @http://petstore.swagger.io:80/v2@
--
-- configUserAgent:
--
-- @"swagger-haskell-http-client/1.0.0"@
--
newConfig :: IO SwaggerPetstoreConfig
newConfig = do
logCxt <- initLogContext
return $ SwaggerPetstoreConfig
{ configHost = "http://petstore.swagger.io:80/v2"
, configUserAgent = "swagger-haskell-http-client/1.0.0"
, configLogExecWithContext = runDefaultLogExecWithContext
, configLogContext = logCxt
, configAuthMethods = []
}
-- | updates config use AuthMethod on matching requests
addAuthMethod :: AuthMethod auth => SwaggerPetstoreConfig -> auth -> SwaggerPetstoreConfig
addAuthMethod config@SwaggerPetstoreConfig {configAuthMethods = as} a =
config { configAuthMethods = AnyAuthMethod a : as}
-- | updates the config to use stdout logging
withStdoutLogging :: SwaggerPetstoreConfig -> IO SwaggerPetstoreConfig
withStdoutLogging p = do
logCxt <- stdoutLoggingContext (configLogContext p)
return $ p { configLogExecWithContext = stdoutLoggingExec, configLogContext = logCxt }
-- | updates the config to use stderr logging
withStderrLogging :: SwaggerPetstoreConfig -> IO SwaggerPetstoreConfig
withStderrLogging p = do
logCxt <- stderrLoggingContext (configLogContext p)
return $ p { configLogExecWithContext = stderrLoggingExec, configLogContext = logCxt }
-- | updates the config to disable logging
withNoLogging :: SwaggerPetstoreConfig -> SwaggerPetstoreConfig
withNoLogging p = p { configLogExecWithContext = runNullLogExec}
-- * Dispatch
@@ -243,35 +171,28 @@ _toInitRequest
-> SwaggerPetstoreRequest req contentType res -- ^ request
-> accept -- ^ "accept" 'MimeType'
-> IO (InitRequest req contentType res accept) -- ^ initialized request
_toInitRequest config req0 accept = do
parsedReq <- NH.parseRequest $ BCL.unpack $ BCL.append (configHost config) (BCL.concat (rUrlPath req0))
let req1 = _applyAuthMethods req0 config
& _setContentTypeHeader
& flip _setAcceptHeader accept
reqHeaders = ("User-Agent", WH.toHeader (configUserAgent config)) : paramsHeaders (rParams req1)
reqQuery = NH.renderQuery True (paramsQuery (rParams req1))
pReq = parsedReq { NH.method = (rMethod req1)
, NH.requestHeaders = reqHeaders
, NH.queryString = reqQuery
}
outReq <- case paramsBody (rParams req1) of
ParamBodyNone -> pure (pReq { NH.requestBody = mempty })
ParamBodyB bs -> pure (pReq { NH.requestBody = NH.RequestBodyBS bs })
ParamBodyBL bl -> pure (pReq { NH.requestBody = NH.RequestBodyLBS bl })
ParamBodyFormUrlEncoded form -> pure (pReq { NH.requestBody = NH.RequestBodyLBS (WH.urlEncodeForm form) })
ParamBodyMultipartFormData parts -> NH.formDataBody parts pReq
_toInitRequest config req0 accept =
runConfigLogWithExceptions "Client" config $ do
parsedReq <- P.liftIO $ NH.parseRequest $ BCL.unpack $ BCL.append (configHost config) (BCL.concat (rUrlPath req0))
req1 <- P.liftIO $ _applyAuthMethods req0 config
P.when
(configValidateAuthMethods config && (not . null . rAuthTypes) req1)
(E.throwString $ "AuthMethod not configured: " <> (show . head . rAuthTypes) req1)
let req2 = req1 & _setContentTypeHeader & flip _setAcceptHeader accept
reqHeaders = ("User-Agent", WH.toHeader (configUserAgent config)) : paramsHeaders (rParams req2)
reqQuery = NH.renderQuery True (paramsQuery (rParams req2))
pReq = parsedReq { NH.method = (rMethod req2)
, NH.requestHeaders = reqHeaders
, NH.queryString = reqQuery
}
outReq <- case paramsBody (rParams req2) of
ParamBodyNone -> pure (pReq { NH.requestBody = mempty })
ParamBodyB bs -> pure (pReq { NH.requestBody = NH.RequestBodyBS bs })
ParamBodyBL bl -> pure (pReq { NH.requestBody = NH.RequestBodyLBS bl })
ParamBodyFormUrlEncoded form -> pure (pReq { NH.requestBody = NH.RequestBodyLBS (WH.urlEncodeForm form) })
ParamBodyMultipartFormData parts -> NH.formDataBody parts pReq
pure (InitRequest outReq)
-- | apply all matching AuthMethods in config to request
_applyAuthMethods
:: SwaggerPetstoreRequest req contentType res
-> SwaggerPetstoreConfig
-> SwaggerPetstoreRequest req contentType res
_applyAuthMethods req SwaggerPetstoreConfig {configAuthMethods = as} =
foldl go req as
where
go r (AnyAuthMethod a) = r `applyAuthMethod` a
pure (InitRequest outReq)
-- | modify the underlying Request
modifyInitRequest :: InitRequest req contentType res accept -> (NH.Request -> NH.Request) -> InitRequest req contentType res accept

532
samples/client/petstore/haskell-http-client/lib/SwaggerPetstore/Core.hs Normal file
View File

@@ -0,0 +1,532 @@
{-
Swagger Petstore
This spec is mainly for testing Petstore server and contains fake endpoints, models. Please do not use this for any other purpose. Special characters: \" \\
OpenAPI spec version: 2.0
Swagger Petstore API version: 1.0.0
Contact: apiteam@swagger.io
Generated by Swagger Codegen (https://github.com/swagger-api/swagger-codegen.git)
-}
{-|
Module : SwaggerPetstore.Core
-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_GHC -fno-warn-name-shadowing -fno-warn-unused-binds #-}
module SwaggerPetstore.Core where
import SwaggerPetstore.MimeTypes
import SwaggerPetstore.Logging
import qualified Control.Arrow as P (left)
import qualified Control.DeepSeq as NF
import qualified Data.Aeson as A
import qualified Data.ByteString as B
import qualified Data.ByteString.Base64.Lazy as BL64
import qualified Data.ByteString.Builder as BB
import qualified Data.ByteString.Char8 as BC
import qualified Data.ByteString.Lazy as BL
import qualified Data.ByteString.Lazy.Char8 as BCL
import qualified Data.CaseInsensitive as CI
import qualified Data.Data as P (Data, Typeable, TypeRep, typeRep)
import qualified Data.Foldable as P
import qualified Data.Ix as P
import qualified Data.Maybe as P
import qualified Data.Proxy as P (Proxy(..))
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import qualified Data.Time as TI
import qualified Data.Time.ISO8601 as TI
import qualified GHC.Base as P (Alternative)
import qualified Lens.Micro as L
import qualified Network.HTTP.Client.MultipartFormData as NH
import qualified Network.HTTP.Types as NH
import qualified Prelude as P
import qualified Web.FormUrlEncoded as WH
import qualified Web.HttpApiData as WH
import qualified Text.Printf as T
import Control.Applicative ((<|>))
import Control.Applicative (Alternative)
import Data.Function ((&))
import Data.Foldable(foldlM)
import Data.Monoid ((<>))
import Data.Text (Text)
import Prelude (($), (.), (<$>), (<*>), Maybe(..), Bool(..), Char, String, fmap, mempty, pure, return, show, IO, Monad, Functor)
-- * SwaggerPetstoreConfig
-- |
data SwaggerPetstoreConfig = SwaggerPetstoreConfig
{ configHost :: BCL.ByteString -- ^ host supplied in the Request
, configUserAgent :: Text -- ^ user-agent supplied in the Request
, configLogExecWithContext :: LogExecWithContext -- ^ Run a block using a Logger instance
, configLogContext :: LogContext -- ^ Configures the logger
, configAuthMethods :: [AnyAuthMethod] -- ^ List of configured auth methods
, configValidateAuthMethods :: Bool -- ^ throw exceptions if auth methods are not configured
}
-- | display the config
instance P.Show SwaggerPetstoreConfig where
show c =
T.printf
"{ configHost = %v, configUserAgent = %v, ..}"
(show (configHost c))
(show (configUserAgent c))
-- | constructs a default SwaggerPetstoreConfig
--
-- configHost:
--
-- @http://petstore.swagger.io:80/v2@
--
-- configUserAgent:
--
-- @"swagger-haskell-http-client/1.0.0"@
--
newConfig :: IO SwaggerPetstoreConfig
newConfig = do
logCxt <- initLogContext
return $ SwaggerPetstoreConfig
{ configHost = "http://petstore.swagger.io:80/v2"
, configUserAgent = "swagger-haskell-http-client/1.0.0"
, configLogExecWithContext = runDefaultLogExecWithContext
, configLogContext = logCxt
, configAuthMethods = []
, configValidateAuthMethods = True
}
-- | updates config use AuthMethod on matching requests
addAuthMethod :: AuthMethod auth => SwaggerPetstoreConfig -> auth -> SwaggerPetstoreConfig
addAuthMethod config@SwaggerPetstoreConfig {configAuthMethods = as} a =
config { configAuthMethods = AnyAuthMethod a : as}
-- | updates the config to use stdout logging
withStdoutLogging :: SwaggerPetstoreConfig -> IO SwaggerPetstoreConfig
withStdoutLogging p = do
logCxt <- stdoutLoggingContext (configLogContext p)
return $ p { configLogExecWithContext = stdoutLoggingExec, configLogContext = logCxt }
-- | updates the config to use stderr logging
withStderrLogging :: SwaggerPetstoreConfig -> IO SwaggerPetstoreConfig
withStderrLogging p = do
logCxt <- stderrLoggingContext (configLogContext p)
return $ p { configLogExecWithContext = stderrLoggingExec, configLogContext = logCxt }
-- | updates the config to disable logging
withNoLogging :: SwaggerPetstoreConfig -> SwaggerPetstoreConfig
withNoLogging p = p { configLogExecWithContext = runNullLogExec}
-- * SwaggerPetstoreRequest
-- | Represents a request. The "req" type variable is the request type. The "res" type variable is the response type.
data SwaggerPetstoreRequest req contentType res = SwaggerPetstoreRequest
{ rMethod :: NH.Method -- ^ Method of SwaggerPetstoreRequest
, rUrlPath :: [BCL.ByteString] -- ^ Endpoint of SwaggerPetstoreRequest
, rParams :: Params -- ^ params of SwaggerPetstoreRequest
, rAuthTypes :: [P.TypeRep] -- ^ types of auth methods
}
deriving (P.Show)
-- | 'rMethod' Lens
rMethodL :: Lens_' (SwaggerPetstoreRequest req contentType res) NH.Method
rMethodL f SwaggerPetstoreRequest{..} = (\rMethod -> SwaggerPetstoreRequest { rMethod, ..} ) <$> f rMethod
{-# INLINE rMethodL #-}
-- | 'rUrlPath' Lens
rUrlPathL :: Lens_' (SwaggerPetstoreRequest req contentType res) [BCL.ByteString]
rUrlPathL f SwaggerPetstoreRequest{..} = (\rUrlPath -> SwaggerPetstoreRequest { rUrlPath, ..} ) <$> f rUrlPath
{-# INLINE rUrlPathL #-}
-- | 'rParams' Lens
rParamsL :: Lens_' (SwaggerPetstoreRequest req contentType res) Params
rParamsL f SwaggerPetstoreRequest{..} = (\rParams -> SwaggerPetstoreRequest { rParams, ..} ) <$> f rParams
{-# INLINE rParamsL #-}
-- | 'rParams' Lens
rAuthTypesL :: Lens_' (SwaggerPetstoreRequest req contentType res) [P.TypeRep]
rAuthTypesL f SwaggerPetstoreRequest{..} = (\rAuthTypes -> SwaggerPetstoreRequest { rAuthTypes, ..} ) <$> f rAuthTypes
{-# INLINE rAuthTypesL #-}
-- * HasBodyParam
-- | Designates the body parameter of a request
class HasBodyParam req param where
setBodyParam :: forall contentType res. (Consumes req contentType, MimeRender contentType param) => SwaggerPetstoreRequest req contentType res -> param -> SwaggerPetstoreRequest req contentType res
setBodyParam req xs =
req `_setBodyLBS` mimeRender (P.Proxy :: P.Proxy contentType) xs & _setContentTypeHeader
-- * HasOptionalParam
-- | Designates the optional parameters of a request
class HasOptionalParam req param where
{-# MINIMAL applyOptionalParam | (-&-) #-}
-- | Apply an optional parameter to a request
applyOptionalParam :: SwaggerPetstoreRequest req contentType res -> param -> SwaggerPetstoreRequest req contentType res
applyOptionalParam = (-&-)
{-# INLINE applyOptionalParam #-}
-- | infix operator \/ alias for 'addOptionalParam'
(-&-) :: SwaggerPetstoreRequest req contentType res -> param -> SwaggerPetstoreRequest req contentType res
(-&-) = applyOptionalParam
{-# INLINE (-&-) #-}
infixl 2 -&-
-- | Request Params
data Params = Params
{ paramsQuery :: NH.Query
, paramsHeaders :: NH.RequestHeaders
, paramsBody :: ParamBody
}
deriving (P.Show)
-- | 'paramsQuery' Lens
paramsQueryL :: Lens_' Params NH.Query
paramsQueryL f Params{..} = (\paramsQuery -> Params { paramsQuery, ..} ) <$> f paramsQuery
{-# INLINE paramsQueryL #-}
-- | 'paramsHeaders' Lens
paramsHeadersL :: Lens_' Params NH.RequestHeaders
paramsHeadersL f Params{..} = (\paramsHeaders -> Params { paramsHeaders, ..} ) <$> f paramsHeaders
{-# INLINE paramsHeadersL #-}
-- | 'paramsBody' Lens
paramsBodyL :: Lens_' Params ParamBody
paramsBodyL f Params{..} = (\paramsBody -> Params { paramsBody, ..} ) <$> f paramsBody
{-# INLINE paramsBodyL #-}
-- | Request Body
data ParamBody
= ParamBodyNone
| ParamBodyB B.ByteString
| ParamBodyBL BL.ByteString
| ParamBodyFormUrlEncoded WH.Form
| ParamBodyMultipartFormData [NH.Part]
deriving (P.Show)
-- ** SwaggerPetstoreRequest Utils
_mkRequest :: NH.Method -- ^ Method
-> [BCL.ByteString] -- ^ Endpoint
-> SwaggerPetstoreRequest req contentType res -- ^ req: Request Type, res: Response Type
_mkRequest m u = SwaggerPetstoreRequest m u _mkParams []
_mkParams :: Params
_mkParams = Params [] [] ParamBodyNone
setHeader :: SwaggerPetstoreRequest req contentType res -> [NH.Header] -> SwaggerPetstoreRequest req contentType res
setHeader req header =
req `removeHeader` P.fmap P.fst header &
L.over (rParamsL . paramsHeadersL) (header P.++)
removeHeader :: SwaggerPetstoreRequest req contentType res -> [NH.HeaderName] -> SwaggerPetstoreRequest req contentType res
removeHeader req header =
req &
L.over
(rParamsL . paramsHeadersL)
(P.filter (\h -> cifst h `P.notElem` P.fmap CI.mk header))
where
cifst = CI.mk . P.fst
_setContentTypeHeader :: forall req contentType res. MimeType contentType => SwaggerPetstoreRequest req contentType res -> SwaggerPetstoreRequest req contentType res
_setContentTypeHeader req =
case mimeType (P.Proxy :: P.Proxy contentType) of
Just m -> req `setHeader` [("content-type", BC.pack $ P.show m)]
Nothing -> req `removeHeader` ["content-type"]
_setAcceptHeader :: forall req contentType res accept. MimeType accept => SwaggerPetstoreRequest req contentType res -> accept -> SwaggerPetstoreRequest req contentType res
_setAcceptHeader req accept =
case mimeType' accept of
Just m -> req `setHeader` [("accept", BC.pack $ P.show m)]
Nothing -> req `removeHeader` ["accept"]
setQuery :: SwaggerPetstoreRequest req contentType res -> [NH.QueryItem] -> SwaggerPetstoreRequest req contentType res
setQuery req query =
req &
L.over
(rParamsL . paramsQueryL)
((query P.++) . P.filter (\q -> cifst q `P.notElem` P.fmap cifst query))
where
cifst = CI.mk . P.fst
addForm :: SwaggerPetstoreRequest req contentType res -> WH.Form -> SwaggerPetstoreRequest req contentType res
addForm req newform =
let form = case paramsBody (rParams req) of
ParamBodyFormUrlEncoded _form -> _form
_ -> mempty
in req & L.set (rParamsL . paramsBodyL) (ParamBodyFormUrlEncoded (newform <> form))
_addMultiFormPart :: SwaggerPetstoreRequest req contentType res -> NH.Part -> SwaggerPetstoreRequest req contentType res
_addMultiFormPart req newpart =
let parts = case paramsBody (rParams req) of
ParamBodyMultipartFormData _parts -> _parts
_ -> []
in req & L.set (rParamsL . paramsBodyL) (ParamBodyMultipartFormData (newpart : parts))
_setBodyBS :: SwaggerPetstoreRequest req contentType res -> B.ByteString -> SwaggerPetstoreRequest req contentType res
_setBodyBS req body =
req & L.set (rParamsL . paramsBodyL) (ParamBodyB body)
_setBodyLBS :: SwaggerPetstoreRequest req contentType res -> BL.ByteString -> SwaggerPetstoreRequest req contentType res
_setBodyLBS req body =
req & L.set (rParamsL . paramsBodyL) (ParamBodyBL body)
_hasAuthType :: AuthMethod authMethod => SwaggerPetstoreRequest req contentType res -> P.Proxy authMethod -> SwaggerPetstoreRequest req contentType res
_hasAuthType req proxy =
req & L.over rAuthTypesL (P.typeRep proxy :)
-- ** Params Utils
toPath
:: WH.ToHttpApiData a
=> a -> BCL.ByteString
toPath = BB.toLazyByteString . WH.toEncodedUrlPiece
toHeader :: WH.ToHttpApiData a => (NH.HeaderName, a) -> [NH.Header]
toHeader x = [fmap WH.toHeader x]
toForm :: WH.ToHttpApiData v => (BC.ByteString, v) -> WH.Form
toForm (k,v) = WH.toForm [(BC.unpack k,v)]
toQuery :: WH.ToHttpApiData a => (BC.ByteString, Maybe a) -> [NH.QueryItem]
toQuery x = [(fmap . fmap) toQueryParam x]
where toQueryParam = T.encodeUtf8 . WH.toQueryParam
-- *** Swagger `CollectionFormat` Utils
-- | Determines the format of the array if type array is used.
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`. This is valid only for parameters in "query" ('NH.Query') or "formData" ('WH.Form')
toHeaderColl :: WH.ToHttpApiData a => CollectionFormat -> (NH.HeaderName, [a]) -> [NH.Header]
toHeaderColl c xs = _toColl c toHeader xs
toFormColl :: WH.ToHttpApiData v => CollectionFormat -> (BC.ByteString, [v]) -> WH.Form
toFormColl c xs = WH.toForm $ fmap unpack $ _toColl c toHeader $ pack xs
where
pack (k,v) = (CI.mk k, v)
unpack (k,v) = (BC.unpack (CI.original k), BC.unpack v)
toQueryColl :: WH.ToHttpApiData a => CollectionFormat -> (BC.ByteString, Maybe [a]) -> NH.Query
toQueryColl c xs = _toCollA c toQuery xs
_toColl :: P.Traversable f => CollectionFormat -> (f a -> [(b, BC.ByteString)]) -> f [a] -> [(b, BC.ByteString)]
_toColl c encode xs = fmap (fmap P.fromJust) (_toCollA' c fencode BC.singleton (fmap Just xs))
where fencode = fmap (fmap Just) . encode . fmap P.fromJust
{-# INLINE fencode #-}
_toCollA :: (P.Traversable f, P.Traversable t, P.Alternative t) => CollectionFormat -> (f (t a) -> [(b, t BC.ByteString)]) -> f (t [a]) -> [(b, t BC.ByteString)]
_toCollA c encode xs = _toCollA' c encode BC.singleton xs
_toCollA' :: (P.Monoid c, P.Traversable f, P.Traversable t, P.Alternative t) => CollectionFormat -> (f (t a) -> [(b, t c)]) -> (Char -> c) -> f (t [a]) -> [(b, t c)]
_toCollA' c encode one xs = case c of
CommaSeparated -> go (one ',')
SpaceSeparated -> go (one ' ')
TabSeparated -> go (one '\t')
PipeSeparated -> go (one '|')
MultiParamArray -> expandList
where
go sep =
[P.foldl1 (\(sk, sv) (_, v) -> (sk, (combine sep <$> sv <*> v) <|> sv <|> v)) expandList]
combine sep x y = x <> sep <> y
expandList = (P.concatMap encode . (P.traverse . P.traverse) P.toList) xs
{-# INLINE go #-}
{-# INLINE expandList #-}
{-# INLINE combine #-}
-- * AuthMethods
-- | Provides a method to apply auth methods to requests
class P.Typeable a =>
AuthMethod a where
applyAuthMethod
:: SwaggerPetstoreConfig
-> a
-> SwaggerPetstoreRequest req contentType res
-> IO (SwaggerPetstoreRequest req contentType res)
-- | An existential wrapper for any AuthMethod
data AnyAuthMethod = forall a. AuthMethod a => AnyAuthMethod a deriving (P.Typeable)
instance AuthMethod AnyAuthMethod where applyAuthMethod config (AnyAuthMethod a) req = applyAuthMethod config a req
-- | apply all matching AuthMethods in config to request
_applyAuthMethods
:: SwaggerPetstoreRequest req contentType res
-> SwaggerPetstoreConfig
-> IO (SwaggerPetstoreRequest req contentType res)
_applyAuthMethods req config@(SwaggerPetstoreConfig {configAuthMethods = as}) =
foldlM go req as
where
go r (AnyAuthMethod a) = applyAuthMethod config a r
-- * Utils
-- | Removes Null fields. (OpenAPI-Specification 2.0 does not allow Null in JSON)
_omitNulls :: [(Text, A.Value)] -> A.Value
_omitNulls = A.object . P.filter notNull
where
notNull (_, A.Null) = False
notNull _ = True
-- | Encodes fields using WH.toQueryParam
_toFormItem :: (WH.ToHttpApiData a, Functor f) => t -> f a -> f (t, [Text])
_toFormItem name x = (name,) . (:[]) . WH.toQueryParam <$> x
-- | Collapse (Just "") to Nothing
_emptyToNothing :: Maybe String -> Maybe String
_emptyToNothing (Just "") = Nothing
_emptyToNothing x = x
{-# INLINE _emptyToNothing #-}
-- | Collapse (Just mempty) to Nothing
_memptyToNothing :: (P.Monoid a, P.Eq a) => Maybe a -> Maybe a
_memptyToNothing (Just x) | x P.== P.mempty = Nothing
_memptyToNothing x = x
{-# INLINE _memptyToNothing #-}
-- * DateTime Formatting
newtype DateTime = DateTime { unDateTime :: TI.UTCTime }
deriving (P.Eq,P.Data,P.Ord,P.Typeable,NF.NFData,TI.ParseTime,TI.FormatTime)
instance A.FromJSON DateTime where
parseJSON = A.withText "DateTime" (_readDateTime . T.unpack)
instance A.ToJSON DateTime where
toJSON (DateTime t) = A.toJSON (_showDateTime t)
instance WH.FromHttpApiData DateTime where
parseUrlPiece = P.left T.pack . _readDateTime . T.unpack
instance WH.ToHttpApiData DateTime where
toUrlPiece (DateTime t) = T.pack (_showDateTime t)
instance P.Show DateTime where
show (DateTime t) = _showDateTime t
instance MimeRender MimeMultipartFormData DateTime where
mimeRender _ = mimeRenderDefaultMultipartFormData
-- | @_parseISO8601@
_readDateTime :: (TI.ParseTime t, Monad m, Alternative m) => String -> m t
_readDateTime =
_parseISO8601
{-# INLINE _readDateTime #-}
-- | @TI.formatISO8601Millis@
_showDateTime :: (t ~ TI.UTCTime, TI.FormatTime t) => t -> String
_showDateTime =
TI.formatISO8601Millis
{-# INLINE _showDateTime #-}
-- | parse an ISO8601 date-time string
_parseISO8601 :: (TI.ParseTime t, Monad m, Alternative m) => String -> m t
_parseISO8601 t =
P.asum $
P.flip (TI.parseTimeM True TI.defaultTimeLocale) t <$>
["%FT%T%QZ", "%FT%T%Q%z", "%FT%T%Q%Z"]
{-# INLINE _parseISO8601 #-}
-- * Date Formatting
newtype Date = Date { unDate :: TI.Day }
deriving (P.Enum,P.Eq,P.Data,P.Ord,P.Ix,NF.NFData,TI.ParseTime,TI.FormatTime)
instance A.FromJSON Date where
parseJSON = A.withText "Date" (_readDate . T.unpack)
instance A.ToJSON Date where
toJSON (Date t) = A.toJSON (_showDate t)
instance WH.FromHttpApiData Date where
parseUrlPiece = P.left T.pack . _readDate . T.unpack
instance WH.ToHttpApiData Date where
toUrlPiece (Date t) = T.pack (_showDate t)
instance P.Show Date where
show (Date t) = _showDate t
instance MimeRender MimeMultipartFormData Date where
mimeRender _ = mimeRenderDefaultMultipartFormData
-- | @TI.parseTimeM True TI.defaultTimeLocale "%Y-%m-%d"@
_readDate :: (TI.ParseTime t, Monad m) => String -> m t
_readDate =
TI.parseTimeM True TI.defaultTimeLocale "%Y-%m-%d"
{-# INLINE _readDate #-}
-- | @TI.formatTime TI.defaultTimeLocale "%Y-%m-%d"@
_showDate :: TI.FormatTime t => t -> String
_showDate =
TI.formatTime TI.defaultTimeLocale "%Y-%m-%d"
{-# INLINE _showDate #-}
-- * Byte/Binary Formatting
-- | base64 encoded characters
newtype ByteArray = ByteArray { unByteArray :: BL.ByteString }
deriving (P.Eq,P.Data,P.Ord,P.Typeable,NF.NFData)
instance A.FromJSON ByteArray where
parseJSON = A.withText "ByteArray" _readByteArray
instance A.ToJSON ByteArray where
toJSON = A.toJSON . _showByteArray
instance WH.FromHttpApiData ByteArray where
parseUrlPiece = P.left T.pack . _readByteArray
instance WH.ToHttpApiData ByteArray where
toUrlPiece = _showByteArray
instance P.Show ByteArray where
show = T.unpack . _showByteArray
instance MimeRender MimeMultipartFormData ByteArray where
mimeRender _ = mimeRenderDefaultMultipartFormData
-- | read base64 encoded characters
_readByteArray :: Monad m => Text -> m ByteArray
_readByteArray = P.either P.fail (pure . ByteArray) . BL64.decode . BL.fromStrict . T.encodeUtf8
{-# INLINE _readByteArray #-}
-- | show base64 encoded characters
_showByteArray :: ByteArray -> Text
_showByteArray = T.decodeUtf8 . BL.toStrict . BL64.encode . unByteArray
{-# INLINE _showByteArray #-}
-- | any sequence of octets
newtype Binary = Binary { unBinary :: BL.ByteString }
deriving (P.Eq,P.Data,P.Ord,P.Typeable,NF.NFData)
instance A.FromJSON Binary where
parseJSON = A.withText "Binary" _readBinaryBase64
instance A.ToJSON Binary where
toJSON = A.toJSON . _showBinaryBase64
instance WH.FromHttpApiData Binary where
parseUrlPiece = P.left T.pack . _readBinaryBase64
instance WH.ToHttpApiData Binary where
toUrlPiece = _showBinaryBase64
instance P.Show Binary where
show = T.unpack . _showBinaryBase64
instance MimeRender MimeMultipartFormData Binary where
mimeRender _ = unBinary
_readBinaryBase64 :: Monad m => Text -> m Binary
_readBinaryBase64 = P.either P.fail (pure . Binary) . BL64.decode . BL.fromStrict . T.encodeUtf8
{-# INLINE _readBinaryBase64 #-}
_showBinaryBase64 :: Binary -> Text
_showBinaryBase64 = T.decodeUtf8 . BL.toStrict . BL64.encode . unBinary
{-# INLINE _showBinaryBase64 #-}
-- * Lens Type Aliases
type Lens_' s a = Lens_ s s a a
type Lens_ s t a b = forall (f :: * -> *). Functor f => (a -> f b) -> s -> f t

6
samples/client/petstore/haskell-http-client/lib/SwaggerPetstore/Logging.hs
View File

@@ -20,9 +20,6 @@ Katip Logging functions
module SwaggerPetstore.Logging where
import Data.Text (Text)
import GHC.Exts (IsString(..))
import qualified Control.Exception.Safe as E
import qualified Control.Monad.IO.Class as P
import qualified Control.Monad.Trans.Reader as P
@@ -30,6 +27,9 @@ import qualified Data.Text as T
import qualified Lens.Micro as L
import qualified System.IO as IO
import Data.Text (Text)
import GHC.Exts (IsString(..))
import qualified Katip as LG
-- * Type Aliases (for compatability)

91
samples/client/petstore/haskell-http-client/lib/SwaggerPetstore/MimeTypes.hs
View File

@@ -23,39 +23,35 @@ Module : SwaggerPetstore.MimeTypes
module SwaggerPetstore.MimeTypes where
import SwaggerPetstore.Model as M
import qualified Control.Arrow as P (left)
import qualified Data.Aeson as A
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as BL
import qualified Data.ByteString.Builder as BB
import qualified Data.ByteString.Char8 as BC
import qualified Data.ByteString.Lazy as BL
import qualified Data.ByteString.Lazy.Char8 as BCL
import qualified Network.HTTP.Media as ME
import qualified Web.FormUrlEncoded as WH
import qualified Web.HttpApiData as WH
import qualified Data.Data as P (Typeable)
import qualified Data.Proxy as P (Proxy(..))
import qualified Data.Text as T
import qualified Data.String as P
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import qualified Control.Arrow as P (left)
import qualified Network.HTTP.Media as ME
import qualified Web.FormUrlEncoded as WH
import qualified Web.HttpApiData as WH
import Prelude (($), (.),(<$>),(<*>),Maybe(..),Bool(..),Char,Double,FilePath,Float,Int,Integer,String,fmap,undefined,mempty)
import qualified Prelude as P
-- * Content Negotiation
-- | A type for responses without content-body.
data NoContent = NoContent
deriving (P.Show, P.Eq)
-- * Consumes Class
-- ** Mime Types
class MimeType mtype => Consumes req mtype where
-- * Produces Class
class MimeType mtype => Produces req mtype where
-- * Default Mime Types
data MimeJSON = MimeJSON deriving (P.Typeable)
data MimeXML = MimeXML deriving (P.Typeable)
@@ -66,10 +62,12 @@ data MimeOctetStream = MimeOctetStream deriving (P.Typeable)
data MimeNoContent = MimeNoContent deriving (P.Typeable)
data MimeAny = MimeAny deriving (P.Typeable)
data MimeJsonCharsetutf8 = MimeJsonCharsetutf8 deriving (P.Typeable)
data MimeXmlCharsetutf8 = MimeXmlCharsetutf8 deriving (P.Typeable)
-- | A type for responses without content-body.
data NoContent = NoContent
deriving (P.Show, P.Eq, P.Typeable)
-- ** MimeType Class
-- * MimeType Class
class P.Typeable mtype => MimeType mtype where
{-# MINIMAL mimeType | mimeTypes #-}
@@ -91,7 +89,7 @@ class P.Typeable mtype => MimeType mtype where
mimeTypes' :: mtype -> [ME.MediaType]
mimeTypes' _ = mimeTypes (P.Proxy :: P.Proxy mtype)
-- ** MimeType Instances
-- Default MimeType Instances
-- | @application/json; charset=utf-8@
instance MimeType MimeJSON where
@@ -117,18 +115,7 @@ instance MimeType MimeAny where
instance MimeType MimeNoContent where
mimeType _ = Nothing
-- | @application/json; charset=utf-8@
instance MimeType MimeJsonCharsetutf8 where
mimeType _ = Just $ P.fromString "application/json; charset=utf-8"
instance A.ToJSON a => MimeRender MimeJsonCharsetutf8 a where mimeRender _ = A.encode
instance A.FromJSON a => MimeUnrender MimeJsonCharsetutf8 a where mimeUnrender _ = A.eitherDecode
-- | @application/xml; charset=utf-8@
instance MimeType MimeXmlCharsetutf8 where
mimeType _ = Just $ P.fromString "application/xml; charset=utf-8"
-- ** MimeRender Class
-- * MimeRender Class
class MimeType mtype => MimeRender mtype x where
mimeRender :: P.Proxy mtype -> x -> BL.ByteString
@@ -136,7 +123,10 @@ class MimeType mtype => MimeRender mtype x where
mimeRender' _ x = mimeRender (P.Proxy :: P.Proxy mtype) x
-- ** MimeRender Instances
mimeRenderDefaultMultipartFormData :: WH.ToHttpApiData a => a -> BL.ByteString
mimeRenderDefaultMultipartFormData = BL.fromStrict . T.encodeUtf8 . WH.toQueryParam
-- Default MimeRender Instances
-- | `A.encode`
instance A.ToJSON a => MimeRender MimeJSON a where mimeRender _ = A.encode
@@ -158,13 +148,9 @@ instance MimeRender MimeOctetStream T.Text where mimeRender _ = BL.fromStrict .
instance MimeRender MimeOctetStream String where mimeRender _ = BCL.pack
instance MimeRender MimeMultipartFormData BL.ByteString where mimeRender _ = P.id
instance MimeRender MimeMultipartFormData Binary where mimeRender _ = unBinary
instance MimeRender MimeMultipartFormData ByteArray where mimeRender _ = mimeRenderDefaultMultipartFormData
instance MimeRender MimeMultipartFormData Bool where mimeRender _ = mimeRenderDefaultMultipartFormData
instance MimeRender MimeMultipartFormData Char where mimeRender _ = mimeRenderDefaultMultipartFormData
instance MimeRender MimeMultipartFormData Date where mimeRender _ = mimeRenderDefaultMultipartFormData
instance MimeRender MimeMultipartFormData DateTime where mimeRender _ = mimeRenderDefaultMultipartFormData
instance MimeRender MimeMultipartFormData Double where mimeRender _ = mimeRenderDefaultMultipartFormData
instance MimeRender MimeMultipartFormData Float where mimeRender _ = mimeRenderDefaultMultipartFormData
instance MimeRender MimeMultipartFormData Int where mimeRender _ = mimeRenderDefaultMultipartFormData
@@ -172,28 +158,18 @@ instance MimeRender MimeMultipartFormData Integer where mimeRender _ = mimeRende
instance MimeRender MimeMultipartFormData String where mimeRender _ = mimeRenderDefaultMultipartFormData
instance MimeRender MimeMultipartFormData T.Text where mimeRender _ = mimeRenderDefaultMultipartFormData
mimeRenderDefaultMultipartFormData :: WH.ToHttpApiData a => a -> BL.ByteString
mimeRenderDefaultMultipartFormData = BL.fromStrict . T.encodeUtf8 . WH.toQueryParam
-- | @P.Right . P.const NoContent@
instance MimeRender MimeNoContent NoContent where mimeRender _ = P.const BCL.empty
-- instance MimeRender MimeOctetStream Double where mimeRender _ = BB.toLazyByteString . BB.doubleDec
-- instance MimeRender MimeOctetStream Float where mimeRender _ = BB.toLazyByteString . BB.floatDec
-- instance MimeRender MimeOctetStream Int where mimeRender _ = BB.toLazyByteString . BB.intDec
-- instance MimeRender MimeOctetStream Integer where mimeRender _ = BB.toLazyByteString . BB.integerDec
-- instance MimeRender MimeJsonCharsetutf8 T.Text where mimeRender _ = undefined
-- instance MimeRender MimeXmlCharsetutf8 T.Text where mimeRender _ = undefined
-- ** MimeUnrender Class
-- * MimeUnrender Class
class MimeType mtype => MimeUnrender mtype o where
mimeUnrender :: P.Proxy mtype -> BL.ByteString -> P.Either String o
mimeUnrender' :: mtype -> BL.ByteString -> P.Either String o
mimeUnrender' _ x = mimeUnrender (P.Proxy :: P.Proxy mtype) x
-- ** MimeUnrender Instances
-- Default MimeUnrender Instances
-- | @A.eitherDecode@
instance A.FromJSON a => MimeUnrender MimeJSON a where mimeUnrender _ = A.eitherDecode
@@ -215,15 +191,4 @@ instance MimeUnrender MimeOctetStream T.Text where mimeUnrender _ = P.left P.sho
instance MimeUnrender MimeOctetStream String where mimeUnrender _ = P.Right . BCL.unpack
-- | @P.Right . P.const NoContent@
instance MimeUnrender MimeNoContent NoContent where mimeUnrender _ = P.Right . P.const NoContent
-- instance MimeUnrender MimeJsonCharsetutf8 T.Text where mimeUnrender _ = undefined
-- instance MimeUnrender MimeXmlCharsetutf8 T.Text where mimeUnrender _ = undefined
-- ** Request Consumes
class MimeType mtype => Consumes req mtype where
-- ** Request Produces
class MimeType mtype => Produces req mtype where
instance MimeUnrender MimeNoContent NoContent where mimeUnrender _ = P.Right . P.const NoContent

441
samples/client/petstore/haskell-http-client/lib/SwaggerPetstore/Model.hs
View File

@@ -27,33 +27,30 @@ Module : SwaggerPetstore.Model
module SwaggerPetstore.Model where
import SwaggerPetstore.Core
import Data.Aeson ((.:),(.:!),(.:?),(.=))
import qualified Data.Aeson as A
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as BL
import qualified Data.ByteString.Base64.Lazy as BL64
import qualified Data.Data as P (Data, Typeable)
import qualified Data.Foldable as P
import qualified Data.HashMap.Lazy as HM
import qualified Data.Map as Map
import qualified Data.Set as Set
import qualified Data.Maybe as P
import qualified Data.Foldable as P
import qualified Web.FormUrlEncoded as WH
import qualified Web.HttpApiData as WH
import qualified Control.DeepSeq as NF
import qualified Data.Ix as P
import qualified Data.Set as Set
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import qualified Control.Arrow as P (left)
import Data.Text (Text)
import qualified Data.Time as TI
import qualified Data.Time.ISO8601 as TI
import qualified Web.FormUrlEncoded as WH
import qualified Web.HttpApiData as WH
import Control.Applicative ((<|>))
import Control.Applicative (Alternative)
import Data.Text (Text)
import Prelude (($), (.),(<$>),(<*>),(>>=),Maybe(..),Bool(..),Char,Double,FilePath,Float,Int,Integer,String,fmap,undefined,mempty,maybe,pure,Monad,Applicative,Functor)
import qualified Prelude as P
@@ -66,8 +63,7 @@ import qualified Prelude as P
data AdditionalPropertiesClass = AdditionalPropertiesClass
{ additionalPropertiesClassMapProperty :: !(Maybe (Map.Map String Text)) -- ^ "map_property"
, additionalPropertiesClassMapOfMapProperty :: !(Maybe (Map.Map String (Map.Map String Text))) -- ^ "map_of_map_property"
} deriving (P.Show,P.Eq,P.Typeable)
} deriving (P.Show, P.Eq, P.Typeable)
-- | FromJSON AdditionalPropertiesClass
instance A.FromJSON AdditionalPropertiesClass where
@@ -93,15 +89,14 @@ mkAdditionalPropertiesClass =
{ additionalPropertiesClassMapProperty = Nothing
, additionalPropertiesClassMapOfMapProperty = Nothing
}
-- ** Animal
-- | Animal
data Animal = Animal
{ animalClassName :: !(Text) -- ^ /Required/ "className"
, animalColor :: !(Maybe Text) -- ^ "color"
} deriving (P.Show,P.Eq,P.Typeable)
} deriving (P.Show, P.Eq, P.Typeable)
-- | FromJSON Animal
instance A.FromJSON Animal where
@@ -128,14 +123,13 @@ mkAnimal animalClassName =
{ animalClassName
, animalColor = Nothing
}
-- ** AnimalFarm
-- | AnimalFarm
data AnimalFarm = AnimalFarm
{
} deriving (P.Show,P.Eq,P.Typeable)
} deriving (P.Show, P.Eq, P.Typeable)
-- | FromJSON AnimalFarm
instance A.FromJSON AnimalFarm where
@@ -158,7 +152,7 @@ mkAnimalFarm =
AnimalFarm
{
}
-- ** ApiResponse
-- | ApiResponse
@@ -166,8 +160,7 @@ data ApiResponse = ApiResponse
{ apiResponseCode :: !(Maybe Int) -- ^ "code"
, apiResponseType :: !(Maybe Text) -- ^ "type"
, apiResponseMessage :: !(Maybe Text) -- ^ "message"
} deriving (P.Show,P.Eq,P.Typeable)
} deriving (P.Show, P.Eq, P.Typeable)
-- | FromJSON ApiResponse
instance A.FromJSON ApiResponse where
@@ -196,14 +189,13 @@ mkApiResponse =
, apiResponseType = Nothing
, apiResponseMessage = Nothing
}
-- ** ArrayOfArrayOfNumberOnly
-- | ArrayOfArrayOfNumberOnly
data ArrayOfArrayOfNumberOnly = ArrayOfArrayOfNumberOnly
{ arrayOfArrayOfNumberOnlyArrayArrayNumber :: !(Maybe [[Double]]) -- ^ "ArrayArrayNumber"
} deriving (P.Show,P.Eq,P.Typeable)
} deriving (P.Show, P.Eq, P.Typeable)
-- | FromJSON ArrayOfArrayOfNumberOnly
instance A.FromJSON ArrayOfArrayOfNumberOnly where
@@ -226,14 +218,13 @@ mkArrayOfArrayOfNumberOnly =
ArrayOfArrayOfNumberOnly
{ arrayOfArrayOfNumberOnlyArrayArrayNumber = Nothing
}
-- ** ArrayOfNumberOnly
-- | ArrayOfNumberOnly
data ArrayOfNumberOnly = ArrayOfNumberOnly
{ arrayOfNumberOnlyArrayNumber :: !(Maybe [Double]) -- ^ "ArrayNumber"
} deriving (P.Show,P.Eq,P.Typeable)
} deriving (P.Show, P.Eq, P.Typeable)
-- | FromJSON ArrayOfNumberOnly
instance A.FromJSON ArrayOfNumberOnly where
@@ -256,7 +247,7 @@ mkArrayOfNumberOnly =
ArrayOfNumberOnly
{ arrayOfNumberOnlyArrayNumber = Nothing
}
-- ** ArrayTest
-- | ArrayTest
@@ -264,8 +255,7 @@ data ArrayTest = ArrayTest
{ arrayTestArrayOfString :: !(Maybe [Text]) -- ^ "array_of_string"
, arrayTestArrayArrayOfInteger :: !(Maybe [[Integer]]) -- ^ "array_array_of_integer"
, arrayTestArrayArrayOfModel :: !(Maybe [[ReadOnlyFirst]]) -- ^ "array_array_of_model"
} deriving (P.Show,P.Eq,P.Typeable)
} deriving (P.Show, P.Eq, P.Typeable)
-- | FromJSON ArrayTest
instance A.FromJSON ArrayTest where
@@ -294,7 +284,7 @@ mkArrayTest =
, arrayTestArrayArrayOfInteger = Nothing
, arrayTestArrayArrayOfModel = Nothing
}
-- ** Capitalization
-- | Capitalization
@@ -305,8 +295,7 @@ data Capitalization = Capitalization
, capitalizationCapitalSnake :: !(Maybe Text) -- ^ "Capital_Snake"
, capitalizationScaEthFlowPoints :: !(Maybe Text) -- ^ "SCA_ETH_Flow_Points"
, capitalizationAttName :: !(Maybe Text) -- ^ "ATT_NAME" - Name of the pet
} deriving (P.Show,P.Eq,P.Typeable)
} deriving (P.Show, P.Eq, P.Typeable)
-- | FromJSON Capitalization
instance A.FromJSON Capitalization where
@@ -344,15 +333,14 @@ mkCapitalization =
, capitalizationScaEthFlowPoints = Nothing
, capitalizationAttName = Nothing
}
-- ** Category
-- | Category
data Category = Category
{ categoryId :: !(Maybe Integer) -- ^ "id"
, categoryName :: !(Maybe Text) -- ^ "name"
} deriving (P.Show,P.Eq,P.Typeable)
} deriving (P.Show, P.Eq, P.Typeable)
-- | FromJSON Category
instance A.FromJSON Category where
@@ -378,15 +366,14 @@ mkCategory =
{ categoryId = Nothing
, categoryName = Nothing
}
-- ** ClassModel
-- | ClassModel
-- Model for testing model with \"_class\" property
data ClassModel = ClassModel
{ classModelClass :: !(Maybe Text) -- ^ "_class"
} deriving (P.Show,P.Eq,P.Typeable)
} deriving (P.Show, P.Eq, P.Typeable)
-- | FromJSON ClassModel
instance A.FromJSON ClassModel where
@@ -409,14 +396,13 @@ mkClassModel =
ClassModel
{ classModelClass = Nothing
}
-- ** Client
-- | Client
data Client = Client
{ clientClient :: !(Maybe Text) -- ^ "client"
} deriving (P.Show,P.Eq,P.Typeable)
} deriving (P.Show, P.Eq, P.Typeable)
-- | FromJSON Client
instance A.FromJSON Client where
@@ -439,15 +425,14 @@ mkClient =
Client
{ clientClient = Nothing
}
-- ** EnumArrays
-- | EnumArrays
data EnumArrays = EnumArrays
{ enumArraysJustSymbol :: !(Maybe Text) -- ^ "just_symbol"
, enumArraysArrayEnum :: !(Maybe [Text]) -- ^ "array_enum"
} deriving (P.Show,P.Eq,P.Typeable)
} deriving (P.Show, P.Eq, P.Typeable)
-- | FromJSON EnumArrays
instance A.FromJSON EnumArrays where
@@ -473,14 +458,13 @@ mkEnumArrays =
{ enumArraysJustSymbol = Nothing
, enumArraysArrayEnum = Nothing
}
-- ** EnumClass
-- | EnumClass
data EnumClass = EnumClass
{
} deriving (P.Show,P.Eq,P.Typeable)
} deriving (P.Show, P.Eq, P.Typeable)
-- | FromJSON EnumClass
instance A.FromJSON EnumClass where
@@ -503,7 +487,7 @@ mkEnumClass =
EnumClass
{
}
-- ** EnumTest
-- | EnumTest
@@ -512,8 +496,7 @@ data EnumTest = EnumTest
, enumTestEnumInteger :: !(Maybe Int) -- ^ "enum_integer"
, enumTestEnumNumber :: !(Maybe Double) -- ^ "enum_number"
, enumTestOuterEnum :: !(Maybe OuterEnum) -- ^ "outerEnum"
} deriving (P.Show,P.Eq,P.Typeable)
} deriving (P.Show, P.Eq, P.Typeable)
-- | FromJSON EnumTest
instance A.FromJSON EnumTest where
@@ -545,7 +528,7 @@ mkEnumTest =
, enumTestEnumNumber = Nothing
, enumTestOuterEnum = Nothing
}
-- ** FormatTest
-- | FormatTest
@@ -563,8 +546,7 @@ data FormatTest = FormatTest
, formatTestDateTime :: !(Maybe DateTime) -- ^ "dateTime"
, formatTestUuid :: !(Maybe Text) -- ^ "uuid"
, formatTestPassword :: !(Text) -- ^ /Required/ "password"
} deriving (P.Show,P.Eq,P.Typeable)
} deriving (P.Show, P.Eq, P.Typeable)
-- | FromJSON FormatTest
instance A.FromJSON FormatTest where
@@ -627,15 +609,14 @@ mkFormatTest formatTestNumber formatTestByte formatTestDate formatTestPassword =
, formatTestUuid = Nothing
, formatTestPassword
}
-- ** HasOnlyReadOnly
-- | HasOnlyReadOnly
data HasOnlyReadOnly = HasOnlyReadOnly
{ hasOnlyReadOnlyBar :: !(Maybe Text) -- ^ "bar"
, hasOnlyReadOnlyFoo :: !(Maybe Text) -- ^ "foo"
} deriving (P.Show,P.Eq,P.Typeable)
} deriving (P.Show, P.Eq, P.Typeable)
-- | FromJSON HasOnlyReadOnly
instance A.FromJSON HasOnlyReadOnly where
@@ -661,15 +642,14 @@ mkHasOnlyReadOnly =
{ hasOnlyReadOnlyBar = Nothing
, hasOnlyReadOnlyFoo = Nothing
}
-- ** MapTest
-- | MapTest
data MapTest = MapTest
{ mapTestMapMapOfString :: !(Maybe (Map.Map String (Map.Map String Text))) -- ^ "map_map_of_string"
, mapTestMapOfEnumString :: !(Maybe (Map.Map String Text)) -- ^ "map_of_enum_string"
} deriving (P.Show,P.Eq,P.Typeable)
} deriving (P.Show, P.Eq, P.Typeable)
-- | FromJSON MapTest
instance A.FromJSON MapTest where
@@ -695,7 +675,7 @@ mkMapTest =
{ mapTestMapMapOfString = Nothing
, mapTestMapOfEnumString = Nothing
}
-- ** MixedPropertiesAndAdditionalPropertiesClass
-- | MixedPropertiesAndAdditionalPropertiesClass
@@ -703,8 +683,7 @@ data MixedPropertiesAndAdditionalPropertiesClass = MixedPropertiesAndAdditionalP
{ mixedPropertiesAndAdditionalPropertiesClassUuid :: !(Maybe Text) -- ^ "uuid"
, mixedPropertiesAndAdditionalPropertiesClassDateTime :: !(Maybe DateTime) -- ^ "dateTime"
, mixedPropertiesAndAdditionalPropertiesClassMap :: !(Maybe (Map.Map String Animal)) -- ^ "map"
} deriving (P.Show,P.Eq,P.Typeable)
} deriving (P.Show, P.Eq, P.Typeable)
-- | FromJSON MixedPropertiesAndAdditionalPropertiesClass
instance A.FromJSON MixedPropertiesAndAdditionalPropertiesClass where
@@ -733,7 +712,7 @@ mkMixedPropertiesAndAdditionalPropertiesClass =
, mixedPropertiesAndAdditionalPropertiesClassDateTime = Nothing
, mixedPropertiesAndAdditionalPropertiesClassMap = Nothing
}
-- ** Model200Response
-- | Model200Response
@@ -741,8 +720,7 @@ mkMixedPropertiesAndAdditionalPropertiesClass =
data Model200Response = Model200Response
{ model200ResponseName :: !(Maybe Int) -- ^ "name"
, model200ResponseClass :: !(Maybe Text) -- ^ "class"
} deriving (P.Show,P.Eq,P.Typeable)
} deriving (P.Show, P.Eq, P.Typeable)
-- | FromJSON Model200Response
instance A.FromJSON Model200Response where
@@ -768,14 +746,13 @@ mkModel200Response =
{ model200ResponseName = Nothing
, model200ResponseClass = Nothing
}
-- ** ModelList
-- | ModelList
data ModelList = ModelList
{ modelList123List :: !(Maybe Text) -- ^ "123-list"
} deriving (P.Show,P.Eq,P.Typeable)
} deriving (P.Show, P.Eq, P.Typeable)
-- | FromJSON ModelList
instance A.FromJSON ModelList where
@@ -798,15 +775,14 @@ mkModelList =
ModelList
{ modelList123List = Nothing
}
-- ** ModelReturn
-- | ModelReturn
-- Model for testing reserved words
data ModelReturn = ModelReturn
{ modelReturnReturn :: !(Maybe Int) -- ^ "return"
} deriving (P.Show,P.Eq,P.Typeable)
} deriving (P.Show, P.Eq, P.Typeable)
-- | FromJSON ModelReturn
instance A.FromJSON ModelReturn where
@@ -829,7 +805,7 @@ mkModelReturn =
ModelReturn
{ modelReturnReturn = Nothing
}
-- ** Name
-- | Name
@@ -839,8 +815,7 @@ data Name = Name
, nameSnakeCase :: !(Maybe Int) -- ^ "snake_case"
, nameProperty :: !(Maybe Text) -- ^ "property"
, name123Number :: !(Maybe Int) -- ^ "123Number"
} deriving (P.Show,P.Eq,P.Typeable)
} deriving (P.Show, P.Eq, P.Typeable)
-- | FromJSON Name
instance A.FromJSON Name where
@@ -873,14 +848,13 @@ mkName nameName =
, nameProperty = Nothing
, name123Number = Nothing
}
-- ** NumberOnly
-- | NumberOnly
data NumberOnly = NumberOnly
{ numberOnlyJustNumber :: !(Maybe Double) -- ^ "JustNumber"
} deriving (P.Show,P.Eq,P.Typeable)
} deriving (P.Show, P.Eq, P.Typeable)
-- | FromJSON NumberOnly
instance A.FromJSON NumberOnly where
@@ -903,7 +877,7 @@ mkNumberOnly =
NumberOnly
{ numberOnlyJustNumber = Nothing
}
-- ** Order
-- | Order
@@ -914,8 +888,7 @@ data Order = Order
, orderShipDate :: !(Maybe DateTime) -- ^ "shipDate"
, orderStatus :: !(Maybe Text) -- ^ "status" - Order Status
, orderComplete :: !(Maybe Bool) -- ^ "complete"
} deriving (P.Show,P.Eq,P.Typeable)
} deriving (P.Show, P.Eq, P.Typeable)
-- | FromJSON Order
instance A.FromJSON Order where
@@ -953,37 +926,15 @@ mkOrder =
, orderStatus = Nothing
, orderComplete = Nothing
}
-- ** OuterBoolean
-- | OuterBoolean
data OuterBoolean = OuterBoolean
{
} deriving (P.Show,P.Eq,P.Typeable)
newtype OuterBoolean = OuterBoolean
{ unOuterBoolean :: Bool
} deriving (P.Eq, P.Show, P.Typeable, A.ToJSON, A.FromJSON, WH.ToHttpApiData, WH.FromHttpApiData)
-- | FromJSON OuterBoolean
instance A.FromJSON OuterBoolean where
parseJSON = A.withObject "OuterBoolean" $ \o ->
pure OuterBoolean
-- | ToJSON OuterBoolean
instance A.ToJSON OuterBoolean where
toJSON OuterBoolean =
_omitNulls
[
]
-- | Construct a value of type 'OuterBoolean' (by applying it's required fields, if any)
mkOuterBoolean
:: OuterBoolean
mkOuterBoolean =
OuterBoolean
{
}
-- ** OuterComposite
-- | OuterComposite
@@ -991,8 +942,7 @@ data OuterComposite = OuterComposite
{ outerCompositeMyNumber :: !(Maybe OuterNumber) -- ^ "my_number"
, outerCompositeMyString :: !(Maybe OuterString) -- ^ "my_string"
, outerCompositeMyBoolean :: !(Maybe OuterBoolean) -- ^ "my_boolean"
} deriving (P.Show,P.Eq,P.Typeable)
} deriving (P.Show, P.Eq, P.Typeable)
-- | FromJSON OuterComposite
instance A.FromJSON OuterComposite where
@@ -1021,14 +971,13 @@ mkOuterComposite =
, outerCompositeMyString = Nothing
, outerCompositeMyBoolean = Nothing
}
-- ** OuterEnum
-- | OuterEnum
data OuterEnum = OuterEnum
{
} deriving (P.Show,P.Eq,P.Typeable)
} deriving (P.Show, P.Eq, P.Typeable)
-- | FromJSON OuterEnum
instance A.FromJSON OuterEnum where
@@ -1051,67 +1000,23 @@ mkOuterEnum =
OuterEnum
{
}
-- ** OuterNumber
-- | OuterNumber
data OuterNumber = OuterNumber
{
} deriving (P.Show,P.Eq,P.Typeable)
newtype OuterNumber = OuterNumber
{ unOuterNumber :: Double
} deriving (P.Eq, P.Show, P.Typeable, A.ToJSON, A.FromJSON, WH.ToHttpApiData, WH.FromHttpApiData)
-- | FromJSON OuterNumber
instance A.FromJSON OuterNumber where
parseJSON = A.withObject "OuterNumber" $ \o ->
pure OuterNumber
-- | ToJSON OuterNumber
instance A.ToJSON OuterNumber where
toJSON OuterNumber =
_omitNulls
[
]
-- | Construct a value of type 'OuterNumber' (by applying it's required fields, if any)
mkOuterNumber
:: OuterNumber
mkOuterNumber =
OuterNumber
{
}
-- ** OuterString
-- | OuterString
data OuterString = OuterString
{
} deriving (P.Show,P.Eq,P.Typeable)
newtype OuterString = OuterString
{ unOuterString :: Text
} deriving (P.Eq, P.Show, P.Typeable, A.ToJSON, A.FromJSON, WH.ToHttpApiData, WH.FromHttpApiData)
-- | FromJSON OuterString
instance A.FromJSON OuterString where
parseJSON = A.withObject "OuterString" $ \o ->
pure OuterString
-- | ToJSON OuterString
instance A.ToJSON OuterString where
toJSON OuterString =
_omitNulls
[
]
-- | Construct a value of type 'OuterString' (by applying it's required fields, if any)
mkOuterString
:: OuterString
mkOuterString =
OuterString
{
}
-- ** Pet
-- | Pet
@@ -1122,8 +1027,7 @@ data Pet = Pet
, petPhotoUrls :: !([Text]) -- ^ /Required/ "photoUrls"
, petTags :: !(Maybe [Tag]) -- ^ "tags"
, petStatus :: !(Maybe Text) -- ^ "status" - pet status in the store
} deriving (P.Show,P.Eq,P.Typeable)
} deriving (P.Show, P.Eq, P.Typeable)
-- | FromJSON Pet
instance A.FromJSON Pet where
@@ -1163,15 +1067,14 @@ mkPet petName petPhotoUrls =
, petTags = Nothing
, petStatus = Nothing
}
-- ** ReadOnlyFirst
-- | ReadOnlyFirst
data ReadOnlyFirst = ReadOnlyFirst
{ readOnlyFirstBar :: !(Maybe Text) -- ^ "bar"
, readOnlyFirstBaz :: !(Maybe Text) -- ^ "baz"
} deriving (P.Show,P.Eq,P.Typeable)
} deriving (P.Show, P.Eq, P.Typeable)
-- | FromJSON ReadOnlyFirst
instance A.FromJSON ReadOnlyFirst where
@@ -1197,14 +1100,13 @@ mkReadOnlyFirst =
{ readOnlyFirstBar = Nothing
, readOnlyFirstBaz = Nothing
}
-- ** SpecialModelName
-- | SpecialModelName
data SpecialModelName = SpecialModelName
{ specialModelNameSpecialPropertyName :: !(Maybe Integer) -- ^ "$special[property.name]"
} deriving (P.Show,P.Eq,P.Typeable)
} deriving (P.Show, P.Eq, P.Typeable)
-- | FromJSON SpecialModelName
instance A.FromJSON SpecialModelName where
@@ -1227,15 +1129,14 @@ mkSpecialModelName =
SpecialModelName
{ specialModelNameSpecialPropertyName = Nothing
}
-- ** Tag
-- | Tag
data Tag = Tag
{ tagId :: !(Maybe Integer) -- ^ "id"
, tagName :: !(Maybe Text) -- ^ "name"
} deriving (P.Show,P.Eq,P.Typeable)
} deriving (P.Show, P.Eq, P.Typeable)
-- | FromJSON Tag
instance A.FromJSON Tag where
@@ -1261,7 +1162,7 @@ mkTag =
{ tagId = Nothing
, tagName = Nothing
}
-- ** User
-- | User
@@ -1274,8 +1175,7 @@ data User = User
, userPassword :: !(Maybe Text) -- ^ "password"
, userPhone :: !(Maybe Text) -- ^ "phone"
, userUserStatus :: !(Maybe Int) -- ^ "userStatus" - User Status
} deriving (P.Show,P.Eq,P.Typeable)
} deriving (P.Show, P.Eq, P.Typeable)
-- | FromJSON User
instance A.FromJSON User where
@@ -1319,7 +1219,7 @@ mkUser =
, userPhone = Nothing
, userUserStatus = Nothing
}
-- ** Cat
-- | Cat
@@ -1327,8 +1227,7 @@ data Cat = Cat
{ catClassName :: !(Text) -- ^ /Required/ "className"
, catColor :: !(Maybe Text) -- ^ "color"
, catDeclawed :: !(Maybe Bool) -- ^ "declawed"
} deriving (P.Show,P.Eq,P.Typeable)
} deriving (P.Show, P.Eq, P.Typeable)
-- | FromJSON Cat
instance A.FromJSON Cat where
@@ -1358,7 +1257,7 @@ mkCat catClassName =
, catColor = Nothing
, catDeclawed = Nothing
}
-- ** Dog
-- | Dog
@@ -1366,8 +1265,7 @@ data Dog = Dog
{ dogClassName :: !(Text) -- ^ /Required/ "className"
, dogColor :: !(Maybe Text) -- ^ "color"
, dogBreed :: !(Maybe Text) -- ^ "breed"
} deriving (P.Show,P.Eq,P.Typeable)
} deriving (P.Show, P.Eq, P.Typeable)
-- | FromJSON Dog
instance A.FromJSON Dog where
@@ -1397,181 +1295,6 @@ mkDog dogClassName =
, dogColor = Nothing
, dogBreed = Nothing
}
-- * Parameter newtypes
newtype AdditionalMetadata = AdditionalMetadata { unAdditionalMetadata :: Text } deriving (P.Eq, P.Show)
newtype ApiKey = ApiKey { unApiKey :: Text } deriving (P.Eq, P.Show)
newtype Body = Body { unBody :: [User] } deriving (P.Eq, P.Show, A.ToJSON)
newtype Byte = Byte { unByte :: ByteArray } deriving (P.Eq, P.Show)
newtype Callback = Callback { unCallback :: Text } deriving (P.Eq, P.Show)
newtype EnumFormString = EnumFormString { unEnumFormString :: Text } deriving (P.Eq, P.Show)
newtype EnumFormStringArray = EnumFormStringArray { unEnumFormStringArray :: [Text] } deriving (P.Eq, P.Show)
newtype EnumHeaderString = EnumHeaderString { unEnumHeaderString :: Text } deriving (P.Eq, P.Show)
newtype EnumHeaderStringArray = EnumHeaderStringArray { unEnumHeaderStringArray :: [Text] } deriving (P.Eq, P.Show)
newtype EnumQueryDouble = EnumQueryDouble { unEnumQueryDouble :: Double } deriving (P.Eq, P.Show)
newtype EnumQueryInteger = EnumQueryInteger { unEnumQueryInteger :: Int } deriving (P.Eq, P.Show)
newtype EnumQueryString = EnumQueryString { unEnumQueryString :: Text } deriving (P.Eq, P.Show)
newtype EnumQueryStringArray = EnumQueryStringArray { unEnumQueryStringArray :: [Text] } deriving (P.Eq, P.Show)
newtype File = File { unFile :: FilePath } deriving (P.Eq, P.Show)
newtype Int32 = Int32 { unInt32 :: Int } deriving (P.Eq, P.Show)
newtype Int64 = Int64 { unInt64 :: Integer } deriving (P.Eq, P.Show)
newtype Name2 = Name2 { unName2 :: Text } deriving (P.Eq, P.Show)
newtype Number = Number { unNumber :: Double } deriving (P.Eq, P.Show)
newtype OrderId = OrderId { unOrderId :: Integer } deriving (P.Eq, P.Show)
newtype OrderIdText = OrderIdText { unOrderIdText :: Text } deriving (P.Eq, P.Show)
newtype Param = Param { unParam :: Text } deriving (P.Eq, P.Show)
newtype Param2 = Param2 { unParam2 :: Text } deriving (P.Eq, P.Show)
newtype ParamBinary = ParamBinary { unParamBinary :: Binary } deriving (P.Eq, P.Show)
newtype ParamDate = ParamDate { unParamDate :: Date } deriving (P.Eq, P.Show)
newtype ParamDateTime = ParamDateTime { unParamDateTime :: DateTime } deriving (P.Eq, P.Show)
newtype ParamDouble = ParamDouble { unParamDouble :: Double } deriving (P.Eq, P.Show)
newtype ParamFloat = ParamFloat { unParamFloat :: Float } deriving (P.Eq, P.Show)
newtype ParamInteger = ParamInteger { unParamInteger :: Int } deriving (P.Eq, P.Show)
newtype ParamString = ParamString { unParamString :: Text } deriving (P.Eq, P.Show)
newtype Password = Password { unPassword :: Text } deriving (P.Eq, P.Show)
newtype PatternWithoutDelimiter = PatternWithoutDelimiter { unPatternWithoutDelimiter :: Text } deriving (P.Eq, P.Show)
newtype PetId = PetId { unPetId :: Integer } deriving (P.Eq, P.Show)
newtype Status = Status { unStatus :: [Text] } deriving (P.Eq, P.Show)
newtype StatusText = StatusText { unStatusText :: Text } deriving (P.Eq, P.Show)
newtype Tags = Tags { unTags :: [Text] } deriving (P.Eq, P.Show)
newtype Username = Username { unUsername :: Text } deriving (P.Eq, P.Show)
-- * Utils
-- | Removes Null fields. (OpenAPI-Specification 2.0 does not allow Null in JSON)
_omitNulls :: [(Text, A.Value)] -> A.Value
_omitNulls = A.object . P.filter notNull
where
notNull (_, A.Null) = False
notNull _ = True
-- | Encodes fields using WH.toQueryParam
_toFormItem :: (WH.ToHttpApiData a, Functor f) => t -> f a -> f (t, [Text])
_toFormItem name x = (name,) . (:[]) . WH.toQueryParam <$> x
-- | Collapse (Just "") to Nothing
_emptyToNothing :: Maybe String -> Maybe String
_emptyToNothing (Just "") = Nothing
_emptyToNothing x = x
{-# INLINE _emptyToNothing #-}
-- | Collapse (Just mempty) to Nothing
_memptyToNothing :: (P.Monoid a, P.Eq a) => Maybe a -> Maybe a
_memptyToNothing (Just x) | x P.== P.mempty = Nothing
_memptyToNothing x = x
{-# INLINE _memptyToNothing #-}
-- * DateTime Formatting
newtype DateTime = DateTime { unDateTime :: TI.UTCTime }
deriving (P.Eq,P.Data,P.Ord,P.Typeable,NF.NFData,TI.ParseTime,TI.FormatTime)
instance A.FromJSON DateTime where
parseJSON = A.withText "DateTime" (_readDateTime . T.unpack)
instance A.ToJSON DateTime where
toJSON (DateTime t) = A.toJSON (_showDateTime t)
instance WH.FromHttpApiData DateTime where
parseUrlPiece = P.left T.pack . _readDateTime . T.unpack
instance WH.ToHttpApiData DateTime where
toUrlPiece (DateTime t) = T.pack (_showDateTime t)
instance P.Show DateTime where
show (DateTime t) = _showDateTime t
-- | @_parseISO8601@
_readDateTime :: (TI.ParseTime t, Monad m, Alternative m) => String -> m t
_readDateTime =
_parseISO8601
{-# INLINE _readDateTime #-}
-- | @TI.formatISO8601Millis@
_showDateTime :: (t ~ TI.UTCTime, TI.FormatTime t) => t -> String
_showDateTime =
TI.formatISO8601Millis
{-# INLINE _showDateTime #-}
-- | parse an ISO8601 date-time string
_parseISO8601 :: (TI.ParseTime t, Monad m, Alternative m) => String -> m t
_parseISO8601 t =
P.asum $
P.flip (TI.parseTimeM True TI.defaultTimeLocale) t <$>
["%FT%T%QZ", "%FT%T%Q%z", "%FT%T%Q%Z"]
{-# INLINE _parseISO8601 #-}
-- * Date Formatting
newtype Date = Date { unDate :: TI.Day }
deriving (P.Enum,P.Eq,P.Data,P.Ord,P.Ix,NF.NFData,TI.ParseTime,TI.FormatTime)
instance A.FromJSON Date where
parseJSON = A.withText "Date" (_readDate . T.unpack)
instance A.ToJSON Date where
toJSON (Date t) = A.toJSON (_showDate t)
instance WH.FromHttpApiData Date where
parseUrlPiece = P.left T.pack . _readDate . T.unpack
instance WH.ToHttpApiData Date where
toUrlPiece (Date t) = T.pack (_showDate t)
instance P.Show Date where
show (Date t) = _showDate t
-- | @TI.parseTimeM True TI.defaultTimeLocale "%Y-%m-%d"@
_readDate :: (TI.ParseTime t, Monad m) => String -> m t
_readDate =
TI.parseTimeM True TI.defaultTimeLocale "%Y-%m-%d"
{-# INLINE _readDate #-}
-- | @TI.formatTime TI.defaultTimeLocale "%Y-%m-%d"@
_showDate :: TI.FormatTime t => t -> String
_showDate =
TI.formatTime TI.defaultTimeLocale "%Y-%m-%d"
{-# INLINE _showDate #-}
-- * Byte/Binary Formatting
-- | base64 encoded characters
newtype ByteArray = ByteArray { unByteArray :: BL.ByteString }
deriving (P.Eq,P.Data,P.Ord,P.Typeable,NF.NFData)
instance A.FromJSON ByteArray where
parseJSON = A.withText "ByteArray" _readByteArray
instance A.ToJSON ByteArray where
toJSON = A.toJSON . _showByteArray
instance WH.FromHttpApiData ByteArray where
parseUrlPiece = P.left T.pack . _readByteArray
instance WH.ToHttpApiData ByteArray where
toUrlPiece = _showByteArray
instance P.Show ByteArray where
show = T.unpack . _showByteArray
-- | read base64 encoded characters
_readByteArray :: Monad m => Text -> m ByteArray
_readByteArray = P.either P.fail (pure . ByteArray) . BL64.decode . BL.fromStrict . T.encodeUtf8
{-# INLINE _readByteArray #-}
-- | show base64 encoded characters
_showByteArray :: ByteArray -> Text
_showByteArray = T.decodeUtf8 . BL.toStrict . BL64.encode . unByteArray
{-# INLINE _showByteArray #-}
-- | any sequence of octets
newtype Binary = Binary { unBinary :: BL.ByteString }
deriving (P.Eq,P.Data,P.Ord,P.Typeable,NF.NFData)
instance A.FromJSON Binary where
parseJSON = A.withText "Binary" _readBinaryBase64
instance A.ToJSON Binary where
toJSON = A.toJSON . _showBinaryBase64
instance WH.FromHttpApiData Binary where
parseUrlPiece = P.left T.pack . _readBinaryBase64
instance WH.ToHttpApiData Binary where
toUrlPiece = _showBinaryBase64
instance P.Show Binary where
show = T.unpack . _showBinaryBase64
_readBinaryBase64 :: Monad m => Text -> m Binary
_readBinaryBase64 = P.either P.fail (pure . Binary) . BL64.decode . BL.fromStrict . T.encodeUtf8
{-# INLINE _readBinaryBase64 #-}
_showBinaryBase64 :: Binary -> Text
_showBinaryBase64 = T.decodeUtf8 . BL.toStrict . BL64.encode . unBinary
{-# INLINE _showBinaryBase64 #-}

8
samples/client/petstore/haskell-http-client/lib/SwaggerPetstore/Lens.hs → samples/client/petstore/haskell-http-client/lib/SwaggerPetstore/ModelLens.hs
View File

@@ -19,7 +19,7 @@ Module : SwaggerPetstore.Lens
{-# LANGUAGE RecordWildCards #-}
{-# OPTIONS_GHC -fno-warn-name-shadowing -fno-warn-unused-matches -fno-warn-unused-binds -fno-warn-unused-imports #-}
module SwaggerPetstore.Lens where
module SwaggerPetstore.ModelLens where
import qualified Data.Aeson as A
import qualified Data.ByteString.Lazy as BL
@@ -34,11 +34,7 @@ import Prelude (($), (.),(<$>),(<*>),(=<<),Maybe(..),Bool(..),Char,Double,FilePa
import qualified Prelude as P
import SwaggerPetstore.Model
-- * Type Aliases
type Lens_' s a = Lens_ s s a a
type Lens_ s t a b = forall (f :: * -> *). Functor f => (a -> f b) -> s -> f t
import SwaggerPetstore.Core
-- * AdditionalPropertiesClass