forked from loafle/openapi-generator-original
[haskell-http-client] refactor & promote accept mimetype to request; simplify templates (#6866)
* add AuthMethodException * rename cli prop * simplify templates
This commit is contained in:
Jon Schoning
wing328
@@ -59,17 +59,16 @@ main = do
|
||||
runPet :: NH.Manager -> S.SwaggerPetstoreConfig -> IO ()
|
||||
runPet mgr config = do
|
||||
|
||||
-- create the request for addPet, encoded with content-type application/json
|
||||
let addPetRequest = S.addPet S.MimeJSON (S.mkPet "name" ["url1", "url2"])
|
||||
-- create the request for addPet, encoded with content-type application/json, with accept header application/json
|
||||
let addPetRequest = S.addPet (S.ContentType S.MimeJSON) (S.Accept S.MimeJSON) (S.mkPet "name" ["url1", "url2"])
|
||||
|
||||
-- send the rquest with accept header application/json
|
||||
-- dispatchLbs simply returns the raw Network.HTTP.Client.Response ByteString
|
||||
addPetResponse <- S.dispatchLbs mgr config addPetRequest S.MimeJSON
|
||||
addPetResponse <- S.dispatchLbs mgr config addPetRequest
|
||||
|
||||
-- the Consumes & Produces typeclasses control which 'content-type'
|
||||
-- and 'accept' encodings are allowed for each operation
|
||||
-- -- No instance for (S.Produces S.AddPet S.MimePlainText)
|
||||
-- addPetResponse <- S.dispatchLbs mgr config addPetRequest S.MimePlainText
|
||||
-- addPetResponse <- S.dispatchLbs mgr config addPetRequest
|
||||
|
||||
-- inspect the AddPet type to see typeclasses indicating wihch
|
||||
-- content-type and accept types (mimeTypes) are valid
|
||||
@@ -94,33 +93,34 @@ runPet mgr config = do
|
||||
Right pet@S.Pet { S.petId = Just pid } -> do
|
||||
|
||||
-- create the request for getPetById
|
||||
let getPetByIdRequest = S.getPetById (S.PetId pid)
|
||||
let getPetByIdRequest = S.getPetById (S.Accept S.MimeJSON) (S.PetId pid)
|
||||
|
||||
-- dispatchMime returns MimeResult, which includes the
|
||||
-- expected decoded model object 'Pet', or a parse failure
|
||||
getPetByIdRequestResult <- S.dispatchMime mgr config getPetByIdRequest S.MimeJSON
|
||||
getPetByIdRequestResult <- S.dispatchMime mgr config getPetByIdRequest
|
||||
case S.mimeResult getPetByIdRequestResult of
|
||||
Left (S.MimeError _ _) -> return () -- parse error, already displayed in the log
|
||||
Right r -> putStrLn $ "getPetById: found pet: " <> show r -- display 'Pet' model object, r
|
||||
|
||||
-- findPetsByStatus
|
||||
let findPetsByStatusRequest = S.findPetsByStatus (S.Status [ S.E'Status2'Available
|
||||
let findPetsByStatusRequest = S.findPetsByStatus (S.Accept S.MimeJSON)
|
||||
(S.Status [ S.E'Status2'Available
|
||||
, S.E'Status2'Pending
|
||||
, S.E'Status2'Sold])
|
||||
findPetsByStatusResult <- S.dispatchMime mgr config findPetsByStatusRequest S.MimeJSON
|
||||
findPetsByStatusResult <- S.dispatchMime mgr config findPetsByStatusRequest
|
||||
mapM_ (\r -> putStrLn $ "findPetsByStatus: found " <> (show . length) r <> " pets") findPetsByStatusResult
|
||||
|
||||
-- findPetsByTags
|
||||
let findPetsByTagsRequest = S.findPetsByTags (S.Tags ["name","tag1"])
|
||||
findPetsByTagsResult <- S.dispatchMime mgr config findPetsByTagsRequest S.MimeJSON
|
||||
let findPetsByTagsRequest = S.findPetsByTags (S.Accept S.MimeJSON) (S.Tags ["name","tag1"])
|
||||
findPetsByTagsResult <- S.dispatchMime mgr config findPetsByTagsRequest
|
||||
mapM_ (\r -> putStrLn $ "findPetsByTags: found " <> (show . length) r <> " pets") findPetsByTagsResult
|
||||
|
||||
-- updatePet
|
||||
let updatePetRequest = S.updatePet S.MimeJSON $ pet
|
||||
let updatePetRequest = S.updatePet (S.ContentType S.MimeJSON) (S.Accept S.MimeXML) $ pet
|
||||
{ S.petStatus = Just S.E'Status2'Available
|
||||
, S.petCategory = Just (S.Category (Just 3) (Just "catname"))
|
||||
}
|
||||
_ <- S.dispatchLbs mgr config updatePetRequest S.MimeXML
|
||||
_ <- S.dispatchLbs mgr config updatePetRequest
|
||||
|
||||
-- requred parameters are included as function arguments, optional parameters are included with applyOptionalParam
|
||||
-- inspect the UpdatePetWithForm type to see typeclasses indicating optional paramteters (:i S.UpdatePetWithForm)
|
||||
@@ -128,22 +128,22 @@ runPet mgr config = do
|
||||
-- -- Defined in ‘SwaggerPetstore.API’
|
||||
-- instance S.HasOptionalParam S.UpdatePetWithForm S.Status
|
||||
-- -- Defined in ‘SwaggerPetstore.API’
|
||||
let updatePetWithFormRequest = S.updatePetWithForm S.MimeFormUrlEncoded (S.PetId pid)
|
||||
let updatePetWithFormRequest = S.updatePetWithForm (S.ContentType S.MimeFormUrlEncoded) (S.Accept S.MimeJSON) (S.PetId pid)
|
||||
`S.applyOptionalParam` S.Name2 "petName"
|
||||
`S.applyOptionalParam` S.StatusText "pending"
|
||||
_ <- S.dispatchLbs mgr config updatePetWithFormRequest S.MimeJSON
|
||||
_ <- S.dispatchLbs mgr config updatePetWithFormRequest
|
||||
|
||||
-- multipart/form-data file uploads are just a different content-type
|
||||
let uploadFileRequest = S.uploadFile S.MimeMultipartFormData (S.PetId pid)
|
||||
let uploadFileRequest = S.uploadFile (S.ContentType S.MimeMultipartFormData) (S.Accept S.MimeJSON) (S.PetId pid)
|
||||
`S.applyOptionalParam` S.File "package.yaml" -- the file contents of the path are read when dispatched
|
||||
`S.applyOptionalParam` S.AdditionalMetadata "a package.yaml file"
|
||||
uploadFileRequestResult <- S.dispatchMime mgr config uploadFileRequest S.MimeJSON
|
||||
uploadFileRequestResult <- S.dispatchMime mgr config uploadFileRequest
|
||||
mapM_ (\r -> putStrLn $ "uploadFile: " <> show r) uploadFileRequestResult
|
||||
|
||||
-- deletePet
|
||||
let deletePetRequest = S.deletePet (S.PetId pid)
|
||||
let deletePetRequest = S.deletePet (S.Accept S.MimeJSON) (S.PetId pid)
|
||||
`S.applyOptionalParam` S.ApiKey "api key"
|
||||
_ <- S.dispatchLbs mgr config deletePetRequest S.MimeJSON
|
||||
_ <- S.dispatchLbs mgr config deletePetRequest
|
||||
|
||||
return ()
|
||||
|
||||
@@ -163,27 +163,27 @@ runStore :: NH.Manager -> S.SwaggerPetstoreConfig -> IO ()
|
||||
runStore mgr config = do
|
||||
|
||||
-- we can set arbitrary headers with setHeader
|
||||
let getInventoryRequest = S.getInventory
|
||||
let getInventoryRequest = S.getInventory (S.Accept S.MimeJSON)
|
||||
`S.setHeader` [("random-header","random-value")]
|
||||
getInventoryRequestRequestResult <- S.dispatchMime mgr config getInventoryRequest S.MimeJSON
|
||||
getInventoryRequestRequestResult <- S.dispatchMime mgr config getInventoryRequest
|
||||
mapM_ (\r -> putStrLn $ "getInventoryRequest: found " <> (show . length) r <> " results") getInventoryRequestRequestResult
|
||||
|
||||
-- placeOrder
|
||||
now <- TI.getCurrentTime
|
||||
let placeOrderRequest = S.placeOrder S.MimeJSON (S.mkOrder { S.orderId = Just 21, S.orderQuantity = Just 210, S.orderShipDate = Just (S.DateTime now)})
|
||||
placeOrderResult <- S.dispatchMime mgr config placeOrderRequest S.MimeJSON
|
||||
let placeOrderRequest = S.placeOrder (S.ContentType S.MimeJSON) (S.Accept S.MimeJSON) (S.mkOrder { S.orderId = Just 21, S.orderQuantity = Just 210, S.orderShipDate = Just (S.DateTime now)})
|
||||
placeOrderResult <- S.dispatchMime mgr config placeOrderRequest
|
||||
mapM_ (\r -> putStrLn $ "placeOrderResult: " <> show r) placeOrderResult
|
||||
|
||||
let orderId = maybe 10 id $ either (const Nothing) (S.orderId) (S.mimeResult placeOrderResult)
|
||||
|
||||
-- getOrderByid
|
||||
let getOrderByIdRequest = S.getOrderById (S.OrderId orderId)
|
||||
getOrderByIdRequestResult <- S.dispatchMime mgr config getOrderByIdRequest S.MimeJSON
|
||||
let getOrderByIdRequest = S.getOrderById (S.Accept S.MimeJSON) (S.OrderId orderId)
|
||||
getOrderByIdRequestResult <- S.dispatchMime mgr config getOrderByIdRequest
|
||||
mapM_ (\r -> putStrLn $ "getOrderById: found order: " <> show r) getOrderByIdRequestResult
|
||||
|
||||
-- deleteOrder
|
||||
let deleteOrderRequest = S.deleteOrder (S.OrderIdText "21")
|
||||
_ <- S.dispatchLbs mgr config deleteOrderRequest S.MimeJSON
|
||||
let deleteOrderRequest = S.deleteOrder (S.Accept S.MimeJSON) (S.OrderIdText "21")
|
||||
_ <- S.dispatchLbs mgr config deleteOrderRequest
|
||||
|
||||
return ()
|
||||
|
||||
@@ -209,37 +209,37 @@ runUser mgr config = do
|
||||
let username = "hsusername"
|
||||
-- createUser
|
||||
let user = S.mkUser { S.userId = Just 21, S.userUsername = Just username }
|
||||
let createUserRequest = S.createUser S.MimeJSON user
|
||||
_ <- S.dispatchLbs mgr config createUserRequest S.MimeJSON
|
||||
let createUserRequest = S.createUser (S.ContentType S.MimeJSON) (S.Accept S.MimeJSON) user
|
||||
_ <- S.dispatchLbs mgr config createUserRequest
|
||||
|
||||
-- can use lenses (model record names are appended L) to view or modify records
|
||||
let users = take 8 $ drop 1 $ iterate (L.over S.userUsernameL (fmap (<> "*")) . L.over S.userIdL (fmap (+ 1))) user
|
||||
let createUsersWithArrayInputRequest = S.createUsersWithArrayInput S.MimeJSON (S.Body users)
|
||||
_ <- S.dispatchLbs mgr config createUsersWithArrayInputRequest S.MimeNoContent
|
||||
let createUsersWithArrayInputRequest = S.createUsersWithArrayInput (S.ContentType S.MimeJSON) (S.Accept S.MimeNoContent) (S.Body users)
|
||||
_ <- S.dispatchLbs mgr config createUsersWithArrayInputRequest
|
||||
|
||||
-- createUsersWithArrayInput
|
||||
let createUsersWithListInputRequest = S.createUsersWithListInput S.MimeJSON (S.Body users)
|
||||
_ <- S.dispatchLbs mgr config createUsersWithListInputRequest S.MimeNoContent
|
||||
let createUsersWithListInputRequest = S.createUsersWithListInput (S.ContentType S.MimeJSON) (S.Accept S.MimeNoContent) (S.Body users)
|
||||
_ <- S.dispatchLbs mgr config createUsersWithListInputRequest
|
||||
|
||||
-- getUserByName
|
||||
let getUserByNameRequest = S.getUserByName (S.Username username)
|
||||
getUserByNameResult <- S.dispatchMime mgr config getUserByNameRequest S.MimeJSON
|
||||
let getUserByNameRequest = S.getUserByName (S.Accept S.MimeJSON) (S.Username username)
|
||||
getUserByNameResult <- S.dispatchMime mgr config getUserByNameRequest
|
||||
mapM_ (\r -> putStrLn $ "getUserByName: found user: " <> show r) getUserByNameResult
|
||||
|
||||
-- loginUser
|
||||
let loginUserRequest = S.loginUser (S.Username username) (S.Password "password1")
|
||||
loginUserResult <- S.dispatchLbs mgr config loginUserRequest S.MimeJSON
|
||||
let loginUserRequest = S.loginUser (S.Accept S.MimeJSON) (S.Username username) (S.Password "password1")
|
||||
loginUserResult <- S.dispatchLbs mgr config loginUserRequest
|
||||
BCL.putStrLn $ "loginUser: " <> (NH.responseBody loginUserResult)
|
||||
|
||||
-- updateUser
|
||||
let updateUserRequest = S.updateUser S.MimeJSON (S.Username username) (user { S.userEmail = Just "xyz@example.com" })
|
||||
_ <- S.dispatchLbs mgr config updateUserRequest S.MimeJSON
|
||||
let updateUserRequest = S.updateUser (S.ContentType S.MimeJSON) (S.Accept S.MimeJSON) (S.Username username) (user { S.userEmail = Just "xyz@example.com" })
|
||||
_ <- S.dispatchLbs mgr config updateUserRequest
|
||||
|
||||
-- logoutUser
|
||||
_ <- S.dispatchLbs mgr config S.logoutUser S.MimeJSON
|
||||
_ <- S.dispatchLbs mgr config (S.logoutUser (S.Accept S.MimeJSON))
|
||||
|
||||
-- deleteUser
|
||||
let deleteUserRequest = S.deleteUser (S.Username username)
|
||||
_ <- S.dispatchLbs mgr config deleteUserRequest S.MimeJSON
|
||||
let deleteUserRequest = S.deleteUser (S.Accept S.MimeJSON) (S.Username username)
|
||||
_ <- S.dispatchLbs mgr config deleteUserRequest
|
||||
|
||||
return ()
|
||||
|
||||
Reference in New Issue
Block a user