wai-middleware-delegate-0.1.4.0: test/Test/TestRequests.hs

{-# 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
      }