Merge pull request #104 from input-output-hk/piotr/56/qa-review-and-e…

…xperiment Add response code verification into integration DSL
cardano-foundation · Mar 22, 2019 · c51903b · c51903b
2 parents f8f4df0 + 8e5b71a
commit c51903b
Show file tree

Hide file tree

Showing 4 changed files with 75 additions and 13 deletions.
diff --git a/cardano-wallet.cabal b/cardano-wallet.cabal
@@ -176,6 +176,7 @@ test-suite integration
     , generic-lens
     , hspec
     , hspec-core
+    , hspec-expectations-lifted
     , http-client
     , http-api-data
     , http-types

diff --git a/test/integration/Main.hs b/test/integration/Main.hs
@@ -1,37 +1,40 @@
 module Main where
 
+import Prelude
+
 import Control.Concurrent
     ( threadDelay )
 import Control.Concurrent.MVar
     ( newMVar )
-
 import Data.Aeson
     ( Value )
+import Data.ByteString.Lazy
+    ( ByteString )
 import Data.Text
     ( Text )
 import Network.HTTP.Client
-    ( Manager, defaultManagerSettings, newManager )
-import Prelude
+    ( Manager, Request, Response, defaultManagerSettings, newManager )
+import Network.HTTP.Types.Status
+    ( status200, status404, status405 )
 import System.Process
     ( proc, withCreateProcess )
 import Test.Hspec
     ( beforeAll, describe, hspec )
-
-import qualified Data.Text as T
-
 import Test.Integration.Framework.DSL
     ( Context (..)
+    , RequestException (..)
     , Scenarios
     , expectError
+    , expectResponseCode
     , request
+    , request'
     , request_
     , scenario
     , verify
     )
-import Test.Integration.Framework.Request
-    ( RequestException (..) )
 
 import qualified Cardano.NetworkLayer.HttpBridgeSpec as HttpBridge
+import qualified Data.Text as T
 
 main :: IO ()
 main = do
@@ -41,6 +44,9 @@ main = do
         beforeAll (withWallet (newMVar . Context ())) $ do
             describe "Integration test framework" dummySpec
 
+        beforeAll (dummySetup (newMVar . Context ())) $ do
+            describe "Test response codes" respCodesSpec
+
 -- Runs the wallet server only. The API is not implemented yet, so this is
 -- basically a placeholder until then.
 withWallet :: ((Text, Manager) -> IO a) -> IO a
@@ -63,3 +69,37 @@ dummySpec = do
 
     scenario "request_ function is always successful" $ do
         request_ ("GET", "api/xyzzy") Nothing
+
+-- Temporary test setup for testing response codes
+dummySetup :: ((Text, Manager) -> IO a) -> IO a
+dummySetup action = do
+        let baseURL = T.pack ("http://httpbin.org")
+        manager <- newManager defaultManagerSettings
+        action (baseURL, manager)
+
+-- Exercise response codes
+respCodesSpec :: Scenarios Context
+respCodesSpec = do
+    scenario "GET; Response code 200" $ do
+        response <- request' ("GET", "/get") Nothing
+        verify (response :: Either RequestException (Request, Response ByteString))
+            [ expectResponseCode status200
+            ]
+
+    scenario "GET; Response code 404" $ do
+        response <- request' ("GET", "/get/nothing") Nothing
+        verify (response :: Either RequestException (Request, Response ByteString))
+            [ expectResponseCode status404
+            ]
+
+    scenario "POST; Response code 200" $ do
+        response <- request' ("POST", "/post") Nothing
+        verify (response :: Either RequestException (Request, Response ByteString))
+            [ expectResponseCode status200
+            ]
+
+    scenario "POST; Response code 405" $ do
+        response <- request' ("POST", "/get") Nothing
+        verify (response :: Either RequestException (Request, Response ByteString))
+            [ expectResponseCode status405
+            ]
diff --git a/test/integration/Test/Integration/Framework/DSL.hs b/test/integration/Test/Integration/Framework/DSL.hs
@@ -12,13 +12,15 @@ module Test.Integration.Framework.DSL
 
     -- * Steps
     , request
+    , request'
     , request_
     , successfulRequest
     , verify
 
     -- * Expectations
     , expectSuccess
     , expectError
+    , expectResponseCode
     , RequestException(..)
 
     -- * Helpers
@@ -39,6 +41,8 @@ import Control.Monad.IO.Class
     ( MonadIO, liftIO )
 import Data.Aeson.QQ
     ( aesonQQ )
+import Data.ByteString.Lazy
+    ( ByteString )
 import Data.Function
     ( (&) )
 import Data.List
@@ -50,19 +54,27 @@ import GHC.Generics
 import Language.Haskell.TH.Quote
     ( QuasiQuoter )
 import Network.HTTP.Client
-    ( Manager )
+    ( Manager, Request, Response, responseStatus )
+import Network.HTTP.Types.Status
+    ( Status )
 import Test.Hspec.Core.Spec
     ( SpecM, it, xit )
-
-import qualified Test.Hspec.Core.Spec as H
-
+import Test.Hspec.Expectations.Lifted
+    ( shouldBe )
 import Test.Integration.Framework.Request
-    ( RequestException (..), request, request_, successfulRequest, ($-) )
+    ( RequestException (..)
+    , request
+    , request'
+    , request_
+    , successfulRequest
+    , ($-)
+    )
 import Test.Integration.Framework.Scenario
     ( Scenario )
 import Web.HttpApiData
     ( ToHttpApiData (..) )
 
+import qualified Test.Hspec.Core.Spec as H
 --
 -- SCENARIO
 --
@@ -120,6 +132,14 @@ expectError = \case
     Left _  -> return ()
     Right a -> wantedErrorButSuccess a
 
+expectResponseCode
+    :: (MonadIO m, MonadFail m)
+    => Status
+    -> Either RequestException (Request, Response ByteString)
+    -> m ()
+expectResponseCode c = \case
+    Left e   -> wantedSuccessButError e
+    Right a -> (responseStatus (snd a)) `shouldBe` c
 
 -- | Expect a successful response, without any further assumptions
 expectSuccess

diff --git a/test/integration/Test/Integration/Framework/Request.hs b/test/integration/Test/Integration/Framework/Request.hs
@@ -7,6 +7,7 @@
 
 module Test.Integration.Framework.Request
     ( request
+    , request'
     , request_
     , successfulRequest
     , RequestException(..)