Initial YesodRequest/YesodRespnse change

This commit is contained in:
Michael Snoyman 2013-03-10 11:58:29 +02:00
parent 4f1a6b461e
commit 1bd193f642
16 changed files with 145 additions and 120 deletions

View File

@ -86,17 +86,37 @@ data ClientSessionDateCache =
, csdcExpiresSerialized :: !ByteString
} deriving (Eq, Show)
-- | The parsed request information.
data Request = Request
{ reqGetParams :: [(Text, Text)]
, reqCookies :: [(Text, Text)]
, reqWaiRequest :: W.Request
-- | Languages which the client supports.
, reqLangs :: [Text]
-- | A random, session-specific token used to prevent CSRF attacks.
, reqToken :: Maybe Text
-- | The parsed request information. This type augments the standard WAI
-- 'W.Request' with additional information.
data YesodRequest = YesodRequest
{ reqGetParams :: ![(Text, Text)]
-- ^ Same as 'W.queryString', but decoded to @Text@.
, reqCookies :: ![(Text, Text)]
, reqWaiRequest :: !W.Request
, reqLangs :: ![Text]
-- ^ Languages which the client supports. This is an ordered list by preference.
, reqToken :: !(Maybe Text)
-- ^ A random, session-specific token used to prevent CSRF attacks.
, reqSession :: !SessionMap
-- ^ Initial session sent from the client.
--
-- Since 1.2.0
, reqAccept :: ![ContentType]
-- ^ An ordered list of the accepted content types.
--
-- Since 1.2.0
, reqOnError :: !(ErrorResponse -> YesodApp)
-- ^ How to respond when an error is thrown internally.
--
-- Since 1.2.0
}
-- | An augmented WAI 'W.Response'. This can either be a standard @Response@,
-- or a higher-level data structure which Yesod will turn into a @Response@.
data YesodResponse
= YRWai W.Response
| YRPlain H.Status [Header] ContentType Content SessionMap
-- | A tuple containing both the POST parameters and submitted files.
type RequestBodyContents =
( [(Text, Text)]
@ -150,7 +170,7 @@ type Texts = [Text]
newtype WaiSubsite = WaiSubsite { runWaiSubsite :: W.Application }
data HandlerData sub master = HandlerData
{ handlerRequest :: Request
{ handlerRequest :: YesodRequest
, handlerSub :: sub
, handlerMaster :: master
, handlerRoute :: Maybe (Route sub)
@ -178,18 +198,7 @@ data GHState = GHState
-- | An extension of the basic WAI 'W.Application' datatype to provide extra
-- features needed by Yesod. Users should never need to use this directly, as
-- the 'GHandler' monad and template haskell code should hide it away.
newtype YesodApp = YesodApp
{ unYesodApp
:: (ErrorResponse -> YesodApp)
-> Request
-> [ContentType]
-> SessionMap
-> ResourceT IO YesodAppResult
}
data YesodAppResult
= YARWai W.Response
| YARPlain H.Status [Header] ContentType Content SessionMap
type YesodApp = YesodRequest -> ResourceT IO YesodResponse
-- | A generic widget, allowing specification of both the subsite and master
-- site datatypes. While this is simply a @WriterT@, we define a newtype for

View File

@ -106,7 +106,7 @@ module Yesod.Handler
, cacheDelete
-- * Internal Yesod
, runHandler
, YesodApp (..)
, YesodApp
, runSubsiteGetter
, toMasterHandler
, toMasterHandlerDyn
@ -114,7 +114,6 @@ module Yesod.Handler
, localNoCurrent
, HandlerData
, ErrorResponse (..)
, YesodAppResult (..)
, handlerToYAR
, yarToResponse
, headerToPair
@ -146,10 +145,9 @@ import qualified Data.Text.Lazy as TL
import qualified Data.Map as Map
import qualified Data.ByteString as S
import qualified Data.ByteString.Lazy as L
import Network.Wai.Parse (parseHttpAccept)
import Yesod.Content
import Data.Maybe (fromMaybe, mapMaybe)
import Data.Maybe (mapMaybe)
import Web.Cookie (SetCookie (..), renderSetCookie)
import Control.Arrow ((***))
import qualified Network.Wai.Parse as NWP
@ -255,7 +253,7 @@ toMasterHandlerMaybe :: (Route sub -> Route master)
-> GHandler sub' master a
toMasterHandlerMaybe tm ts route = local (handlerSubDataMaybe tm ts route)
getRequest :: GHandler s m Request
getRequest :: GHandler s m YesodRequest
getRequest = handlerRequest `liftM` ask
hcError :: ErrorResponse -> GHandler sub master a
@ -415,8 +413,7 @@ runHandler :: HasReps c
-> (W.RequestBodyLength -> FileUpload)
-> (Loc -> LogSource -> LogLevel -> LogStr -> IO ())
-> YesodApp
runHandler handler mrender sroute tomr master sub upload log' =
YesodApp $ \eh rr cts initSession -> do
runHandler handler mrender sroute tomr master sub upload log' req = do
let toErrorHandler e =
case fromException e of
Just (HCError x) -> x
@ -429,7 +426,7 @@ runHandler handler mrender sroute tomr master sub upload log' =
, ghsHeaders = mempty
}
let hd = HandlerData
{ handlerRequest = rr
{ handlerRequest = req
, handlerSub = sub
, handlerMaster = master
, handlerRoute = sroute
@ -447,21 +444,24 @@ runHandler handler mrender sroute tomr master sub upload log' =
let headers = ghsHeaders state
let contents = either id (HCContent H.status200 . chooseRep) contents'
let handleError e = do
yar <- unYesodApp (eh e) safeEh rr cts finalSession
yar <- eh e req
{ reqOnError = safeEh
, reqSession = finalSession
}
case yar of
YARPlain _ hs ct c sess ->
YRPlain _ hs ct c sess ->
let hs' = appEndo headers hs
in return $ YARPlain (getStatus e) hs' ct c sess
YARWai _ -> return yar
in return $ YRPlain (getStatus e) hs' ct c sess
YRWai _ -> return yar
let sendFile' ct fp p =
return $ YARPlain H.status200 (appEndo headers []) ct (ContentFile fp p) finalSession
return $ YRPlain H.status200 (appEndo headers []) ct (ContentFile fp p) finalSession
case contents of
HCContent status a -> do
(ct, c) <- liftIO $ a cts
ec' <- liftIO $ evaluateContent c
case ec' of
Left e -> handleError e
Right c' -> return $ YARPlain status (appEndo headers []) ct c' finalSession
Right c' -> return $ YRPlain status (appEndo headers []) ct c' finalSession
HCError e -> handleError e
HCRedirect status loc -> do
let disable_caching x =
@ -470,7 +470,7 @@ runHandler handler mrender sroute tomr master sub upload log' =
: x
hs = (if status /= H.movedPermanently301 then disable_caching else id)
$ Header "Location" (encodeUtf8 loc) : appEndo headers []
return $ YARPlain
return $ YRPlain
status hs typePlain emptyContent
finalSession
HCSendFile ct fp p -> catch
@ -478,13 +478,17 @@ runHandler handler mrender sroute tomr master sub upload log' =
(handleError . toErrorHandler)
HCCreated loc -> do
let hs = Header "Location" (encodeUtf8 loc) : appEndo headers []
return $ YARPlain
return $ YRPlain
H.status201
hs
typePlain
emptyContent
finalSession
HCWai r -> return $ YARWai r
HCWai r -> return $ YRWai r
where
eh = reqOnError req
cts = reqAccept req
initSession = reqSession req
evaluateContent :: Content -> IO (Either ErrorResponse Content)
evaluateContent (ContentBuilder b mlen) = Control.Exception.handle f $ do
@ -496,14 +500,14 @@ evaluateContent (ContentBuilder b mlen) = Control.Exception.handle f $ do
evaluateContent c = return (Right c)
safeEh :: ErrorResponse -> YesodApp
safeEh er = YesodApp $ \_ _ _ session -> do
safeEh er req = do
liftIO $ hPutStrLn stderr $ "Error handler errored out: " ++ show er
return $ YARPlain
return $ YRPlain
H.status500
[]
typePlain
(toContent ("Internal Server Error" :: S.ByteString))
session
(reqSession req)
-- | Redirect to the given route.
-- HTTP status code 303 for HTTP 1.1 clients and 302 for HTTP 1.0
@ -806,6 +810,9 @@ instance (key ~ Text, val ~ Text) => RedirectUrl master (Route master, [(key, va
r <- getUrlRenderParams
return $ r url params
instance (key ~ Text, val ~ Text) => RedirectUrl master (Route master, Map.Map key val) where
toTextUrl (url, params) = toTextUrl (url, Map.toList params)
localNoCurrent :: GHandler s m a -> GHandler s m a
localNoCurrent =
local (\hd -> hd { handlerRoute = Nothing })
@ -832,22 +839,21 @@ handlerToYAR :: (HasReps a, HasReps b)
-> (Route sub -> Route master)
-> (Route master -> [(Text, Text)] -> Text) -- route renderer
-> (ErrorResponse -> GHandler sub master a)
-> Request
-> YesodRequest
-> Maybe (Route sub)
-> SessionMap
-> GHandler sub master b
-> ResourceT IO YesodAppResult
-> ResourceT IO YesodResponse
handlerToYAR y s upload log' toMasterRoute render errorHandler rr murl sessionMap h =
unYesodApp ya eh' rr types sessionMap
ya rr { reqOnError = eh', reqSession = sessionMap }
where
ya = runHandler h render murl toMasterRoute y s upload log'
eh' er = runHandler (errorHandler' er) render murl toMasterRoute y s upload log'
types = httpAccept $ reqWaiRequest rr
errorHandler' = localNoCurrent . errorHandler
yarToResponse :: YesodAppResult -> [(CI ByteString, ByteString)] -> W.Response
yarToResponse (YARWai a) _ = a
yarToResponse (YARPlain s hs _ c _) extraHeaders =
yarToResponse :: YesodResponse -> [(CI ByteString, ByteString)] -> W.Response
yarToResponse (YRWai a) _ = a
yarToResponse (YRPlain s hs _ c _) extraHeaders =
go c
where
finalHeaders = extraHeaders ++ map headerToPair hs
@ -862,12 +868,6 @@ yarToResponse (YARPlain s hs _ c _) extraHeaders =
go (ContentSource body) = W.ResponseSource s finalHeaders body
go (ContentDontEvaluate c') = go c'
httpAccept :: W.Request -> [ContentType]
httpAccept = parseHttpAccept
. fromMaybe mempty
. lookup "Accept"
. W.requestHeaders
-- | Convert Header to a key/value pair.
headerToPair :: Header
-> (CI ByteString, ByteString)

View File

@ -44,6 +44,8 @@ module Yesod.Internal.Core
import Yesod.Content
import Yesod.Handler hiding (lift, getExpires)
import Control.Monad.Logger (logErrorS)
import Control.Applicative ((<$>))
import System.Random (newStdGen)
import Yesod.Routes.Class
@ -422,9 +424,10 @@ defaultYesodRunner logger handler' master sub murl toMasterRoute msb req
| W.KnownLength len <- W.requestBodyLength req, maxLen < len = return tooLargeResponse
| otherwise = do
let dontSaveSession _ = return []
let onError _ = error "FIXME: Yesod.Internal.Core.defaultYesodRunner.onError"
(session, saveSession) <- liftIO $ do
maybe (return (Map.empty, dontSaveSession)) (\sb -> sbLoadSession sb master req) msb
rr <- liftIO $ parseWaiRequest req session (isJust msb) maxLen
rr <- liftIO $ parseWaiRequest req session onError (isJust msb) maxLen <$> newStdGen
let h = {-# SCC "h" #-} do
case murl of
Nothing -> handler
@ -448,7 +451,7 @@ defaultYesodRunner logger handler' master sub murl toMasterRoute msb req
yar <- handlerToYAR master sub (fileUpload master) log' toMasterRoute
(yesodRender master ra) errorHandler rr murl sessionMap h
extraHeaders <- case yar of
(YARPlain _ _ ct _ newSess) -> do
(YRPlain _ _ ct _ newSess) -> do
let nsToken = maybe
newSess
(\n -> Map.insert tokenKey (TE.encodeUtf8 n) newSess)
@ -800,7 +803,7 @@ runFakeHandler fakeSessionMap logger master handler = liftIO $ do
ret <- I.newIORef (Left $ InternalError "runFakeHandler: no result")
let handler' = do liftIO . I.writeIORef ret . Right =<< handler
return ()
let YesodApp yapp =
let yapp =
runHandler
handler'
(yesodRender master $ resolveApproot master fakeWaiRequest)
@ -810,15 +813,14 @@ runFakeHandler fakeSessionMap logger master handler = liftIO $ do
master
(fileUpload master)
(messageLoggerSource master $ logger master)
errHandler err =
YesodApp $ \_ _ _ session -> do
errHandler err req = do
liftIO $ I.writeIORef ret (Left err)
return $ YARPlain
return $ YRPlain
H.status500
[]
typePlain
(toContent ("runFakeHandler: errHandler" :: S8.ByteString))
session
(reqSession req)
fakeWaiRequest =
W.Request
{ W.requestMethod = "POST"
@ -839,15 +841,17 @@ runFakeHandler fakeSessionMap logger master handler = liftIO $ do
#endif
}
fakeRequest =
Request
YesodRequest
{ reqGetParams = []
, reqCookies = []
, reqWaiRequest = fakeWaiRequest
, reqLangs = []
, reqToken = Just "NaN" -- not a nonce =)
, reqOnError = errHandler
, reqAccept = []
, reqSession = fakeSessionMap
}
fakeContentType = []
_ <- runResourceT $ yapp errHandler fakeRequest fakeContentType fakeSessionMap
_ <- runResourceT $ yapp fakeRequest
I.readIORef ret
{-# WARNING runFakeHandler "Usually you should *not* use runFakeHandler unless you really understand how it works and why you need it." #-}

View File

@ -2,7 +2,6 @@
{-# LANGUAGE CPP #-}
module Yesod.Internal.Request
( parseWaiRequest
, Request (..)
, RequestBodyContents
, FileInfo
, fileName
@ -16,21 +15,18 @@ module Yesod.Internal.Request
, tooLargeResponse
-- The below are exported for testing.
, randomString
, parseWaiRequest'
) where
import Control.Applicative ((<$>))
import Control.Arrow (second)
import qualified Network.Wai.Parse as NWP
import Yesod.Internal
import qualified Network.Wai as W
import System.Random (RandomGen, newStdGen, randomRs)
import System.Random (RandomGen, randomRs)
import Web.Cookie (parseCookiesText)
import Data.ByteString (ByteString)
import qualified Data.ByteString.Char8 as S8
import Data.Text (Text, pack)
import Network.HTTP.Types (queryToQueryText, Status (Status))
import Control.Monad (join)
import Data.Maybe (fromMaybe, catMaybes)
import qualified Data.ByteString.Lazy as L
import qualified Data.Set as Set
@ -46,14 +42,6 @@ import Control.Exception (throwIO)
import Yesod.Core.Types
import qualified Data.Map as Map
parseWaiRequest :: W.Request
-> SessionMap
-> Bool
-> Word64 -- ^ maximum allowed body size
-> IO Request
parseWaiRequest env session' useToken maxBodySize =
parseWaiRequest' env session' useToken maxBodySize <$> newStdGen
-- | Impose a limit on the size of the request body.
limitRequestBody :: Word64 -> W.Request -> W.Request
limitRequestBody maxLen req =
@ -79,29 +67,40 @@ tooLargeResponse = W.responseLBS
[("Content-Type", "text/plain")]
"Request body too large to be processed."
parseWaiRequest' :: RandomGen g
=> W.Request
-> SessionMap
-> Bool
-> Word64 -- ^ max body size
-> g
-> Request
parseWaiRequest' env session' useToken maxBodySize gen =
Request gets'' cookies' (limitRequestBody maxBodySize env) langs'' token
parseWaiRequest :: RandomGen g
=> W.Request
-> SessionMap
-> (ErrorResponse -> YesodApp)
-> Bool
-> Word64 -- ^ max body size
-> g
-> YesodRequest
parseWaiRequest env session onError useToken maxBodySize gen =
YesodRequest
{ reqGetParams = gets
, reqCookies = cookies
, reqWaiRequest = limitRequestBody maxBodySize env
, reqLangs = langs''
, reqToken = token
, reqSession = session
, reqAccept = httpAccept env
, reqOnError = onError
}
where
gets' = queryToQueryText $ W.queryString env
gets'' = map (second $ fromMaybe "") gets'
gets = map (second $ fromMaybe "")
$ queryToQueryText
$ W.queryString env
reqCookie = lookup "Cookie" $ W.requestHeaders env
cookies' = maybe [] parseCookiesText reqCookie
cookies = maybe [] parseCookiesText reqCookie
acceptLang = lookup "Accept-Language" $ W.requestHeaders env
langs = map (pack . S8.unpack) $ maybe [] NWP.parseHttpAccept acceptLang
lookupText k = fmap (decodeUtf8With lenientDecode) . Map.lookup k
-- The language preferences are prioritized as follows:
langs' = catMaybes [ join $ lookup langKey gets' -- Query _LANG
, lookup langKey cookies' -- Cookie _LANG
, lookupText langKey session' -- Session _LANG
langs' = catMaybes [ lookup langKey gets -- Query _LANG
, lookup langKey cookies -- Cookie _LANG
, lookupText langKey session -- Session _LANG
] ++ langs -- Accept-Language(s)
-- Github issue #195. We want to add an extra two-letter version of any
@ -117,7 +116,17 @@ parseWaiRequest' env session' useToken maxBodySize gen =
else Just $ maybe
(pack $ randomString 10 gen)
(decodeUtf8With lenientDecode)
(Map.lookup tokenKey session')
(Map.lookup tokenKey session)
-- | Get the list of accepted content types from the WAI Request\'s Accept
-- header.
--
-- Since 1.2.0
httpAccept :: W.Request -> [ContentType]
httpAccept = NWP.parseHttpAccept
. fromMaybe S8.empty
. lookup "Accept"
. W.requestHeaders
addTwoLetters :: ([Text] -> [Text], Set.Set Text) -> [Text] -> [Text]
addTwoLetters (toAdd, exist) [] =

View File

@ -5,7 +5,7 @@
-- imported by library users.
--
module Yesod.Internal.TestApi
( randomString, parseWaiRequest'
( randomString, parseWaiRequest
) where
import Yesod.Internal.Request (randomString, parseWaiRequest')
import Yesod.Internal.Request (randomString, parseWaiRequest)

View File

@ -15,7 +15,7 @@ module Yesod.Request
(
-- * Request datatype
RequestBodyContents
, Request (..)
, YesodRequest (..)
, FileInfo
, fileName
, fileContentType
@ -41,6 +41,7 @@ import Control.Monad (liftM)
import Control.Monad.Instances () -- I'm missing the instance Monad ((->) r
import Data.Maybe (listToMaybe)
import Data.Text (Text)
import Yesod.Core.Types
-- | Get the list of supported languages supplied by the user.
--

View File

@ -5,7 +5,7 @@ module YesodCoreTest.CleanPath (cleanPathTest, Widget) where
import Test.Hspec
import Yesod.Core hiding (Request)
import Yesod.Core
import Network.Wai
import Network.Wai.Test

View File

@ -5,7 +5,7 @@ module YesodCoreTest.Exceptions (exceptionsTest, Widget) where
import Test.Hspec
import Yesod.Core hiding (Request)
import Yesod.Core
import Network.Wai
import Network.Wai.Test
import Network.HTTP.Types (status301)

View File

@ -6,8 +6,8 @@ import System.Random (StdGen, mkStdGen)
import Network.Wai as W
import Network.Wai.Test
import Yesod.Internal.TestApi (randomString, parseWaiRequest')
import Yesod.Request (Request (..))
import Yesod.Internal.TestApi (randomString, parseWaiRequest)
import Yesod.Request (YesodRequest (..))
import Test.Hspec
import Data.Monoid (mempty)
import Data.Map (singleton)
@ -40,19 +40,19 @@ tokenSpecs = describe "Yesod.Internal.Request.parseWaiRequest (reqToken)" $ do
noDisabledToken :: Bool
noDisabledToken = reqToken r == Nothing where
r = parseWaiRequest' defaultRequest mempty False 1000 g
r = parseWaiRequest defaultRequest mempty onError False 1000 g
ignoreDisabledToken :: Bool
ignoreDisabledToken = reqToken r == Nothing where
r = parseWaiRequest' defaultRequest (singleton "_TOKEN" "old") False 1000 g
r = parseWaiRequest defaultRequest (singleton "_TOKEN" "old") onError False 1000 g
useOldToken :: Bool
useOldToken = reqToken r == Just "old" where
r = parseWaiRequest' defaultRequest (singleton "_TOKEN" "old") True 1000 g
r = parseWaiRequest defaultRequest (singleton "_TOKEN" "old") onError True 1000 g
generateToken :: Bool
generateToken = reqToken r /= Nothing where
r = parseWaiRequest' defaultRequest (singleton "_TOKEN" "old") True 1000 g
r = parseWaiRequest defaultRequest (singleton "_TOKEN" "old") onError True 1000 g
langSpecs :: Spec
@ -65,32 +65,34 @@ langSpecs = describe "Yesod.Internal.Request.parseWaiRequest (reqLangs)" $ do
respectAcceptLangs :: Bool
respectAcceptLangs = reqLangs r == ["en-US", "es", "en"] where
r = parseWaiRequest' defaultRequest
{ requestHeaders = [("Accept-Language", "en-US, es")] } mempty False 1000 g
r = parseWaiRequest defaultRequest
{ requestHeaders = [("Accept-Language", "en-US, es")] } mempty onError False 1000 g
respectSessionLang :: Bool
respectSessionLang = reqLangs r == ["en"] where
r = parseWaiRequest' defaultRequest (singleton "_LANG" "en") False 1000 g
r = parseWaiRequest defaultRequest (singleton "_LANG" "en") onError False 1000 g
respectCookieLang :: Bool
respectCookieLang = reqLangs r == ["en"] where
r = parseWaiRequest' defaultRequest
r = parseWaiRequest defaultRequest
{ requestHeaders = [("Cookie", "_LANG=en")]
} mempty False 1000 g
} mempty onError False 1000 g
respectQueryLang :: Bool
respectQueryLang = reqLangs r == ["en-US", "en"] where
r = parseWaiRequest' defaultRequest { queryString = [("_LANG", Just "en-US")] } mempty False 1000 g
r = parseWaiRequest defaultRequest { queryString = [("_LANG", Just "en-US")] } mempty onError False 1000 g
prioritizeLangs :: Bool
prioritizeLangs = reqLangs r == ["en-QUERY", "en-COOKIE", "en-SESSION", "en", "es"] where
r = parseWaiRequest' defaultRequest
r = parseWaiRequest defaultRequest
{ requestHeaders = [ ("Accept-Language", "en, es")
, ("Cookie", "_LANG=en-COOKIE")
]
, queryString = [("_LANG", Just "en-QUERY")]
} (singleton "_LANG" "en-SESSION") False 10000 g
} (singleton "_LANG" "en-SESSION") onError False 10000 g
onError :: a
onError = error "Yesod.InternalRequest.onError"
internalRequestTest :: Spec
internalRequestTest = describe "Test.InternalRequestTest" $ do

View File

@ -8,7 +8,7 @@ import YesodCoreTest.JsLoaderSites.Bottom (B(..))
import Test.Hspec
import Yesod.Core hiding (Request)
import Yesod.Core
import Network.Wai.Test
data H = H

View File

@ -5,7 +5,7 @@ module YesodCoreTest.Links (linksTest, Widget) where
import Test.Hspec
import Yesod.Core hiding (Request)
import Yesod.Core
import Text.Hamlet
import Network.Wai
import Network.Wai.Test

View File

@ -5,7 +5,7 @@
module YesodCoreTest.Media (mediaTest, Widget) where
import Test.Hspec
import Yesod.Core hiding (Request)
import Yesod.Core
import Network.Wai
import Network.Wai.Test
import Text.Lucius

View File

@ -4,7 +4,7 @@ module YesodCoreTest.NoOverloadedStrings (noOverloadedTest, Widget) where
import Test.Hspec
import Yesod.Core hiding (Request)
import Yesod.Core
import Network.Wai.Test
import Data.Monoid (mempty)

View File

@ -5,7 +5,7 @@ module YesodCoreTest.RequestBodySize (specs, Widget) where
import Test.Hspec
import Yesod.Core hiding (Request)
import Yesod.Core
import Network.Wai
import Network.Wai.Test

View File

@ -5,7 +5,7 @@ module YesodCoreTest.Widget (widgetTest) where
import Test.Hspec
import Yesod.Core hiding (Request)
import Yesod.Core
import Text.Julius
import Text.Lucius
import Text.Hamlet

View File

@ -9,7 +9,7 @@ module YesodCoreTest.YesodTest
, module Test.Hspec
) where
import Yesod.Core hiding (Request)
import Yesod.Core
import Network.Wai.Test
import Network.Wai
import Test.Hspec