{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-} {-# OPTIONS_GHC -fno-warn-missing-signatures #-} import Test.Framework import Test.Framework.Providers.HUnit import Web.Apiary import Network.Wai import Network.Wai.Test import qualified Network.HTTP.Types as HTTP import qualified Data.ByteString.Lazy.Char8 as L import qualified Data.ByteString.Char8 as S testReq :: String -> (Request -> IO ()) -> Test testReq str f = let (meth, other) = break (== ' ') str (p, version) = break (== ' ') (tail other) in testCase str $ f (setPath (setVersion version $ (defaultRequest { requestMethod = S.pack meth })) (S.pack p)) where setVersion [] r = r setVersion v r | v == " HTTP/1.1" = r { Network.Wai.httpVersion = HTTP.http11 } | v == " HTTP/1.0" = r { Network.Wai.httpVersion = HTTP.http10 } | v == " HTTP/0.9" = r { Network.Wai.httpVersion = HTTP.http09 } | otherwise = error "unknown HTTP version" -------------------------------------------------------------------------------- assertPlain200 :: L.ByteString -> Application -> Request -> IO () assertPlain200 body app req = flip runSession app $ do res <- request req assertStatus 200 res assertContentType "text/plain" res assertBody body res assertHtml200 :: L.ByteString -> Application -> Request -> IO () assertHtml200 body app req = flip runSession app $ do res <- request req assertStatus 200 res assertContentType "text/html" res assertBody body res assert404 :: Application -> Request -> IO () assert404 app req = flip runSession app $ do res <- request req assertStatus 404 res assertContentType "text/plain" res assertBody "404 Page Notfound.\n" res -------------------------------------------------------------------------------- helloWorldApp :: Application helloWorldApp = runApiary def $ action $ do contentType "text/plain" lbs "hello" helloWorldAllTest :: Test helloWorldAllTest = testGroup "helloWorld" [ testReq "GET /" $ assertPlain200 "hello" helloWorldApp , testReq "GET /foo" $ assertPlain200 "hello" helloWorldApp , testReq "POST /" $ assertPlain200 "hello" helloWorldApp ] -------------------------------------------------------------------------------- methodFilterApp :: Application methodFilterApp = runApiary def $ do method "GET" . action $ contentType "text/plain" >> lbs "GET" stdMethod POST . action $ contentType "text/plain" >> lbs "POST" methodFilterTest :: Test methodFilterTest = testGroup "methodFilter" [ testReq "GET /" $ assertPlain200 "GET" methodFilterApp , testReq "POST /" $ assertPlain200 "POST" methodFilterApp , testReq "GET /foo" $ assertPlain200 "GET" methodFilterApp , testReq "DELETE /" $ assert404 methodFilterApp ] -------------------------------------------------------------------------------- httpVersionApp :: Application httpVersionApp = runApiary def $ do http09 . action $ contentType "text/plain" >> lbs "09" http10 . action $ contentType "text/plain" >> lbs "10" http11 . action $ contentType "text/plain" >> lbs "11" httpVersionTest :: Test httpVersionTest = testGroup "httpVersionFilter" [ testReq "GET / HTTP/0.9" $ assertPlain200 "09" httpVersionApp , testReq "GET / HTTP/1.0" $ assertPlain200 "10" httpVersionApp , testReq "GET / HTTP/1.1" $ assertPlain200 "11" httpVersionApp ] -------------------------------------------------------------------------------- rootFilterApp :: Application rootFilterApp = runApiary def . root . action $ do contentType "text/html" lbs "root" rootFilterTest :: Test rootFilterTest = testGroup "rootFilter" [ testReq "GET /" $ assertHtml200 "root" rootFilterApp , testReq "POST /" $ assertHtml200 "root" rootFilterApp , testReq "GET /neko" $ assert404 rootFilterApp , testReq "GET /index.html" $ assertHtml200 "root" rootFilterApp ] -------------------------------------------------------------------------------- captureApp :: Application captureApp = runApiary def $ do [capture|/foo|] . action $ contentType "text/plain" >> lbs "foo" [capture|/:Int|] . stdMethod GET . action $ \i -> contentType "text/plain" >> lbs (L.unwords ["Int", L.pack $ show i]) [capture|/:Double|] . action $ \i -> contentType "text/plain" >> lbs (L.unwords ["Double", L.pack $ show i]) [capture|/bar/:L.ByteString/:Int|] . action $ \s i -> contentType "text/plain" >> lbs (L.unwords [s, L.pack $ show i]) [capture|/:L.ByteString|] . action $ \s -> contentType "text/plain" >> lbs (L.unwords ["fall", s]) captureTest :: Test captureTest = testGroup "capture" [ testReq "GET /foo" $ assertPlain200 "foo" captureApp , testReq "GET /12" $ assertPlain200 "Int 12" captureApp , testReq "GET /12.4" $ assertPlain200 "Double 12.4" captureApp , testReq "POST /12" $ assertPlain200 "Double 12.0" captureApp , testReq "GET /bar" $ assertPlain200 "fall bar" captureApp , testReq "GET /baz" $ assertPlain200 "fall baz" captureApp , testReq "GET /bar/nyan/12" $ assertPlain200 "nyan 12" captureApp , testReq "GET /bar/nyan/12/other" $ assert404 captureApp ] -------------------------------------------------------------------------------- queryApp f g h = runApiary def $ do _ <- (f "foo" pInt) . action $ \i -> contentType "text/plain" >> lbs (L.unwords ["foo", "Int", L.pack $ show i]) _ <- (g "foo" pString) . action $ \i -> contentType "text/plain" >> lbs (L.unwords ["foo", "String", L.pack $ show i]) (h "foo" (pMaybe pString)) . action $ \i -> contentType "text/plain" >> lbs (L.unwords ["foo", "Maybe String", L.pack $ show i]) queryCheckApp :: Application queryCheckApp = runApiary def $ do ("foo" ?: pInt) . action $ contentType "text/plain" >> lbs (L.unwords ["foo", "Int"]) ("foo" ?: pString) . action $ contentType "text/plain" >> lbs (L.unwords ["foo", "String"]) ("foo" ?: pMaybe pString) . action $ contentType "text/plain" >> lbs (L.unwords ["foo", "Maybe String"]) queryFirstTest :: Test queryFirstTest = testGroup "First" [ testReq "GET /" $ assert404 app , testReq "GET /?foo" $ assertPlain200 "foo Maybe String Nothing" app , testReq "GET /?foo&foo=3" $ assertPlain200 "foo Maybe String Nothing" app , testReq "GET /?foo=12" $ assertPlain200 "foo Int 12" app , testReq "GET /?foo=a" $ assertPlain200 "foo String \"a\"" app , testReq "GET /?foo=12&foo=23" $ assertPlain200 "foo Int 12" app , testReq "GET /?foo=12&foo=b" $ assertPlain200 "foo String \"12\"" app ] where app = queryApp (=:) (=:) (=:) queryOneTest :: Test queryOneTest = testGroup "One" [ testReq "GET /" $ assert404 app , testReq "GET /?foo" $ assertPlain200 "foo Maybe String Nothing" app , testReq "GET /?foo&foo=3" $ assert404 app , testReq "GET /?foo=12" $ assertPlain200 "foo Int 12" app , testReq "GET /?foo=a" $ assertPlain200 "foo String \"a\"" app , testReq "GET /?foo=12&foo=23" $ assert404 app , testReq "GET /?foo=12&foo=b" $ assert404 app ] where app = queryApp (=!:) (=!:) (=!:) queryOptionTest :: Test queryOptionTest = testGroup "Option" [ testReq "GET /" $ assertPlain200 "foo Int Nothing" app , testReq "GET /?foo" $ assertPlain200 "foo Maybe String Just Nothing" app , testReq "GET /?foo&foo=3" $ assertPlain200 "foo Maybe String Just Nothing" app , testReq "GET /?foo=12" $ assertPlain200 "foo Int Just 12" app , testReq "GET /?foo=a" $ assertPlain200 "foo String Just \"a\"" app , testReq "GET /?foo=12&foo=23" $ assertPlain200 "foo Int Just 12" app , testReq "GET /?foo=12&foo=b" $ assertPlain200 "foo String Just \"12\"" app ] where app = queryApp (=?:) (=?:) (=?:) queryCheckTest :: Test queryCheckTest = testGroup "Check" [ testReq "GET /" $ assert404 app , testReq "GET /?foo" $ assertPlain200 "foo Maybe String" app , testReq "GET /?foo&foo=3" $ assertPlain200 "foo Maybe String" app , testReq "GET /?foo=12" $ assertPlain200 "foo Int" app , testReq "GET /?foo=a" $ assertPlain200 "foo String" app , testReq "GET /?foo=12&foo=23" $ assertPlain200 "foo Int" app , testReq "GET /?foo=12&foo=b" $ assertPlain200 "foo String" app ] where app = queryCheckApp queryManyTest :: Test queryManyTest = testGroup "Many" [ testReq "GET /" $ assertPlain200 "foo Int []" app , testReq "GET /?foo" $ assertPlain200 "foo Maybe String [Nothing]" app , testReq "GET /?foo&foo=3" $ assertPlain200 "foo Maybe String [Nothing,Just \"3\"]" app , testReq "GET /?foo=12" $ assertPlain200 "foo Int [12]" app , testReq "GET /?foo=a" $ assertPlain200 "foo String [\"a\"]" app , testReq "GET /?foo=12&foo=23" $ assertPlain200 "foo Int [12,23]" app , testReq "GET /?foo=12&foo=b" $ assertPlain200 "foo String [\"12\",\"b\"]" app ] where app = queryApp (=*:) (=*:) (=*:) querySomeTest :: Test querySomeTest = testGroup "Some" [ testReq "GET /" $ assert404 app , testReq "GET /?foo" $ assertPlain200 "foo Maybe String [Nothing]" app , testReq "GET /?foo&foo=3" $ assertPlain200 "foo Maybe String [Nothing,Just \"3\"]" app , testReq "GET /?foo=12" $ assertPlain200 "foo Int [12]" app , testReq "GET /?foo=a" $ assertPlain200 "foo String [\"a\"]" app , testReq "GET /?foo=12&foo=23" $ assertPlain200 "foo Int [12,23]" app , testReq "GET /?foo=12&foo=b" $ assertPlain200 "foo String [\"12\",\"b\"]" app ] where app = queryApp (=+:) (=+:) (=+:) queryTest :: Test queryTest = testGroup "query" [ queryFirstTest , queryOneTest , queryOptionTest , queryCheckTest , queryManyTest , querySomeTest ] -------------------------------------------------------------------------------- multipleFilter1App :: Application multipleFilter1App = runApiary def $ do root $ do stdMethod GET . action $ contentType "text/plain" >> lbs "GET /" stdMethod POST . action $ contentType "text/html" >> lbs "POST /" stdMethod DELETE . action $ contentType "text/plain" >> lbs "DELETE ANY" multipleFilter1Test :: Test multipleFilter1Test = testGroup "multiple test1: root, method" [ testReq "GET /index.html" $ assertPlain200 "GET /" multipleFilter1App , testReq "POST /" $ assertHtml200 "POST /" multipleFilter1App , testReq "DELETE /" $ assertPlain200 "DELETE ANY" multipleFilter1App , testReq "PUT /" $ assert404 multipleFilter1App ] -------------------------------------------------------------------------------- main :: IO () main = defaultMain [ helloWorldAllTest , methodFilterTest , httpVersionTest , rootFilterTest , captureTest , queryTest , multipleFilter1Test ]