{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} module Test.TestRequests ( RequestBuilder (..) , buildRequest , testRequests , testGetRequests , testPostRequests , testNotProxiedRequests , testOverRedirectedRequests ) where import qualified Data.ByteString as BS import qualified Data.ByteString.Char8 as C8 import Data.Default (Default (..)) import Data.Maybe (fromMaybe) import Network.HTTP.Client ( Request , RequestBody (..) , host , method , parseRequest , redirectCount , requestBody ) import Network.HTTP.Types (Method, methodGet, methodPost) data RequestBuilder = RequestBuilder { rbMethod :: !Method , rbSecure :: !Bool , rbPath :: !String , rbBody :: !(Maybe RequestBody) , rbHost :: !BS.ByteString , rbPort :: !(Maybe Int) } instance Default RequestBuilder where def = RequestBuilder { rbMethod = methodGet , rbSecure = False , rbPath = "/" , rbBody = Nothing , rbHost = "httpbin.org" , rbPort = Nothing } testRequests :: [(String, RequestBuilder -> RequestBuilder)] testRequests = testGetRequests <> testPostRequests testGetRequests :: [(String, RequestBuilder -> RequestBuilder)] testGetRequests = [ ( "GET" , (\builder -> builder {rbPath = "/get"}) ) , ( "GET (with a query)" , (\builder -> builder {rbPath = "/get?a=10&b=whatever"}) ) , ( "GET (multiple redirects)" , (\builder -> builder {rbPath = "/redirect/3"}) ) , ( "GET (with a body)" , ( \builder -> builder { rbPath = "/get" , rbBody = Just $ RequestBodyBS "Hello httpbin!" } ) ) , ( "GET (forbidden resource)" , (\builder -> builder {rbPath = "/status/403"}) ) , ( "GET (missing resource)" , (\builder -> builder {rbPath = "/status/404"}) ) ] testNotProxiedRequests :: [(String, RequestBuilder -> RequestBuilder)] testNotProxiedRequests = [ ( "GET (funny resource - differs on proxy)" , (\builder -> builder {rbPath = "/status/418"}) ) ] testOverRedirectedRequests :: [(String, RequestBuilder -> RequestBuilder)] testOverRedirectedRequests = [ ( "GET (multiple redirects)" , (\builder -> builder {rbPath = "/redirect/3"}) ) ] testPostRequests :: [(String, RequestBuilder -> RequestBuilder)] testPostRequests = [ ( "POST" , (\builder -> builder {rbMethod = methodPost, rbPath = "/post"}) ) , ( "POST (with a query)" , (\builder -> builder {rbMethod = methodPost, rbPath = "/post?a=10&b=whatever"}) ) , ( "POST (with a body)" , ( \builder -> builder { rbPath = "/post" , rbBody = Just $ RequestBodyBS "Hello httpbin!" , rbMethod = methodPost } ) ) , ( "POST (forbidden resource)" , (\builder -> builder {rbMethod = methodPost, rbPath = "/status/403"}) ) , ( "POST (missing resource)" , (\builder -> builder {rbMethod = methodPost, rbPath = "/status/404"}) ) ] -- | Simplifies creation of the requests used in testing buildRequest :: RequestBuilder -> IO Request buildRequest RequestBuilder {rbMethod, rbSecure, rbPath, rbBody, rbHost, rbPort} = do let scheme | rbSecure = "https" | otherwise = "http" portStr = maybe "" (\x -> ":" ++ show x) rbPort url = scheme ++ "://" ++ (C8.unpack rbHost) ++ portStr ++ rbPath req <- parseRequest url return $ req { method = rbMethod , requestBody = fromMaybe (requestBody req) rbBody , host = rbHost , redirectCount = 0 }