{-# LANGUAGE CPP, OverloadedStrings #-}
module Snap.Internal.Test.Assertions where

------------------------------------------------------------------------------
import           Control.Monad              (liftM)
import           Data.ByteString.Builder    (toLazyByteString)
import           Data.ByteString.Char8      (ByteString)
import qualified Data.ByteString.Char8      as S
import qualified Data.ByteString.Lazy.Char8 as L
import           Data.Maybe                 (fromJust)
import           Snap.Internal.Http.Types   (Response (rspBody, rspStatus), getHeader, rspBodyToEnum)
import qualified System.IO.Streams          as Streams
import           Test.HUnit                 (Assertion, assertBool, assertEqual)
import           Text.Regex.Posix           ((=~))
#if !MIN_VERSION_base(4,8,0)
import           Data.Monoid                (mconcat)
#endif
------------------------------------------------------------------------------

------------------------------------------------------------------------------
-- | Given a 'Response', return its body as a 'ByteString'.
--
-- Example:
--
-- @
-- ghci> 'getResponseBody' 'emptyResponse'
-- \"\"
-- @
--
getResponseBody :: Response -> IO ByteString
getResponseBody :: Response -> IO ByteString
getResponseBody Response
rsp = do
    (OutputStream Builder
os, IO [Builder]
grab) <- IO (OutputStream Builder, IO [Builder])
forall c. IO (OutputStream c, IO [c])
Streams.listOutputStream
    OutputStream Builder -> IO ()
enum OutputStream Builder
os
    ([Builder] -> ByteString) -> IO [Builder] -> IO ByteString
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM [Builder] -> ByteString
toBS IO [Builder]
grab

  where
    enum :: OutputStream Builder -> IO ()
enum OutputStream Builder
os = do
        OutputStream Builder
os' <- ResponseBody -> StreamProc
rspBodyToEnum (Response -> ResponseBody
rspBody Response
rsp) OutputStream Builder
os
        Maybe Builder -> OutputStream Builder -> IO ()
forall a. Maybe a -> OutputStream a -> IO ()
Streams.write Maybe Builder
forall a. Maybe a
Nothing OutputStream Builder
os'

    toBS :: [Builder] -> ByteString
toBS = [ByteString] -> ByteString
S.concat ([ByteString] -> ByteString)
-> ([Builder] -> [ByteString]) -> [Builder] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
L.toChunks (ByteString -> [ByteString])
-> ([Builder] -> ByteString) -> [Builder] -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
toLazyByteString (Builder -> ByteString)
-> ([Builder] -> Builder) -> [Builder] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat


------------------------------------------------------------------------------
-- | Given a 'Response', assert that its HTTP status code is 200 (success).
--
-- Example:
--
-- @
-- ghci> :set -XOverloadedStrings
-- ghci> import qualified "Test.HUnit" as T
-- ghci> let test = T.runTestTT . T.TestCase
-- ghci> test $ 'assertSuccess' 'Snap.Core.emptyResponse'
-- Cases: 1  Tried: 1  Errors: 0  Failures: 0
-- Counts {cases = 1, tried = 1, errors = 0, failures = 0}
-- ghci> test $ 'assertSuccess' ('Snap.Core.setResponseStatus' 500 \"Internal Server Error\" 'Snap.Core.emptyResponse')
-- ### Failure:
-- Expected success (200) but got (500)
-- expected: 200
--  but got: 500
-- Cases: 1  Tried: 1  Errors: 0  Failures: 1
-- Counts {cases = 1, tried = 1, errors = 0, failures = 1}
-- @
assertSuccess :: Response -> Assertion
assertSuccess :: Response -> IO ()
assertSuccess Response
rsp = String -> Int -> Int -> IO ()
forall a. (HasCallStack, Eq a, Show a) => String -> a -> a -> IO ()
assertEqual String
message Int
200 Int
status
  where
    message :: String
message = String
"Expected success (200) but got (" String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Int -> String
forall a. Show a => a -> String
show Int
status) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
    status :: Int
status  = Response -> Int
rspStatus Response
rsp


------------------------------------------------------------------------------
-- | Given a 'Response', assert that its HTTP status code is 404 (Not Found).
--
-- Example:
--
-- @
-- ghci> :set -XOverloadedStrings
-- ghci> 'assert404' $ 'Snap.Core.setResponseStatus' 404 \"Not Found\" 'Snap.Core.emptyResponse'
-- ghci> 'assert404' 'Snap.Core.emptyResponse'
-- *** Exception: HUnitFailure \"Expected Not Found (404) but got (200)\\nexpected: 404\\n but got: 200\"
-- @
assert404 :: Response -> Assertion
assert404 :: Response -> IO ()
assert404 Response
rsp = String -> Int -> Int -> IO ()
forall a. (HasCallStack, Eq a, Show a) => String -> a -> a -> IO ()
assertEqual String
message Int
404 Int
status
  where
    message :: String
message = String
"Expected Not Found (404) but got (" String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Int -> String
forall a. Show a => a -> String
show Int
status) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
    status :: Int
