From 90c2efcff694043c98138e519e06f59a9d82a4ef Mon Sep 17 00:00:00 2001 From: Piotr Stachyra Date: Thu, 28 Mar 2019 17:19:32 +0100 Subject: [PATCH 1/3] Ability to send non-valid Json payload in the request. Also introduced custom data types for request headers and payload. --- test/integration/Main.hs | 24 ++++++++++-- .../Test/Integration/Framework/DSL.hs | 2 + .../Test/Integration/Framework/Request.hs | 39 ++++++++++++++----- 3 files changed, 52 insertions(+), 13 deletions(-) diff --git a/test/integration/Main.hs b/test/integration/Main.hs index 4cfdd4228b1..a6aea009546 100644 --- a/test/integration/Main.hs +++ b/test/integration/Main.hs @@ -1,4 +1,5 @@ {-# LANGUAGE TypeApplications #-} +{-# LANGUAGE QuasiQuotes #-} module Main where @@ -111,16 +112,31 @@ dummySetup = do respCodesSpec :: SpecWith Context respCodesSpec = do it "GET; Response code 200" $ \ctx -> do - response <- request @Value ctx ("GET", "/get?my=arg") Nothing Nothing + response <- request @Value ctx ("GET", "/get?my=arg") Default Empty expectResponseCode @IO status200 response it "GET; Response code 404" $ \ctx -> do - response <- request @Value ctx ("GET", "/get/nothing") Nothing Nothing + response <- request @Value ctx ("GET", "/get/nothing") Default Empty expectResponseCode @IO status404 response it "POST; Response code 200" $ \ctx -> do - let header = [("dummy", "header")] - response <- request @Value ctx ("POST", "/post") (Just header) Nothing + let headers = Headers [("dummy", "header")] + let payload = Json [json| { + "addressPoolGap": 70, + "assuranceLevel": "strict", + "name": "Wallet EOS" + } |] + response <- request @Value ctx ("POST", "/post") headers payload + expectResponseCode @IO status200 response + + it "POST; Response code 200" $ \ctx -> do + let headers = Headers [("dummy", "header")] + let payloadInvalid = NonJson "{\ + \\"addressPoolGap: 70,\ + \\"assuranceLevel\": strict,\ + \\"name\": \"Wallet EOS\"\ + \}" + response <- request @Value ctx ("POST", "/post") headers payloadInvalid expectResponseCode @IO status200 response it "POST; Response code 405" $ \ctx -> do diff --git a/test/integration/Test/Integration/Framework/DSL.hs b/test/integration/Test/Integration/Framework/DSL.hs index 909a3181787..b3aa521cc43 100644 --- a/test/integration/Test/Integration/Framework/DSL.hs +++ b/test/integration/Test/Integration/Framework/DSL.hs @@ -9,6 +9,8 @@ module Test.Integration.Framework.DSL , expectSuccess , expectError , expectResponseCode + , Headers(..) + , Payload(..) , RequestException(..) -- * Helpers diff --git a/test/integration/Test/Integration/Framework/Request.hs b/test/integration/Test/Integration/Framework/Request.hs index 018183e9721..d3c76daff32 100644 --- a/test/integration/Test/Integration/Framework/Request.hs +++ b/test/integration/Test/Integration/Framework/Request.hs @@ -8,6 +8,8 @@ module Test.Integration.Framework.Request ( request , unsafeRequest + , Headers(..) + , Payload(..) , RequestException(..) , Context(..) ) where @@ -72,6 +74,19 @@ data RequestException instance Exception RequestException +-- | The payload of the request +data Payload + = Json Aeson.Value + | NonJson ByteString + | Empty + +-- | The headers of the request +data Headers + = Headers RequestHeaders + | Default + | None + +-- | Makes a request to the API and decodes the response. request :: forall a m. ( FromJSON a @@ -82,9 +97,9 @@ request => Context -> (Method, Text) -- ^ HTTP method and request path - -> Maybe RequestHeaders + -> Headers -- ^ Request headers - -> Maybe Aeson.Value + -> Payload -- ^ Request body -> m (HTTP.Status, Either RequestException a) request (Context _ (base, manager)) (verb, path) reqHeaders body = do @@ -94,15 +109,21 @@ request (Context _ (base, manager)) (verb, path) reqHeaders body = do prepareReq :: HTTP.Request -> HTTP.Request prepareReq req = req { method = verb - , requestBody = maybe mempty (RequestBodyLBS . Aeson.encode) body - , requestHeaders = fromMaybe defaultHeaders reqHeaders + , requestBody = payload + , requestHeaders = headers } + where + headers = case h of + Headers x -> x + Default -> [ ("Content-Type", "application/json") + , ("Accept", "application/json") + ] + None -> mempty - defaultHeaders :: RequestHeaders - defaultHeaders = - [ ("Content-Type", "application/json") - , ("Accept", "application/json") - ] + payload = case body of + Json x -> (RequestBodyLBS . Aeson.encode) x + NonJson x -> RequestBodyLBS x + Empty -> mempty handleResponse res = case responseStatus res of s | s < status500 -> maybe From 6558742c66c146978a4c4f7a349cc894b0af384b Mon Sep 17 00:00:00 2001 From: Piotr Stachyra Date: Fri, 29 Mar 2019 09:45:49 +0100 Subject: [PATCH 2/3] Adjusting after #132 --- test/integration/Main.hs | 10 ++++++++-- test/integration/Test/Integration/Framework/DSL.hs | 8 +++++++- test/integration/Test/Integration/Framework/Request.hs | 8 +++----- 3 files changed, 18 insertions(+), 8 deletions(-) diff --git a/test/integration/Main.hs b/test/integration/Main.hs index a6aea009546..756fe8b9815 100644 --- a/test/integration/Main.hs +++ b/test/integration/Main.hs @@ -24,7 +24,13 @@ import Network.HTTP.Types.Status import Test.Hspec ( SpecWith, afterAll, beforeAll, describe, hspec, it, shouldBe ) import Test.Integration.Framework.DSL - ( Context (..), expectResponseCode, request ) + ( Context (..) + , Headers (..) + , Payload (..) + , expectResponseCode + , json + , request + ) import qualified Cardano.Wallet.Network.HttpBridgeSpec as HttpBridge import qualified Cardano.WalletSpec as Wallet @@ -140,5 +146,5 @@ respCodesSpec = do expectResponseCode @IO status200 response it "POST; Response code 405" $ \ctx -> do - response <- request @Value ctx ("POST", "/get") Nothing Nothing + response <- request @Value ctx ("POST", "/get") None Empty expectResponseCode @IO status405 response diff --git a/test/integration/Test/Integration/Framework/DSL.hs b/test/integration/Test/Integration/Framework/DSL.hs index b3aa521cc43..8ab252049e5 100644 --- a/test/integration/Test/Integration/Framework/DSL.hs +++ b/test/integration/Test/Integration/Framework/DSL.hs @@ -37,7 +37,13 @@ import Language.Haskell.TH.Quote import Test.Hspec.Expectations.Lifted ( shouldBe ) import Test.Integration.Framework.Request - ( Context (..), RequestException (..), request, unsafeRequest ) + ( Context (..) + , Headers (..) + , Payload (..) + , RequestException (..) + , request + , unsafeRequest + ) import Web.HttpApiData ( ToHttpApiData (..) ) diff --git a/test/integration/Test/Integration/Framework/Request.hs b/test/integration/Test/Integration/Framework/Request.hs index d3c76daff32..f9547933648 100644 --- a/test/integration/Test/Integration/Framework/Request.hs +++ b/test/integration/Test/Integration/Framework/Request.hs @@ -26,8 +26,6 @@ import Data.Aeson ( FromJSON ) import Data.ByteString.Lazy ( ByteString ) -import Data.Maybe - ( fromMaybe ) import Data.Text ( Text ) import Network.HTTP.Client @@ -113,7 +111,7 @@ request (Context _ (base, manager)) (verb, path) reqHeaders body = do , requestHeaders = headers } where - headers = case h of + headers = case reqHeaders of Headers x -> x Default -> [ ("Content-Type", "application/json") , ("Accept", "application/json") @@ -146,8 +144,8 @@ unsafeRequest ) => Context -> (Method, Text) - -> Maybe Aeson.Value + -> Payload -> m (HTTP.Status, a) unsafeRequest ctx req body = do - (s, res) <- request ctx req Nothing body + (s, res) <- request ctx req Default body either throwM (pure . (s,)) res From 142b98c9fdfe20ba86efd64c3120d2c748040245 Mon Sep 17 00:00:00 2001 From: Piotr Stachyra Date: Fri, 29 Mar 2019 10:20:57 +0100 Subject: [PATCH 3/3] stylish haskell --- test/integration/Main.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/test/integration/Main.hs b/test/integration/Main.hs index 756fe8b9815..59702f64ce1 100644 --- a/test/integration/Main.hs +++ b/test/integration/Main.hs @@ -1,5 +1,6 @@ -{-# LANGUAGE TypeApplications #-} {-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE TypeApplications #-} + module Main where