1{-# LANGUAGE OverloadedStrings #-}
2module Network.HTTP.ClientSpec where
3
4import qualified Data.ByteString.Char8        as BS
5import           Network.HTTP.Client
6import           Network.HTTP.Client.Internal
7import           Network.HTTP.Types        (status200, found302, status405)
8import           Network.HTTP.Types.Status
9import           Test.Hspec
10import           Control.Applicative       ((<$>))
11import           Data.ByteString.Lazy.Char8 () -- orphan instance
12
13main :: IO ()
14main = hspec spec
15
16spec :: Spec
17spec = describe "Client" $ do
18    it "works" $ do
19        req <- parseUrlThrow "http://httpbin.org/"
20        man <- newManager defaultManagerSettings
21        res <- httpLbs req man
22        responseStatus res `shouldBe` status200
23
24    describe "method in URL" $ do
25        it "success" $ do
26            req <- parseUrlThrow "POST http://httpbin.org/post"
27            man <- newManager defaultManagerSettings
28            res <- httpLbs req man
29            responseStatus res `shouldBe` status200
30
31        it "failure" $ do
32            req <- parseRequest "PUT http://httpbin.org/post"
33            man <- newManager defaultManagerSettings
34            res <- httpLbs req man
35            responseStatus res `shouldBe` status405
36
37    describe "redirects" $ do
38        it "follows redirects" $ do
39            req <- parseRequest "http://httpbin.org/redirect-to?url=http://httpbin.org"
40            man <- newManager defaultManagerSettings
41            res <- httpLbs req man
42            responseStatus res `shouldBe` status200
43
44        it "allows to disable redirect following" $ do
45            req <- (\ r -> r{ redirectCount = 0 }) <$>
46              parseRequest "http://httpbin.org/redirect-to?url=http://httpbin.org"
47            man <- newManager defaultManagerSettings
48            res <- httpLbs req man
49            responseStatus res `shouldBe` found302
50
51    context "managerModifyResponse" $ do
52      it "allows to modify the response status code" $ do
53        let modify :: Response BodyReader -> IO (Response BodyReader)
54            modify res = do
55              return res {
56                responseStatus = (responseStatus res) {
57                  statusCode = 201
58                }
59              }
60            settings = defaultManagerSettings { managerModifyResponse = modify }
61        man <- newManager settings
62        res <- httpLbs "http://httpbin.org" man
63        (statusCode.responseStatus) res `shouldBe` 201
64
65      it "modifies the response body" $ do
66        let modify :: Response BodyReader -> IO (Response BodyReader)
67            modify res = do
68              reader <- constBodyReader [BS.pack "modified response body"]
69              return res {
70                responseBody = reader
71              }
72            settings = defaultManagerSettings { managerModifyResponse = modify }
73        man <- newManager settings
74        res <- httpLbs "http://httpbin.org" man
75        responseBody res `shouldBe` "modified response body"
76
77    context "managerModifyRequest" $ do
78        it "port" $ do
79            let modify req = return req { port = 80 }
80                settings = defaultManagerSettings { managerModifyRequest = modify }
81            man <- newManager settings
82            res <- httpLbs "http://httpbin.org:1234" man
83            responseStatus res `shouldBe` status200
84
85        it "checkResponse" $ do
86            let modify req = return req { checkResponse = \_ _ -> error "some exception" }
87                settings = defaultManagerSettings { managerModifyRequest = modify }
88            man <- newManager settings
89            httpLbs "http://httpbin.org" man `shouldThrow` anyException
90
91        it "redirectCount" $ do
92            let modify req = return req { redirectCount = 0 }
93                settings = defaultManagerSettings { managerModifyRequest = modify }
94            man <- newManager settings
95            response <- httpLbs "http://httpbin.org/redirect-to?url=foo" man
96            responseStatus response `shouldBe` found302
97