Safe Haskell | None |
---|---|
Language | Haskell2010 |
- data SwaggerPetstoreConfig = SwaggerPetstoreConfig {}
- newConfig :: IO SwaggerPetstoreConfig
- addAuthMethod :: AuthMethod auth => SwaggerPetstoreConfig -> auth -> SwaggerPetstoreConfig
- withStdoutLogging :: SwaggerPetstoreConfig -> IO SwaggerPetstoreConfig
- withStderrLogging :: SwaggerPetstoreConfig -> IO SwaggerPetstoreConfig
- withNoLogging :: SwaggerPetstoreConfig -> SwaggerPetstoreConfig
- data SwaggerPetstoreRequest req contentType res = SwaggerPetstoreRequest {
- rMethod :: Method
- rUrlPath :: [ByteString]
- rParams :: Params
- rAuthTypes :: [TypeRep]
- rMethodL :: Lens_' (SwaggerPetstoreRequest req contentType res) Method
- rUrlPathL :: Lens_' (SwaggerPetstoreRequest req contentType res) [ByteString]
- rParamsL :: Lens_' (SwaggerPetstoreRequest req contentType res) Params
- rAuthTypesL :: Lens_' (SwaggerPetstoreRequest req contentType res) [TypeRep]
- class HasBodyParam req param where
- class HasOptionalParam req param where
- data Params = Params {}
- paramsQueryL :: Lens_' Params Query
- paramsHeadersL :: Lens_' Params RequestHeaders
- paramsBodyL :: Lens_' Params ParamBody
- data ParamBody
- _mkRequest :: Method -> [ByteString] -> SwaggerPetstoreRequest req contentType res
- _mkParams :: Params
- setHeader :: SwaggerPetstoreRequest req contentType res -> [Header] -> SwaggerPetstoreRequest req contentType res
- removeHeader :: SwaggerPetstoreRequest req contentType res -> [HeaderName] -> SwaggerPetstoreRequest req contentType res
- _setContentTypeHeader :: forall req contentType res. MimeType contentType => SwaggerPetstoreRequest req contentType res -> SwaggerPetstoreRequest req contentType res
- _setAcceptHeader :: forall req contentType res accept. MimeType accept => SwaggerPetstoreRequest req contentType res -> accept -> SwaggerPetstoreRequest req contentType res
- setQuery :: SwaggerPetstoreRequest req contentType res -> [QueryItem] -> SwaggerPetstoreRequest req contentType res
- addForm :: SwaggerPetstoreRequest req contentType res -> Form -> SwaggerPetstoreRequest req contentType res
- _addMultiFormPart :: SwaggerPetstoreRequest req contentType res -> Part -> SwaggerPetstoreRequest req contentType res
- _setBodyBS :: SwaggerPetstoreRequest req contentType res -> ByteString -> SwaggerPetstoreRequest req contentType res
- _setBodyLBS :: SwaggerPetstoreRequest req contentType res -> ByteString -> SwaggerPetstoreRequest req contentType res
- _hasAuthType :: AuthMethod authMethod => SwaggerPetstoreRequest req contentType res -> Proxy authMethod -> SwaggerPetstoreRequest req contentType res
- toPath :: ToHttpApiData a => a -> ByteString
- toHeader :: ToHttpApiData a => (HeaderName, a) -> [Header]
- toForm :: ToHttpApiData v => (ByteString, v) -> Form
- toQuery :: ToHttpApiData a => (ByteString, Maybe a) -> [QueryItem]
- data CollectionFormat
- toHeaderColl :: ToHttpApiData a => CollectionFormat -> (HeaderName, [a]) -> [Header]
- toFormColl :: ToHttpApiData v => CollectionFormat -> (ByteString, [v]) -> Form
- toQueryColl :: ToHttpApiData a => CollectionFormat -> (ByteString, Maybe [a]) -> Query
- _toColl :: Traversable f => CollectionFormat -> (f a -> [(b, ByteString)]) -> f [a] -> [(b, ByteString)]
- _toCollA :: (Traversable f, Traversable t, Alternative t) => CollectionFormat -> (f (t a) -> [(b, t ByteString)]) -> f (t [a]) -> [(b, t ByteString)]
- _toCollA' :: (Monoid c, Traversable f, Traversable t, Alternative t) => CollectionFormat -> (f (t a) -> [(b, t c)]) -> (Char -> c) -> f (t [a]) -> [(b, t c)]
- class Typeable a => AuthMethod a where
- data AnyAuthMethod = AuthMethod a => AnyAuthMethod a
- _applyAuthMethods :: SwaggerPetstoreRequest req contentType res -> SwaggerPetstoreConfig -> IO (SwaggerPetstoreRequest req contentType res)
- _omitNulls :: [(Text, Value)] -> Value
- _toFormItem :: (ToHttpApiData a, Functor f) => t -> f a -> f (t, [Text])
- _emptyToNothing :: Maybe String -> Maybe String
- _memptyToNothing :: (Monoid a, Eq a) => Maybe a -> Maybe a
- newtype DateTime = DateTime {}
- _readDateTime :: (ParseTime t, Monad m, Alternative m) => String -> m t
- _showDateTime :: (t ~ UTCTime, FormatTime t) => t -> String
- _parseISO8601 :: (ParseTime t, Monad m, Alternative m) => String -> m t
- newtype Date = Date {}
- _readDate :: (ParseTime t, Monad m) => String -> m t
- _showDate :: FormatTime t => t -> String
- newtype ByteArray = ByteArray {}
- _readByteArray :: Monad m => Text -> m ByteArray
- _showByteArray :: ByteArray -> Text
- newtype Binary = Binary {}
- _readBinaryBase64 :: Monad m => Text -> m Binary
- _showBinaryBase64 :: Binary -> Text
- 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
SwaggerPetstoreConfig
data SwaggerPetstoreConfig Source #
SwaggerPetstoreConfig | |
|
Show SwaggerPetstoreConfig Source # | display the config |
newConfig :: IO SwaggerPetstoreConfig Source #
constructs a default SwaggerPetstoreConfig
configHost:
http://petstore.swagger.io:80/v2
configUserAgent:
"swagger-haskell-http-client/1.0.0"
addAuthMethod :: AuthMethod auth => SwaggerPetstoreConfig -> auth -> SwaggerPetstoreConfig Source #
updates config use AuthMethod on matching requests
withStdoutLogging :: SwaggerPetstoreConfig -> IO SwaggerPetstoreConfig Source #
updates the config to use stdout logging
withStderrLogging :: SwaggerPetstoreConfig -> IO SwaggerPetstoreConfig Source #
updates the config to use stderr logging
withNoLogging :: SwaggerPetstoreConfig -> SwaggerPetstoreConfig Source #
updates the config to disable logging
SwaggerPetstoreRequest
data SwaggerPetstoreRequest req contentType res Source #
Represents a request. The "req" type variable is the request type. The "res" type variable is the response type.
SwaggerPetstoreRequest | |
|
Show (SwaggerPetstoreRequest req contentType res) Source # | |
rUrlPathL :: Lens_' (SwaggerPetstoreRequest req contentType res) [ByteString] Source #
rUrlPath
Lens
rAuthTypesL :: Lens_' (SwaggerPetstoreRequest req contentType res) [TypeRep] Source #
rParams
Lens
HasBodyParam
class HasBodyParam req param where Source #
Designates the body parameter of a request
setBodyParam :: forall contentType res. (Consumes req contentType, MimeRender contentType param) => SwaggerPetstoreRequest req contentType res -> param -> SwaggerPetstoreRequest req contentType res Source #
HasBodyParam UpdateUser User Source # | Body Param "body" - Updated user object |
HasBodyParam CreateUsersWithListInput Body Source # | Body Param "body" - List of user object |
HasBodyParam CreateUsersWithArrayInput Body Source # | Body Param "body" - List of user object |
HasBodyParam CreateUser User Source # | Body Param "body" - Created user object |
HasBodyParam PlaceOrder Order Source # | Body Param "body" - order placed for purchasing the pet |
HasBodyParam UpdatePet Pet Source # | Body Param "body" - Pet object that needs to be added to the store |
HasBodyParam AddPet Pet Source # | Body Param "body" - Pet object that needs to be added to the store |
HasBodyParam TestClassname Client Source # | Body Param "body" - client model |
HasBodyParam TestClientModel Client Source # | Body Param "body" - client model |
HasBodyParam FakeOuterStringSerialize OuterString Source # | Body Param "body" - Input string as post body |
HasBodyParam FakeOuterNumberSerialize OuterNumber Source # | Body Param "body" - Input number as post body |
HasBodyParam FakeOuterCompositeSerialize OuterComposite Source # | Body Param "body" - Input composite as post body |
HasBodyParam FakeOuterBooleanSerialize OuterBoolean Source # | Body Param "body" - Input boolean as post body |
HasBodyParam TestSpecialTags Client Source # | Body Param "body" - client model |
HasOptionalParam
class HasOptionalParam req param where Source #
Designates the optional parameters of a request
applyOptionalParam :: SwaggerPetstoreRequest req contentType res -> param -> SwaggerPetstoreRequest req contentType res Source #
Apply an optional parameter to a request
(-&-) :: SwaggerPetstoreRequest req contentType res -> param -> SwaggerPetstoreRequest req contentType res infixl 2 Source #
infix operator / alias for addOptionalParam
HasOptionalParam UploadFile File Source # | Optional Param "file" - file to upload |
HasOptionalParam UploadFile AdditionalMetadata Source # | Optional Param "additionalMetadata" - Additional data to pass to server |
HasOptionalParam UpdatePetWithForm StatusText Source # | Optional Param "status" - Updated status of the pet |
HasOptionalParam UpdatePetWithForm Name2 Source # | Optional Param "name" - Updated name of the pet |
HasOptionalParam DeletePet ApiKey Source # | |
HasOptionalParam TestEnumParameters EnumQueryStringArray Source # | Optional Param "enum_query_string_array" - Query parameter enum test (string array) |
HasOptionalParam TestEnumParameters EnumQueryString Source # | Optional Param "enum_query_string" - Query parameter enum test (string) |
HasOptionalParam TestEnumParameters EnumQueryInteger Source # | Optional Param "enum_query_integer" - Query parameter enum test (double) |
HasOptionalParam TestEnumParameters EnumQueryDouble Source # | Optional Param "enum_query_double" - Query parameter enum test (double) |
HasOptionalParam TestEnumParameters EnumHeaderStringArray Source # | Optional Param "enum_header_string_array" - Header parameter enum test (string array) |
HasOptionalParam TestEnumParameters EnumHeaderString Source # | Optional Param "enum_header_string" - Header parameter enum test (string) |
HasOptionalParam TestEnumParameters EnumFormStringArray Source # | Optional Param "enum_form_string_array" - Form parameter enum test (string array) |
HasOptionalParam TestEnumParameters EnumFormString Source # | Optional Param "enum_form_string" - Form parameter enum test (string) |
HasOptionalParam TestEndpointParameters Password Source # | Optional Param "password" - None |
HasOptionalParam TestEndpointParameters ParamString Source # | Optional Param "string" - None |
HasOptionalParam TestEndpointParameters ParamInteger Source # | Optional Param "integer" - None |
HasOptionalParam TestEndpointParameters ParamFloat Source # | Optional Param "float" - None |
HasOptionalParam TestEndpointParameters ParamDateTime Source # | Optional Param "dateTime" - None |
HasOptionalParam TestEndpointParameters ParamDate Source # | Optional Param "date" - None |
HasOptionalParam TestEndpointParameters ParamBinary Source # | Optional Param "binary" - None |
HasOptionalParam TestEndpointParameters Int64 Source # | Optional Param "int64" - None |
HasOptionalParam TestEndpointParameters Int32 Source # | Optional Param "int32" - None |
HasOptionalParam TestEndpointParameters Callback Source # | Optional Param "callback" - None |
Request Params
paramsQueryL :: Lens_' Params Query Source #
paramsQuery
Lens
paramsBodyL :: Lens_' Params ParamBody Source #
paramsBody
Lens
Request Body
SwaggerPetstoreRequest Utils
:: Method | Method |
-> [ByteString] | Endpoint |
-> SwaggerPetstoreRequest req contentType res | req: Request Type, res: Response Type |
setHeader :: SwaggerPetstoreRequest req contentType res -> [Header] -> SwaggerPetstoreRequest req contentType res Source #
removeHeader :: SwaggerPetstoreRequest req contentType res -> [HeaderName] -> SwaggerPetstoreRequest req contentType res Source #
_setContentTypeHeader :: forall req contentType res. MimeType contentType => SwaggerPetstoreRequest req contentType res -> SwaggerPetstoreRequest req contentType res Source #
_setAcceptHeader :: forall req contentType res accept. MimeType accept => SwaggerPetstoreRequest req contentType res -> accept -> SwaggerPetstoreRequest req contentType res Source #
setQuery :: SwaggerPetstoreRequest req contentType res -> [QueryItem] -> SwaggerPetstoreRequest req contentType res Source #
addForm :: SwaggerPetstoreRequest req contentType res -> Form -> SwaggerPetstoreRequest req contentType res Source #
_addMultiFormPart :: SwaggerPetstoreRequest req contentType res -> Part -> SwaggerPetstoreRequest req contentType res Source #
_setBodyBS :: SwaggerPetstoreRequest req contentType res -> ByteString -> SwaggerPetstoreRequest req contentType res Source #
_setBodyLBS :: SwaggerPetstoreRequest req contentType res -> ByteString -> SwaggerPetstoreRequest req contentType res Source #
_hasAuthType :: AuthMethod authMethod => SwaggerPetstoreRequest req contentType res -> Proxy authMethod -> SwaggerPetstoreRequest req contentType res Source #
Params Utils
toPath :: ToHttpApiData a => a -> ByteString Source #
toHeader :: ToHttpApiData a => (HeaderName, a) -> [Header] Source #
toForm :: ToHttpApiData v => (ByteString, v) -> Form Source #
toQuery :: ToHttpApiData a => (ByteString, Maybe a) -> [QueryItem] Source #
Swagger CollectionFormat
Utils
data CollectionFormat Source #
Determines the format of the array if type array is used.
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" ( |
toHeaderColl :: ToHttpApiData a => CollectionFormat -> (HeaderName, [a]) -> [Header] Source #
toFormColl :: ToHttpApiData v => CollectionFormat -> (ByteString, [v]) -> Form Source #
toQueryColl :: ToHttpApiData a => CollectionFormat -> (ByteString, Maybe [a]) -> Query Source #
_toColl :: Traversable f => CollectionFormat -> (f a -> [(b, ByteString)]) -> f [a] -> [(b, ByteString)] Source #
_toCollA :: (Traversable f, Traversable t, Alternative t) => CollectionFormat -> (f (t a) -> [(b, t ByteString)]) -> f (t [a]) -> [(b, t ByteString)] Source #
_toCollA' :: (Monoid c, Traversable f, Traversable t, Alternative t) => CollectionFormat -> (f (t a) -> [(b, t c)]) -> (Char -> c) -> f (t [a]) -> [(b, t c)] Source #
AuthMethods
class Typeable a => AuthMethod a where Source #
Provides a method to apply auth methods to requests
applyAuthMethod :: SwaggerPetstoreConfig -> a -> SwaggerPetstoreRequest req contentType res -> IO (SwaggerPetstoreRequest req contentType res) Source #
_applyAuthMethods :: SwaggerPetstoreRequest req contentType res -> SwaggerPetstoreConfig -> IO (SwaggerPetstoreRequest req contentType res) Source #
apply all matching AuthMethods in config to request
Utils
_omitNulls :: [(Text, Value)] -> Value Source #
Removes Null fields. (OpenAPI-Specification 2.0 does not allow Null in JSON)
_toFormItem :: (ToHttpApiData a, Functor f) => t -> f a -> f (t, [Text]) Source #
Encodes fields using WH.toQueryParam
_memptyToNothing :: (Monoid a, Eq a) => Maybe a -> Maybe a Source #
Collapse (Just mempty) to Nothing
DateTime Formatting
_readDateTime :: (ParseTime t, Monad m, Alternative m) => String -> m t Source #
_parseISO8601
_showDateTime :: (t ~ UTCTime, FormatTime t) => t -> String Source #
TI.formatISO8601Millis
_parseISO8601 :: (ParseTime t, Monad m, Alternative m) => String -> m t Source #
parse an ISO8601 date-time string
Date Formatting
_readDate :: (ParseTime t, Monad m) => String -> m t Source #
TI.parseTimeM True TI.defaultTimeLocale "%Y-%m-%d"
_showDate :: FormatTime t => t -> String Source #
TI.formatTime TI.defaultTimeLocale "%Y-%m-%d"
Byte/Binary Formatting
base64 encoded characters
_showByteArray :: ByteArray -> Text Source #
show base64 encoded characters
any sequence of octets
_showBinaryBase64 :: Binary -> Text Source #