packages feed

swagger-petstore (empty) → 0.0.1.0

raw patch · 15 files changed

+3306/−0 lines, 15 filesdep +QuickCheckdep +aesondep +basesetup-changed

Dependencies added: QuickCheck, aeson, base, bytestring, case-insensitive, containers, exceptions, hspec, http-api-data, http-client, http-client-tls, http-media, http-types, iso8601-time, monad-logger, mtl, network, random, safe-exceptions, semigroups, swagger-petstore, text, time, transformers, unordered-containers, vector

Files

+ LICENSE view
@@ -0,0 +1,21 @@+The MIT License (MIT)++Copyright (c) 2015 Jon Schoning++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in+all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN+THE SOFTWARE.
+ README.md view
@@ -0,0 +1,163 @@+## Swagger Auto-Generated [http-client](https://www.stackage.org/lts-9.0/package/http-client-0.5.7.0) Bindings to `SwaggerPetstore` ++The library in `lib` provides auto-generated-from-Swagger [http-client](https://www.stackage.org/lts-9.0/package/http-client-0.5.7.0) bindings to the SwaggerPetstore API.++Targeted swagger version: 2.0++OpenAPI-Specification: https://github.com/OAI/OpenAPI-Specification/blob/master/versions/2.0.md++## Installation++Installation follows the standard approach to installing Stack-based projects.++1. Install the [Haskell `stack` tool](http://docs.haskellstack.org/en/stable/README).+2. To build the package, and generate the documentation (recommended):+```+stack haddock+```+which will generate docs for this lib in the `docs` folder.++To generate the docs in the normal location (to enable hyperlinks to external libs), remove +```+build:+  haddock-arguments:+    haddock-args:+    - "--odir=./docs"+```+from the stack.yaml file and run `stack haddock` again.++3. To run unit tests:+```+stack test+```++## Swagger-Codegen++The code generator that produced this library, and which explains how+to obtain and use the swagger-codegen cli tool lives at++https://github.com/swagger-api/swagger-codegen++The _language_ argument (`--lang`) passed to the cli tool used should be ++```+haskell-http-client+```++### Unsupported Swagger Features++* Auth Methods (https://swagger.io/docs/specification/2-0/authentication/)+    +    - use `setHeader` to add any required headers to requests++* Default Parameter Values++* Enum Parameters++This is beta software; other cases may not be supported.++### Codegen "config option" parameters++These options allow some customization of the code generation process.++**haskell-http-client specific options:**++| OPTION                          | DESCRIPTION                                                                                                                   | DEFAULT  | ACTUAL                              |+| ------------------------------- | ----------------------------------------------------------------------------------------------------------------------------- | -------- | ----------------------------------- |+| allowFromJsonNulls              | allow JSON Null during model decoding from JSON                                                                               | true     | true              |+| allowToJsonNulls                | allow emitting JSON Null during model encoding to JSON                                                                        | false    | false                |+| dateFormat                      | format string used to parse/render a date                                                                                     | %Y-%m-%d |                       |+| dateTimeFormat                  | format string used to parse/render a datetime. (Defaults to [formatISO8601Millis][1] when not provided)                       |          |                   |+| generateFormUrlEncodedInstances | Generate FromForm/ToForm instances for models used by x-www-form-urlencoded operations (model fields must be primitive types) | true     | true |+| generateLenses                  | Generate Lens optics for Models                                                                                               | true     | true                  |+| generateModelConstructors       | Generate smart constructors (only supply required fields) for models                                                          | true     | true       |+| modelDeriving                   | Additional classes to include in the deriving() clause of Models                                                              |          |                    |++[1]: https://www.stackage.org/haddock/lts-9.0/iso8601-time-0.1.4/Data-Time-ISO8601.html#v:formatISO8601Millis++View the full list of Codegen "config option" parameters with the command:++```+java -jar modules/swagger-codegen-cli/target/swagger-codegen-cli.jar config-help -l haskell-http-client+```++### Example SwaggerPetstore Haddock documentation ++An example of the generated haddock documentation targeting the server http://petstore.swagger.io/ (SwaggerPetstore) can be found [here][2]++[2]: https://jonschoning.github.io/swaggerpetstore-haskell-http-client/++### Example SwaggerPetstore App++An example application using the auto-generated haskell-http-client bindings for the server http://petstore.swagger.io/ can be found [here][3]++[3]: https://github.com/jonschoning/swagger-codegen/tree/haskell-http-client/samples/client/petstore/haskell-http-client/example-app++### Usage Notes++This library is intended to be imported qualified.++| MODULE              | NOTES                                               |+| ------------------- | --------------------------------------------------- |+| SwaggerPetstore.Client    | use the "dispatch" functions to send requests       |+| SwaggerPetstore.API       | construct requetss                                  |+| SwaggerPetstore.Model     | describes models                                    |+| SwaggerPetstore.MimeTypes | encoding/decoding MIME types (content-types/accept) |+| SwaggerPetstore.Lens      | lenses & traversals for model fields                |++This library adds type safety around what swagger specifies as+Produces and Consumes for each Operation (e.g. the list of MIME types an+Operation can Produce (using 'accept' headers) and Consume (using 'content-type' headers).++For example, if there is an Operation named _addFoo_, there will be a+data type generated named _AddFoo_ (note the capitalization) which+describes additional constraints and actions on the _addFoo_+operation, which can be viewed in GHCi or via the Haddocks.++* requried parameters are included as function arguments to _addFoo_+* optional non-body parameters are included by using  `applyOptionalParam`+* optional body parameters are set by using  `setBodyParam`++Example for pretend _addFoo_ operation: ++```haskell+data AddFoo 	+instance Consumes AddFoo MimeJSON+instance Produces AddFoo MimeJSON+instance Produces AddFoo MimeXML+instance HasBodyParam AddFoo FooModel+instance HasOptionalParam AddFoo FooName+instance HasOptionalParam AddFoo FooId+```++this would indicate that:++* the _addFoo_ operation can consume JSON+* the _addFoo_ operation produces JSON or XML, depending on the argument passed to the dispatch function+* the _addFoo_ operation can set it's body param of _FooModel_ via `setBodyParam`+* the _addFoo_ operation can set 2 different optional parameters via `applyOptionalParam`++putting this together:++```haskell+let addFooRequest = addFoo MimeJSON foomodel requiredparam1 requiredparam2+  `applyOptionalParam` FooId 1+  `applyOptionalParam` FooName "name"+  `setHeader` [("api_key","xxyy")]+addFooResult <- dispatchMime mgr config addFooRequest MimeXML+```++If the swagger spec doesn't declare it can accept or produce a certain+MIME type for a given Operation, you should either add a Produces or+Consumes instance for the desired MIME types (assuming the server+supports it), use `dispatchLbsUnsafe` or modify the swagger spec and+run the generator again.++New MIME type instances can be added via MimeType/MimeRender/MimeUnrender++Only JSON instances are generated by default, and in some case+x-www-form-urlencoded instances (FromFrom, ToForm) will also be+generated if the model fields are primitive types, and there are+Operations using x-www-form-urlencoded which use those models.++See the example app and the haddocks for details.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ lib/SwaggerPetstore.hs view
@@ -0,0 +1,17 @@+{-|+Module : SwaggerPetstore+-}++module SwaggerPetstore+  ( module SwaggerPetstore.Client+  , module SwaggerPetstore.API+  , module SwaggerPetstore.Model+  , module SwaggerPetstore.MimeTypes+  , module SwaggerPetstore.Lens+  ) where++import SwaggerPetstore.API+import SwaggerPetstore.Client+import SwaggerPetstore.Model+import SwaggerPetstore.MimeTypes+import SwaggerPetstore.Lens
+ lib/SwaggerPetstore/API.hs view
@@ -0,0 +1,830 @@+{-|+Module : SwaggerPetstore.API+-}++{-# LANGUAGE RecordWildCards #-}++{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE InstanceSigs #-}+{-# OPTIONS_GHC -fno-warn-unused-binds -fno-warn-unused-imports #-}++module SwaggerPetstore.API where+++import SwaggerPetstore.Model as M+import SwaggerPetstore.MimeTypes++import qualified Data.Aeson as A+import Data.Aeson (Value)++import qualified Data.Time as TI+import Data.Time (UTCTime)++import qualified Data.ByteString as B+import qualified Data.ByteString.Lazy as BL+import Data.ByteString.Lazy (ByteString)+import qualified Data.ByteString.Builder as BB+import qualified Data.ByteString.Char8 as BC+import qualified Data.ByteString.Lazy.Char8 as BCL++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.Data as P (Typeable)+import qualified Data.Foldable as P+import qualified Data.Map as Map+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.Text.Lazy as TL+import qualified Data.Text.Lazy.Encoding as TL+import qualified GHC.Base as P (Alternative)+import qualified Control.Arrow as P (left)++import Data.Monoid ((<>))+import Data.Function ((&))+import Data.Set (Set)+import Data.Text (Text)+import GHC.Base ((<|>))++import Prelude ((==),(/=),($), (.),(<$>),(<*>),(>>=),Maybe(..),Bool(..),Char,Double,FilePath,Float,Int,Integer,String,fmap,undefined,mempty,maybe,pure,Monad,Applicative,Functor)+import qualified Prelude as P++-- * Operations+++-- ** Pet++-- *** addPet++-- | @POST \/pet@+-- +-- Add a new pet to the store+-- +-- +-- +-- AuthMethod: petstore_auth+-- +-- Note: Has 'Produces' instances, but no response schema+-- +addPet +  :: (Consumes AddPet contentType, MimeRender contentType Pet)+  => contentType -- ^ request content-type ('MimeType')+  -> Pet -- ^ "body" -  Pet object that needs to be added to the store+  -> SwaggerPetstoreRequest AddPet contentType res+addPet _ body =+  _mkRequest "POST" ["/pet"]+    `setBodyParam` body++data AddPet ++-- | /Body Param/ "body" - Pet object that needs to be added to the store+instance HasBodyParam AddPet Pet ++-- | @application/json@+instance Consumes AddPet MimeJSON+-- | @application/xml@+instance Consumes AddPet MimeXML++-- | @application/xml@+instance Produces AddPet MimeXML+-- | @application/json@+instance Produces AddPet MimeJSON+++-- *** deletePet++-- | @DELETE \/pet\/{petId}@+-- +-- Deletes a pet+-- +-- +-- +-- AuthMethod: petstore_auth+-- +-- Note: Has 'Produces' instances, but no response schema+-- +deletePet +  :: Integer -- ^ "petId" -  Pet id to delete+  -> SwaggerPetstoreRequest DeletePet MimeNoContent res+deletePet petId =+  _mkRequest "DELETE" ["/pet/",toPath petId]+    ++data DeletePet  +instance HasOptionalParam DeletePet ApiUnderscorekey where+  applyOptionalParam req (ApiUnderscorekey xs) =+    req `setHeader` toHeader ("api_key", xs)+-- | @application/xml@+instance Produces DeletePet MimeXML+-- | @application/json@+instance Produces DeletePet MimeJSON+++-- *** findPetsByStatus++-- | @GET \/pet\/findByStatus@+-- +-- Finds Pets by status+-- +-- Multiple status values can be provided with comma separated strings+-- +-- AuthMethod: petstore_auth+-- +findPetsByStatus +  :: [Text] -- ^ "status" -  Status values that need to be considered for filter+  -> SwaggerPetstoreRequest FindPetsByStatus MimeNoContent [Pet]+findPetsByStatus status =+  _mkRequest "GET" ["/pet/findByStatus"]+    `_setQuery` toQueryColl CommaSeparated ("status", Just status)++data FindPetsByStatus  +-- | @application/xml@+instance Produces FindPetsByStatus MimeXML+-- | @application/json@+instance Produces FindPetsByStatus MimeJSON+++-- *** findPetsByTags++-- | @GET \/pet\/findByTags@+-- +-- Finds Pets by tags+-- +-- Multiple tags can be provided with comma separated strings. Use tag1, tag2, tag3 for testing.+-- +-- AuthMethod: petstore_auth+-- +findPetsByTags +  :: [Text] -- ^ "tags" -  Tags to filter by+  -> SwaggerPetstoreRequest FindPetsByTags MimeNoContent [Pet]+findPetsByTags tags =+  _mkRequest "GET" ["/pet/findByTags"]+    `_setQuery` toQueryColl CommaSeparated ("tags", Just tags)++{-# DEPRECATED findPetsByTags "" #-}++data FindPetsByTags  +-- | @application/xml@+instance Produces FindPetsByTags MimeXML+-- | @application/json@+instance Produces FindPetsByTags MimeJSON+++-- *** getPetById++-- | @GET \/pet\/{petId}@+-- +-- Find pet by ID+-- +-- Returns a single pet+-- +-- AuthMethod: api_key+-- +getPetById +  :: Integer -- ^ "petId" -  ID of pet to return+  -> SwaggerPetstoreRequest GetPetById MimeNoContent Pet+getPetById petId =+  _mkRequest "GET" ["/pet/",toPath petId]+    ++data GetPetById  +-- | @application/xml@+instance Produces GetPetById MimeXML+-- | @application/json@+instance Produces GetPetById MimeJSON+++-- *** updatePet++-- | @PUT \/pet@+-- +-- Update an existing pet+-- +-- +-- +-- AuthMethod: petstore_auth+-- +-- Note: Has 'Produces' instances, but no response schema+-- +updatePet +  :: (Consumes UpdatePet contentType, MimeRender contentType Pet)+  => contentType -- ^ request content-type ('MimeType')+  -> Pet -- ^ "body" -  Pet object that needs to be added to the store+  -> SwaggerPetstoreRequest UpdatePet contentType res+updatePet _ body =+  _mkRequest "PUT" ["/pet"]+    `setBodyParam` body++data UpdatePet ++-- | /Body Param/ "body" - Pet object that needs to be added to the store+instance HasBodyParam UpdatePet Pet ++-- | @application/json@+instance Consumes UpdatePet MimeJSON+-- | @application/xml@+instance Consumes UpdatePet MimeXML++-- | @application/xml@+instance Produces UpdatePet MimeXML+-- | @application/json@+instance Produces UpdatePet MimeJSON+++-- *** updatePetWithForm++-- | @POST \/pet\/{petId}@+-- +-- Updates a pet in the store with form data+-- +-- +-- +-- AuthMethod: petstore_auth+-- +-- Note: Has 'Produces' instances, but no response schema+-- +updatePetWithForm +  :: (Consumes UpdatePetWithForm contentType)+  => contentType -- ^ request content-type ('MimeType')+  -> Integer -- ^ "petId" -  ID of pet that needs to be updated+  -> SwaggerPetstoreRequest UpdatePetWithForm contentType res+updatePetWithForm _ petId =+  _mkRequest "POST" ["/pet/",toPath petId]+    ++data UpdatePetWithForm  ++-- | /Optional Param/ "name" - Updated name of the pet+instance HasOptionalParam UpdatePetWithForm Name where+  applyOptionalParam req (Name xs) =+    req `_addForm` toForm ("name", xs)++-- | /Optional Param/ "status" - Updated status of the pet+instance HasOptionalParam UpdatePetWithForm Status where+  applyOptionalParam req (Status xs) =+    req `_addForm` toForm ("status", xs)++-- | @application/x-www-form-urlencoded@+instance Consumes UpdatePetWithForm MimeFormUrlEncoded++-- | @application/xml@+instance Produces UpdatePetWithForm MimeXML+-- | @application/json@+instance Produces UpdatePetWithForm MimeJSON+++-- *** uploadFile++-- | @POST \/pet\/{petId}\/uploadImage@+-- +-- uploads an image+-- +-- +-- +-- AuthMethod: petstore_auth+-- +uploadFile +  :: (Consumes UploadFile contentType)+  => contentType -- ^ request content-type ('MimeType')+  -> Integer -- ^ "petId" -  ID of pet to update+  -> SwaggerPetstoreRequest UploadFile contentType ApiResponse+uploadFile _ petId =+  _mkRequest "POST" ["/pet/",toPath petId,"/uploadImage"]+    ++data UploadFile  ++-- | /Optional Param/ "additionalMetadata" - Additional data to pass to server+instance HasOptionalParam UploadFile AdditionalMetadata where+  applyOptionalParam req (AdditionalMetadata xs) =+    req `_addMultiFormPart` NH.partLBS "additionalMetadata" (mimeRender' MimeMultipartFormData xs)++-- | /Optional Param/ "file" - file to upload+instance HasOptionalParam UploadFile File where+  applyOptionalParam req (File xs) =+    req `_addMultiFormPart` NH.partFileSource "file" xs++-- | @multipart/form-data@+instance Consumes UploadFile MimeMultipartFormData++-- | @application/json@+instance Produces UploadFile MimeJSON+++-- ** Store++-- *** deleteOrder++-- | @DELETE \/store\/order\/{orderId}@+-- +-- Delete purchase order by ID+-- +-- For valid response try integer IDs with value < 1000. Anything above 1000 or nonintegers will generate API errors+-- +-- Note: Has 'Produces' instances, but no response schema+-- +deleteOrder +  :: Text -- ^ "orderId" -  ID of the order that needs to be deleted+  -> SwaggerPetstoreRequest DeleteOrder MimeNoContent res+deleteOrder orderId =+  _mkRequest "DELETE" ["/store/order/",toPath orderId]+    ++data DeleteOrder  +-- | @application/xml@+instance Produces DeleteOrder MimeXML+-- | @application/json@+instance Produces DeleteOrder MimeJSON+++-- *** getInventory++-- | @GET \/store\/inventory@+-- +-- Returns pet inventories by status+-- +-- Returns a map of status codes to quantities+-- +-- AuthMethod: api_key+-- +getInventory +  :: SwaggerPetstoreRequest GetInventory MimeNoContent (Map.Map String Int)+getInventory =+  _mkRequest "GET" ["/store/inventory"]++data GetInventory  +-- | @application/json@+instance Produces GetInventory MimeJSON+++-- *** getOrderById++-- | @GET \/store\/order\/{orderId}@+-- +-- Find purchase order by ID+-- +-- For valid response try integer IDs with value <= 5 or > 10. Other values will generated exceptions+-- +getOrderById +  :: Integer -- ^ "orderId" -  ID of pet that needs to be fetched+  -> SwaggerPetstoreRequest GetOrderById MimeNoContent Order+getOrderById orderId =+  _mkRequest "GET" ["/store/order/",toPath orderId]+    ++data GetOrderById  +-- | @application/xml@+instance Produces GetOrderById MimeXML+-- | @application/json@+instance Produces GetOrderById MimeJSON+++-- *** placeOrder++-- | @POST \/store\/order@+-- +-- Place an order for a pet+-- +-- +-- +placeOrder +  :: (Consumes PlaceOrder contentType, MimeRender contentType Order)+  => contentType -- ^ request content-type ('MimeType')+  -> Order -- ^ "body" -  order placed for purchasing the pet+  -> SwaggerPetstoreRequest PlaceOrder contentType Order+placeOrder _ body =+  _mkRequest "POST" ["/store/order"]+    `setBodyParam` body++data PlaceOrder ++-- | /Body Param/ "body" - order placed for purchasing the pet+instance HasBodyParam PlaceOrder Order +-- | @application/xml@+instance Produces PlaceOrder MimeXML+-- | @application/json@+instance Produces PlaceOrder MimeJSON+++-- ** User++-- *** createUser++-- | @POST \/user@+-- +-- Create user+-- +-- This can only be done by the logged in user.+-- +-- Note: Has 'Produces' instances, but no response schema+-- +createUser +  :: (Consumes CreateUser contentType, MimeRender contentType User)+  => contentType -- ^ request content-type ('MimeType')+  -> User -- ^ "body" -  Created user object+  -> SwaggerPetstoreRequest CreateUser contentType res+createUser _ body =+  _mkRequest "POST" ["/user"]+    `setBodyParam` body++data CreateUser ++-- | /Body Param/ "body" - Created user object+instance HasBodyParam CreateUser User +-- | @application/xml@+instance Produces CreateUser MimeXML+-- | @application/json@+instance Produces CreateUser MimeJSON+++-- *** createUsersWithArrayInput++-- | @POST \/user\/createWithArray@+-- +-- Creates list of users with given input array+-- +-- +-- +-- Note: Has 'Produces' instances, but no response schema+-- +createUsersWithArrayInput +  :: (Consumes CreateUsersWithArrayInput contentType, MimeRender contentType [User])+  => contentType -- ^ request content-type ('MimeType')+  -> [User] -- ^ "body" -  List of user object+  -> SwaggerPetstoreRequest CreateUsersWithArrayInput contentType res+createUsersWithArrayInput _ body =+  _mkRequest "POST" ["/user/createWithArray"]+    `setBodyParam` body++data CreateUsersWithArrayInput ++-- | /Body Param/ "body" - List of user object+instance HasBodyParam CreateUsersWithArrayInput [User] +-- | @application/xml@+instance Produces CreateUsersWithArrayInput MimeXML+-- | @application/json@+instance Produces CreateUsersWithArrayInput MimeJSON+++-- *** createUsersWithListInput++-- | @POST \/user\/createWithList@+-- +-- Creates list of users with given input array+-- +-- +-- +-- Note: Has 'Produces' instances, but no response schema+-- +createUsersWithListInput +  :: (Consumes CreateUsersWithListInput contentType, MimeRender contentType [User])+  => contentType -- ^ request content-type ('MimeType')+  -> [User] -- ^ "body" -  List of user object+  -> SwaggerPetstoreRequest CreateUsersWithListInput contentType res+createUsersWithListInput _ body =+  _mkRequest "POST" ["/user/createWithList"]+    `setBodyParam` body++data CreateUsersWithListInput ++-- | /Body Param/ "body" - List of user object+instance HasBodyParam CreateUsersWithListInput [User] +-- | @application/xml@+instance Produces CreateUsersWithListInput MimeXML+-- | @application/json@+instance Produces CreateUsersWithListInput MimeJSON+++-- *** deleteUser++-- | @DELETE \/user\/{username}@+-- +-- Delete user+-- +-- This can only be done by the logged in user.+-- +-- Note: Has 'Produces' instances, but no response schema+-- +deleteUser +  :: Text -- ^ "username" -  The name that needs to be deleted+  -> SwaggerPetstoreRequest DeleteUser MimeNoContent res+deleteUser username =+  _mkRequest "DELETE" ["/user/",toPath username]+    ++data DeleteUser  +-- | @application/xml@+instance Produces DeleteUser MimeXML+-- | @application/json@+instance Produces DeleteUser MimeJSON+++-- *** getUserByName++-- | @GET \/user\/{username}@+-- +-- Get user by user name+-- +-- +-- +getUserByName +  :: Text -- ^ "username" -  The name that needs to be fetched. Use user1 for testing. +  -> SwaggerPetstoreRequest GetUserByName MimeNoContent User+getUserByName username =+  _mkRequest "GET" ["/user/",toPath username]+    ++data GetUserByName  +-- | @application/xml@+instance Produces GetUserByName MimeXML+-- | @application/json@+instance Produces GetUserByName MimeJSON+++-- *** loginUser++-- | @GET \/user\/login@+-- +-- Logs user into the system+-- +-- +-- +loginUser +  :: Text -- ^ "username" -  The user name for login+  -> Text -- ^ "password" -  The password for login in clear text+  -> SwaggerPetstoreRequest LoginUser MimeNoContent Text+loginUser username password =+  _mkRequest "GET" ["/user/login"]+    `_setQuery` toQuery ("username", Just username)+    `_setQuery` toQuery ("password", Just password)++data LoginUser  +-- | @application/xml@+instance Produces LoginUser MimeXML+-- | @application/json@+instance Produces LoginUser MimeJSON+++-- *** logoutUser++-- | @GET \/user\/logout@+-- +-- Logs out current logged in user session+-- +-- +-- +-- Note: Has 'Produces' instances, but no response schema+-- +logoutUser +  :: SwaggerPetstoreRequest LogoutUser MimeNoContent res+logoutUser =+  _mkRequest "GET" ["/user/logout"]++data LogoutUser  +-- | @application/xml@+instance Produces LogoutUser MimeXML+-- | @application/json@+instance Produces LogoutUser MimeJSON+++-- *** updateUser++-- | @PUT \/user\/{username}@+-- +-- Updated user+-- +-- This can only be done by the logged in user.+-- +-- Note: Has 'Produces' instances, but no response schema+-- +updateUser +  :: (Consumes UpdateUser contentType, MimeRender contentType User)+  => contentType -- ^ request content-type ('MimeType')+  -> Text -- ^ "username" -  name that need to be deleted+  -> User -- ^ "body" -  Updated user object+  -> SwaggerPetstoreRequest UpdateUser contentType res+updateUser _ username body =+  _mkRequest "PUT" ["/user/",toPath username]+    +    `setBodyParam` body++data UpdateUser ++-- | /Body Param/ "body" - Updated user object+instance HasBodyParam UpdateUser User +-- | @application/xml@+instance Produces UpdateUser MimeXML+-- | @application/json@+instance Produces UpdateUser MimeJSON++++-- * 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 -&-+ +-- * Optional Request Parameter Types+++newtype ApiUnderscorekey = ApiUnderscorekey { unApiUnderscorekey :: Text } deriving (P.Eq, P.Show)++newtype Name = Name { unName :: Text } deriving (P.Eq, P.Show)++newtype Status = Status { unStatus :: Text } deriving (P.Eq, P.Show)++newtype AdditionalMetadata = AdditionalMetadata { unAdditionalMetadata :: Text } deriving (P.Eq, P.Show)++newtype File = File { unFile :: FilePath } deriving (P.Eq, P.Show)+++-- * 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+  , urlPath :: [BCL.ByteString] -- ^ Endpoint of SwaggerPetstoreRequest+  , params   :: Params -- ^ params of SwaggerPetstoreRequest+  }+  deriving (P.Show)++-- | Request Params+data Params = Params+  { paramsQuery :: NH.Query+  , paramsHeaders :: NH.RequestHeaders+  , paramsBody :: ParamBody+  }+  deriving (P.Show)++-- | 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 = +    let _params = params (req `removeHeader` P.fmap P.fst header)+    in req { params = _params { paramsHeaders = header P.++ paramsHeaders _params } }++removeHeader :: SwaggerPetstoreRequest req contentType res -> [NH.HeaderName] -> SwaggerPetstoreRequest req contentType res+removeHeader req header = +    let _params = params req+    in req { params = _params { paramsHeaders = [h | h <- paramsHeaders _params, 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 = +    let _params = params req +    in req { params = _params { paramsQuery = query P.++ [q | q <- paramsQuery _params, 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 _params = params req+        form = case paramsBody _params of+            ParamBodyFormUrlEncoded _form -> _form+            _ -> mempty+    in req { params = _params { paramsBody = ParamBodyFormUrlEncoded (newform <> form) } }++_addMultiFormPart :: SwaggerPetstoreRequest req contentType res -> NH.Part -> SwaggerPetstoreRequest req contentType res+_addMultiFormPart req newpart = +    let _params = params req+        parts = case paramsBody _params of+            ParamBodyMultipartFormData _parts -> _parts+            _ -> []+    in req { params = _params { paramsBody = ParamBodyMultipartFormData (newpart : parts) } }++_setBodyBS :: SwaggerPetstoreRequest req contentType res -> B.ByteString -> SwaggerPetstoreRequest req contentType res+_setBodyBS req body = +    let _params = params req+    in req { params = _params { paramsBody = ParamBodyB body } }++_setBodyLBS :: SwaggerPetstoreRequest req contentType res -> BL.ByteString -> SwaggerPetstoreRequest req contentType res+_setBodyLBS req body = +    let _params = params req+    in req { params = _params { paramsBody = ParamBodyBL body } }+++-- ** 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 #-}+
+ lib/SwaggerPetstore/Client.hs view
@@ -0,0 +1,317 @@+{-|+Module : SwaggerPetstore.Client+-}++{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE DeriveFoldable #-}+{-# LANGUAGE DeriveTraversable #-}+{-# OPTIONS_GHC -fno-warn-unused-binds -fno-warn-unused-imports #-}++module SwaggerPetstore.Client where++import SwaggerPetstore.Model+import SwaggerPetstore.API+import SwaggerPetstore.MimeTypes++import qualified Control.Monad.IO.Class as P+import qualified Data.Aeson as A+import qualified Data.Aeson.Types as A+import qualified Data.Proxy as P (Proxy(..))+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 Control.Monad.Logger as LG++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+  , configExecLoggingT :: ExecLoggingT -- ^ Run a block using a MonadLogger instance+  , configLoggingFilter :: LG.LogSource -> LG.LogLevel -> Bool -- ^ Only log messages passing the given predicate function.+  }++-- | 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/v2@+--+-- configUserAgent:+--+-- @"swagger-haskell-http-client/1.0.0"@+--+-- configExecLoggingT: 'runNullLoggingT'+--+-- configLoggingFilter: 'infoLevelFilter'+newConfig :: SwaggerPetstoreConfig+newConfig =+  SwaggerPetstoreConfig+  { configHost = "http://petstore.swagger.io/v2"+  , configUserAgent = "swagger-haskell-http-client/1.0.0"+  , configExecLoggingT = runNullLoggingT+  , configLoggingFilter = infoLevelFilter+  }++-- | updates the config to use a MonadLogger instance which prints to stdout.+withStdoutLogging :: SwaggerPetstoreConfig -> SwaggerPetstoreConfig+withStdoutLogging p = p { configExecLoggingT = LG.runStdoutLoggingT}++-- | updates the config to use a MonadLogger instance which prints to stderr.+withStderrLogging :: SwaggerPetstoreConfig -> SwaggerPetstoreConfig+withStderrLogging p = p { configExecLoggingT = LG.runStderrLoggingT}++-- | updates the config to disable logging+withNoLogging :: SwaggerPetstoreConfig -> SwaggerPetstoreConfig+withNoLogging p = p { configExecLoggingT = runNullLoggingT}++-- * Dispatch++-- ** Lbs++-- | send a request returning the raw http response+dispatchLbs+  :: (Produces req accept, MimeType contentType)+  => NH.Manager -- ^ http-client Connection manager+  -> SwaggerPetstoreConfig -- ^ config+  -> SwaggerPetstoreRequest req contentType res -- ^ request+  -> accept -- ^ "accept" 'MimeType'+  -> IO (NH.Response BCL.ByteString) -- ^ response+dispatchLbs manager config request accept = do+  initReq <- _toInitRequest config request accept +  dispatchInitUnsafe manager config initReq++-- ** Mime++-- | pair of decoded http body and http response+data MimeResult res =+  MimeResult { mimeResult :: Either MimeError res -- ^ decoded http body+             , mimeResultResponse :: NH.Response BCL.ByteString -- ^ http response +             }+  deriving (Show, Functor, Foldable, Traversable)++-- | pair of unrender/parser error and http response+data MimeError =+  MimeError {+    mimeError :: String -- ^ unrender/parser error+  , mimeErrorResponse :: NH.Response BCL.ByteString -- ^ http response +  } deriving (Eq, Show)++-- | send a request returning the 'MimeResult'+dispatchMime+  :: (Produces req accept, MimeUnrender accept res, MimeType contentType)+  => NH.Manager -- ^ http-client Connection manager+  -> SwaggerPetstoreConfig -- ^ config+  -> SwaggerPetstoreRequest req contentType res -- ^ request+  -> accept -- ^ "accept" 'MimeType'+  -> IO (MimeResult res) -- ^ response+dispatchMime manager config request accept = do+  httpResponse <- dispatchLbs manager config request accept+  parsedResult <-+    runExceptionLoggingT "Client" config $+    do case mimeUnrender' accept (NH.responseBody httpResponse) of+         Left s -> do+           logNST LG.LevelError "Client" (T.pack s)+           pure (Left (MimeError s httpResponse))+         Right r -> pure (Right r)+  return (MimeResult parsedResult httpResponse)++-- | like 'dispatchMime', but only returns the decoded http body+dispatchMime'+  :: (Produces req accept, MimeUnrender accept res, MimeType contentType)+  => NH.Manager -- ^ http-client Connection manager+  -> SwaggerPetstoreConfig -- ^ config+  -> SwaggerPetstoreRequest req contentType res -- ^ request+  -> accept -- ^ "accept" 'MimeType'+  -> IO (Either MimeError res) -- ^ response+dispatchMime' manager config request accept = do+    MimeResult parsedResult _ <- dispatchMime manager config request accept +    return parsedResult++-- ** Unsafe++-- | like 'dispatchReqLbs', but does not validate the operation is a 'Producer' of the "accept" 'MimeType'.  (Useful if the server's response is undocumented)+dispatchLbsUnsafe+  :: (MimeType accept, MimeType contentType)+  => NH.Manager -- ^ http-client Connection manager+  -> SwaggerPetstoreConfig -- ^ config+  -> SwaggerPetstoreRequest req contentType res -- ^ request+  -> accept -- ^ "accept" 'MimeType'+  -> IO (NH.Response BCL.ByteString) -- ^ response+dispatchLbsUnsafe manager config request accept = do+  initReq <- _toInitRequest config request accept+  dispatchInitUnsafe manager config initReq++-- | dispatch an InitRequest+dispatchInitUnsafe+  :: NH.Manager -- ^ http-client Connection manager+  -> SwaggerPetstoreConfig -- ^ config+  -> InitRequest req contentType res accept -- ^ init request+  -> IO (NH.Response BCL.ByteString) -- ^ response+dispatchInitUnsafe manager config (InitRequest req) = do+  runExceptionLoggingT logSrc config $+    do logNST LG.LevelInfo logSrc requestLogMsg+       logNST LG.LevelDebug logSrc requestDbgLogMsg+       res <- P.liftIO $ NH.httpLbs req manager+       logNST LG.LevelInfo logSrc (responseLogMsg res)+       logNST LG.LevelDebug logSrc ((T.pack . show) res)+       return res+  where+    logSrc = "Client"+    endpoint =+      T.pack $+      BC.unpack $+      NH.method req <> " " <> NH.host req <> NH.path req <> NH.queryString req+    requestLogMsg = "REQ:" <> endpoint+    requestDbgLogMsg =+      "Headers=" <> (T.pack . show) (NH.requestHeaders req) <> " Body=" <>+      (case NH.requestBody req of+         NH.RequestBodyLBS xs -> T.decodeUtf8 (BL.toStrict xs)+         _ -> "<RequestBody>")+    responseStatusCode = (T.pack . show) . NH.statusCode . NH.responseStatus+    responseLogMsg res =+      "RES:statusCode=" <> responseStatusCode res <> " (" <> endpoint <> ")"++-- * InitRequest++-- | wraps an http-client 'Request' with request/response type parameters+newtype InitRequest req contentType res accept = InitRequest+  { unInitRequest :: NH.Request+  } deriving (Show)++-- |  Build an http-client 'Request' record from the supplied config and request+_toInitRequest+  :: (MimeType accept, MimeType contentType)+  => SwaggerPetstoreConfig -- ^ config+  -> 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 (urlPath req0))+  let req1 = _setAcceptHeader req0 accept & _setContentTypeHeader+      reqHeaders = ("User-Agent", WH.toHeader (configUserAgent config)) : paramsHeaders (params req1)+      reqQuery = NH.renderQuery True (paramsQuery (params req1))+      pReq = parsedReq { NH.method = (rMethod req1)+                       , NH.requestHeaders = reqHeaders+                       , NH.queryString = reqQuery+                       }+  outReq <- case paramsBody (params 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++  pure (InitRequest outReq)++-- | modify the underlying Request+modifyInitRequest :: InitRequest req contentType res accept -> (NH.Request -> NH.Request) -> InitRequest req contentType res accept +modifyInitRequest (InitRequest req) f = InitRequest (f req)++-- | modify the underlying Request (monadic)+modifyInitRequestM :: Monad m => InitRequest req contentType res accept -> (NH.Request -> m NH.Request) -> m (InitRequest req contentType res accept)+modifyInitRequestM (InitRequest req) f = fmap InitRequest (f req)++-- * Logging++-- | A block using a MonadLogger instance+type ExecLoggingT = forall m. P.MonadIO m =>+                              forall a. LG.LoggingT m a -> m a++-- ** Null Logger++-- | a logger which disables logging+nullLogger :: LG.Loc -> LG.LogSource -> LG.LogLevel -> LG.LogStr -> IO ()+nullLogger _ _ _ _ = return ()++-- | run the monad transformer that disables logging+runNullLoggingT :: LG.LoggingT m a -> m a+runNullLoggingT = (`LG.runLoggingT` nullLogger)++-- ** Logging Filters++-- | a log filter that uses 'LevelError' as the minimum logging level+errorLevelFilter :: LG.LogSource -> LG.LogLevel -> Bool+errorLevelFilter = minLevelFilter LG.LevelError++-- | a log filter that uses 'LevelInfo' as the minimum logging level+infoLevelFilter :: LG.LogSource -> LG.LogLevel -> Bool+infoLevelFilter = minLevelFilter LG.LevelInfo++-- | a log filter that uses 'LevelDebug' as the minimum logging level+debugLevelFilter :: LG.LogSource -> LG.LogLevel -> Bool+debugLevelFilter = minLevelFilter LG.LevelDebug++minLevelFilter :: LG.LogLevel -> LG.LogSource -> LG.LogLevel -> Bool+minLevelFilter l _ l' = l' >= l++-- ** Logging ++-- | Log a message using the current time+logNST :: (P.MonadIO m, LG.MonadLogger m) => LG.LogLevel -> Text -> Text -> m ()+logNST level src msg = do+  now <- P.liftIO (formatTimeLog <$> TI.getCurrentTime)+  LG.logOtherNS sourceLog level (now <> " " <> msg)+ where+  sourceLog = "SwaggerPetstore/" <> src+  formatTimeLog =+    T.pack . TI.formatTime TI.defaultTimeLocale "%Y-%m-%dT%H:%M:%S%Z"++-- | re-throws exceptions after logging them+logExceptions+  :: (LG.MonadLogger m, E.MonadCatch m, P.MonadIO m)+  => Text -> m a -> m a+logExceptions src =+  E.handle+    (\(e :: E.SomeException) -> do+       logNST LG.LevelError src ((T.pack . show) e)+       E.throw e)++-- | Run a block using the configured MonadLogger instance+runLoggingT :: SwaggerPetstoreConfig -> ExecLoggingT+runLoggingT config =+  configExecLoggingT config . LG.filterLogger (configLoggingFilter config)++-- | Run a block using the configured MonadLogger instance (logs exceptions)+runExceptionLoggingT+  :: (E.MonadCatch m, P.MonadIO m)+  => T.Text -> SwaggerPetstoreConfig -> LG.LoggingT m a -> m a+runExceptionLoggingT logSrc config = runLoggingT config . logExceptions logSrc
+ lib/SwaggerPetstore/Lens.hs view
@@ -0,0 +1,202 @@+{-|+Module : SwaggerPetstore.Lens+-}++{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE RecordWildCards #-}+{-# OPTIONS_GHC -fno-warn-name-shadowing -fno-warn-unused-matches -fno-warn-unused-binds -fno-warn-unused-imports #-}++module SwaggerPetstore.Lens where++import Data.Text (Text)++import qualified Data.Aeson as A+import Data.Aeson (Value)+import qualified Data.ByteString as B+import Data.ByteString.Lazy (ByteString)+import qualified Data.Data as P (Data, Typeable)+import qualified Data.Map as Map++import qualified Data.Time as TI+import Data.Time (UTCTime)++import Prelude (($), (.),(<$>),(<*>),(=<<),Maybe(..),Bool(..),Char,Double,FilePath,Float,Int,Integer,String,fmap,undefined,mempty,maybe,pure,Monad,Applicative,Functor)+import qualified Prelude as P++import SwaggerPetstore.Model++-- * Type Aliases++type Traversal_' s a = Traversal_ s s a a+type Traversal_ s t a b = forall (f :: * -> *). Applicative f => (a -> f b) -> s -> f t+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+++-- * ApiResponse++-- | 'apiResponseCode' Traversal+apiResponseCodeT :: Traversal_' ApiResponse Int+apiResponseCodeT f s = _mtraversal apiResponseCode (\b -> s { apiResponseCode = Just b}) f s+{-# INLINE apiResponseCodeT #-}++-- | 'apiResponseType' Traversal+apiResponseTypeT :: Traversal_' ApiResponse Text+apiResponseTypeT f s = _mtraversal apiResponseType (\b -> s { apiResponseType = Just b}) f s+{-# INLINE apiResponseTypeT #-}++-- | 'apiResponseMessage' Traversal+apiResponseMessageT :: Traversal_' ApiResponse Text+apiResponseMessageT f s = _mtraversal apiResponseMessage (\b -> s { apiResponseMessage = Just b}) f s+{-# INLINE apiResponseMessageT #-}++++-- * Category++-- | 'categoryId' Traversal+categoryIdT :: Traversal_' Category Integer+categoryIdT f s = _mtraversal categoryId (\b -> s { categoryId = Just b}) f s+{-# INLINE categoryIdT #-}++-- | 'categoryName' Traversal+categoryNameT :: Traversal_' Category Text+categoryNameT f s = _mtraversal categoryName (\b -> s { categoryName = Just b}) f s+{-# INLINE categoryNameT #-}++++-- * Order++-- | 'orderId' Traversal+orderIdT :: Traversal_' Order Integer+orderIdT f s = _mtraversal orderId (\b -> s { orderId = Just b}) f s+{-# INLINE orderIdT #-}++-- | 'orderPetId' Traversal+orderPetIdT :: Traversal_' Order Integer+orderPetIdT f s = _mtraversal orderPetId (\b -> s { orderPetId = Just b}) f s+{-# INLINE orderPetIdT #-}++-- | 'orderQuantity' Traversal+orderQuantityT :: Traversal_' Order Int+orderQuantityT f s = _mtraversal orderQuantity (\b -> s { orderQuantity = Just b}) f s+{-# INLINE orderQuantityT #-}++-- | 'orderShipDate' Traversal+orderShipDateT :: Traversal_' Order UTCTime+orderShipDateT f s = _mtraversal orderShipDate (\b -> s { orderShipDate = Just b}) f s+{-# INLINE orderShipDateT #-}++-- | 'orderStatus' Traversal+orderStatusT :: Traversal_' Order Text+orderStatusT f s = _mtraversal orderStatus (\b -> s { orderStatus = Just b}) f s+{-# INLINE orderStatusT #-}++-- | 'orderComplete' Traversal+orderCompleteT :: Traversal_' Order Bool+orderCompleteT f s = _mtraversal orderComplete (\b -> s { orderComplete = Just b}) f s+{-# INLINE orderCompleteT #-}++++-- * Pet++-- | 'petId' Traversal+petIdT :: Traversal_' Pet Integer+petIdT f s = _mtraversal petId (\b -> s { petId = Just b}) f s+{-# INLINE petIdT #-}++-- | 'petCategory' Traversal+petCategoryT :: Traversal_' Pet Category+petCategoryT f s = _mtraversal petCategory (\b -> s { petCategory = Just b}) f s+{-# INLINE petCategoryT #-}++-- | 'petName' Lens+petNameL :: Lens_' Pet Text+petNameL f Pet{..} = (\petName -> Pet { petName, ..} ) <$> f petName+{-# INLINE petNameL #-}++-- | 'petPhotoUrls' Lens+petPhotoUrlsL :: Lens_' Pet [Text]+petPhotoUrlsL f Pet{..} = (\petPhotoUrls -> Pet { petPhotoUrls, ..} ) <$> f petPhotoUrls+{-# INLINE petPhotoUrlsL #-}++-- | 'petTags' Traversal+petTagsT :: Traversal_' Pet [Tag]+petTagsT f s = _mtraversal petTags (\b -> s { petTags = Just b}) f s+{-# INLINE petTagsT #-}++-- | 'petStatus' Traversal+petStatusT :: Traversal_' Pet Text+petStatusT f s = _mtraversal petStatus (\b -> s { petStatus = Just b}) f s+{-# INLINE petStatusT #-}++++-- * Tag++-- | 'tagId' Traversal+tagIdT :: Traversal_' Tag Integer+tagIdT f s = _mtraversal tagId (\b -> s { tagId = Just b}) f s+{-# INLINE tagIdT #-}++-- | 'tagName' Traversal+tagNameT :: Traversal_' Tag Text+tagNameT f s = _mtraversal tagName (\b -> s { tagName = Just b}) f s+{-# INLINE tagNameT #-}++++-- * User++-- | 'userId' Traversal+userIdT :: Traversal_' User Integer+userIdT f s = _mtraversal userId (\b -> s { userId = Just b}) f s+{-# INLINE userIdT #-}++-- | 'userUsername' Traversal+userUsernameT :: Traversal_' User Text+userUsernameT f s = _mtraversal userUsername (\b -> s { userUsername = Just b}) f s+{-# INLINE userUsernameT #-}++-- | 'userFirstName' Traversal+userFirstNameT :: Traversal_' User Text+userFirstNameT f s = _mtraversal userFirstName (\b -> s { userFirstName = Just b}) f s+{-# INLINE userFirstNameT #-}++-- | 'userLastName' Traversal+userLastNameT :: Traversal_' User Text+userLastNameT f s = _mtraversal userLastName (\b -> s { userLastName = Just b}) f s+{-# INLINE userLastNameT #-}++-- | 'userEmail' Traversal+userEmailT :: Traversal_' User Text+userEmailT f s = _mtraversal userEmail (\b -> s { userEmail = Just b}) f s+{-# INLINE userEmailT #-}++-- | 'userPassword' Traversal+userPasswordT :: Traversal_' User Text+userPasswordT f s = _mtraversal userPassword (\b -> s { userPassword = Just b}) f s+{-# INLINE userPasswordT #-}++-- | 'userPhone' Traversal+userPhoneT :: Traversal_' User Text+userPhoneT f s = _mtraversal userPhone (\b -> s { userPhone = Just b}) f s+{-# INLINE userPhoneT #-}++-- | 'userUserStatus' Traversal+userUserStatusT :: Traversal_' User Int+userUserStatusT f s = _mtraversal userUserStatus (\b -> s { userUserStatus = Just b}) f s+{-# INLINE userUserStatusT #-}+++++-- * Helpers++_mtraversal :: Applicative f => (b -> Maybe t) -> (a -> b) -> (t -> f a) -> b -> f b+_mtraversal x fsb f s = maybe (pure s) (\a -> fsb <$> f a) (x s)+{-# INLINE _mtraversal #-}
+ lib/SwaggerPetstore/MimeTypes.hs view
@@ -0,0 +1,190 @@++{-|+Module : SwaggerPetstore.MimeTypes+-}++{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# OPTIONS_GHC -fno-warn-unused-binds -fno-warn-unused-imports #-}++module SwaggerPetstore.MimeTypes where+++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.Char8 as BCL++import qualified Network.HTTP.Media as ME++import qualified Web.FormUrlEncoded 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.Text.Encoding as T+import qualified Control.Arrow as P (left)++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)++-- ** Mime Types++data MimeJSON = MimeJSON deriving (P.Typeable)+data MimeXML = MimeXML deriving (P.Typeable)+data MimePlainText = MimePlainText deriving (P.Typeable)+data MimeFormUrlEncoded = MimeFormUrlEncoded deriving (P.Typeable)+data MimeMultipartFormData = MimeMultipartFormData deriving (P.Typeable)+data MimeOctetStream = MimeOctetStream deriving (P.Typeable)+data MimeNoContent = MimeNoContent deriving (P.Typeable)+++-- ** MimeType Class++class P.Typeable mtype => MimeType mtype  where+  {-# MINIMAL mimeType | mimeTypes #-}++  mimeTypes :: P.Proxy mtype -> [ME.MediaType]+  mimeTypes p =+    case mimeType p of+      Just x -> [x]+      Nothing -> []++  mimeType :: P.Proxy mtype -> Maybe ME.MediaType+  mimeType p =+    case mimeTypes p of+      [] -> Nothing+      (x:_) -> Just x++  mimeType' :: mtype -> Maybe ME.MediaType+  mimeType' _ = mimeType (P.Proxy :: P.Proxy mtype)+  mimeTypes' :: mtype -> [ME.MediaType]+  mimeTypes' _ = mimeTypes (P.Proxy :: P.Proxy mtype)++-- ** MimeType Instances++-- | @application/json@+instance MimeType MimeJSON where+  mimeTypes _ =+    [ "application" ME.// "json" ME./: ("charset", "utf-8")+    , "application" ME.// "json"+    ]++-- | @application/xml@+instance MimeType MimeXML where+  mimeType _ = Just $ "application" ME.// "xml"++-- | @application/x-www-form-urlencoded@+instance MimeType MimeFormUrlEncoded where+  mimeType _ = Just $ "application" ME.// "x-www-form-urlencoded"++-- | @multipart/form-data@+instance MimeType MimeMultipartFormData where+  mimeType _ = Just $ "multipart" ME.// "form-data"++-- | @text/plain;charset=utf-8@+instance MimeType MimePlainText where+  mimeType _ = Just $ "text" ME.// "plain" ME./: ("charset", "utf-8")+instance MimeType MimeOctetStream where+  mimeType _ = Just $ "application" ME.// "octet-stream"+instance MimeType MimeNoContent where+  mimeType _ = Nothing+++-- ** MimeRender Class++class MimeType mtype => MimeRender mtype x where+    mimeRender  :: P.Proxy mtype -> x -> BL.ByteString+    mimeRender' :: mtype -> x -> BL.ByteString+    mimeRender' _ x = mimeRender (P.Proxy :: P.Proxy mtype) x+++-- ** MimeRender Instances++-- | `A.encode`+instance A.ToJSON a => MimeRender MimeJSON a where mimeRender _ = A.encode+-- | @WH.urlEncodeAsForm@+instance WH.ToForm a => MimeRender MimeFormUrlEncoded a where mimeRender _ = WH.urlEncodeAsForm++-- | @P.id@+instance MimeRender MimePlainText BL.ByteString where mimeRender _ = P.id+-- | @BL.fromStrict . T.encodeUtf8@+instance MimeRender MimePlainText T.Text where mimeRender _ = BL.fromStrict . T.encodeUtf8+-- | @BCL.pack@+instance MimeRender MimePlainText String where mimeRender _ = BCL.pack++-- | @P.id@+instance MimeRender MimeOctetStream BL.ByteString where mimeRender _ = P.id+-- | @BL.fromStrict . T.encodeUtf8@+instance MimeRender MimeOctetStream T.Text where mimeRender _ = BL.fromStrict . T.encodeUtf8+-- | @BCL.pack@+instance MimeRender MimeOctetStream String where mimeRender _ = BCL.pack++-- | @P.id@+instance MimeRender MimeMultipartFormData BL.ByteString where mimeRender _ = P.id+-- | @BL.fromStrict . T.encodeUtf8@+instance MimeRender MimeMultipartFormData T.Text where mimeRender _ = BL.fromStrict . T.encodeUtf8+-- | @BCL.pack@+instance MimeRender MimeMultipartFormData String where mimeRender _ = BCL.pack++-- | @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+++-- ** 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++-- | @A.eitherDecode@+instance A.FromJSON a => MimeUnrender MimeJSON a where mimeUnrender _ = A.eitherDecode+-- | @P.left T.unpack . WH.urlDecodeAsForm@+instance WH.FromForm a => MimeUnrender MimeFormUrlEncoded a where mimeUnrender _ = P.left T.unpack . WH.urlDecodeAsForm+-- | @P.Right . P.id@++instance MimeUnrender MimePlainText BL.ByteString where mimeUnrender _ = P.Right . P.id+-- | @P.left P.show . TL.decodeUtf8'@+instance MimeUnrender MimePlainText T.Text where mimeUnrender _ = P.left P.show . T.decodeUtf8' . BL.toStrict+-- | @P.Right . BCL.unpack@+instance MimeUnrender MimePlainText String where mimeUnrender _ = P.Right . BCL.unpack++-- | @P.Right . P.id@+instance MimeUnrender MimeOctetStream BL.ByteString where mimeUnrender _ = P.Right . P.id+-- | @P.left P.show . T.decodeUtf8' . BL.toStrict@+instance MimeUnrender MimeOctetStream T.Text where mimeUnrender _ = P.left P.show . T.decodeUtf8' . BL.toStrict+-- | @P.Right . BCL.unpack@+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+++-- ** Request Consumes++class MimeType mtype => Consumes req mtype where++-- ** Request Produces++class MimeType mtype => Produces req mtype where
+ lib/SwaggerPetstore/Model.hs view
@@ -0,0 +1,378 @@+{-|+Module : SwaggerPetstore.Model+-}++{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveFoldable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DeriveTraversable #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE TypeFamilies #-}+{-# OPTIONS_GHC -fno-warn-unused-matches -fno-warn-unused-binds -fno-warn-unused-imports #-}++module SwaggerPetstore.Model where++import Data.Aeson ((.:),(.:!),(.:?),(.=))+import Data.Text (Text)++import Data.Aeson (Value)+import Data.ByteString.Lazy (ByteString)++import qualified Data.Aeson as A+import qualified Data.ByteString as B+import qualified Data.Data as P (Data, Typeable)+import qualified Data.HashMap.Lazy as HM+import qualified Data.Map as Map+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 Data.Time as TI+import qualified Data.Time.ISO8601 as TI+import Data.Time (UTCTime)++import Control.Applicative ((<|>))+import Control.Applicative (Alternative)+import Prelude (($), (.),(<$>),(<*>),(>>=),Maybe(..),Bool(..),Char,Double,FilePath,Float,Int,Integer,String,fmap,undefined,mempty,maybe,pure,Monad,Applicative,Functor)+import qualified Prelude as P++++-- * Models+++-- ** ApiResponse+-- |+-- An uploaded response+-- +-- Describes the result of uploading an image resource+data ApiResponse = ApiResponse+  { apiResponseCode :: Maybe Int -- ^ "code"+  , apiResponseType :: Maybe Text -- ^ "type"+  , apiResponseMessage :: Maybe Text -- ^ "message"+  } deriving (P.Show,P.Eq,P.Typeable)++instance A.FromJSON ApiResponse where+  parseJSON = A.withObject "ApiResponse" $ \o ->+    ApiResponse+      <$> (o .:? "code")+      <*> (o .:? "type")+      <*> (o .:? "message")++instance A.ToJSON ApiResponse where+  toJSON ApiResponse {..} =+   _omitNulls+      [ "code" .=  apiResponseCode+      , "type" .=  apiResponseType+      , "message" .=  apiResponseMessage+      ]+++-- | Construct a value of type 'ApiResponse' (by applying it's required fields, if any)+mkApiResponse+  :: ApiResponse+mkApiResponse =+  ApiResponse+  { apiResponseCode = Nothing+  , apiResponseType = Nothing+  , apiResponseMessage = Nothing+  }+  +++-- ** Category+-- |+-- Pet catehgry+-- +-- A category for a pet+data Category = Category+  { categoryId :: Maybe Integer -- ^ "id"+  , categoryName :: Maybe Text -- ^ "name"+  } deriving (P.Show,P.Eq,P.Typeable)++instance A.FromJSON Category where+  parseJSON = A.withObject "Category" $ \o ->+    Category+      <$> (o .:? "id")+      <*> (o .:? "name")++instance A.ToJSON Category where+  toJSON Category {..} =+   _omitNulls+      [ "id" .=  categoryId+      , "name" .=  categoryName+      ]+++-- | Construct a value of type 'Category' (by applying it's required fields, if any)+mkCategory+  :: Category+mkCategory =+  Category+  { categoryId = Nothing+  , categoryName = Nothing+  }+  +++-- ** Order+-- |+-- Pet Order+-- +-- An order for a pets from the pet store+data Order = Order+  { orderId :: Maybe Integer -- ^ "id"+  , orderPetId :: Maybe Integer -- ^ "petId"+  , orderQuantity :: Maybe Int -- ^ "quantity"+  , orderShipDate :: Maybe UTCTime -- ^ "shipDate"+  , orderStatus :: Maybe Text -- ^ "status" - Order Status+  , orderComplete :: Maybe Bool -- ^ "complete"+  } deriving (P.Show,P.Eq,P.Typeable)++instance A.FromJSON Order where+  parseJSON = A.withObject "Order" $ \o ->+    Order+      <$> (o .:? "id")+      <*> (o .:? "petId")+      <*> (o .:? "quantity")+      <*> (o .:? "shipDate" >>= P.mapM _readDateTime)+      <*> (o .:? "status")+      <*> (o .:? "complete")++instance A.ToJSON Order where+  toJSON Order {..} =+   _omitNulls+      [ "id" .=  orderId+      , "petId" .=  orderPetId+      , "quantity" .=  orderQuantity+      , "shipDate" .= P.fmap _showDateTime orderShipDate+      , "status" .=  orderStatus+      , "complete" .=  orderComplete+      ]+++-- | Construct a value of type 'Order' (by applying it's required fields, if any)+mkOrder+  :: Order+mkOrder =+  Order+  { orderId = Nothing+  , orderPetId = Nothing+  , orderQuantity = Nothing+  , orderShipDate = Nothing+  , orderStatus = Nothing+  , orderComplete = Nothing+  }+  +++-- ** Pet+-- |+-- a Pet+-- +-- A pet for sale in the pet store+data Pet = Pet+  { petId :: Maybe Integer -- ^ "id"+  , petCategory :: Maybe Category -- ^ "category"+  , petName :: Text -- ^ /Required/ "name"+  , petPhotoUrls :: [Text] -- ^ /Required/ "photoUrls"+  , petTags :: Maybe [Tag] -- ^ "tags"+  , petStatus :: Maybe Text -- ^ "status" - pet status in the store+  } deriving (P.Show,P.Eq,P.Typeable)++instance A.FromJSON Pet where+  parseJSON = A.withObject "Pet" $ \o ->+    Pet+      <$> (o .:? "id")+      <*> (o .:? "category")+      <*> (o .:  "name")+      <*> (o .:  "photoUrls")+      <*> (o .:? "tags")+      <*> (o .:? "status")++instance A.ToJSON Pet where+  toJSON Pet {..} =+   _omitNulls+      [ "id" .=  petId+      , "category" .=  petCategory+      , "name" .=  petName+      , "photoUrls" .=  petPhotoUrls+      , "tags" .=  petTags+      , "status" .=  petStatus+      ]+++-- | Construct a value of type 'Pet' (by applying it's required fields, if any)+mkPet+  :: Text -- ^ 'petName' +  -> [Text] -- ^ 'petPhotoUrls' +  -> Pet+mkPet petName petPhotoUrls =+  Pet+  { petId = Nothing+  , petCategory = Nothing+  , petName+  , petPhotoUrls+  , petTags = Nothing+  , petStatus = Nothing+  }+  +++-- ** Tag+-- |+-- Pet Tag+-- +-- A tag for a pet+data Tag = Tag+  { tagId :: Maybe Integer -- ^ "id"+  , tagName :: Maybe Text -- ^ "name"+  } deriving (P.Show,P.Eq,P.Typeable)++instance A.FromJSON Tag where+  parseJSON = A.withObject "Tag" $ \o ->+    Tag+      <$> (o .:? "id")+      <*> (o .:? "name")++instance A.ToJSON Tag where+  toJSON Tag {..} =+   _omitNulls+      [ "id" .=  tagId+      , "name" .=  tagName+      ]+++-- | Construct a value of type 'Tag' (by applying it's required fields, if any)+mkTag+  :: Tag+mkTag =+  Tag+  { tagId = Nothing+  , tagName = Nothing+  }+  +++-- ** User+-- |+-- a User+-- +-- A User who is purchasing from the pet store+data User = User+  { userId :: Maybe Integer -- ^ "id"+  , userUsername :: Maybe Text -- ^ "username"+  , userFirstName :: Maybe Text -- ^ "firstName"+  , userLastName :: Maybe Text -- ^ "lastName"+  , userEmail :: Maybe Text -- ^ "email"+  , userPassword :: Maybe Text -- ^ "password"+  , userPhone :: Maybe Text -- ^ "phone"+  , userUserStatus :: Maybe Int -- ^ "userStatus" - User Status+  } deriving (P.Show,P.Eq,P.Typeable)++instance A.FromJSON User where+  parseJSON = A.withObject "User" $ \o ->+    User+      <$> (o .:? "id")+      <*> (o .:? "username")+      <*> (o .:? "firstName")+      <*> (o .:? "lastName")+      <*> (o .:? "email")+      <*> (o .:? "password")+      <*> (o .:? "phone")+      <*> (o .:? "userStatus")++instance A.ToJSON User where+  toJSON User {..} =+   _omitNulls+      [ "id" .=  userId+      , "username" .=  userUsername+      , "firstName" .=  userFirstName+      , "lastName" .=  userLastName+      , "email" .=  userEmail+      , "password" .=  userPassword+      , "phone" .=  userPhone+      , "userStatus" .=  userUserStatus+      ]+++-- | Construct a value of type 'User' (by applying it's required fields, if any)+mkUser+  :: User+mkUser =+  User+  { userId = Nothing+  , userUsername = Nothing+  , userFirstName = Nothing+  , userLastName = Nothing+  , userEmail = Nothing+  , userPassword = Nothing+  , userPhone = Nothing+  , userUserStatus = Nothing+  }+  +++-- * 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++_toFormItem :: (WH.ToHttpApiData a, Functor f) => t -> f a -> f (t, [Text])+_toFormItem name x = (name,) . (:[]) . WH.toQueryParam <$> x++_emptyToNothing :: Maybe String -> Maybe String+_emptyToNothing (Just "") = Nothing+_emptyToNothing x = x+{-# INLINE _emptyToNothing #-}++_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++-- | @_parseISO8601@+_readDateTime :: (TI.ParseTime t, Monad m, Alternative m) => String -> m t+_readDateTime =+  _parseISO8601+{-# INLINE _readDateTime #-}++-- | @TI.formatISO8601Millis@+_showDateTime :: (t ~ UTCTime, TI.FormatTime t) => t -> String+_showDateTime =+  TI.formatISO8601Millis+{-# INLINE _showDateTime #-}++_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++-- | @TI.parseTimeM True TI.defaultTimeLocale ""@+_readDate :: (TI.ParseTime t, Monad m) => String -> m t+_readDate =+  TI.parseTimeM True TI.defaultTimeLocale ""+{-# INLINE _readDate #-}++-- | @TI.formatTime TI.defaultTimeLocale ""@+_showDate :: TI.FormatTime t => t -> String+_showDate =+  TI.formatTime TI.defaultTimeLocale ""+{-# INLINE _showDate #-}
+ swagger-petstore.cabal view
@@ -0,0 +1,96 @@+-- This file has been generated from package.yaml by hpack version 0.17.1.+--+-- see: https://github.com/sol/hpack++name:           swagger-petstore+version:        0.0.1.0+synopsis:       Auto-generated swagger-petstore API Client+description:    .+                Client library for calling the swagger-petstore API based on http-client.+                host: petstore.swagger.io+                .+                base path: http://petstore.swagger.io/v2+                .+                apiVersion: 0.0.1+                .+                swagger version: 2.0+                .+                OpenAPI-Specification: https://github.com/OAI/OpenAPI-Specification/blob/master/versions/2.0.md +category:       Web+homepage:       https://github.com/swagger-api/swagger-codegen#readme+author:         Jon Schoning+maintainer:     jonschoning@gmail.com+copyright:      Copyright (c) 2015 Jon Schoning+license:        MIT+license-file:   LICENSE+build-type:     Simple+cabal-version:  >= 1.10++extra-source-files:+    README.md+    swagger.json++library+  hs-source-dirs:+      lib+  ghc-options: -Wall+  build-depends:+      base >=4.7 && <5.0+    , transformers >=0.4.0.0+    , mtl >=2.2.1+    , unordered-containers+    , aeson >=1.0 && <2.0+    , bytestring >=0.10.0 && <0.11+    , containers >=0.5.0.0 && <0.6+    , http-types >=0.8 && <0.10+    , http-client >=0.5 && <0.6+    , http-client-tls+    , http-api-data >= 0.3.4 && <0.4+    , http-media >= 0.4 && < 0.8+    , text >=0.11 && <1.3+    , time >=1.5 && <1.9+    , iso8601-time >=0.1.3 && <0.2.0+    , vector >=0.10.9 && <0.13+    , network >=2.6.2 && <2.7+    , random >=1.1+    , exceptions >= 0.4+    , monad-logger >=0.3 && <0.4+    , safe-exceptions <0.2+    , case-insensitive+  exposed-modules:+      SwaggerPetstore+      SwaggerPetstore.API+      SwaggerPetstore.Client+      SwaggerPetstore.Model+      SwaggerPetstore.MimeTypes+      SwaggerPetstore.Lens+  other-modules:+      Paths_swagger_petstore+  default-language: Haskell2010++test-suite tests+  type: exitcode-stdio-1.0+  main-is: Test.hs+  hs-source-dirs:+      tests+  ghc-options: -fno-warn-orphans+  build-depends:+      base >=4.7 && <5.0+    , transformers >=0.4.0.0+    , mtl >=2.2.1+    , unordered-containers+    , swagger-petstore+    , bytestring >=0.10.0 && <0.11+    , containers+    , hspec >=1.8+    , text+    , time+    , iso8601-time+    , aeson+    , semigroups+    , QuickCheck+  other-modules:+      ApproxEq+      Instances+      PropMime+  default-language: Haskell2010
+ swagger.json view
@@ -0,0 +1,831 @@+{+  "swagger" : "2.0",+  "info" : {+    "description" : "This is a sample server Petstore server.  You can find out more about Swagger at [http://swagger.io](http://swagger.io) or on [irc.freenode.net, #swagger](http://swagger.io/irc/).  For this sample, you can use the api key `special-key` to test the authorization filters.",+    "version" : "1.0.0",+    "title" : "Swagger Petstore",+    "termsOfService" : "http://swagger.io/terms/",+    "contact" : {+      "email" : "apiteam@swagger.io"+    },+    "license" : {+      "name" : "Apache 2.0",+      "url" : "http://www.apache.org/licenses/LICENSE-2.0.html"+    }+  },+  "host" : "petstore.swagger.io",+  "basePath" : "/v2",+  "tags" : [ {+    "name" : "pet",+    "description" : "Everything about your Pets",+    "externalDocs" : {+      "description" : "Find out more",+      "url" : "http://swagger.io"+    }+  }, {+    "name" : "store",+    "description" : "Access to Petstore orders"+  }, {+    "name" : "user",+    "description" : "Operations about user",+    "externalDocs" : {+      "description" : "Find out more about our store",+      "url" : "http://swagger.io"+    }+  } ],+  "schemes" : [ "http" ],+  "paths" : {+    "/pet" : {+      "post" : {+        "tags" : [ "pet" ],+        "summary" : "Add a new pet to the store",+        "description" : "",+        "operationId" : "addPet",+        "consumes" : [ "application/json", "application/xml" ],+        "produces" : [ "application/xml", "application/json" ],+        "parameters" : [ {+          "in" : "body",+          "name" : "body",+          "description" : "Pet object that needs to be added to the store",+          "required" : true,+          "schema" : {+            "$ref" : "#/definitions/Pet"+          }+        } ],+        "responses" : {+          "405" : {+            "description" : "Invalid input"+          }+        },+        "security" : [ {+          "petstore_auth" : [ "write:pets", "read:pets" ]+        } ]+      },+      "put" : {+        "tags" : [ "pet" ],+        "summary" : "Update an existing pet",+        "description" : "",+        "operationId" : "updatePet",+        "consumes" : [ "application/json", "application/xml" ],+        "produces" : [ "application/xml", "application/json" ],+        "parameters" : [ {+          "in" : "body",+          "name" : "body",+          "description" : "Pet object that needs to be added to the store",+          "required" : true,+          "schema" : {+            "$ref" : "#/definitions/Pet"+          }+        } ],+        "responses" : {+          "400" : {+            "description" : "Invalid ID supplied"+          },+          "404" : {+            "description" : "Pet not found"+          },+          "405" : {+            "description" : "Validation exception"+          }+        },+        "security" : [ {+          "petstore_auth" : [ "write:pets", "read:pets" ]+        } ]+      }+    },+    "/pet/findByStatus" : {+      "get" : {+        "tags" : [ "pet" ],+        "summary" : "Finds Pets by status",+        "description" : "Multiple status values can be provided with comma separated strings",+        "operationId" : "findPetsByStatus",+        "produces" : [ "application/xml", "application/json" ],+        "parameters" : [ {+          "name" : "status",+          "in" : "query",+          "description" : "Status values that need to be considered for filter",+          "required" : true,+          "type" : "array",+          "items" : {+            "type" : "string",+            "enum" : [ "available", "pending", "sold" ],+            "default" : "available"+          },+          "collectionFormat" : "csv"+        } ],+        "responses" : {+          "200" : {+            "description" : "successful operation",+            "schema" : {+              "type" : "array",+              "items" : {+                "$ref" : "#/definitions/Pet"+              }+            }+          },+          "400" : {+            "description" : "Invalid status value"+          }+        },+        "security" : [ {+          "petstore_auth" : [ "write:pets", "read:pets" ]+        } ]+      }+    },+    "/pet/findByTags" : {+      "get" : {+        "tags" : [ "pet" ],+        "summary" : "Finds Pets by tags",+        "description" : "Multiple tags can be provided with comma separated strings. Use tag1, tag2, tag3 for testing.",+        "operationId" : "findPetsByTags",+        "produces" : [ "application/xml", "application/json" ],+        "parameters" : [ {+          "name" : "tags",+          "in" : "query",+          "description" : "Tags to filter by",+          "required" : true,+          "type" : "array",+          "items" : {+            "type" : "string"+          },+          "collectionFormat" : "csv"+        } ],+        "responses" : {+          "200" : {+            "description" : "successful operation",+            "schema" : {+              "type" : "array",+              "items" : {+                "$ref" : "#/definitions/Pet"+              }+            }+          },+          "400" : {+            "description" : "Invalid tag value"+          }+        },+        "security" : [ {+          "petstore_auth" : [ "write:pets", "read:pets" ]+        } ],+        "deprecated" : true+      }+    },+    "/pet/{petId}" : {+      "get" : {+        "tags" : [ "pet" ],+        "summary" : "Find pet by ID",+        "description" : "Returns a single pet",+        "operationId" : "getPetById",+        "produces" : [ "application/xml", "application/json" ],+        "parameters" : [ {+          "name" : "petId",+          "in" : "path",+          "description" : "ID of pet to return",+          "required" : true,+          "type" : "integer",+          "format" : "int64"+        } ],+        "responses" : {+          "200" : {+            "description" : "successful operation",+            "schema" : {+              "$ref" : "#/definitions/Pet"+            }+          },+          "400" : {+            "description" : "Invalid ID supplied"+          },+          "404" : {+            "description" : "Pet not found"+          }+        },+        "security" : [ {+          "api_key" : [ ]+        } ]+      },+      "post" : {+        "tags" : [ "pet" ],+        "summary" : "Updates a pet in the store with form data",+        "description" : "",+        "operationId" : "updatePetWithForm",+        "consumes" : [ "application/x-www-form-urlencoded" ],+        "produces" : [ "application/xml", "application/json" ],+        "parameters" : [ {+          "name" : "petId",+          "in" : "path",+          "description" : "ID of pet that needs to be updated",+          "required" : true,+          "type" : "integer",+          "format" : "int64"+        }, {+          "name" : "name",+          "in" : "formData",+          "description" : "Updated name of the pet",+          "required" : false,+          "type" : "string"+        }, {+          "name" : "status",+          "in" : "formData",+          "description" : "Updated status of the pet",+          "required" : false,+          "type" : "string"+        } ],+        "responses" : {+          "405" : {+            "description" : "Invalid input"+          }+        },+        "security" : [ {+          "petstore_auth" : [ "write:pets", "read:pets" ]+        } ]+      },+      "delete" : {+        "tags" : [ "pet" ],+        "summary" : "Deletes a pet",+        "description" : "",+        "operationId" : "deletePet",+        "produces" : [ "application/xml", "application/json" ],+        "parameters" : [ {+          "name" : "api_key",+          "in" : "header",+          "required" : false,+          "type" : "string"+        }, {+          "name" : "petId",+          "in" : "path",+          "description" : "Pet id to delete",+          "required" : true,+          "type" : "integer",+          "format" : "int64"+        } ],+        "responses" : {+          "400" : {+            "description" : "Invalid pet value"+          }+        },+        "security" : [ {+          "petstore_auth" : [ "write:pets", "read:pets" ]+        } ]+      }+    },+    "/pet/{petId}/uploadImage" : {+      "post" : {+        "tags" : [ "pet" ],+        "summary" : "uploads an image",+        "description" : "",+        "operationId" : "uploadFile",+        "consumes" : [ "multipart/form-data" ],+        "produces" : [ "application/json" ],+        "parameters" : [ {+          "name" : "petId",+          "in" : "path",+          "description" : "ID of pet to update",+          "required" : true,+          "type" : "integer",+          "format" : "int64"+        }, {+          "name" : "additionalMetadata",+          "in" : "formData",+          "description" : "Additional data to pass to server",+          "required" : false,+          "type" : "string"+        }, {+          "name" : "file",+          "in" : "formData",+          "description" : "file to upload",+          "required" : false,+          "type" : "file"+        } ],+        "responses" : {+          "200" : {+            "description" : "successful operation",+            "schema" : {+              "$ref" : "#/definitions/ApiResponse"+            }+          }+        },+        "security" : [ {+          "petstore_auth" : [ "write:pets", "read:pets" ]+        } ]+      }+    },+    "/store/inventory" : {+      "get" : {+        "tags" : [ "store" ],+        "summary" : "Returns pet inventories by status",+        "description" : "Returns a map of status codes to quantities",+        "operationId" : "getInventory",+        "produces" : [ "application/json" ],+        "parameters" : [ ],+        "responses" : {+          "200" : {+            "description" : "successful operation",+            "schema" : {+              "type" : "object",+              "additionalProperties" : {+                "type" : "integer",+                "format" : "int32"+              }+            }+          }+        },+        "security" : [ {+          "api_key" : [ ]+        } ]+      }+    },+    "/store/order" : {+      "post" : {+        "tags" : [ "store" ],+        "summary" : "Place an order for a pet",+        "description" : "",+        "operationId" : "placeOrder",+        "produces" : [ "application/xml", "application/json" ],+        "parameters" : [ {+          "in" : "body",+          "name" : "body",+          "description" : "order placed for purchasing the pet",+          "required" : true,+          "schema" : {+            "$ref" : "#/definitions/Order"+          }+        } ],+        "responses" : {+          "200" : {+            "description" : "successful operation",+            "schema" : {+              "$ref" : "#/definitions/Order"+            }+          },+          "400" : {+            "description" : "Invalid Order"+          }+        }+      }+    },+    "/store/order/{orderId}" : {+      "get" : {+        "tags" : [ "store" ],+        "summary" : "Find purchase order by ID",+        "description" : "For valid response try integer IDs with value <= 5 or > 10. Other values will generated exceptions",+        "operationId" : "getOrderById",+        "produces" : [ "application/xml", "application/json" ],+        "parameters" : [ {+          "name" : "orderId",+          "in" : "path",+          "description" : "ID of pet that needs to be fetched",+          "required" : true,+          "type" : "integer",+          "maximum" : 5,+          "minimum" : 1,+          "format" : "int64"+        } ],+        "responses" : {+          "200" : {+            "description" : "successful operation",+            "schema" : {+              "$ref" : "#/definitions/Order"+            }+          },+          "400" : {+            "description" : "Invalid ID supplied"+          },+          "404" : {+            "description" : "Order not found"+          }+        }+      },+      "delete" : {+        "tags" : [ "store" ],+        "summary" : "Delete purchase order by ID",+        "description" : "For valid response try integer IDs with value < 1000. Anything above 1000 or nonintegers will generate API errors",+        "operationId" : "deleteOrder",+        "produces" : [ "application/xml", "application/json" ],+        "parameters" : [ {+          "name" : "orderId",+          "in" : "path",+          "description" : "ID of the order that needs to be deleted",+          "required" : true,+          "type" : "string"+        } ],+        "responses" : {+          "400" : {+            "description" : "Invalid ID supplied"+          },+          "404" : {+            "description" : "Order not found"+          }+        }+      }+    },+    "/user" : {+      "post" : {+        "tags" : [ "user" ],+        "summary" : "Create user",+        "description" : "This can only be done by the logged in user.",+        "operationId" : "createUser",+        "produces" : [ "application/xml", "application/json" ],+        "parameters" : [ {+          "in" : "body",+          "name" : "body",+          "description" : "Created user object",+          "required" : true,+          "schema" : {+            "$ref" : "#/definitions/User"+          }+        } ],+        "responses" : {+          "default" : {+            "description" : "successful operation"+          }+        }+      }+    },+    "/user/createWithArray" : {+      "post" : {+        "tags" : [ "user" ],+        "summary" : "Creates list of users with given input array",+        "description" : "",+        "operationId" : "createUsersWithArrayInput",+        "produces" : [ "application/xml", "application/json" ],+        "parameters" : [ {+          "in" : "body",+          "name" : "body",+          "description" : "List of user object",+          "required" : true,+          "schema" : {+            "type" : "array",+            "items" : {+              "$ref" : "#/definitions/User"+            }+          }+        } ],+        "responses" : {+          "default" : {+            "description" : "successful operation"+          }+        }+      }+    },+    "/user/createWithList" : {+      "post" : {+        "tags" : [ "user" ],+        "summary" : "Creates list of users with given input array",+        "description" : "",+        "operationId" : "createUsersWithListInput",+        "produces" : [ "application/xml", "application/json" ],+        "parameters" : [ {+          "in" : "body",+          "name" : "body",+          "description" : "List of user object",+          "required" : true,+          "schema" : {+            "type" : "array",+            "items" : {+              "$ref" : "#/definitions/User"+            }+          }+        } ],+        "responses" : {+          "default" : {+            "description" : "successful operation"+          }+        }+      }+    },+    "/user/login" : {+      "get" : {+        "tags" : [ "user" ],+        "summary" : "Logs user into the system",+        "description" : "",+        "operationId" : "loginUser",+        "produces" : [ "application/xml", "application/json" ],+        "parameters" : [ {+          "name" : "username",+          "in" : "query",+          "description" : "The user name for login",+          "required" : true,+          "type" : "string"+        }, {+          "name" : "password",+          "in" : "query",+          "description" : "The password for login in clear text",+          "required" : true,+          "type" : "string"+        } ],+        "responses" : {+          "200" : {+            "description" : "successful operation",+            "schema" : {+              "type" : "string"+            },+            "headers" : {+              "X-Rate-Limit" : {+                "type" : "integer",+                "format" : "int32",+                "description" : "calls per hour allowed by the user"+              },+              "X-Expires-After" : {+                "type" : "string",+                "format" : "date-time",+                "description" : "date in UTC when toekn expires"+              }+            }+          },+          "400" : {+            "description" : "Invalid username/password supplied"+          }+        }+      }+    },+    "/user/logout" : {+      "get" : {+        "tags" : [ "user" ],+        "summary" : "Logs out current logged in user session",+        "description" : "",+        "operationId" : "logoutUser",+        "produces" : [ "application/xml", "application/json" ],+        "parameters" : [ ],+        "responses" : {+          "default" : {+            "description" : "successful operation"+          }+        }+      }+    },+    "/user/{username}" : {+      "get" : {+        "tags" : [ "user" ],+        "summary" : "Get user by user name",+        "description" : "",+        "operationId" : "getUserByName",+        "produces" : [ "application/xml", "application/json" ],+        "parameters" : [ {+          "name" : "username",+          "in" : "path",+          "description" : "The name that needs to be fetched. Use user1 for testing. ",+          "required" : true,+          "type" : "string"+        } ],+        "responses" : {+          "200" : {+            "description" : "successful operation",+            "schema" : {+              "$ref" : "#/definitions/User"+            }+          },+          "400" : {+            "description" : "Invalid username supplied"+          },+          "404" : {+            "description" : "User not found"+          }+        }+      },+      "put" : {+        "tags" : [ "user" ],+        "summary" : "Updated user",+        "description" : "This can only be done by the logged in user.",+        "operationId" : "updateUser",+        "produces" : [ "application/xml", "application/json" ],+        "parameters" : [ {+          "name" : "username",+          "in" : "path",+          "description" : "name that need to be deleted",+          "required" : true,+          "type" : "string"+        }, {+          "in" : "body",+          "name" : "body",+          "description" : "Updated user object",+          "required" : true,+          "schema" : {+            "$ref" : "#/definitions/User"+          }+        } ],+        "responses" : {+          "400" : {+            "description" : "Invalid user supplied"+          },+          "404" : {+            "description" : "User not found"+          }+        }+      },+      "delete" : {+        "tags" : [ "user" ],+        "summary" : "Delete user",+        "description" : "This can only be done by the logged in user.",+        "operationId" : "deleteUser",+        "produces" : [ "application/xml", "application/json" ],+        "parameters" : [ {+          "name" : "username",+          "in" : "path",+          "description" : "The name that needs to be deleted",+          "required" : true,+          "type" : "string"+        } ],+        "responses" : {+          "400" : {+            "description" : "Invalid username supplied"+          },+          "404" : {+            "description" : "User not found"+          }+        }+      }+    }+  },+  "securityDefinitions" : {+    "petstore_auth" : {+      "type" : "oauth2",+      "authorizationUrl" : "http://petstore.swagger.io/api/oauth/dialog",+      "flow" : "implicit",+      "scopes" : {+        "write:pets" : "modify pets in your account",+        "read:pets" : "read your pets"+      }+    },+    "api_key" : {+      "type" : "apiKey",+      "name" : "api_key",+      "in" : "header"+    }+  },+  "definitions" : {+    "Order" : {+      "type" : "object",+      "properties" : {+        "id" : {+          "type" : "integer",+          "format" : "int64"+        },+        "petId" : {+          "type" : "integer",+          "format" : "int64"+        },+        "quantity" : {+          "type" : "integer",+          "format" : "int32"+        },+        "shipDate" : {+          "type" : "string",+          "format" : "date-time"+        },+        "status" : {+          "type" : "string",+          "description" : "Order Status",+          "enum" : [ "placed", "approved", "delivered" ]+        },+        "complete" : {+          "type" : "boolean",+          "default" : false+        }+      },+      "title" : "Pet Order",+      "description" : "An order for a pets from the pet store",+      "xml" : {+        "name" : "Order"+      }+    },+    "Category" : {+      "type" : "object",+      "properties" : {+        "id" : {+          "type" : "integer",+          "format" : "int64"+        },+        "name" : {+          "type" : "string"+        }+      },+      "title" : "Pet catehgry",+      "description" : "A category for a pet",+      "xml" : {+        "name" : "Category"+      }+    },+    "User" : {+      "type" : "object",+      "properties" : {+        "id" : {+          "type" : "integer",+          "format" : "int64"+        },+        "username" : {+          "type" : "string"+        },+        "firstName" : {+          "type" : "string"+        },+        "lastName" : {+          "type" : "string"+        },+        "email" : {+          "type" : "string"+        },+        "password" : {+          "type" : "string"+        },+        "phone" : {+          "type" : "string"+        },+        "userStatus" : {+          "type" : "integer",+          "format" : "int32",+          "description" : "User Status"+        }+      },+      "title" : "a User",+      "description" : "A User who is purchasing from the pet store",+      "xml" : {+        "name" : "User"+      }+    },+    "Tag" : {+      "type" : "object",+      "properties" : {+        "id" : {+          "type" : "integer",+          "format" : "int64"+        },+        "name" : {+          "type" : "string"+        }+      },+      "title" : "Pet Tag",+      "description" : "A tag for a pet",+      "xml" : {+        "name" : "Tag"+      }+    },+    "Pet" : {+      "type" : "object",+      "required" : [ "name", "photoUrls" ],+      "properties" : {+        "id" : {+          "type" : "integer",+          "format" : "int64"+        },+        "category" : {+          "$ref" : "#/definitions/Category"+        },+        "name" : {+          "type" : "string",+          "example" : "doggie"+        },+        "photoUrls" : {+          "type" : "array",+          "xml" : {+            "name" : "photoUrl",+            "wrapped" : true+          },+          "items" : {+            "type" : "string"+          }+        },+        "tags" : {+          "type" : "array",+          "xml" : {+            "name" : "tag",+            "wrapped" : true+          },+          "items" : {+            "$ref" : "#/definitions/Tag"+          }+        },+        "status" : {+          "type" : "string",+          "description" : "pet status in the store",+          "enum" : [ "available", "pending", "sold" ]+        }+      },+      "title" : "a Pet",+      "description" : "A pet for sale in the pet store",+      "xml" : {+        "name" : "Pet"+      }+    },+    "ApiResponse" : {+      "type" : "object",+      "properties" : {+        "code" : {+          "type" : "integer",+          "format" : "int32"+        },+        "type" : {+          "type" : "string"+        },+        "message" : {+          "type" : "string"+        }+      },+      "title" : "An uploaded response",+      "description" : "Describes the result of uploading an image resource"+    }+  },+  "externalDocs" : {+    "description" : "Find out more about Swagger",+    "url" : "http://swagger.io"+  }+}
+ tests/ApproxEq.hs view
@@ -0,0 +1,81 @@+{-# LANGUAGE DefaultSignatures #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeOperators #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++module ApproxEq where++import Data.Text (Text)+import Data.Time.Clock+import Test.QuickCheck+import GHC.Generics as G++(==~)+  :: (ApproxEq a, Show a)+  => a -> a -> Property+a ==~ b = counterexample (show a ++ " !=~ " ++ show b) (a =~ b)++class GApproxEq f  where+  gApproxEq :: f a -> f a -> Bool++instance GApproxEq U1 where+  gApproxEq U1 U1 = True++instance (GApproxEq a, GApproxEq b) =>+         GApproxEq (a :+: b) where+  gApproxEq (L1 a) (L1 b) = gApproxEq a b+  gApproxEq (R1 a) (R1 b) = gApproxEq a b+  gApproxEq _ _ = False++instance (GApproxEq a, GApproxEq b) =>+         GApproxEq (a :*: b) where+  gApproxEq (a1 :*: b1) (a2 :*: b2) = gApproxEq a1 a2 && gApproxEq b1 b2++instance (ApproxEq a) =>+         GApproxEq (K1 i a) where+  gApproxEq (K1 a) (K1 b) = a =~ b++instance (GApproxEq f) =>+         GApproxEq (M1 i t f) where+  gApproxEq (M1 a) (M1 b) = gApproxEq a b++class ApproxEq a  where+  (=~) :: a -> a -> Bool+  default (=~) :: (Generic a, GApproxEq (Rep a)) => a -> a -> Bool+  a =~ b = gApproxEq (G.from a) (G.from b)++instance ApproxEq Text where+  (=~) = (==)++instance ApproxEq Char where+  (=~) = (==)++instance ApproxEq Bool where+  (=~) = (==)++instance ApproxEq Int where+  (=~) = (==)++instance ApproxEq Double where+  (=~) = (==)++instance ApproxEq a =>+         ApproxEq (Maybe a)++instance ApproxEq UTCTime where+  (=~) = (==)++instance ApproxEq a =>+         ApproxEq [a] where+  as =~ bs = and (zipWith (=~) as bs)++instance (ApproxEq l, ApproxEq r) =>+         ApproxEq (Either l r) where+  Left a =~ Left b = a =~ b+  Right a =~ Right b = a =~ b+  _ =~ _ = False++instance (ApproxEq l, ApproxEq r) =>+         ApproxEq (l, r) where+  (=~) (l1, r1) (l2, r2) = l1 =~ l2 && r1 =~ r2
+ tests/Instances.hs view
@@ -0,0 +1,100 @@+module Instances where++import Data.Text (Text, pack)+import Data.Char (isSpace)+import Data.List (sort)+import Data.Time.Calendar (Day(..))+import Data.Time.Clock (UTCTime(..), secondsToDiffTime)+import Test.QuickCheck+import qualified Data.HashMap.Strict as HM+import qualified Data.Set as Set++import ApproxEq+import SwaggerPetstore.Model++instance Arbitrary Text where+  arbitrary = pack <$> arbitrary++instance Arbitrary Day where+  arbitrary = ModifiedJulianDay . (2000 +) <$> arbitrary+  shrink = (ModifiedJulianDay <$>) . shrink . toModifiedJulianDay++instance Arbitrary UTCTime where+  arbitrary =+    UTCTime <$> arbitrary <*> (secondsToDiffTime <$> choose (0, 86401))++-- | Checks if a given list has no duplicates in _O(n log n)_.+hasNoDups+  :: (Ord a)+  => [a] -> Bool+hasNoDups = go Set.empty+  where+    go _ [] = True+    go s (x:xs)+      | s' <- Set.insert x s+      , Set.size s' > Set.size s = go s' xs+      | otherwise = False++instance ApproxEq Day where+  (=~) = (==)++-- * Models+ +instance Arbitrary ApiResponse where+  arbitrary =+    ApiResponse+    <$> arbitrary -- apiResponseCode :: Maybe Int+    <*> arbitrary -- apiResponseType :: Maybe Text+    <*> arbitrary -- apiResponseMessage :: Maybe Text+    ++instance Arbitrary Category where+  arbitrary =+    Category+    <$> arbitrary -- categoryId :: Maybe Integer+    <*> arbitrary -- categoryName :: Maybe Text+    ++instance Arbitrary Order where+  arbitrary =+    Order+    <$> arbitrary -- orderId :: Maybe Integer+    <*> arbitrary -- orderPetId :: Maybe Integer+    <*> arbitrary -- orderQuantity :: Maybe Int+    <*> arbitrary -- orderShipDate :: Maybe UTCTime+    <*> arbitrary -- orderStatus :: Maybe Text+    <*> arbitrary -- orderComplete :: Maybe Bool+    ++instance Arbitrary Pet where+  arbitrary =+    Pet+    <$> arbitrary -- petId :: Maybe Integer+    <*> arbitrary -- petCategory :: Maybe Category+    <*> arbitrary -- petName :: Text+    <*> arbitrary -- petPhotoUrls :: [Text]+    <*> arbitrary -- petTags :: Maybe [Tag]+    <*> arbitrary -- petStatus :: Maybe Text+    ++instance Arbitrary Tag where+  arbitrary =+    Tag+    <$> arbitrary -- tagId :: Maybe Integer+    <*> arbitrary -- tagName :: Maybe Text+    ++instance Arbitrary User where+  arbitrary =+    User+    <$> arbitrary -- userId :: Maybe Integer+    <*> arbitrary -- userUsername :: Maybe Text+    <*> arbitrary -- userFirstName :: Maybe Text+    <*> arbitrary -- userLastName :: Maybe Text+    <*> arbitrary -- userEmail :: Maybe Text+    <*> arbitrary -- userPassword :: Maybe Text+    <*> arbitrary -- userPhone :: Maybe Text+    <*> arbitrary -- userUserStatus :: Maybe Int+    ++
+ tests/PropMime.hs view
@@ -0,0 +1,50 @@+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ConstraintKinds #-}++module PropMime where++import Data.Aeson+import Data.Aeson.Types (parseEither)+import Data.Monoid ((<>))+import Data.Typeable (Proxy(..), typeOf, Typeable)+import qualified Data.ByteString.Lazy.Char8 as BL8+import Test.Hspec+import Test.QuickCheck+import Test.QuickCheck.Property+import Test.Hspec.QuickCheck (prop)++import SwaggerPetstore.MimeTypes++import ApproxEq++-- * Type Aliases++type ArbitraryMime mime a = ArbitraryRoundtrip (MimeUnrender mime) (MimeRender mime) a++type ArbitraryRoundtrip from to a = (from a, to a, Arbitrary' a)++type Arbitrary' a = (Arbitrary a, Show a, Typeable a)++-- * Mime++propMime+  :: forall a b mime.+     (ArbitraryMime mime a, Testable b)+  => String -> (a -> a -> b) -> mime -> Proxy a -> Spec+propMime eqDescr eq m _ =+  prop+    (show (typeOf (undefined :: a)) <> " " <> show (typeOf (undefined :: mime)) <> " roundtrip " <> eqDescr) $+  \(x :: a) ->+     let rendered = mimeRender' m x+         actual = mimeUnrender' m rendered+         expected = Right x+         failMsg =+           "ACTUAL: " <> show actual <> "\nRENDERED: " <> BL8.unpack rendered+     in counterexample failMsg $+        either reject property (eq <$> actual <*> expected)+  where+    reject = property . const rejected++propMimeEq :: (ArbitraryMime mime a, Eq a) => mime -> Proxy a -> Spec+propMimeEq = propMime "(EQ)" (==)
+ tests/Test.hs view
@@ -0,0 +1,28 @@+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE PartialTypeSignatures #-}++module Main where++import Data.Typeable (Proxy(..))+import Test.Hspec+import Test.Hspec.QuickCheck++import PropMime+import Instances ()++import SwaggerPetstore.Model+import SwaggerPetstore.MimeTypes++main :: IO ()+main =+  hspec $ modifyMaxSize (const 10) $+  do describe "JSON instances" $+       do propMimeEq MimeJSON (Proxy :: Proxy ApiResponse)+          propMimeEq MimeJSON (Proxy :: Proxy Category)+          propMimeEq MimeJSON (Proxy :: Proxy Order)+          propMimeEq MimeJSON (Proxy :: Proxy Pet)+          propMimeEq MimeJSON (Proxy :: Proxy Tag)+          propMimeEq MimeJSON (Proxy :: Proxy User)+