Json.hs

{-# LANGUAGE OverloadedStrings, TemplateHaskell, QuasiQuotes, TypeFamilies, MultiParamTypeClasses #-}
module YesodCoreTest.Json (specs, Widget) where

import Yesod.Core
import Test.Hspec
import qualified Data.Map as Map
import Network.Wai.Test
import Data.Text (Text)
import Data.ByteString.Lazy (ByteString)

data App = App

mkYesod "App" [parseRoutes|
/ HomeR GET
/has-multiple-pieces/#Int/#Int MultiplePiecesR GET
|]

instance Yesod App

getHomeR :: Handler RepPlain
getHomeR = do
    val <- parseJsonBody_
    case Map.lookup ("foo" :: Text) val of
        Nothing -> invalidArgs ["foo not found"]
        Just foo -> return $ RepPlain $ toContent (foo :: Text)

getMultiplePiecesR :: Int -> Int -> Handler ()
getMultiplePiecesR _ _ = return ()

test :: String
     -> ByteString
     -> (SResponse -> Session ())
     -> Spec
test name rbody f = it name $ do
    app <- toWaiApp App
    flip runSession app $ do
        sres <- srequest SRequest
            { simpleRequest = defaultRequest
            , simpleRequestBody = rbody
            }
        f sres

specs :: Spec
specs = describe "Yesod.Json" $ do
    test "parses valid content" "{\"foo\":\"bar\"}" $ \sres -> do
        assertStatus 200 sres
        assertBody "bar" sres
    test "400 for bad JSON" "{\"foo\":\"bar\"" $ \sres -> do
        assertStatus 400 sres
    test "400 for bad structure" "{\"foo2\":\"bar\"}" $ \sres -> do
        assertStatus 400 sres
        assertBodyContains "foo not found" sres