{-# 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.Maybe (fromMaybe, maybe) import Data.Default (Default (..)) 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 }