add haskell-http-client-generator (#6429)

2025-12-04 14:56:14 +00:00 · 2017-09-05 11:33:48 -05:00
parent 4eab5406c5
commit c7d145a4ba
117 changed files with 10499 additions and 0 deletions
--- a/samples/client/petstore/haskell-http-client/tests-integration/README.md
+++ b/samples/client/petstore/haskell-http-client/tests-integration/README.md
@@ -0,0 +1,54 @@
+# swagger-petstore-tests-integration
+
+This contains integration tests for the haskell http-client swagger-petstore api client library.
+
+This module is not auto-generated.
+
+The integration tests require a swagger petstore server running at
+`http://0.0.0.0/v2`, or the value of the `HOST` environment variable.
+
+The api client library bindings are expected to live in the parent folder
+
+
+### Petstore Server
+
+The petstore server can be obtained at:
+
+https://github.com/wing328/swagger-samples/tree/docker/java/java-jersey-jaxrs
+
+Follow the instructions in the readme to install and run the petstore
+server (the docker branch is used here, but docker is not required)
+
+### Usage
+
+1. Install the [Haskell `stack` tool](http://docs.haskellstack.org/en/stable/README).
+2. Start the petstore server (described above)
+3. To run the integration tests: 
+```
+stack --install-ghc test
+```
+4. After stack installs ghc on the first run, `--install-ghc` can be omitted
+
+### Optional Environment Variables
+
+* `HOST` - the root url of the petstore server
+* `http_proxy` - the address of the http proxy 
+
+Example: 
+
+```
+HOST=http://0.0.0.0/v2  http_proxy=http://0.0.0.0:8080 stack --install-ghc test
+```
+
+
+### Running with Maven
+
+If using Maven, after ensuring the haskell `stack` tool is installed
+(run `stack --version` to verify installation), an example command to
+run the integration tests with maven in this directory is:
+
+```
+mvn -q verify -Pintegration-test
+```
+
+Adjust `pom.xml` as necessary to set environment variables.
--- a/samples/client/petstore/haskell-http-client/tests-integration/package.yaml
+++ b/samples/client/petstore/haskell-http-client/tests-integration/package.yaml
@@ -0,0 +1,52 @@
+name: swagger-petstore-tests-integration
+version: '0.1.0.0'
+synopsis: integration tests for auto-generated swagger-petstore API Client
+description: ! '
+    integration tests for auto-generated swagger-petstore API Client
+'
+category: Web
+author: Author Name Here
+maintainer: author.name@email.com
+copyright: YEAR - AUTHOR
+license: UnspecifiedLicense
+homepage: https://github.com/swagger-api/swagger-codegen#readme
+extra-source-files:
+- README.md
+ghc-options: -Wall
+dependencies:
+- base >=4.7 && <5.0
+- transformers >=0.4.0.0
+- mtl >=2.2.1
+- unordered-containers
+- containers >=0.5.0.0 && <0.6
+- aeson >=1.0 && <2.0
+- bytestring >=0.10.0 && <0.11
+- 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
+- vector >=0.10.9 && <0.13
+- case-insensitive
+- swagger-petstore
+- microlens
+tests:
+  tests:
+    main: Test.hs
+    source-dirs: tests
+    ghc-options:
+    - -fno-warn-orphans
+    dependencies:
+    - swagger-petstore
+    - bytestring >=0.10.0 && <0.11
+    - containers
+    - hspec >=1.8
+    - HUnit > 1.5.0
+    - text
+    - time
+    - iso8601-time
+    - aeson
+    - semigroups
+    - QuickCheck
--- a/samples/client/petstore/haskell-http-client/tests-integration/pom.xml
+++ b/samples/client/petstore/haskell-http-client/tests-integration/pom.xml
@@ -0,0 +1,49 @@
+<project>
+  <modelVersion>4.0.0</modelVersion>
+  <groupId>io.swagger</groupId>
+  <artifactId>swagger-petstore-haskell-http-client-tests-integration</artifactId>
+  <packaging>pom</packaging>
+  <version>1.0-SNAPSHOT</version>
+  <name>Swagger Petstore - Haskell http-client Client - Integration Tests</name>
+  <build>
+    <plugins>
+      <plugin>
+        <artifactId>maven-dependency-plugin</artifactId>
+        <executions>
+          <execution>
+            <phase>package</phase>
+            <goals>
+              <goal>copy-dependencies</goal>
+            </goals>
+            <configuration>
+              <outputDirectory>${project.build.directory}</outputDirectory>
+            </configuration>
+          </execution>
+        </executions>
+      </plugin>
+      <plugin>
+        <groupId>org.codehaus.mojo</groupId>
+        <artifactId>exec-maven-plugin</artifactId>
+        <version>1.2.1</version>
+        <executions>
+          <execution>
+            <id>stack-test</id>
+            <phase>integration-test</phase>
+            <goals>
+              <goal>exec</goal>
+            </goals>
+            <configuration>
+              <environmentVariables> 
+                <HOST>http://0.0.0.0/v2</HOST>
+              </environmentVariables> 
+              <executable>stack</executable>
+              <arguments>
+                <argument>test</argument>
+              </arguments>
+            </configuration>
+          </execution>
+        </executions>
+      </plugin>
+    </plugins>
+  </build>
+</project>
--- a/samples/client/petstore/haskell-http-client/tests-integration/stack.yaml
+++ b/samples/client/petstore/haskell-http-client/tests-integration/stack.yaml
@@ -0,0 +1,5 @@
+resolver: lts-9.0
+packages:
+  - location: '.'
+  - location: '..'
+    extra-dep: true
--- a/samples/client/petstore/haskell-http-client/tests-integration/swagger-petstore-tests-integration.cabal
+++ b/samples/client/petstore/haskell-http-client/tests-integration/swagger-petstore-tests-integration.cabal
@@ -0,0 +1,57 @@
+-- This file has been generated from package.yaml by hpack version 0.17.1.
+--
+-- see: https://github.com/sol/hpack
+
+name:           swagger-petstore-tests-integration
+version:        0.1.0.0
+synopsis:       integration tests for auto-generated swagger-petstore API Client
+description:     integration tests for auto-generated swagger-petstore API Client 
+category:       Web
+homepage:       https://github.com/swagger-api/swagger-codegen#readme
+author:         Author Name Here
+maintainer:     author.name@email.com
+copyright:      YEAR - AUTHOR
+license:        UnspecifiedLicense
+build-type:     Simple
+cabal-version:  >= 1.10
+
+extra-source-files:
+    README.md
+
+test-suite tests
+  type: exitcode-stdio-1.0
+  main-is: Test.hs
+  hs-source-dirs:
+      tests
+  ghc-options: -Wall -fno-warn-orphans
+  build-depends:
+      base >=4.7 && <5.0
+    , transformers >=0.4.0.0
+    , mtl >=2.2.1
+    , unordered-containers
+    , containers >=0.5.0.0 && <0.6
+    , aeson >=1.0 && <2.0
+    , bytestring >=0.10.0 && <0.11
+    , 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
+    , vector >=0.10.9 && <0.13
+    , case-insensitive
+    , swagger-petstore
+    , microlens
+    , swagger-petstore
+    , bytestring >=0.10.0 && <0.11
+    , containers
+    , hspec >=1.8
+    , HUnit > 1.5.0
+    , text
+    , time
+    , iso8601-time
+    , aeson
+    , semigroups
+    , QuickCheck
+  default-language: Haskell2010
--- a/samples/client/petstore/haskell-http-client/tests-integration/tests/Test.hs
+++ b/samples/client/petstore/haskell-http-client/tests-integration/tests/Test.hs
@@ -0,0 +1,289 @@
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE LambdaCase #-}
+{-# OPTIONS_GHC -fno-warn-deprecations -fno-warn-unused-matches -fno-warn-unused-imports -fno-warn-unused-binds -fno-warn-orphans #-}
+
+import qualified Data.Aeson as A
+import qualified Data.ByteString.Lazy.Char8 as BCL
+import qualified Data.Text as T
+import qualified Data.Time as TI
+import qualified Lens.Micro as L
+import qualified Network.HTTP.Client as NH
+import qualified Network.HTTP.Types.Status as NH
+
+import Data.Typeable (Proxy(..))
+import Test.Hspec
+import Test.Hspec.QuickCheck
+import Test.HUnit
+import Test.HUnit.Lang
+
+import Control.Monad.IO.Class
+import Data.IORef
+import qualified Data.Map.Strict as Map
+import Data.Map.Strict (Map)
+import System.Environment (getEnvironment)
+
+import qualified SwaggerPetstore as S
+
+import Data.Monoid ((<>))
+
+-- * UTILS
+
+assertSuccess :: Expectation
+assertSuccess = Success `shouldBe` Success
+
+-- * INSTANCES 
+
+instance S.Consumes S.PlaceOrder S.MimeJSON 
+instance S.Consumes S.CreateUser S.MimeJSON
+instance S.Consumes S.UpdateUser S.MimeJSON
+instance S.Consumes S.CreateUsersWithArrayInput S.MimeJSON
+instance S.Consumes S.CreateUsersWithListInput S.MimeJSON
+instance S.Produces S.CreateUsersWithArrayInput S.MimeNoContent
+instance S.Produces S.CreateUsersWithListInput S.MimeNoContent
+
+-- * MAIN
+
+main :: IO ()
+main = do
+
+  env <- getEnvironment
+
+  let host = case lookup "HOST" env of
+        Just h -> BCL.pack h
+        _ -> "http://0.0.0.0/v2"
+
+  let config =
+        S.withStdoutLogging
+          S.newConfig { S.configHost = host }
+                      -- , S.configLoggingFilter = S.debugLevelFilter }
+
+  putStrLn "\n******** CONFIG ********"
+  putStrLn (show config)
+
+  mgr <- NH.newManager NH.defaultManagerSettings
+
+  hspec $ do
+    testPetOps mgr config
+    testStoreOps mgr config
+    testUserOps mgr config
+
+-- * PET TESTS
+
+testPetOps :: NH.Manager -> S.SwaggerPetstoreConfig -> Spec
+testPetOps mgr config = 
+
+  describe "** pet operations" $ do
+
+    _pet <- runIO $ newIORef (Nothing :: Maybe S.Pet)
+
+    it "addPet" $ do
+      let addPetRequest =
+             S.addPet S.MimeJSON (S.mkPet "name" ["url1", "url2"])
+      addPetResponse <- S.dispatchLbs mgr config addPetRequest S.MimeJSON
+      NH.responseStatus addPetResponse `shouldBe` NH.status200
+      case A.eitherDecode (NH.responseBody addPetResponse) of
+        Right pet -> do
+          _pet `writeIORef` Just pet 
+          assertSuccess
+        Left e -> assertFailure e
+
+    around (\go ->
+      readIORef _pet >>= \case
+        Just pet@S.Pet {S.petId = Just petId} -> go (petId, pet)
+        _ -> pendingWith "no petId") $
+      it "getPetById" $ \(petId, pet) -> do
+        let getPetByIdRequest = S.getPetById petId
+        getPetByIdRequestResult <- S.dispatchMime mgr config getPetByIdRequest S.MimeJSON
+        NH.responseStatus (S.mimeResultResponse getPetByIdRequestResult) `shouldBe` NH.status200
+        case S.mimeResult getPetByIdRequestResult of
+          Right p -> p `shouldBe` pet
+          Left (S.MimeError e _) -> assertFailure e
+
+    it "findPetsByStatus" $ do
+      let findPetsByStatusRequest = S.findPetsByStatus ["available","pending","sold"]
+      findPetsByStatusResult <- S.dispatchMime mgr config findPetsByStatusRequest S.MimeJSON
+      NH.responseStatus (S.mimeResultResponse findPetsByStatusResult) `shouldBe` NH.status200
+      case S.mimeResult findPetsByStatusResult of
+        Right r -> length r `shouldSatisfy` (> 0)
+        Left (S.MimeError e _) -> assertFailure e
+      
+    it "findPetsByTags" $ do
+      let findPetsByTagsRequest = S.findPetsByTags ["name","tag1"]
+      findPetsByTagsResult <- S.dispatchMime mgr config findPetsByTagsRequest S.MimeJSON
+      NH.responseStatus (S.mimeResultResponse findPetsByTagsResult) `shouldBe` NH.status200
+      case S.mimeResult findPetsByTagsResult of
+        Right r -> length r `shouldSatisfy` (> 0)
+        Left (S.MimeError e _) -> assertFailure e
+
+    around (\go ->
+      readIORef _pet >>= \case
+        Just pet -> go pet
+        _ -> pendingWith "no pet") $
+      it "updatePet" $ \pet -> do
+        let updatePetRequest = S.updatePet S.MimeJSON $ pet
+                { S.petStatus   = Just "available"
+                , S.petCategory = Just (S.Category (Just 3) (Just "catname"))
+                }
+        updatePetResponse <- S.dispatchLbs mgr config updatePetRequest S.MimeXML
+        NH.responseStatus updatePetResponse `shouldBe` NH.status200
+
+    it "updatePetWithFormRequest" $ do
+      readIORef _pet >>= \case
+        Just S.Pet {S.petId = Just petId} -> do
+          let updatePetWithFormRequest = S.updatePetWithForm S.MimeFormUrlEncoded petId
+                  `S.applyOptionalParam` S.Name "petName"
+                  `S.applyOptionalParam` S.Status "pending"
+          updatePetWithFormResponse <- S.dispatchLbs mgr config updatePetWithFormRequest S.MimeJSON
+          NH.responseStatus updatePetWithFormResponse `shouldBe` NH.status200
+        _ -> pendingWith "no pet"
+
+    around (\go ->
+      readIORef _pet >>= \case
+        Just pet@S.Pet {S.petId = Just petId} -> go petId
+        _ -> pendingWith "no petId") $
+      it "uploadFile" $ \petId -> do
+          let uploadFileRequest = S.uploadFile S.MimeMultipartFormData petId
+                  `S.applyOptionalParam` S.File "package.yaml"
+                  `S.applyOptionalParam` S.AdditionalMetadata "a package.yaml file"
+          uploadFileRequestResult <- S.dispatchMime mgr config uploadFileRequest S.MimeJSON
+          NH.responseStatus (S.mimeResultResponse uploadFileRequestResult) `shouldBe` NH.status200
+          case S.mimeResult uploadFileRequestResult of
+              Right _ -> assertSuccess
+              Left (S.MimeError e _) -> assertFailure e
+
+    around (\go ->
+      readIORef _pet >>= \case
+        Just pet@S.Pet {S.petId = Just petId} -> go petId
+        _ -> pendingWith "no petId") $
+      it "deletePet" $ \petId -> do
+        let deletePetRequest = S.deletePet petId
+                  `S.applyOptionalParam` S.ApiUnderscorekey "api key"
+        deletePetResponse <- S.dispatchLbs mgr config deletePetRequest S.MimeJSON
+        NH.responseStatus deletePetResponse `shouldBe` NH.status200
+
+-- * STORE TESTS
+  
+
+testStoreOps :: NH.Manager -> S.SwaggerPetstoreConfig -> Spec
+testStoreOps mgr config = do
+
+  describe "** store operations" $ do
+
+    _order <- runIO $ newIORef (Nothing :: Maybe S.Order)
+
+    it "getInventory" $ do
+      let getInventoryRequest = S.getInventory
+            `S.setHeader` [("api_key","special-key")] 
+      getInventoryRequestRequestResult <- S.dispatchMime mgr config getInventoryRequest S.MimeJSON
+      NH.responseStatus (S.mimeResultResponse getInventoryRequestRequestResult) `shouldBe` NH.status200
+      case S.mimeResult getInventoryRequestRequestResult of
+          Right r -> length r `shouldSatisfy` (> 0)
+          Left (S.MimeError e _) -> assertFailure e
+
+    it "placeOrder" $ do
+      now <- TI.getCurrentTime
+      let placeOrderRequest = S.placeOrder S.MimeJSON
+            (S.mkOrder
+             { S.orderId = Just 21
+             , S.orderQuantity = Just 210
+             , S.orderShipDate = Just now
+             })
+      placeOrderResult <- S.dispatchMime mgr config placeOrderRequest S.MimeJSON
+      NH.responseStatus (S.mimeResultResponse placeOrderResult) `shouldBe` NH.status200
+      case S.mimeResult placeOrderResult of
+          Right order -> do
+            _order `writeIORef` Just order 
+            assertSuccess
+          Left (S.MimeError e _) -> assertFailure e
+
+    around (\go ->
+      readIORef _order >>= \case
+        Just order@S.Order {S.orderId = Just orderId} -> go (orderId, order)
+        _ -> pendingWith "no orderId") $
+      it "getOrderById" $ \(orderId, order) -> do
+        let getOrderByIdRequest = S.getOrderById orderId
+        getOrderByIdRequestResult <- S.dispatchMime mgr config getOrderByIdRequest S.MimeJSON
+        NH.responseStatus (S.mimeResultResponse getOrderByIdRequestResult) `shouldBe` NH.status200
+        case S.mimeResult getOrderByIdRequestResult of
+            Right o -> o `shouldBe` order
+            Left (S.MimeError e _) -> assertFailure e
+
+    around (\go ->
+      readIORef _order >>= \case
+        Just S.Order {S.orderId = Just orderId} -> go (T.pack (show orderId))
+        _ -> pendingWith "no orderId") $
+      it "deleteOrder" $ \orderId -> do
+        let deleteOrderRequest = S.deleteOrder orderId
+        deleteOrderResult <- S.dispatchLbs mgr config deleteOrderRequest S.MimeJSON
+        NH.responseStatus deleteOrderResult `shouldBe` NH.status200
+
+
+-- * USER TESTS
+
+testUserOps :: NH.Manager -> S.SwaggerPetstoreConfig -> Spec
+testUserOps mgr config = do
+
+  describe "** user operations" $ do
+
+    let _username = "hsusername"
+        _password = "password1"
+        _user =
+          S.mkUser
+          { S.userId = Just 21
+          , S.userUsername = Just _username
+          , S.userEmail = Just "xyz@example.com"
+          , S.userUserStatus = Just 0
+          }
+        _users =
+          take 8 $
+          drop 1 $ iterate (L.over S.userUsernameT (<> "*") . L.over S.userIdT (+ 1)) _user
+
+    before (pure _user) $
+      it "createUser" $ \user -> do
+        let createUserRequest = S.createUser S.MimeJSON user
+        createUserResult <- S.dispatchLbs mgr config createUserRequest S.MimeJSON
+        NH.responseStatus createUserResult `shouldBe` NH.status200
+
+    before (pure _users) $
+      it "createUsersWithArrayInput" $ \users -> do
+        let createUsersWithArrayInputRequest = S.createUsersWithArrayInput S.MimeJSON 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
+        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
+        getUserByNameResult <- S.dispatchMime mgr config getUserByNameRequest S.MimeJSON
+        NH.responseStatus (S.mimeResultResponse getUserByNameResult) `shouldBe` NH.status200
+        case S.mimeResult getUserByNameResult of
+          Right u -> u `shouldBe` user
+          Left (S.MimeError e _) -> assertFailure e
+
+    before (pure (_username, _password)) $
+      it "loginUser" $ \(username, password) -> do
+        let loginUserRequest = S.loginUser username 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
+        updateUserResult <- S.dispatchLbs mgr config updateUserRequest S.MimeJSON
+        NH.responseStatus updateUserResult `shouldBe` NH.status200
+
+    it "logoutuser" $ do
+        logoutUserResult <- S.dispatchLbs mgr config S.logoutUser S.MimeJSON
+        NH.responseStatus logoutUserResult `shouldBe` NH.status200
+
+    before (pure _username) $
+      it "deleteUser" $ \username -> do
+        let deleteUserRequest = S.deleteUser username
+        deleteUserResult <- S.dispatchLbs mgr config deleteUserRequest S.MimeJSON
+        NH.responseStatus deleteUserResult `shouldBe` NH.status200