apiary-0.5.0.0: test/main.hs

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}

import Test.Framework
import Test.Framework.Providers.HUnit

import Web.Apiary
import Network.Wai
import Network.Wai.Test

import qualified Data.ByteString.Lazy as L

getRoot :: Request
getRoot = defaultRequest

postRoot :: Request
postRoot = defaultRequest { requestMethod = "POST" }

deleteRoot :: Request
deleteRoot = defaultRequest { requestMethod = "DELETE" }

putRoot :: Request
putRoot = defaultRequest { requestMethod = "PUT" }

getIndexHtml :: Request
getIndexHtml = setPath defaultRequest "/index.html"

getNeko :: Request
getNeko = setPath defaultRequest "/neko"

--------------------------------------------------------------------------------

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" 
    [ testCase "GET /"     $ assertPlain200 "hello" helloWorldApp getRoot
    , testCase "GET /neko" $ assertPlain200 "hello" helloWorldApp getNeko
    , testCase "POST /"    $ assertPlain200 "hello" helloWorldApp postRoot
    ]

--------------------------------------------------------------------------------

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"
    [ testCase "GET /"     $ assertPlain200 "GET" methodFilterApp getRoot
    , testCase "POST /"    $ assertPlain200 "POST" methodFilterApp postRoot
    , testCase "GET /neko" $ assertPlain200 "GET" methodFilterApp getNeko
    , testCase "DELETE /"  $ assert404 methodFilterApp deleteRoot
    ]

--------------------------------------------------------------------------------
rootFilterApp :: Application
rootFilterApp = runApiary def .  root . action $ do
    contentType "text/html"
    lbs "root"

rootFilterTest :: Test
rootFilterTest = testGroup "rootFilter"
    [ testCase "GET /"           $ assertHtml200 "root" rootFilterApp getRoot
    , testCase "POST /"          $ assertHtml200 "root" rootFilterApp postRoot
    , testCase "GET /neko"       $ assert404 rootFilterApp getNeko
    , testCase "GET /index.html" $ assertHtml200 "root" rootFilterApp getIndexHtml
    ]

--------------------------------------------------------------------------------

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"
    [ testCase "GET /index.html" $ assertPlain200 "GET /"       multipleFilter1App getIndexHtml
    , testCase "POST /"          $ assertHtml200 "POST /"      multipleFilter1App postRoot
    , testCase "DELETE /"        $ assertPlain200 "DELETE ANY" multipleFilter1App deleteRoot
    , testCase "PUT /"           $ assert404 multipleFilter1App putRoot
    ]

--------------------------------------------------------------------------------


--------------------------------------------------------------------------------


main :: IO ()
main = defaultMain 
    [ helloWorldAllTest
    , methodFilterTest
    , rootFilterTest
    , multipleFilter1Test
    ]