module SwaggerPetstore.API where
import SwaggerPetstore.Model as M
import SwaggerPetstore.MimeTypes
import SwaggerPetstore.Lens
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 qualified Lens.Micro as L
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
addPet
:: (Consumes AddPet contentType, MimeRender contentType Pet)
=> contentType
-> Pet
-> SwaggerPetstoreRequest AddPet contentType res
addPet _ body =
_mkRequest "POST" ["/pet"]
`setBodyParam` body
data AddPet
instance HasBodyParam AddPet Pet
instance Consumes AddPet MimeJSON
instance Consumes AddPet MimeXML
instance Produces AddPet MimeXML
instance Produces AddPet MimeJSON
deletePet
:: Integer
-> 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)
instance Produces DeletePet MimeXML
instance Produces DeletePet MimeJSON
findPetsByStatus
:: [Text]
-> SwaggerPetstoreRequest FindPetsByStatus MimeNoContent [Pet]
findPetsByStatus status =
_mkRequest "GET" ["/pet/findByStatus"]
`_setQuery` toQueryColl CommaSeparated ("status", Just status)
data FindPetsByStatus
instance Produces FindPetsByStatus MimeXML
instance Produces FindPetsByStatus MimeJSON
findPetsByTags
:: [Text]
-> SwaggerPetstoreRequest FindPetsByTags MimeNoContent [Pet]
findPetsByTags tags =
_mkRequest "GET" ["/pet/findByTags"]
`_setQuery` toQueryColl CommaSeparated ("tags", Just tags)
data FindPetsByTags
instance Produces FindPetsByTags MimeXML
instance Produces FindPetsByTags MimeJSON
getPetById
:: Integer
-> SwaggerPetstoreRequest GetPetById MimeNoContent Pet
getPetById petId =
_mkRequest "GET" ["/pet/",toPath petId]
data GetPetById
instance Produces GetPetById MimeXML
instance Produces GetPetById MimeJSON
updatePet
:: (Consumes UpdatePet contentType, MimeRender contentType Pet)
=> contentType
-> Pet
-> SwaggerPetstoreRequest UpdatePet contentType res
updatePet _ body =
_mkRequest "PUT" ["/pet"]
`setBodyParam` body
data UpdatePet
instance HasBodyParam UpdatePet Pet
instance Consumes UpdatePet MimeJSON
instance Consumes UpdatePet MimeXML
instance Produces UpdatePet MimeXML
instance Produces UpdatePet MimeJSON
updatePetWithForm
:: (Consumes UpdatePetWithForm contentType)
=> contentType
-> Integer
-> SwaggerPetstoreRequest UpdatePetWithForm contentType res
updatePetWithForm _ petId =
_mkRequest "POST" ["/pet/",toPath petId]
data UpdatePetWithForm
instance HasOptionalParam UpdatePetWithForm Name where
applyOptionalParam req (Name xs) =
req `_addForm` toForm ("name", xs)
instance HasOptionalParam UpdatePetWithForm Status where
applyOptionalParam req (Status xs) =
req `_addForm` toForm ("status", xs)
instance Consumes UpdatePetWithForm MimeFormUrlEncoded
instance Produces UpdatePetWithForm MimeXML
instance Produces UpdatePetWithForm MimeJSON
uploadFile
:: (Consumes UploadFile contentType)
=> contentType
-> Integer
-> SwaggerPetstoreRequest UploadFile contentType ApiResponse
uploadFile _ petId =
_mkRequest "POST" ["/pet/",toPath petId,"/uploadImage"]
data UploadFile
instance HasOptionalParam UploadFile AdditionalMetadata where
applyOptionalParam req (AdditionalMetadata xs) =
req `_addMultiFormPart` NH.partLBS "additionalMetadata" (mimeRender' MimeMultipartFormData xs)
instance HasOptionalParam UploadFile File where
applyOptionalParam req (File xs) =
req `_addMultiFormPart` NH.partFileSource "file" xs
instance Consumes UploadFile MimeMultipartFormData
instance Produces UploadFile MimeJSON
deleteOrder
:: Text
-> SwaggerPetstoreRequest DeleteOrder MimeNoContent res
deleteOrder orderId =
_mkRequest "DELETE" ["/store/order/",toPath orderId]
data DeleteOrder
instance Produces DeleteOrder MimeXML
instance Produces DeleteOrder MimeJSON
getInventory
:: SwaggerPetstoreRequest GetInventory MimeNoContent (Map.Map String Int)
getInventory =
_mkRequest "GET" ["/store/inventory"]
data GetInventory
instance Produces GetInventory MimeJSON
getOrderById
:: Integer
-> SwaggerPetstoreRequest GetOrderById MimeNoContent Order
getOrderById orderId =
_mkRequest "GET" ["/store/order/",toPath orderId]
data GetOrderById
instance Produces GetOrderById MimeXML
instance Produces GetOrderById MimeJSON
placeOrder
:: (Consumes PlaceOrder contentType, MimeRender contentType Order)
=> contentType
-> Order
-> SwaggerPetstoreRequest PlaceOrder contentType Order
placeOrder _ body =
_mkRequest "POST" ["/store/order"]
`setBodyParam` body
data PlaceOrder
instance HasBodyParam PlaceOrder Order
instance Produces PlaceOrder MimeXML
instance Produces PlaceOrder MimeJSON
createUser
:: (Consumes CreateUser contentType, MimeRender contentType User)
=> contentType
-> User
-> SwaggerPetstoreRequest CreateUser contentType res
createUser _ body =
_mkRequest "POST" ["/user"]
`setBodyParam` body
data CreateUser
instance HasBodyParam CreateUser User
instance Produces CreateUser MimeXML
instance Produces CreateUser MimeJSON
createUsersWithArrayInput
:: (Consumes CreateUsersWithArrayInput contentType, MimeRender contentType [User])
=> contentType
-> [User]
-> SwaggerPetstoreRequest CreateUsersWithArrayInput contentType res
createUsersWithArrayInput _ body =
_mkRequest "POST" ["/user/createWithArray"]
`setBodyParam` body
data CreateUsersWithArrayInput
instance HasBodyParam CreateUsersWithArrayInput [User]
instance Produces CreateUsersWithArrayInput MimeXML
instance Produces CreateUsersWithArrayInput MimeJSON
createUsersWithListInput
:: (Consumes CreateUsersWithListInput contentType, MimeRender contentType [User])
=> contentType
-> [User]
-> SwaggerPetstoreRequest CreateUsersWithListInput contentType res
createUsersWithListInput _ body =
_mkRequest "POST" ["/user/createWithList"]
`setBodyParam` body
data CreateUsersWithListInput
instance HasBodyParam CreateUsersWithListInput [User]
instance Produces CreateUsersWithListInput MimeXML
instance Produces CreateUsersWithListInput MimeJSON
deleteUser
:: Text
-> SwaggerPetstoreRequest DeleteUser MimeNoContent res
deleteUser username =
_mkRequest "DELETE" ["/user/",toPath username]
data DeleteUser
instance Produces DeleteUser MimeXML
instance Produces DeleteUser MimeJSON
getUserByName
:: Text
-> SwaggerPetstoreRequest GetUserByName MimeNoContent User
getUserByName username =
_mkRequest "GET" ["/user/",toPath username]
data GetUserByName
instance Produces GetUserByName MimeXML
instance Produces GetUserByName MimeJSON
loginUser
:: Text
-> Text
-> SwaggerPetstoreRequest LoginUser MimeNoContent Text
loginUser username password =
_mkRequest "GET" ["/user/login"]
`_setQuery` toQuery ("username", Just username)
`_setQuery` toQuery ("password", Just password)
data LoginUser
instance Produces LoginUser MimeXML
instance Produces LoginUser MimeJSON
logoutUser
:: SwaggerPetstoreRequest LogoutUser MimeNoContent res
logoutUser =
_mkRequest "GET" ["/user/logout"]
data LogoutUser
instance Produces LogoutUser MimeXML
instance Produces LogoutUser MimeJSON
updateUser
:: (Consumes UpdateUser contentType, MimeRender contentType User)
=> contentType
-> Text
-> User
-> SwaggerPetstoreRequest UpdateUser contentType res
updateUser _ username body =
_mkRequest "PUT" ["/user/",toPath username]
`setBodyParam` body
data UpdateUser
instance HasBodyParam UpdateUser User
instance Produces UpdateUser MimeXML
instance Produces UpdateUser MimeJSON
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
class HasOptionalParam req param where
applyOptionalParam :: SwaggerPetstoreRequest req contentType res -> param -> SwaggerPetstoreRequest req contentType res
applyOptionalParam = (-&-)
(-&-) :: SwaggerPetstoreRequest req contentType res -> param -> SwaggerPetstoreRequest req contentType res
(-&-) = applyOptionalParam
infixl 2 -&-
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)
data SwaggerPetstoreRequest req contentType res = SwaggerPetstoreRequest
{ rMethod :: NH.Method
, rUrlPath :: [BCL.ByteString]
, rParams :: Params
}
deriving (P.Show)
rMethodL :: Lens_' (SwaggerPetstoreRequest req contentType res) NH.Method
rMethodL f SwaggerPetstoreRequest{..} = (\rMethod -> SwaggerPetstoreRequest { rMethod, ..} ) <$> f rMethod
rUrlPathL :: Lens_' (SwaggerPetstoreRequest req contentType res) [BCL.ByteString]
rUrlPathL f SwaggerPetstoreRequest{..} = (\rUrlPath -> SwaggerPetstoreRequest { rUrlPath, ..} ) <$> f rUrlPath
rParamsL :: Lens_' (SwaggerPetstoreRequest req contentType res) Params
rParamsL f SwaggerPetstoreRequest{..} = (\rParams -> SwaggerPetstoreRequest { rParams, ..} ) <$> f rParams
data Params = Params
{ paramsQuery :: NH.Query
, paramsHeaders :: NH.RequestHeaders
, paramsBody :: ParamBody
}
deriving (P.Show)
paramsQueryL :: Lens_' Params NH.Query
paramsQueryL f Params{..} = (\paramsQuery -> Params { paramsQuery, ..} ) <$> f paramsQuery
paramsHeadersL :: Lens_' Params NH.RequestHeaders
paramsHeadersL f Params{..} = (\paramsHeaders -> Params { paramsHeaders, ..} ) <$> f paramsHeaders
paramsBodyL :: Lens_' Params ParamBody
paramsBodyL f Params{..} = (\paramsBody -> Params { paramsBody, ..} ) <$> f paramsBody
data ParamBody
= ParamBodyNone
| ParamBodyB B.ByteString
| ParamBodyBL BL.ByteString
| ParamBodyFormUrlEncoded WH.Form
| ParamBodyMultipartFormData [NH.Part]
deriving (P.Show)
_mkRequest :: NH.Method
-> [BCL.ByteString]
-> SwaggerPetstoreRequest req contentType res
_mkRequest m u = SwaggerPetstoreRequest m u _mkParams
_mkParams :: Params
_mkParams = Params [] [] ParamBodyNone
setHeader :: SwaggerPetstoreRequest req contentType res -> [NH.Header] -> SwaggerPetstoreRequest req contentType res
setHeader req header =
req `removeHeader` P.fmap P.fst header &
L.over (rParamsL . paramsHeadersL) (header P.++)
removeHeader :: SwaggerPetstoreRequest req contentType res -> [NH.HeaderName] -> SwaggerPetstoreRequest req contentType res
removeHeader req header =
req &
L.over
(rParamsL . paramsHeadersL)
(P.filter (\h -> cifst h `P.notElem` P.fmap CI.mk header))
where
cifst = CI.mk . P.fst
_setContentTypeHeader :: forall req contentType res. MimeType contentType => SwaggerPetstoreRequest req contentType res -> SwaggerPetstoreRequest req contentType res
_setContentTypeHeader req =
case mimeType (P.Proxy :: P.Proxy contentType) of
Just m -> req `setHeader` [("content-type", BC.pack $ P.show m)]
Nothing -> req `removeHeader` ["content-type"]
_setAcceptHeader :: forall req contentType res accept. MimeType accept => SwaggerPetstoreRequest req contentType res -> accept -> SwaggerPetstoreRequest req contentType res
_setAcceptHeader req accept =
case mimeType' accept of
Just m -> req `setHeader` [("accept", BC.pack $ P.show m)]
Nothing -> req `removeHeader` ["accept"]
_setQuery :: SwaggerPetstoreRequest req contentType res -> [NH.QueryItem] -> SwaggerPetstoreRequest req contentType res
_setQuery req query =
req &
L.over
(rParamsL . paramsQueryL)
((query P.++) . P.filter (\q -> cifst q `P.notElem` P.fmap cifst query))
where
cifst = CI.mk . P.fst
_addForm :: SwaggerPetstoreRequest req contentType res -> WH.Form -> SwaggerPetstoreRequest req contentType res
_addForm req newform =
let form = case paramsBody (rParams req) of
ParamBodyFormUrlEncoded _form -> _form
_ -> mempty
in req & L.set (rParamsL . paramsBodyL) (ParamBodyFormUrlEncoded (newform <> form))
_addMultiFormPart :: SwaggerPetstoreRequest req contentType res -> NH.Part -> SwaggerPetstoreRequest req contentType res
_addMultiFormPart req newpart =
let parts = case paramsBody (rParams req) of
ParamBodyMultipartFormData _parts -> _parts
_ -> []
in req & L.set (rParamsL . paramsBodyL) (ParamBodyMultipartFormData (newpart : parts))
_setBodyBS :: SwaggerPetstoreRequest req contentType res -> B.ByteString -> SwaggerPetstoreRequest req contentType res
_setBodyBS req body =
req & L.set (rParamsL . paramsBodyL) (ParamBodyB body)
_setBodyLBS :: SwaggerPetstoreRequest req contentType res -> BL.ByteString -> SwaggerPetstoreRequest req contentType res
_setBodyLBS req body =
req & L.set (rParamsL . paramsBodyL) (ParamBodyBL body)
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
data CollectionFormat
= CommaSeparated
| SpaceSeparated
| TabSeparated
| PipeSeparated
| MultiParamArray
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
_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