{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ConstraintKinds #-}
module Test.Hspec.Wai (
WaiSession
, WaiExpectation
, get
, post
, put
, patch
, options
, delete
, request
, postHtmlForm
, shouldRespondWith
, ResponseMatcher(..)
, MatchHeader(..)
, MatchBody(..)
, Body
, (<:>)
, liftIO
, with
, withState
, getState
, pending
, pendingWith
) where
import Data.Foldable
import Data.ByteString (ByteString)
import qualified Data.ByteString.Lazy as LB
import Control.Monad.IO.Class
import Network.Wai (Request(..))
import Network.HTTP.Types
import Network.Wai.Test hiding (request)
import qualified Network.Wai.Test as Wai
import Test.Hspec.Expectations
import Test.Hspec.Core.Spec hiding (pending, pendingWith)
import qualified Test.Hspec.Core.Spec as Core
import Test.Hspec.Core.Hooks
import Test.Hspec.Wai.Util
import Test.Hspec.Wai.Internal
import Test.Hspec.Wai.Matcher
import Network.Wai (Application)
with :: IO Application -> SpecWith ((), Application) -> Spec
with action = before ((,) () <$> action)
withState :: IO (st, Application) -> SpecWith (st, Application) -> Spec
withState = before
pending :: WaiSession st ()
pending = liftIO Core.pending
pendingWith :: String -> WaiSession st ()
pendingWith = liftIO . Core.pendingWith
shouldRespondWith :: HasCallStack => WaiSession st SResponse -> ResponseMatcher -> WaiExpectation st
shouldRespondWith action matcher = do
r <- action
forM_ (match r matcher) (liftIO . expectationFailure)
get :: ByteString -> WaiSession st SResponse
get path = request methodGet path [] ""
post :: ByteString -> LB.ByteString -> WaiSession st SResponse
post path = request methodPost path []
put :: ByteString -> LB.ByteString -> WaiSession st SResponse
put path = request methodPut path []
patch :: ByteString -> LB.ByteString -> WaiSession st SResponse
patch path = request methodPatch path []
options :: ByteString -> WaiSession st SResponse
options path = request methodOptions path [] ""
delete :: ByteString -> WaiSession st SResponse
delete path = request methodDelete path [] ""
request :: Method -> ByteString -> [Header] -> LB.ByteString -> WaiSession st SResponse
request method path headers body = getApp >>= liftIO . runSession (Wai.srequest $ SRequest req body)
where
req = setPath defaultRequest {requestMethod = method, requestHeaders = headers} path
postHtmlForm :: ByteString -> [(String, String)] -> WaiSession st SResponse
postHtmlForm path = request methodPost path [(hContentType, "application/x-www-form-urlencoded")] . formUrlEncodeQuery