80 lines
2.1 KiB
Haskell
80 lines
2.1 KiB
Haskell
{-# LANGUAGE QuasiQuotes, TypeFamilies, TemplateHaskell, MultiParamTypeClasses #-}
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
module Test.CleanPath (cleanPathTest) where
|
|
|
|
import Yesod.Core
|
|
import Yesod.Content
|
|
import Yesod.Dispatch
|
|
|
|
import Test.Framework (defaultMain, testGroup, Test)
|
|
import Test.Framework.Providers.HUnit
|
|
import Test.HUnit hiding (Test)
|
|
import Network.Wai
|
|
import Network.Wai.Test
|
|
|
|
data Y = Y
|
|
mkYesod "Y" [$parseRoutes|
|
|
/foo FooR GET
|
|
/bar BarR GET
|
|
|]
|
|
|
|
instance Yesod Y where
|
|
approot _ = "http://test"
|
|
cleanPath _ ["bar", ""] = Right ["bar"]
|
|
cleanPath _ ["bar"] = Left ["bar", ""]
|
|
cleanPath _ s =
|
|
if corrected == s
|
|
then Right s
|
|
else Left corrected
|
|
where
|
|
corrected = filter (not . null) s
|
|
|
|
getFooR = return $ RepPlain "foo"
|
|
getBarR = return $ RepPlain "bar"
|
|
|
|
cleanPathTest :: Test
|
|
cleanPathTest = testGroup "Test.CleanPath"
|
|
[ testCase "remove trailing slash" removeTrailingSlash
|
|
, testCase "noTrailingSlash" noTrailingSlash
|
|
, testCase "add trailing slash" addTrailingSlash
|
|
, testCase "has trailing slash" hasTrailingSlash
|
|
]
|
|
|
|
runner f = toWaiApp Y >>= runSession f
|
|
defaultRequest = Request
|
|
{ pathInfo = ""
|
|
, requestHeaders = []
|
|
, queryString = ""
|
|
, requestMethod = "GET"
|
|
}
|
|
|
|
removeTrailingSlash = runner $ do
|
|
res <- request defaultRequest
|
|
{ pathInfo = "/foo/"
|
|
}
|
|
assertStatus 301 res
|
|
assertHeader "Location" "http://test/foo" res
|
|
|
|
noTrailingSlash = runner $ do
|
|
res <- request defaultRequest
|
|
{ pathInfo = "/foo"
|
|
}
|
|
assertStatus 200 res
|
|
assertContentType "text/plain; charset=utf-8" res
|
|
assertBody "foo" res
|
|
|
|
addTrailingSlash = runner $ do
|
|
res <- request defaultRequest
|
|
{ pathInfo = "/bar"
|
|
}
|
|
assertStatus 301 res
|
|
assertHeader "Location" "http://test/bar/" res
|
|
|
|
hasTrailingSlash = runner $ do
|
|
res <- request defaultRequest
|
|
{ pathInfo = "/bar/"
|
|
}
|
|
assertStatus 200 res
|
|
assertContentType "text/plain; charset=utf-8" res
|
|
assertBody "bar" res
|