ClientSpec.hs

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

import           Control.Concurrent        (forkIO, threadDelay)
import           Control.Concurrent.Async  (withAsync)
import           Control.Exception         (bracket)
import           Control.Monad             (forever, replicateM_)
import           Network                   (PortID (PortNumber), listenOn)
import           Network.HTTP.Client
import           Network.HTTP.Types        (status200)
import           Network.Socket            (accept, sClose)
import           Network.Socket.ByteString (recv, sendAll)
import           Test.Hspec

main :: IO ()
main = hspec spec

redirectServer :: (Int -> IO a) -> IO a
redirectServer inner = do
    let port = 23456
    bracket (listenOn $ PortNumber $ fromIntegral port) sClose $ \listener -> do
        withAsync (forker listener) $ \_ -> inner port
  where
    forker listener = forever $ do
        (socket, _) <- accept listener
        _ <- forkIO $ forever $ do
            sendAll socket "HTTP/1.1 301 Redirect\r\nLocation: /\r\ncontent-length: 5\r\n\r\n"
            threadDelay 10000
            sendAll socket "hello\r\n"
            threadDelay 10000
        _ <- forkIO $ forever $ recv socket 4096
        return ()

spec :: Spec
spec = describe "Client" $ do
    it "works" $ do
        req <- parseUrl "http://www.yesodweb.com/"
        man <- newManager defaultManagerSettings
        res <- httpLbs req man
        responseStatus res `shouldBe` status200
    describe "fails on empty hostnames #40" $ do
        let test url = it url $ do
                req <- parseUrl url
                man <- newManager defaultManagerSettings
                _ <- httpLbs req man `shouldThrow` \e ->
                    case e of
                        InvalidDestinationHost "" -> True
                        _ -> False
                return ()
        mapM_ test ["http://", "https://", "http://:8000", "https://:8001"]
    it "redirecting #41" $ redirectServer $ \port -> do
        req' <- parseUrl $ "http://127.0.0.1:" ++ show port
        let req = req' { redirectCount = 1 }
        withManager defaultManagerSettings $ \man -> replicateM_ 10 $ do
            httpLbs req man `shouldThrow` \e ->
                case e of
                    TooManyRedirects _ -> True
                    _ -> False
    it "redirectCount=0" $ redirectServer $ \port -> do
        req' <- parseUrl $ "http://127.0.0.1:" ++ show port
        let req = req' { redirectCount = 0 }
        withManager defaultManagerSettings $ \man -> replicateM_ 10 $ do
            httpLbs req man `shouldThrow` \e ->
                case e of
                    StatusCodeException{} -> True
                    _ -> False