status = Response -> Int
rspStatus Response
rsp


------------------------------------------------------------------------------
-- | Given a 'Response', assert that its HTTP status code is between 300 and 399
-- (a redirect), and that the Location header of the 'Response' points to the
-- specified URI.
--
-- Example:
--
-- @
-- ghci> :set -XOverloadedStrings
-- ghci> let r' = 'Snap.Core.setResponseStatus' 301 \"Moved Permanently\" 'Snap.Core.emptyResponse'
-- ghci> let r  = 'Snap.Core.setHeader' \"Location\" \"www.example.com\" r'
-- ghci> 'assertRedirectTo' \"www.example.com\" r
-- ghci> 'assertRedirectTo' \"www.example.com\" 'Snap.Core.emptyResponse'
-- *** Exception: HUnitFailure \"Expected redirect but got status code (200)\"
-- @
assertRedirectTo :: ByteString     -- ^ The Response should redirect to this
                                   -- URI
                 -> Response
                 -> Assertion
assertRedirectTo :: ByteString -> Response -> IO ()
assertRedirectTo ByteString
uri Response
rsp = do
    Response -> IO ()
assertRedirect Response
rsp
    String -> ByteString -> ByteString -> IO ()
forall a. (HasCallStack, Eq a, Show a) => String -> a -> a -> IO ()
assertEqual String
message ByteString
uri ByteString
rspUri

  where
    rspUri :: ByteString
rspUri = Maybe ByteString -> ByteString
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe ByteString -> ByteString) -> Maybe ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ CI ByteString -> Response -> Maybe ByteString
forall a. HasHeaders a => CI ByteString -> a -> Maybe ByteString
getHeader CI ByteString
"Location" Response
rsp
    message :: String
message = String
"Expected redirect to " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ByteString -> String
forall a. Show a => a -> String
show ByteString
uri
              String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" but got redirected to "
              String -> String -> String
forall a. [a] -> [a] -> [a]
++ ByteString -> String
forall a. Show a => a -> String
show ByteString
rspUri String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" instead"


------------------------------------------------------------------------------
-- | Given a 'Response', assert that its HTTP status code is between 300 and 399
-- (a redirect).
--
-- Example:
--
-- @
-- ghci> :set -XOverloadedStrings
-- ghci> 'assertRedirect' $ 'Snap.Core.setResponseStatus' 301 \"Moved Permanently\" 'Snap.Core.emptyResponse'
-- ghci> 'assertRedirect' 'Snap.Core.emptyResponse'
-- *** Exception: HUnitFailure \"Expected redirect but got status code (200)\"
-- @
assertRedirect :: Response -> Assertion
assertRedirect :: Response -> IO ()
assertRedirect Response
rsp = HasCallStack => String -> Bool -> IO ()
String -> Bool -> IO ()
assertBool String
message (Int
300 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
status Bool -> Bool -> Bool
&& Int
status Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
399)
  where
    message :: String
message = String
"Expected redirect but got status code ("
              String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
status String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
    status :: Int
status  = Response -> Int
rspStatus Response
rsp


------------------------------------------------------------------------------
-- | Given a 'Response', assert that its body matches the given regular
-- expression.
--
-- Example:
--
-- @
-- ghci> :set -XOverloadedStrings
-- ghci> import qualified "System.IO.Streams" as Streams
-- ghci> import qualified "Data.ByteString.Builder" as Builder
-- ghci> :{
-- ghci| let r = 'Snap.Core.setResponseBody'
-- ghci|         (\out -> do
-- ghci|             Streams.write (Just $ Builder.byteString \"Hello, world!\") out
-- ghci|             return out)
-- ghci|         'Snap.Core.emptyResponse'
-- ghci| :}
-- ghci> 'assertBodyContains' \"^Hello\" r
-- ghci> 'assertBodyContains' \"Bye\" r
-- *** Exception: HUnitFailure "Expected body to match regexp \\\"\\\"Bye\\\"\\\", but didn\'t"
-- @
assertBodyContains :: ByteString  -- ^ Regexp that will match the body content
                   -> Response
                   -> Assertion
assertBodyContains :: ByteString -> Response -> IO ()
assertBodyContains ByteString
match Response
rsp = do
    ByteString
body <- Response -> IO ByteString
getResponseBody Response
rsp
    HasCallStack => String -> Bool -> IO ()
String -> Bool -> IO ()
assertBool String
message (ByteString
body ByteString -> ByteString -> Bool
forall source source1 target.
(RegexMaker Regex CompOption ExecOption source,
 RegexContext Regex source1 target) =>
source1 -> source -> target
=~ ByteString
match)
  where
    message :: String
message = String
"Expected body to match regexp \"" String -> String -> String
forall a. [a] -> [a] -> [a]
++ ByteString -> String
forall a. Show a => a -> String
show ByteString
match
              String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\", but didn't"