Initial YesodRequest/YesodRespnse change

yesod-core/Yesod/Core/Types.hs

@@ -86,17 +86,37 @@ data ClientSessionDateCache =
   , csdcExpiresSerialized :: !ByteString
   } deriving (Eq, Show)
 
--- | The parsed request information.
+-- | The parsed request information. This type augments the standard WAI
-data Request = Request
+-- 'W.Request' with additional information.
-    { reqGetParams  :: [(Text, Text)]
+data YesodRequest = YesodRequest
-    , reqCookies    :: [(Text, Text)]
+    { reqGetParams  :: ![(Text, Text)]
-    , reqWaiRequest :: W.Request
+      -- ^ Same as 'W.queryString', but decoded to @Text@.
-      -- | Languages which the client supports.
+    , reqCookies    :: ![(Text, Text)]
-    , reqLangs      :: [Text]
+    , reqWaiRequest :: !W.Request
-      -- | A random, session-specific token used to prevent CSRF attacks.
+    , reqLangs      :: ![Text]
-    , reqToken      :: Maybe 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
+type YesodApp = YesodRequest -> ResourceT IO YesodResponse
-    { unYesodApp
-    :: (ErrorResponse -> YesodApp)
-    -> Request
-    -> [ContentType]
-    -> SessionMap
-    -> ResourceT IO YesodAppResult
-    }
-
-data YesodAppResult
-    = YARWai W.Response
-    | YARPlain H.Status [Header] ContentType Content SessionMap
 
 -- | A generic widget, allowing specification of both the subsite and master
 -- site datatypes. While this is simply a @WriterT@, we define a newtype for

yesod-core/Yesod/Handler.hs

@@ -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' =
+runHandler handler mrender sroute tomr master sub upload log' req = do
-  YesodApp $ \eh rr cts initSession -> 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
+                     in return $ YRPlain (getStatus e) hs' ct c sess
-                YARWai _ -> return yar
+                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 :: YesodResponse -> [(CI ByteString, ByteString)] -> W.Response
-yarToResponse (YARWai a) _ = a
+yarToResponse (YRWai a) _ = a
-yarToResponse (YARPlain s hs _ c _) extraHeaders =
+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)

yesod-core/Yesod/Internal/Core.hs

@@ -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 =
+      errHandler err req = do
-        YesodApp $ \_ _ _ session -> 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 fakeRequest
-  _ <- runResourceT $ yapp errHandler fakeRequest fakeContentType fakeSessionMap
   I.readIORef ret
 {-# WARNING runFakeHandler "Usually you should *not* use runFakeHandler unless you really understand how it works and why you need it." #-}
 

yesod-core/Yesod/Internal/Request.hs

@@ -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
+parseWaiRequest :: RandomGen g
-                 => W.Request
+                => W.Request
-                 -> SessionMap
+                -> SessionMap
-                 -> Bool
+                -> (ErrorResponse -> YesodApp)
-                 -> Word64 -- ^ max body size
+                -> Bool
-                 -> g
+                -> Word64 -- ^ max body size
-                 -> Request
+                -> g
-parseWaiRequest' env session' useToken maxBodySize gen =
+                -> YesodRequest
-    Request gets'' cookies' (limitRequestBody maxBodySize env) langs'' token
+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'' = map (second $ fromMaybe "") gets'
+         $ 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
+    langs' = catMaybes [ lookup langKey gets -- Query _LANG
-                       , lookup langKey cookies'     -- Cookie _LANG
+                       , lookup langKey cookies     -- Cookie _LANG
-                       , lookupText langKey session' -- Session _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) [] =

yesod-core/Yesod/Internal/TestApi.hs

@@ -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)

yesod-core/Yesod/Request.hs

@@ -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.
 --

yesod-core/test/YesodCoreTest/CleanPath.hs

@@ -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

yesod-core/test/YesodCoreTest/Exceptions.hs

@@ -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)

yesod-core/test/YesodCoreTest/InternalRequest.hs

@@ -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.Internal.TestApi (randomString, parseWaiRequest)
-import Yesod.Request (Request (..))
+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
+  r = parseWaiRequest defaultRequest
-        { requestHeaders = [("Accept-Language", "en-US, es")] } mempty False 1000 g
+        { 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

yesod-core/test/YesodCoreTest/JsLoader.hs

@@ -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

yesod-core/test/YesodCoreTest/Links.hs

@@ -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

yesod-core/test/YesodCoreTest/Media.hs

@@ -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

yesod-core/test/YesodCoreTest/NoOverloadedStrings.hs

@@ -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)
 

yesod-core/test/YesodCoreTest/RequestBodySize.hs

@@ -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

yesod-core/test/YesodCoreTest/Widget.hs

@@ -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

yesod-core/test/YesodCoreTest/YesodTest.hs

@@ -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