Merge pull request #131 from input-output-hk/piotr/94/not_valid_json_…

…payload

Ability to send non-valid Json payload in the request.

test/integration/Main.hs

@@ -1,5 +1,7 @@
+{-# LANGUAGE QuasiQuotes #-}
 {-# LANGUAGE TypeApplications #-}
 
+
 module Main where
 
 import Prelude
@@ -23,7 +25,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
@@ -111,18 +119,33 @@ 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
-        response <- request @Value ctx ("POST", "/get") Nothing Nothing
+        response <- request @Value ctx ("POST", "/get") None Empty
         expectResponseCode @IO status405 response

test/integration/Test/Integration/Framework/DSL.hs

@@ -9,6 +9,8 @@ module Test.Integration.Framework.DSL
     , expectSuccess
     , expectError
     , expectResponseCode
+    , Headers(..)
+    , Payload(..)
     , RequestException(..)
 
     -- * Helpers
@@ -35,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 (..) )
 

test/integration/Test/Integration/Framework/Request.hs

@@ -8,6 +8,8 @@
 module Test.Integration.Framework.Request
     ( request
     , unsafeRequest
+    , Headers(..)
+    , Payload(..)
     , RequestException(..)
     , Context(..)
     ) where
@@ -24,8 +26,6 @@ import Data.Aeson
     ( FromJSON )
 import Data.ByteString.Lazy
     ( ByteString )
-import Data.Maybe
-    ( fromMaybe )
 import Data.Text
     ( Text )
 import Network.HTTP.Client
@@ -72,6 +72,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 +95,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 +107,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 reqHeaders 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
@@ -125,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