Util.hs

{-# LANGUAGE OverloadedStrings #-}

module Tests.Wai.Util where

import Control.Monad (void)
import Data.ByteString (ByteString)
import Data.CaseInsensitive (CI)
import Data.IORef
import Network.Wai
import Network.Wai.Internal
import Network.HTTP.Types

import qualified Data.ByteString.Lazy     as Lazy
import qualified Blaze.ByteString.Builder as Builder

request :: ByteString -> Request
request p = defaultRequest { rawPathInfo = p }

withHeader :: CI ByteString -> ByteString -> Request -> Request
withHeader k v r = r { requestHeaders = (k, v) : requestHeaders r }

withQuery :: ByteString -> ByteString -> Request -> Request
withQuery k v r = r { queryString = (k, Just v) : queryString r }

json :: Request -> Request
json = withHeader "Accept" "application/json"

responseBody :: Response -> Lazy.ByteString
responseBody (ResponseBuilder _ _ b) = Builder.toLazyByteString b
responseBody _                       = ""

writeText :: Lazy.ByteString -> IO Response
writeText = return . responseLBS status200 []

apply :: (a -> (Response -> IO ResponseReceived) -> IO ResponseReceived) -> a -> IO Response
apply f r = do
    ref <- newIORef undefined
    void $ f r $ \x -> writeIORef ref x >> return ResponseReceived
    readIORef ref