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

import           Control.Concurrent (threadDelay)
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
import           System.Mem (performGC)

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

    -- Test the failure condition described in https://github.com/snoyberg/http-client/issues/489
    it "keeps connection alive long enough" $ do
        req <- parseUrlThrow "http://httpbin.org/"
        man <- newManager defaultManagerSettings
        res <- responseOpen req man
        responseStatus res `shouldBe` status200
        let
            getChunk = responseBody res
            drainAll = do
                chunk <- getChunk
                if BS.null chunk then pure () else drainAll

        -- The returned `BodyReader` used to not contain a reference to the `Managed Connection`,
        -- only to the extracted connection and to the release action. Therefore, triggering a GC
        -- would close the connection even though we were not done reading.
        performGC
        -- Not ideal, but weak finalizers run on a separate thread, so it's racing with our drain
        -- call
        threadDelay 500000

        drainAll
        -- Calling `responseClose res` here prevents the early collection from happening in this
        -- test, but in a larger production application that did involve a `responseClose`, it still
        -- occurred.

    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 ()