Predicates.hs

{-# LANGUAGE OverloadedStrings, FlexibleContexts, TypeFamilies #-}
module Tests.Snap.Predicates (tests) where

import Test.Framework
import Test.Framework.Providers.HUnit
import Test.HUnit hiding (Test)
import Data.ByteString (ByteString)
import Data.Predicate
import Snap.Predicates
import Snap.Test
import qualified Data.Map.Strict as M

tests :: [Test]
tests =
    [ testAccept
    , testParam
    , testParamOpt
    , testAcceptJson
    , testAcceptThrift
    ]

testAccept :: Test
testAccept = testCase "Accept Predicate" $ do
    rq0 <- buildRequest $ addHeader "Accept" "x/y"
    let predicate = Accept (Type "x") (SubType "y")
    let true = T 0 $ MediaType (Type "x") (SubType "y") 1.0 []
    assertEqual "Matching Accept" true (eval predicate rq0)

    rq1 <- buildRequest $ addHeader "Accept" "u/v"
    assertEqual "Status Code 406"
        (F (err 406 ("Expected 'Accept: \"x\"/\"y\"'.")))
        (eval predicate rq1)

testAcceptJson :: Test
testAcceptJson = testCase "AcceptJson Predicate" $ do
    rq0 <- buildRequest $ addHeader "Accept" "application/json"
    let predicate = Accept Application Json
    let true = T 0 $ MediaType Application Json 1.0 []
    assertEqual "Matching AcceptJson" true (eval predicate rq0)

    rq1 <- buildRequest $ addHeader "Accept" "foo/bar"
    assertEqual "Status Code 406"
        (F (err 406 ("Expected 'Accept: application/json'.")))
        (eval predicate rq1)

testAcceptThrift :: Test
testAcceptThrift = testCase "AcceptThrift Predicate" $ do
    rq0 <- buildRequest $ addHeader "Accept" "application/x-thrift"
    let predicate = Accept Application Thrift
    let true = T 0 $ MediaType Application Thrift 1.0 []
    assertEqual "Matching AcceptThrift" true (eval predicate rq0)

    rq1 <- buildRequest $ addHeader "Accept" "application/json"
    assertEqual "Status Code 406"
        (F (err 406 ("Expected 'Accept: application/x-thrift'.")))
        (eval predicate rq1)

testParam :: Test
testParam = testCase "Param Predicate" $ do
    rq0 <- buildRequest $ get "/" (M.fromList [("x", ["y", "z"])])
    assertEqual "Matching Param" (T 0 "y") (eval (Param "x" :: Param ByteString) rq0)

    rq1 <- buildRequest $ get "/" M.empty
    assertEqual "Status Code 400"
        (F (err 400 ("Missing parameter 'x'.")))
        (eval (Param "x" :: Param ByteString) rq1)

testParamOpt :: Test
testParamOpt = testCase "ParamOpt Predicate" $ do
    rq0 <- buildRequest $ get "/" (M.fromList [("x", ["y", "z"])])
    assertEqual "Matching Param 1" (T 0 (Just "y")) (eval (ParamOpt "x" :: ParamOpt ByteString) rq0)

    rq1 <- buildRequest $ get "/" M.empty
    assertEqual "Matching Param 2" (T 0 Nothing) (eval (ParamOpt "x" :: ParamOpt ByteString) rq1)