From f035b1fc22c31fa1b081ef650b0c44363126a380 Mon Sep 17 00:00:00 2001
From: Michael Xavier <michael@michaelxavier.net>
Date: Thu, 22 Mar 2012 19:20:15 -0700
Subject: [PATCH 1/3] Add bodyEquals assertion

---
 yesod-test/Yesod/Test.hs | 9 ++++++++-
 1 file changed, 8 insertions(+), 1 deletion(-)

diff --git a/yesod-test/Yesod/Test.hs b/yesod-test/Yesod/Test.hs
index 3548ddf8..42a020c3 100644
--- a/yesod-test/Yesod/Test.hs
+++ b/yesod-test/Yesod/Test.hs
@@ -50,7 +50,7 @@ module Yesod.Test (
   runDB,
 
   -- * Assertions
-  assertEqual, statusIs, bodyContains, htmlAllContain, htmlCount,
+  assertEqual, statusIs, bodyEquals, bodyContains, htmlAllContain, htmlCount,
 
   -- * Utils for debugging tests
   printBody, printMatches,
@@ -179,6 +179,13 @@ statusIs number = withResponse $ \ SResponse { simpleStatus = s } ->
     , " but received status was ", show $ H.statusCode s
     ]
 
+-- | Assert the last response is exactly equal to the given text. This is
+-- useful for testing API responses.
+bodyEquals :: HoldsResponse a => String -> ST.StateT a IO ()
+bodyEquals text = withResponse $ \ res ->
+  liftIO $ HUnit.assertBool ("Expected body to equal " ++ text) $
+    (simpleBody res) == BSL8.pack text
+
 -- | Assert the last response has the given text. The check is performed using the response
 -- body in full text form.
 bodyContains :: HoldsResponse a => String -> ST.StateT a IO ()

From 05ed37807b58f528a2278b6f81b53da2297e155d Mon Sep 17 00:00:00 2001
From: Michael Xavier <michael@michaelxavier.net>
Date: Thu, 22 Mar 2012 19:47:10 -0700
Subject: [PATCH 2/3] Port assertHeader/assertNoHeader from wai-test

---
 yesod-test/Yesod/Test.hs    | 38 +++++++++++++++++++++++++++++++++++--
 yesod-test/yesod-test.cabal |  1 +
 2 files changed, 37 insertions(+), 2 deletions(-)

diff --git a/yesod-test/Yesod/Test.hs b/yesod-test/Yesod/Test.hs
index 42a020c3..7d1607ec 100644
--- a/yesod-test/Yesod/Test.hs
+++ b/yesod-test/Yesod/Test.hs
@@ -50,7 +50,8 @@ module Yesod.Test (
   runDB,
 
   -- * Assertions
-  assertEqual, statusIs, bodyEquals, bodyContains, htmlAllContain, htmlCount,
+  assertEqual, assertHeader, assertNoHeader, statusIs, bodyEquals, bodyContains,
+  htmlAllContain, htmlCount,
 
   -- * Utils for debugging tests
   printBody, printMatches,
@@ -75,9 +76,10 @@ import qualified Test.HUnit as HUnit
 import qualified Test.Hspec.HUnit ()
 import qualified Network.HTTP.Types as H
 import qualified Network.Socket.Internal as Sock
+import Data.CaseInsensitive (CI)
 import Text.XML.HXT.Core hiding (app, err)
 import Network.Wai
-import Network.Wai.Test
+import Network.Wai.Test hiding (assertHeader, assertNoHeader)
 import qualified Control.Monad.Trans.State as ST
 import Control.Monad.IO.Class
 import System.IO
@@ -179,6 +181,38 @@ statusIs number = withResponse $ \ SResponse { simpleStatus = s } ->
     , " but received status was ", show $ H.statusCode s
     ]
 
+-- | Assert the given header key/value pair was returned.
+assertHeader :: HoldsResponse a => CI BS8.ByteString -> BS8.ByteString -> ST.StateT a IO ()
+assertHeader header value = withResponse $ \ SResponse { simpleHeaders = h } ->
+  case lookup header h of
+    Nothing -> failure $ concat
+        [ "Expected header "
+        , show header
+        , " to be "
+        , show value
+        , ", but it was not present"
+        ]
+    Just value' -> liftIO $ flip HUnit.assertBool (value == value') $ concat
+        [ "Expected header "
+        , show header
+        , " to be "
+        , show value
+        , ", but received "
+        , show value'
+        ]
+
+-- | Assert the given header was not included in the response.
+assertNoHeader :: HoldsResponse a => CI BS8.ByteString -> ST.StateT a IO ()
+assertNoHeader header = withResponse $ \ SResponse { simpleHeaders = h } ->
+  case lookup header h of
+    Nothing -> return ()
+    Just s  -> failure $ concat
+        [ "Unexpected header "
+        , show header
+        , " containing "
+        , show s
+        ]
+
 -- | Assert the last response is exactly equal to the given text. This is
 -- useful for testing API responses.
 bodyEquals :: HoldsResponse a => String -> ST.StateT a IO ()
diff --git a/yesod-test/yesod-test.cabal b/yesod-test/yesod-test.cabal
index 982d91c4..f038e611 100644
--- a/yesod-test/yesod-test.cabal
+++ b/yesod-test/yesod-test.cabal
@@ -32,6 +32,7 @@ library
                    , HUnit                     >= 1.2      && < 1.3
                    , hspec                     >= 0.9      && < 1.0
                    , bytestring                >= 0.9
+                   , case-insensitive          >= 0.2
                    , text
     exposed-modules: Yesod.Test
     other-modules: Yesod.Test.TransversingCSS

From e18253e6e98e2c72afef1c5f5145bf1e4324b924 Mon Sep 17 00:00:00 2001
From: Michael Xavier <michael@michaelxavier.net>
Date: Thu, 22 Mar 2012 19:58:18 -0700
Subject: [PATCH 3/3] Expose withResponse in yesod-test

---
 yesod-test/Yesod/Test.hs | 5 +++--
 1 file changed, 3 insertions(+), 2 deletions(-)

diff --git a/yesod-test/Yesod/Test.hs b/yesod-test/Yesod/Test.hs
index 7d1607ec..6d5ba66f 100644
--- a/yesod-test/Yesod/Test.hs
+++ b/yesod-test/Yesod/Test.hs
@@ -58,7 +58,7 @@ module Yesod.Test (
 
   -- * Utils for building your own assertions
   -- | Please consider generalizing and contributing the assertions you write.
-  htmlQuery, parseHTML
+  htmlQuery, parseHTML, withResponse
 
 )
 
@@ -152,7 +152,8 @@ it label action = do
         return ()
   ST.put $ SpecsData app conn (specs++spec)
 
--- Performs a given action using the last response.
+-- Performs a given action using the last response. Use this to create
+-- response-level assertions
 withResponse :: HoldsResponse a => (SResponse -> ST.StateT a IO b) -> ST.StateT a IO b
 withResponse f = maybe err f =<< fmap readResponse ST.get
  where err = failure "There was no response, you should make a request"