ClientSpec.hs

{-# LANGUAGE OverloadedStrings #-}
module Network.HTTP.ClientSpec where

import qualified Data.ByteString.Char8        as BS
import           Network.HTTP.Client
import           Network.HTTP.Client.Internal
import           Network.HTTP.Types        (status200, found302, status405)
import           Network.HTTP.Types.Status
import qualified Network.Socket               as NS
import           Test.Hspec
import           Control.Applicative       ((<$>))
import           Data.ByteString.Lazy.Char8 () -- orphan instance

main :: IO ()
main = hspec spec

spec :: Spec
spec = describe "Client" $ do
    it "works" $ do
        req <- parseUrlThrow "http://httpbin.org/"
        man <- newManager defaultManagerSettings
        res <- httpLbs req man
        responseStatus res `shouldBe` status200

    describe "method in URL" $ do
        it "success" $ do
            req <- parseUrlThrow "POST http://httpbin.org/post"
            man <- newManager defaultManagerSettings
            res <- httpLbs req man
            responseStatus res `shouldBe` status200

        it "failure" $ do
            req <- parseRequest "PUT http://httpbin.org/post"
            man <- newManager defaultManagerSettings
            res <- httpLbs req man
            responseStatus res `shouldBe` status405
    describe "bearer auth" $ do
        it "success" $ do
            initialReq <- parseUrlThrow "http://httpbin.org/bearer"
            let finalReq = applyBearerAuth "token" initialReq
            man <- newManager defaultManagerSettings
            res <- httpLbs finalReq man
            responseStatus res `shouldBe` status200
        it "failure" $ do
            req <- parseRequest "http://httpbin.org/bearer"
            man <- newManager defaultManagerSettings
            res <- httpLbs req man
            responseStatus res `shouldBe` status401

    describe "redirects" $ do
        xit "follows redirects" $ do
            req <- parseRequest "http://httpbin.org/redirect-to?url=http://httpbin.org"
            man <- newManager defaultManagerSettings
            res <- httpLbs req man
            responseStatus res `shouldBe` status200

        xit "allows to disable redirect following" $ do
            req <- (\ r -> r{ redirectCount = 0 }) <$>
              parseRequest "http://httpbin.org/redirect-to?url=http://httpbin.org"
            man <- newManager defaultManagerSettings
            res <- httpLbs req man
            responseStatus res `shouldBe` found302

    context "managerModifyResponse" $ do
      it "allows to modify the response status code" $ do
        let modify :: Response BodyReader -> IO (Response BodyReader)
            modify res = do
              return res {
                responseStatus = (responseStatus res) {
                  statusCode = 201
                }
              }
            settings = defaultManagerSettings { managerModifyResponse = modify }
        man <- newManager settings
        res <- httpLbs "http://httpbin.org" man
        (statusCode.responseStatus) res `shouldBe` 201

      it "modifies the response body" $ do
        let modify :: Response BodyReader -> IO (Response BodyReader)
            modify res = do
              reader <- constBodyReader [BS.pack "modified response body"]
              return res {
                responseBody = reader
              }
            settings = defaultManagerSettings { managerModifyResponse = modify }
        man <- newManager settings
        res <- httpLbs "http://httpbin.org" man
        responseBody res `shouldBe` "modified response body"

    context "managerModifyRequest" $ do
        it "port" $ do
            let modify req = return req { port = 80 }
                settings = defaultManagerSettings { managerModifyRequest = modify }
            man <- newManager settings
            res <- httpLbs "http://httpbin.org:1234" man
            responseStatus res `shouldBe` status200

        it "checkResponse" $ do
            let modify req = return req { checkResponse = \_ _ -> error "some exception" }
                settings = defaultManagerSettings { managerModifyRequest = modify }
            man <- newManager settings
            httpLbs "http://httpbin.org" man `shouldThrow` anyException

        xit "redirectCount" $ do
            let modify req = return req { redirectCount = 0 }
                settings = defaultManagerSettings { managerModifyRequest = modify }
            man <- newManager settings
            response <- httpLbs "http://httpbin.org/redirect-to?url=foo" man
            responseStatus response `shouldBe` found302

    -- skipped because CI doesn't have working IPv6
    xdescribe "raw IPV6 address as hostname" $ do
        it "works" $ do
            -- We rely on example.com serving a web page over IPv6.
            -- The request (currently) actually ends up as 404 due to
            -- virtual hosting, but we just care that the networking
            -- side works.
            (addr:_) <- NS.getAddrInfo
                (Just NS.defaultHints { NS.addrFamily = NS.AF_INET6 })
                (Just "example.com")
                (Just "http")
            -- ipv6Port will be of the form [::1]:80, which is good enough
            -- for our purposes; ideally we'd easily get just the ::1.
            let ipv6Port = show $ NS.addrAddress addr
            ipv6Port `shouldStartWith` "["
            req <- parseUrlThrow $ "http://" ++ ipv6Port
            man <- newManager defaultManagerSettings
            _ <- httpLbs (setRequestIgnoreStatus req) man
            return ()