[haskell-http-client] add support for auth methods (#6622)

* add support for auth methods

* use newtypes for required params

* fix duplicate operationId issues

* prevent aliasing of vendorextension references in fromOperation

* add --fast to stack ci build
This commit is contained in:
Jon Schoning
2017-10-07 04:12:48 -05:00
committed by wing328
parent 0db4b32384
commit 5b32e886f4
47 changed files with 4923 additions and 4097 deletions

View File

@@ -49,17 +49,24 @@ main = do
env <- getEnvironment
let host = case lookup "HOST" env of
Just h -> BCL.pack h
_ -> "http://0.0.0.0/v2"
mgr <- NH.newManager NH.defaultManagerSettings
config0 <- S.withStdoutLogging =<< S.newConfig
let config = config0 { S.configHost = host }
let config =
-- configure host
case lookup "HOST" env of
Just h -> config0 { S.configHost = BCL.pack h }
_ -> config0 { S.configHost = "http://0.0.0.0/v2" }
-- each configured auth method is only applied to requests that specify them
`S.addAuthMethod` S.AuthBasicHttpBasicTest "username" "password"
`S.addAuthMethod` S.AuthApiKeyApiKey "secret-key"
`S.addAuthMethod` S.AuthApiKeyApiKeyQuery "secret-key"
`S.addAuthMethod` S.AuthOAuthPetstoreAuth "secret-key"
putStrLn "\n******** CONFIG ********"
putStrLn (show config)
mgr <- NH.newManager NH.defaultManagerSettings
hspec $ do
testPetOps mgr config
@@ -91,7 +98,7 @@ testPetOps mgr config =
Just pet@S.Pet {S.petId = Just petId} -> go (petId, pet)
_ -> pendingWith "no petId") $
it "getPetById" $ \(petId, pet) -> do
let getPetByIdRequest = S.getPetById petId
let getPetByIdRequest = S.getPetById (S.PetId petId)
getPetByIdRequestResult <- S.dispatchMime mgr config getPetByIdRequest S.MimeJSON
NH.responseStatus (S.mimeResultResponse getPetByIdRequestResult) `shouldBe` NH.status200
case S.mimeResult getPetByIdRequestResult of
@@ -99,7 +106,7 @@ testPetOps mgr config =
Left (S.MimeError e _) -> assertFailure e
it "findPetsByStatus" $ do
let findPetsByStatusRequest = S.findPetsByStatus ["available","pending","sold"]
let findPetsByStatusRequest = S.findPetsByStatus (S.Status ["available","pending","sold"])
findPetsByStatusResult <- S.dispatchMime mgr config findPetsByStatusRequest S.MimeJSON
NH.responseStatus (S.mimeResultResponse findPetsByStatusResult) `shouldBe` NH.status200
case S.mimeResult findPetsByStatusResult of
@@ -107,7 +114,7 @@ testPetOps mgr config =
Left (S.MimeError e _) -> assertFailure e
it "findPetsByTags" $ do
let findPetsByTagsRequest = S.findPetsByTags ["name","tag1"]
let findPetsByTagsRequest = S.findPetsByTags (S.Tags ["name","tag1"])
findPetsByTagsResult <- S.dispatchMime mgr config findPetsByTagsRequest S.MimeJSON
NH.responseStatus (S.mimeResultResponse findPetsByTagsResult) `shouldBe` NH.status200
case S.mimeResult findPetsByTagsResult of
@@ -129,9 +136,9 @@ testPetOps mgr config =
it "updatePetWithFormRequest" $ do
readIORef _pet >>= \case
Just S.Pet {S.petId = Just petId} -> do
let updatePetWithFormRequest = S.updatePetWithForm S.MimeFormUrlEncoded petId
let updatePetWithFormRequest = S.updatePetWithForm S.MimeFormUrlEncoded (S.PetId petId)
`S.applyOptionalParam` S.Name2 "petName"
`S.applyOptionalParam` S.Status "pending"
`S.applyOptionalParam` S.StatusText "pending"
updatePetWithFormResponse <- S.dispatchLbs mgr config updatePetWithFormRequest S.MimeJSON
NH.responseStatus updatePetWithFormResponse `shouldBe` NH.status200
_ -> pendingWith "no pet"
@@ -141,7 +148,7 @@ testPetOps mgr config =
Just pet@S.Pet {S.petId = Just petId} -> go petId
_ -> pendingWith "no petId") $
it "uploadFile" $ \petId -> do
let uploadFileRequest = S.uploadFile S.MimeMultipartFormData petId
let uploadFileRequest = S.uploadFile S.MimeMultipartFormData (S.PetId petId)
`S.applyOptionalParam` S.File "package.yaml"
`S.applyOptionalParam` S.AdditionalMetadata "a package.yaml file"
uploadFileRequestResult <- S.dispatchMime mgr config uploadFileRequest S.MimeJSON
@@ -155,7 +162,7 @@ testPetOps mgr config =
Just pet@S.Pet {S.petId = Just petId} -> go petId
_ -> pendingWith "no petId") $
it "deletePet" $ \petId -> do
let deletePetRequest = S.deletePet petId
let deletePetRequest = S.deletePet (S.PetId petId)
`S.applyOptionalParam` S.ApiKey "api key"
deletePetResponse <- S.dispatchLbs mgr config deletePetRequest S.MimeJSON
NH.responseStatus deletePetResponse `shouldBe` NH.status200
@@ -200,7 +207,7 @@ testStoreOps mgr config = do
Just order@S.Order {S.orderId = Just orderId} -> go (orderId, order)
_ -> pendingWith "no orderId") $
it "getOrderById" $ \(orderId, order) -> do
let getOrderByIdRequest = S.getOrderById orderId
let getOrderByIdRequest = S.getOrderById (S.OrderId orderId)
getOrderByIdRequestResult <- S.dispatchMime mgr config getOrderByIdRequest S.MimeJSON
NH.responseStatus (S.mimeResultResponse getOrderByIdRequestResult) `shouldBe` NH.status200
case S.mimeResult getOrderByIdRequestResult of
@@ -212,7 +219,7 @@ testStoreOps mgr config = do
Just S.Order {S.orderId = Just orderId} -> go (T.pack (show orderId))
_ -> pendingWith "no orderId") $
it "deleteOrder" $ \orderId -> do
let deleteOrderRequest = S.deleteOrder orderId
let deleteOrderRequest = S.deleteOrder (S.OrderIdText orderId)
deleteOrderResult <- S.dispatchLbs mgr config deleteOrderRequest S.MimeJSON
NH.responseStatus deleteOrderResult `shouldBe` NH.status200
@@ -249,19 +256,19 @@ testUserOps mgr config = do
before (pure _users) $
it "createUsersWithArrayInput" $ \users -> do
let createUsersWithArrayInputRequest = S.createUsersWithArrayInput S.MimeJSON users
let createUsersWithArrayInputRequest = S.createUsersWithArrayInput S.MimeJSON (S.Body users)
createUsersWithArrayInputResult <- S.dispatchLbs mgr config createUsersWithArrayInputRequest S.MimeNoContent
NH.responseStatus createUsersWithArrayInputResult `shouldBe` NH.status200
before (pure _users) $
it "createUsersWithListInput" $ \users -> do
let createUsersWithListInputRequest = S.createUsersWithListInput S.MimeJSON users
let createUsersWithListInputRequest = S.createUsersWithListInput S.MimeJSON (S.Body users)
createUsersWithListInputResult <- S.dispatchLbs mgr config createUsersWithListInputRequest S.MimeNoContent
NH.responseStatus createUsersWithListInputResult `shouldBe` NH.status200
before (pure (_username, _user)) $
it "getUserByName" $ \(username, user) -> do
let getUserByNameRequest = S.getUserByName username
let getUserByNameRequest = S.getUserByName (S.Username username)
getUserByNameResult <- S.dispatchMime mgr config getUserByNameRequest S.MimeJSON
NH.responseStatus (S.mimeResultResponse getUserByNameResult) `shouldBe` NH.status200
case S.mimeResult getUserByNameResult of
@@ -270,13 +277,13 @@ testUserOps mgr config = do
before (pure (_username, _password)) $
it "loginUser" $ \(username, password) -> do
let loginUserRequest = S.loginUser username password
let loginUserRequest = S.loginUser (S.Username username) (S.Password password)
loginUserResult <- S.dispatchLbs mgr config loginUserRequest S.MimeJSON
NH.responseStatus loginUserResult `shouldBe` NH.status200
before (pure (_username, _user)) $
it "updateUser" $ \(username, user) -> do
let updateUserRequest = S.updateUser S.MimeJSON username user
let updateUserRequest = S.updateUser S.MimeJSON (S.Username username) user
updateUserResult <- S.dispatchLbs mgr config updateUserRequest S.MimeJSON
NH.responseStatus updateUserResult `shouldBe` NH.status200
@@ -286,6 +293,6 @@ testUserOps mgr config = do
before (pure _username) $
it "deleteUser" $ \username -> do
let deleteUserRequest = S.deleteUser username
let deleteUserRequest = S.deleteUser (S.Username username)
deleteUserResult <- S.dispatchLbs mgr config deleteUserRequest S.MimeJSON
NH.responseStatus deleteUserResult `shouldBe` NH.status200