    {-# 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
        (os, grab) <- IO (OutputStream Builder, IO [Builder])
    forall c. IO (OutputStream c, IO [c])
    Streams.listOutputStream
        enum os
        liftM toBS grab

      where
        enum :: OutputStream Builder -> IO ()
    enum OutputStream Builder
    os = do
            os' <- ResponseBody -> StreamProc
    rspBodyToEnum (Response -> ResponseBody
    rspBody Response
    rsp) OutputStream Builder
    os
            Streams.write Nothing 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
    . LazyByteString -> [ByteString]
    L.toChunks (LazyByteString -> [ByteString])
    -> ([Builder] -> LazyByteString) -> [Builder] -> [ByteString]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Builder -> LazyByteString
    toLazyByteString (Builder -> LazyByteString)
    -> ([Builder] -> Builder) -> [Builder] -> LazyByteString
    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
        body <- Response -> IO ByteString
    getResponseBody Response
    rsp
        assertBool message (body =~ 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"